our
$VERSION
=
'0.03'
;
sub
encoding {
'euc-jp'
}
sub
gen_conf {
my
$self
=
shift
;
my
$conf
=
shift
;
my
$url
=
$conf
->{url};
my
(
$host
,
$bbs
,
$key
);
if
(
$url
=~ m|^http://jbbs\.livedoor\.jp/bbs/
read
.cgi/([^/]+)/([^/]+)/(\d+)/|i) {
(
$host
,
$bbs
,
$key
) = ($1, $2, $3);
}
elsif
(
$url
=~ m|^http://jbbs\.livedoor\.jp/([^/]+)/([^/]+)/|i) {
(
$host
,
$bbs
) = ($1, $2);
}
else
{
die
'url format error.'
;
}
$self
->config(+{
host
=>
$host
,
domain
=>
'jbbs.livedoor.jp'
,
bbs
=>
$bbs
,
key
=>
$key
,
local_path
=>
"jbbs.livedoor.jp/$host/$bbs/"
,
});
$self
->config;
}
sub
daturl {
my
(
$self
,
$key
) =
@_
;
'http://'
.
$self
->config->{domain} .
'/bbs/rawmode.cgi/'
.
$self
->config->{host} .
'/'
.
$self
->config->{bbs} .
"/$key/"
;
}
sub
permalink {
my
(
$self
,
$key
,
$resid
) =
@_
;
if
(
$key
) {
if
(
$resid
) {
return
'http://'
.
$self
->config->{domain} .
'/bbs/read.cgi/'
.
$self
->config->{host} .
'/'
.
$self
->config->{bbs} .
"/$key/$resid"
;
}
else
{
return
'http://'
.
$self
->config->{domain} .
'/bbs/read.cgi/'
.
$self
->config->{host} .
'/'
.
$self
->config->{bbs} .
"/$key/"
;
}
}
else
{
return
$self
->config->{setting};
}
}
sub
get_dat {
my
(
$self
,
$c
) =
@_
;
my
$res
=
$c
->c->ua->diff_request(
$c
->url);
return
unless
$res
->is_success;
my
$data
=
$res
->content;
$c
->set_cache(
$data
,
$res
);
$data
;
}
sub
parse_setting {
my
(
$self
,
$data
) =
@_
;
my
$config
;
$data
=~ m|<title>(.*?)</title>|;
$config
->{title} = $1;
$config
;
}
sub
parse_subject {
my
(
$self
,
$data
) =
@_
;
my
@subject
;
foreach
(
split
(/\n/,
$data
)) {
/^(\d+).cgi,(.+?)\((\d+)\)$/;
push
(
@subject
, +{
key
=> $1,
title
=> $2,
resnum
=> $3,
});
}
return
\
@subject
;
}
sub
parse_dat {
my
(
$self
,
$data
) =
@_
;
my
@dat
;
foreach
(
split
(/\n/,
$data
)) {
if
(/^(.*?)<>(.*?)<>(.*?)<>(.*?)<>(.*?)<>(.*?)<>(.*?)$/i) {
my
$res
={
resid
=> $1,
name
=> $2,
mail
=> $3,
date
=> $4,
body
=> $5,
id
=> $7,
};
my
$date
=
$self
->parse_date(
$res
->{date});
$res
->{
$_
} =
$date
->{
$_
}
foreach
(
keys
%{
$date
});
push
(
@dat
,
$res
);
}
}
return
\
@dat
;
}
sub
parse_date {
my
(
$self
,
$data
) =
@_
;
my
$ret
= {
time
=>
time
,
};
my
(
$y
,
$m
,
$d
,
$h
,
$i
,
$s
) = (0, 0, 0, 0, 0, 0);
if
(
$data
=~ m|(\d+)/(\d+)/(\d+)|) {
(
$y
,
$m
,
$d
) = ($1, $2, $3);
if
(
$data
=~ m| (\d+):(\d+):(\d+)|) {
(
$h
,
$i
,
$s
) = ($1, $2, $3);
}
elsif
(
$data
=~ m| (\d+):(\d+)|) {
(
$h
,
$i
,
$s
) = ($1, $2, 0);
}
$y
+= 2000
if
$y
< 10;
$y
-= 1900;
$m
--;
$ret
->{
time
} = mktime(
$s
,
$i
,
$h
,
$d
,
$m
,
$y
);
}
$ret
;
}
1;