package WWW::Mixi; use strict; use Carp (); use vars qw($VERSION @ISA); $VERSION = sprintf("%d.%02d", q$Revision: 0.42$ =~ /(\d+)\.(\d+)/); require LWP::RobotUA; @ISA = qw(LWP::RobotUA); require HTTP::Request; require HTTP::Response; use LWP::Debug (); use HTTP::Cookies; use HTTP::Request::Common; sub new { my ($class, $email, $password, %opt) = @_; my $base = 'http://mixi.jp/'; # オプションの処理 Carp::croak('WWW::Mixi mail address required') unless $email; # Carp::croak('WWW::Mixi password required') unless $password; # オブジェクトの生成 my $name = "WWW::Mixi/" . $VERSION; my $rules = WWW::Mixi::RobotRules->new($name); my $self = LWP::RobotUA->new($name, $email, $rules); $self = bless $self, $class; $self->from($email); $self->delay(1/60); # 独自変数の設定 $self->{'mixi'} = { 'base' => $base, 'email' => $email, 'password' => $password, 'response' => undef, 'log' => $opt{'-log'} ? $opt{'-log'} : \&callback_log, 'abort' => $opt{'-abort'} ? $opt{'-abort'} : \&callback_abort, 'rewrite' => $opt{'-rewrite'} ? $opt{'-rewrite'} : \&callback_rewrite, }; return $self; } sub login { my $self = shift; my $page = 'login.pl'; my $next = ($self->{'mixi'}->{'next_url'}) ? $self->{'mixi'}->{'next_url'} : '/home.pl'; my $password = (@_) ? shift : $self->{'mixi'}->{'password'}; return undef unless (defined($password) and length($password)); my %form = ( 'email' => $self->{'mixi'}->{'email'}, 'password' => $password, 'next_url' => $self->absolute_url($next), ); $self->enable_cookies; # ログイン $self->log("[info] 再ログインします。\n") if ($self->session); my $res = $self->post($page, %form); $self->{'mixi'}->{'refresh'} = ($res->is_success and $res->headers->header('refresh') =~ /url=([^ ;]+)/) ? $self->absolute_url($1) : undef; $self->{'mixi'}->{'password'} = $password if ($res->is_success); return $res; } sub is_logined { my $self = shift; return ($self->session and $self->stamp) ? 1 : 0; } sub is_login_required { my $self = shift; my $res = (@_) ? shift : $self->{'mixi'}->{'response'}; if (not $res) { return "ページを取得できていません。"; } elsif (not $res->is_success) { return sprintf('ページ取得に失敗しました。（%s）', $res->message); } else { my $re_attr = '(?:"[^"]+"|\'[^\']+\'|[^\s<>]+)\s+'; my $content = $res->content; return 0 if ($content !~ /
]+)/); return 0 if ($self->absolute_url($1) ne $self->absolute_url('login.pl')); $self->{'mixi'}->{'next_url'} = ($content =~ //) ? $1 : '/home.pl'; return "Login Failed ($1)" if ($content =~ /(.*?)<\/font><\/b>/); return 'Login Required'; } return 0; } sub session { my $self = shift; if (@_) { my $session = shift; $self->enable_cookies; $self->cookie_jar->set_cookie(undef, 'BF_SESSION', $session, '/', 'mixi.jp', undef, 1, undef, undef, 1); } return undef unless ($self->cookie_jar); return ($self->cookie_jar->as_string =~ /\bSet-Cookie.*?:.*? BF_SESSION=(.*?);/) ? $1 : undef; } sub stamp { my $self = shift; if (@_) { my $stamp = shift; $self->enable_cookies; $self->cookie_jar->set_cookie(undef, 'BF_STAMP', $stamp, '/', 'mixi.jp', undef, 1, undef, undef, 1); } return undef unless ($self->cookie_jar); return ($self->cookie_jar->as_string =~ /\bSet-Cookie.*?:.*? BF_STAMP=(.*?);/) ? $1 : undef; } sub refresh { return $_[0]->{'mixi'}->{'refresh'}; } sub request { my $self = shift; my @args = @_; my $res = $self->SUPER::request(@args); if ($res->is_success) { # check contents existence if ($res->content and $res->content =~ /^\Qデータはありません。\E/) { $res->code(400); $res->message('No Data'); # check rejcted by too frequent requests. } elsif ($res->content and $res->content =~ /^\Q間隔を空けない連続的なページの遷移・更新を頻繁におこなわれている\E/) { $res->code(503); $res->message('Too frequently requests'); # check rejcted since content is closed. } elsif ($res->content and $res->content =~ /^\Qアクセスできません\E/) { $res->code(403); $res->message('Closed content'); # check login form existence } elsif (my $message = $self->is_login_required($res)) { $res->code(401); $res->message($message); } } # store and return response $self->{'mixi'}->{'response'} = $res; return $res; } sub get { my $self = shift; my $url = shift; $url = $self->absolute_url($url); $self->log("[info] GETメソッドで\"${url}\"を取得します。\n"); # 取得 my $res = $self->request(HTTP::Request->new('GET', $url)); $self->log("[info] リクエストが処理されました。\n"); return $res; } sub post { my $self = shift; my $url = shift; $url = $self->absolute_url($url); $self->log("[info] POSTメソッドで\"${url}\"を取得します。\n"); # リクエストの生成 my @form = @_; my $req = (grep {ref($_) eq 'ARRAY'} @form) ? &HTTP::Request::Common::POST($url, Content_Type => 'form-data', Content => [@form]) : &HTTP::Request::Common::POST($url, [@form]); $self->log("[info] リクエストが生成されました。\n"); # 取得 my $res = $self->request($req); $self->log("[info] リクエストが処理されました。\n"); return $res; } sub response { my $self = shift; return $self->{'mixi'}->{'response'}; } sub parse_main_menu { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /(.*?)<\/map>/s) { $content = $1; while ($content =~ s/]*?) .*?href=([^\s<>]*?)>//) { my $item = { 'link' => $self->absolute_url($2, $base), 'subject' => $self->rewrite($1) }; push(@items, $item); } } return @items; } sub parse_banner { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); while ($content =~ s/ ]*).*?>]*?)['"]? border=0 width=468 height=60 alt=["']?([^<>]*?)['"]?><\/a>//is) { my ($link, $image, $subject) = ($1, $2, $3); $link = $1 if ($link =~ /^"(.*?)"$/ or /^'(.*?)'$/); $link = $self->absolute_url($link, $base); $image = $self->absolute_url($image, $base); $subject = $self->rewrite($subject); my $item = { 'link' => $link, 'image' => $image, 'subject' => $subject }; push(@items, $item); } return @items; } sub parse_tool_bar { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /<\/td>(.*?)<\/td>/s) { $content = $1; while ($content =~ s/ ]*?) .*?> ]*?) .*?><\/a>//) { my $item = { 'link' => $self->absolute_url($1, $base), 'subject' => $self->rewrite($2) }; push(@items, $item); } } return @items; } sub parse_information { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /]+ ALT=お知らせ VSPACE=1 WIDTH=100 HEIGHT=37>.*?(.*?)<\/table>/is) { $content = $1; $content =~ s/[\r\n]+//gs; $content =~ s///g; while ($content =~ s/
(.*?)<\/td>(.*?)<\/td>(.*?)<\/td><\/tr>//i) { my ($subject, $linker) = ($1, $3); my $re_attr_val = '(?:"[^"]+"|\'[^\']+\'|[^\s<>]+)\s*'; my $style = {}; $subject =~ s/^.*?・<\/font>(?: | )//; while ($subject =~ s/^\s*<([^<>]*)>\s*//) { my $tag = lc($1); my ($tag_part, $attr_part) = split(/\s+/, $tag, 2); $style->{'font-weight'} = 'bold' if ($tag_part eq 'b'); while ($attr_part =~ s/([^\s<>=]+)(?:=($re_attr_val))?//) { my ($attr, $val) = ($1, $2); $val =~ s/^"(.*)"$/$1/ or $val =~ s/^'(.*)'$/$1/; $val = $self->unescape($val); if ($attr eq 'style') { $style->{$1} = $2 while ($val =~ s/([^\s:]+)\s*:\s*([^\s:]+)//); } elsif ($attr eq 'color') { $style->{'color'} = $val; } } } $subject =~ s/\s*<.*?>\s*//g; my ($link, $description) = ($1, $2) if ($linker =~ /(.*?)<\/a>/i); my $item = { 'subject' => $self->rewrite($subject), 'style' => $style, 'link' => $self->absolute_url($link, $base), 'description' => $self->rewrite($description) }; push(@items, $item); } } return @items; } sub parse_home_new_album { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /マイミクシィ最新アルバム(.*?)/s) { $content = $1; while ($content =~ s/(\d{2})月(\d{2})日.*?(.*?)<\/a>.*?\((.+?)\)
//is) { my ($date, $link, $subj, $name) = ((sprintf('%02d/%02d', $1, $2)), $3, $4, $5); $subj = $self->rewrite($subj); $name = $self->rewrite($name); $link = $self->absolute_url($link, $base); push(@items, {'time' => $date, 'link' => $link, 'subject' => $subj, 'name' => $name}); } } return @items; } sub parse_home_new_bbs { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /コミュニティ最新書き込み(.*?)
/s) { $content = $1; while ($content =~ s/(\d{2})月(\d{2})日.*?(.*?)<\/a>.*?\((.+?)\)
//is) { my ($date, $link, $subj, $name) = ((sprintf('%02d/%02d', $1, $2)), $3, $4, $5); $subj = $self->rewrite($subj); $name = $self->rewrite($name); $link = $self->absolute_url($link, $base); push(@items, {'time' => $date, 'link' => $link, 'subject' => $subj, 'name' => $name}); } } return @items; } sub parse_home_new_comment { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /日記コメント記入履歴(.*?)
/s) { $content = $1; while ($content =~ s/(\d{2})月(\d{2})日.*?(.*?)<\/a>.*?\((.+?)\)
//is) { my ($date, $link, $subj, $name) = ((sprintf('%02d/%02d', $1, $2)), $3, $4, $5); $subj = $self->rewrite($subj); $name = $self->rewrite($name); $link = $self->absolute_url($link, $base); push(@items, {'time' => $date, 'link' => $link, 'subject' => $subj, 'name' => $name}); } } return @items; } sub parse_home_new_friend_diary { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /
マイミクシィ最新日記<\/font>.*?<\/td>(.*?)/s) { $content = $1; while ($content =~ s/(\d{2})月(\d{2})日.*?(.*?)<\/a>.*?\((.+?)\)
//is) { my ($date, $link, $subj, $name) = ((sprintf('%02d/%02d', $1, $2)), $3, $4, $5); $subj = $self->rewrite($subj); $name = $self->rewrite($name); $link = $self->absolute_url($link, $base); push(@items, {'time' => $date, 'link' => $link, 'subject' => $subj, 'name' => $name}); } } return @items; } sub parse_home_new_review { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /マイミクシィ最新レビュー(.*?)
/s) { $content = $1; while ($content =~ s/(\d{2})月(\d{2})日.*?(.*?)<\/a>.*?\((.+?)\)
//is) { my ($date, $link, $subj, $name) = ((sprintf('%02d/%02d', $1, $2)), $3, $4, $5); $subj = $self->rewrite($subj); $name = $self->rewrite($name); $link = $self->absolute_url($link, $base); push(@items, {'time' => $date, 'link' => $link, 'subject' => $subj, 'name' => $name}); } } return @items; } sub parse_ajax_new_diary { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = q{(\d{1,2})月(\d{1,2})日}; my $re_link = q{(]+)*>)(.*?)<\/a>}; my $re_name = q{\((.*?)\)}; my @today = reverse((localtime)[3..5]); $today[0] += 1900; $today[1] += 1; foreach my $row ($content =~ /
(.*?)<\/div>/isg) { next unless ($row =~ /$re_date … $re_link/); my $item = {}; my @date = (undef, $1, $2); $item->{'link'} = $self->absolute_url($self->parse_standard_anchor($3), $base); $item->{'subject'} = (defined($4) and length($4)) ? $self->rewrite($4) : '(削除)'; $date[0] = ($date[1] > $today[1]) ? $today[0] - 1 : $today[0] if (not defined($date[0])); $item->{'time'} = sprintf('%04d/%02d/%02d', @date); map { $item->{$_} =~ s/^\s+|\s+$//gs } (keys(%{$item})); push(@items, $item); } return @items; } sub parse_community_id { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my $item; if ($content =~ /view_community.pl\?id=(\d+) /) { $item = $1; } return $item; } sub parse_list_bbs { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '
'; my $re_subj = ''; my $re_desc = ''; my $re_name = '\((.*?)\)'; my $re_link = '書き込み\((\d+)\)<\/a>'; if ($content =~ /
(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})		 (.+?)(.*?)\n
(.+)<\/table>/s) { $content = $1 ; while ($content =~ s/.*?${re_date}.*?${re_subj}(.*?)${re_desc}.*?${re_link}.*?<\/tr>//is) { my $time = sprintf('%02d/%02d %02d:%02d', $1, $2, $3, $4); my ($subj, $thumbs, $desc, $link, $count) = ($5, $6, $7, $8, $9); $subj = $self->rewrite($subj); $desc = $self->rewrite($desc); $desc =~ s/^$//g; $link = $self->absolute_url($link, $base); my @images = (); while ($thumbs =~ s/MM_openBrWindow\('(.*?)',.+?]*?)['"]? border//is){ my $img = $self->absolute_url($1, $base); my $thumbimg = $self->absolute_url($2, $base); push(@images, {'thumb_link' => $thumbimg, 'link' => $img}); } push(@items, {'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $link, 'count' => $count, 'images' => [@images]}); } } return @items; } sub parse_list_bbs_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /
.*?]*?list_bbs.pl[^<>]*?)>([^<>]*?)<\/a><\/td>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_bbs_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /]*?list_bbs.pl[^<>]*?)>([^<>]*?)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_bookmark { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /(.+?)]*?>/s) { $content = $1; while ($content =~ s/
(.*?)<\/table>//is) { my $record = $1; my @lines = ($record =~ /(.*?)<\/tr>/gis); my $item = {}; # parse record ($item->{'link'}, $item->{'image'}) = ($1, $2) if ($lines[0] =~ /
/is); ($item->{'subject'}, $item->{'gender'}) = ($1, $2) if ($lines[0] =~ /(.*?) \((.*?)\)<\/td>/is); $item->{'description'} = $1 if ($lines[1] =~ /(.*?)<\/td>/is); $item->{'time'} = $1 if ($lines[2] =~ /(.*?)<\/td>/is); # format foreach (qw(image link)) { $item->{$_} = $self->absolute_url($item->{$_}, $base) if ($item->{$_}); } foreach (qw(subject description gender)) { $item->{$_} = $self->rewrite($item->{$_}); } $item->{'time'} = $self->convert_login_time($item->{'time'}) if ($item->{'time'}); push(@items, $item) if ($item->{'subject'} and $item->{'link'}); } } @items = sort { $b->{'time'} cmp $a->{'time'} } @items; return @items; } sub parse_list_comment { my $self = shift; return $self->parse_standard_history(@_); } sub parse_list_community { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $status_backgrounds = { 'http://img.mixi.jp/img/bg_orange1-.gif' => '管理者', }; if ($content =~ /(.+?)<\/table>/s) { $content = $1; while ($content =~ s/(.*?)(.*?)<\/tr>//is) { my ($image_part, $text_part) = ($1, $2); my @images = ($image_part =~ /
.*?<\/td>/gi); my @texts = ($text_part =~ /(.*?)<\/td>/gi); for (my $i = 0; $i < @images or $i < @texts; $i++) { my $item = {}; my ($image, $text) = ($images[$i], $texts[$i]); ($item->{'subject'}, $item->{'count'}) = ($1, $2) if ($text =~ /^\s*(.*?)\((\d+)\)\s*$/); ($item->{'background'}, $item->{'link'}, $item->{'image'}) = ($1, $2, $3) if ($image =~ / ]*).*?><\/a>/); if ($item->{'link'}) { $item->{'subject'} = $self->rewrite($item->{'subject'}); $item->{'link'} = $self->absolute_url($item->{'link'}, $base); $item->{'image'} = $self->absolute_url($item->{'image'}, $base); $item->{'background'} = $self->absolute_url($item->{'background'}, $base); $item->{'status'} = $status_backgrounds->{$item->{'background'}}; push(@items, $item); } } } } return @items; } sub parse_list_community_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /.*?]*?)>([^<>]*?)<\/a><\/td>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_community_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; return unless ($content =~ /
.*?'; my $re_desc = ''; my $re_name = '\((.*?)\)'; my $re_link = 'コメント\((\d+)\)<\/a>'; if ($content =~ /
([^<>]+)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $previous = {'link' => $link, 'subject' => $2}; return $previous; } sub parse_list_diary { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})'; my $re_subj = '		 (.+?)\n(.*?)\n(.+?)\n
\n\n
(.+)<\/table>/s) { $content = $1 ; while ($content =~ s/.*?${re_date}.*?${re_subj}.*?${re_desc}.*?${re_link}.*?<\/tr>//is) { my $time = sprintf('%02d/%02d %02d:%02d', $1, $2, $3, $4); my ($subj, $thumbs, $desc, $link, $count) = ($5, $6, $7, $8, $9); $subj = $self->rewrite($subj); $desc = $self->rewrite($desc); $desc =~ s/^$//g; $link = $self->absolute_url($link, $base); my @images = (); while ($thumbs =~ s/MM_openBrWindow\('(.*?)',.+?]*?)['"]? border//is){ my $img = $self->absolute_url($1, $base); my $thumbimg = $self->absolute_url($2, $base); push(@images, {'thumb_link' => $thumbimg, 'link' => $img}); } push(@items, {'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $link, 'count' => $count, 'images' => [@images]}); } } return @items; } sub parse_list_diary_capacity { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; return unless ($content =~ /
(.*?)<\/table>/is); my $box = $1; return unless ($box =~ /(\d+\.\d+).*?MB\/.*?(\d+\.\d+).*?MB/); my $capacity = {'used' => $1, 'max' => $2}; return $capacity; } sub parse_list_diary_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /
.*?]*?list_diary.pl[^<>]*?)>([^<>]*?)<\/a><\/td>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_diary_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /]*?list_diary.pl[^<>]*?)>([^<>]*?)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_diary_monthly_menu { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /各月の日記(.+?)<\/table>/is) { $content = $1; $content =~ s/\s+/ /gs; while ($content =~ s/.*?<\/a>//is) { push(@items, {'link' => $self->absolute_url($1, $base), 'year' => $2, 'month' => $3}); } } return @items; } sub parse_list_friend { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $status_backgrounds = { 'http://img.mixi.jp/img/bg_orange1-.gif' => '1時間以内', 'http://img.mixi.jp/img/bg_orange2-.gif' => '1日以内', }; my @time1 = reverse((localtime(time - 3600))[0..5]); my @time2 = reverse((localtime(time - 3600 * 24))[0..5]); if ($content =~ /(.+?)<\/table>/s) { $content = $1 ; while ($content =~ s/(.*?)(.*?)<\/tr>//is) { my ($image_part, $text_part) = ($1, $2); my @images = ($image_part =~ /
.*?<\/td>/gi); my @texts = ($text_part =~ /(.*?)<\/td>/gi); for (my $i = 0; $i < @images or $i < @texts; $i++) { my $item = {}; my ($image, $text) = ($images[$i], $texts[$i]); ($item->{'subject'}, $item->{'count'}) = ($1, $2) if ($text =~ /^\s*(.+?)\((\d+)\)/); ($item->{'background'}, $item->{'link'}, $item->{'image'}) = ($1, $2, $3) if ($image =~ / ]*).*?>(?:.*?)<\/a>/); if ($item->{'link'}) { $item->{'subject'} = $self->rewrite($item->{'subject'}); $item->{'link'} = $self->absolute_url($item->{'link'}, $base); $item->{'id'} = $2 if ($item->{'link'} =~ /(.*?)?id=(\d*)/); $item->{'image'} = $self->absolute_url($item->{'image'}, $base); $item->{'background'} = $self->absolute_url($item->{'background'}, $base); $item->{'status'} = $status_backgrounds->{$item->{'background'}}; push(@items, $item); } } } } return @items; } sub parse_list_friend_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /  ]*?list_friend.pl\?[^<>\s]*page=[^<>\s]*)>((?:(?!<\/a>).)*)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_friend_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; return unless ($content =~ /\s]*list_friend.pl\?[^<>\s]*page=[^<>\s]*)>((?:(?!<\/a>).)*)<\/a>  /); my $subject = $2; my $link = $self->absolute_url($1, $base); my $previous = {'link' => $link, 'subject' => $2}; return $previous; } sub parse_list_member { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /(.+?)<\/table>/s) { $content = $1 ; while ($content =~ s/(.*?)(.*?)<\/tr>//is) { my ($image_part, $text_part) = ($1, $2); my @images = ($image_part =~ /
.*?<\/td>/gi); my @texts = ($text_part =~ /(.*?)<\/td>/gi); for (my $i = 0; $i < @images or $i < @texts; $i++) { my $item = {}; my ($image, $text) = ($images[$i], $texts[$i]); ($item->{'subject'}, $item->{'count'}) = ($1, $2) if ($text =~ /^\s*(.+?)\((\d+)\)/); ($item->{'background'}, $item->{'link'}, $item->{'image'}) = ($1, $2, $3) if ($image =~ / ]*).*?><\/a>/i); if ($item->{'link'}) { $item->{'subject'} = $self->rewrite($item->{'subject'}); $item->{'link'} = $self->absolute_url($item->{'link'}, $base); $item->{'id'} = $2 if ($item->{'link'} =~ /(.*?)?id=(\d*)/); $item->{'image'} = $self->absolute_url($item->{'image'}, $base); $item->{'background'} = $self->absolute_url($item->{'background'}, $base); push(@items, $item); } } } } return @items; } sub parse_list_member_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /  ]*?list_member.pl\?[^<>\s]*page=[^<>\s]*)>((?:(?!<\/a>).)*)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_list_member_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; return unless ($content =~ /\s]*list_member.pl\?[^<>\s]*page=[^<>\s]*)>((?:(?!<\/a>).)*)<\/a>  /); my $subject = $2; my $link = $self->absolute_url($1, $base); my $previous = {'link' => $link, 'subject' => $2}; return $previous; } sub parse_list_message { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; my @items = (); my $img_rep = $self->absolute_url('img/mail5.gif', $base); my %emvelopes = ( $self->absolute_url('img/mail1.gif', $base) => 'new', $self->absolute_url('img/mail2.gif', $base) => 'opened', $self->absolute_url('img/mail5.gif', $base) => 'replied', ); my $re_link = '(.+?)<\/a>'; if ($content =~ /.*?(.+?)<\/table>/s) { $content = $1; while ($content =~ s/(.*?)<\/tr>//s) { my $message = $2; my $emvelope = ($message =~ s/]*>\s*\s*<\/td>//s) ? $self->absolute_url($1, $base) : undef; my $status = $emvelopes{$emvelope} ? $emvelopes{$emvelope} : 'unknown'; if ($message =~ /
([^<>]*?)<\/td>\s*${re_link}<\/td>\s*(\d{2})月(\d{2})日<\/td>/is) { my ($name, $link, $subj) = ($1, $2, $3); my $time = sprintf('%02d/%02d', $4, $5); my $item = { 'time' => $time, 'subject' => $self->rewrite($subj), 'name' => $self->rewrite($name), 'link' => $self->absolute_url($link, $base), 'status' => $status, 'emvelope' => $emvelope, }; push(@items, $item); } } } return @items; } sub parse_list_outbox { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; my @items = (); my $re_link = '(.+?)<\/a>'; if ($content =~ /.*?(.+?)<\/table>/s) { $content = $1; while ($content =~ s/(.*?)<\/tr>//s) { my $message = $2; if ($message =~ /
([^<>]*?)<\/td>\s*${re_link}<\/td>\s*(\d{2})月(\d{2})日<\/td>/is) { my ($name, $link, $subj) = ($1, $2, $3); my $time = sprintf('%02d/%02d', $4, $5); my $item = { 'time' => $time, 'subject' => $self->rewrite($subj), 'name' => $self->rewrite($name), 'link' => $self->absolute_url($link, $base), }; push(@items, $item); } } } return @items; } sub parse_list_request { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /(.+?)
/s) { $content = $1; while ($content =~ s/
(.*?)<\/table>//is) { my $record = $1; my @lines = ($record =~ /(.*?)<\/tr>/gis); my $item = {}; # parse record ($item->{'link'}, $item->{'image'}) = ($1, $2) if ($lines[0] =~ /'; my $re_desc = ''; if ($content =~ /新機能リリース・障害のご報告(.*?)/s) { $content = $1; while ($content =~ s/
/is); ($item->{'subject'}, $item->{'gender'}) = ($1, $2) if ($lines[0] =~ /(.*?) \((.*?)\)<\/td>/is); $item->{'description'} = $1 if ($lines[1] =~ /(.*?)<\/td>/is); $item->{'message'} = $1 if ($lines[2] =~ /(.*?)<\/td>/is); $item->{'time'} = $1 if ($lines[3] =~ /(.*?)<\/td>/is); while ($lines[3] =~ s/["']?(.*?)['"]?]*?><\/a>//) { my $button = { 'link' => $1, 'image' => $2, 'title' => $3 }; map { $button->{$_} = $self->absolute_url($button->{$_}, $base) } qw(link image); map { $button->{$_} = $self->rewrite($button->{$_}, $base) } qw(title); $item->{'button'} = [] unless ($item->{'button'}); push(@{$item->{'button'}}, $button); } # format map { $item->{$_} = $self->absolute_url($item->{$_}, $base) } qw(link image); map { $item->{$_} = $self->rewrite($item->{$_}, $base) } qw(subject description message gender); $item->{'time'} = $self->convert_login_time($item->{'time'}) if ($item->{'time'}); push(@items, $item) if ($item->{'subject'} and $item->{'link'}); } } @items = sort { $b->{'time'} cmp $a->{'time'} } @items; return @items; } sub parse_new_album { my $self = shift; return $self->parse_standard_history(@_); } sub parse_new_bbs { my $self = shift; return $self->parse_standard_history(@_); } sub parse_new_bbs_next { my $self = shift; return $self->parse_standard_history_next(@_); } sub parse_new_bbs_previous { my $self = shift; return $self->parse_standard_history_previous(@_); } sub parse_new_comment { my $self = shift; return $self->parse_standard_history(@_); } sub parse_new_friend_diary { my $self = shift; return $self->parse_standard_history(@_); } sub parse_new_friend_diary_next { my $self = shift; return $self->parse_standard_history_next(@_); } sub parse_new_friend_diary_previous { my $self = shift; return $self->parse_standard_history_previous(@_); } sub parse_new_review { my $self = shift; return $self->parse_standard_history(@_); } sub parse_release_info { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_subj = '(.+?)'; my $re_date = '(\d{4}).(\d{2}).(\d{2})(.*?)
.*?${re_subj}.*?${re_date}.*?${re_desc}.*?//is) { my $subj = $1; my $date = sprintf('%04d/%02d/%02d', $2, $3, $4); my $desc = $5; $subj = $self->rewrite($subj); $desc = $self->rewrite($desc); $desc =~ s/^$//g; push(@items, {'time' => $date, 'description' => $desc, 'subject' => $subj}); } } return @items; } sub parse_self_id { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my $self_id = ($content =~ /\(URL は http:\/\/mixi.jp\/show_friend.pl\?id=(\d+) です。\)/) ? $1 : 0; return $self_id; } sub parse_search_diary { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my @time = localtime(); my ($month, $year) = ($time[4] + 1, $time[5] + 1900); if ($content =~ m{(.+?)}s) { $content = $1; while ($content =~ s/
(.*?)<\/table>//is) { my $record = $1; my @lines = ($record =~ /(.*?)<\/tr>/gis); my $item = {}; # parse record ($item->{'link'}, $item->{'image'}) = ($1, $2) if ($lines[0] =~ /
/is); ($item->{'name'}, $item->{'gender'}) = ($1, $2) if ($lines[0] =~ /(.*?) \((.*?)\).*<\/td>/is); $item->{'subject'} = $1 if ($lines[1] =~ /(.*?)<\/td>/is); $item->{'description'} = $1 if ($lines[2] =~ /(.*?)<\/td>/is); $item->{'time'} = $1 if ($lines[3] =~ /(.*?)<\/td>/is); # format my @time = ($item->{'time'} =~ /\d+/g); unshift(@time, ($time[0] == $month) ? $year : $year - 1) if (@time == 4); $item->{'time'} = (@time == 5) ? sprintf('%04d/%02d/%02d %02d:%02d', @time) : ''; foreach (qw(image link)) { $item->{$_} = $self->absolute_url($item->{$_}, $base) if ($item->{$_}); } foreach (qw(name subject description gender time)) { $item->{$_} =~ s/<.*?>//g if ($item->{$_}); $item->{$_} = $self->rewrite($item->{$_}); } push(@items, $item) if ($item->{'subject'} and $item->{'link'}); } } return @items; } sub parse_search_diary_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /.*?]*?search_diary.pl[^<>]*?)>([^<>]*?)<\/a><\/td>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_search_diary_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /]*?search_diary.pl[^<>]*?)>([^<>]*?)<\/a>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_show_calendar { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my %icons = ('i_sc-.gif' => '予定', 'i_bd.gif' => '誕生日', 'i_iv1.gif' => '参加イベント', 'i_iv2.gif' => 'イベント'); my %whethers = ('1' => '晴', '2' => '曇', '3' => '雨', '4' => '雪', '8' => 'のち', '9' => 'ときどき'); my @items = (); my $term = $self->parse_show_calendar_term($res) or return undef; if ($content =~ /(.+?)<\/table>/s) { $content = $1; $content =~ s/.*?<\/tr>//is; while ($content =~ s/
]*>(\S*?)<\/font>(.*?)<\/td>//is) { my $date = $1; my $text = $2; next unless ($date =~ /(\d+)/); $date = sprintf('%04d/%02d/%02d', $term->{'year'}, $term->{'month'}, $1); if ($text =~ s/(.*?)<\/font><\/font>//) { my $item = { 'subject' => "天気", 'link' => undef, 'name' => $2, 'time' => $date, 'icon' => $1}; $item->{'icon'} = $self->absolute_url($item->{'icon'}, $base); my $weather = ($item->{'icon'} =~ /i_w(\d+).gif$/) ? $1 : '不明'; $weather =~ s/(\d)/$whethers{$1}/g; $item->{'name'} = sprintf("%s(%s%%)", $weather, $self->rewrite($item->{'name'})); push(@items, $item); } my @events = split(/
/, $text); foreach my $event (@events) { my $item = {}; if ($event =~ /(.*?)<\/a>/) { $item = { 'subject' => $1, 'link' => $2, 'name' => $3, 'time' => $date, 'icon' => $1}; } elsif ($event =~ /(.*?)<\/a>/) { $item = { 'subject' => $2, 'link' => $1, 'name' => $3, 'time' => $date, 'icon' => $2}; } else { next; } $item->{'subject'} = ($item->{'subject'} =~ /([^\/]+)$/ and $icons{$1}) ? $icons{$1} : "不明($1)"; $item->{'link'} = $self->absolute_url($item->{'link'}, $base); $item->{'icon'} = $self->absolute_url($item->{'icon'}, $base); $item->{'subject'} = $self->rewrite($item->{'subject'}); $item->{'name'} = $self->rewrite($item->{'name'}); push(@items, $item); } } } return @items; } sub parse_show_calendar_term { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /[^&]*?<\/a>/); return {'year' => $1, 'month' => $2}; } sub parse_show_calendar_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /([^<>]+?) >>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $subject}; return $next; } sub parse_show_calendar_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /<< ([^<>]+)/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $subject}; return $next; } sub parse_show_friend_outline { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; my $outline = {'link' => $base}; return unless ($content =~ /]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow2.gif['"]?[^<>]*?>[^\r\n]*\n(.+?)\n[^\r\n]*?]*?src=["']?http:\/\/img.mixi.jp\/img\/q_yellow3.gif['"]?[^<>]*?>/s); $content = $1; # parse relation if ($content =~ s/		(.*?)//s) { my $relation_part = $1; my @nodes = ($relation_part =~ /(.*?<\/a>)/g); $outline->{'step'} = @nodes; if ($outline->{'step'} == 2) { if ($nodes[0] =~ /(.+?)<\/a>/) { my ($link, $name) = ($1, $2); $outline->{'relation'} = { 'link' => $self->absolute_url($link, $base), 'name' => $self->rewrite($name) }; } else { $outline->{'relation'} = { 'link' => '', 'name' => '' }; } } } # parse image if ($content =~ s/
(.*?)<\/table>//s) { my $image_part = $1; $outline->{'image'} = ($image_part =~ s///) ? $self->absolute_url($1, $base) : ''; } # parse nickname if ($content =~ s/([^\n]+)さん\((\d+)\)
\n\((.*?)\)<\/span>
//) { my ($name, $count, $desc) = ($1, $2, $3); $outline->{'name'} = $self->rewrite($name); $outline->{'count'} = $count; $outline->{'description'} = $self->rewrite($desc); } return $outline; } sub parse_show_friend_profile { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my $profile = {}; my $re_link = '(.+?)<\/a>'; return unless ($content = ($content =~ /(.+?)/s) ? $1 : ''); return unless ($content = ($content =~ /
(.+?)/s) { $content = $1; while ($content =~ s/.*?.*?'; my $re_c_date = ''; my $re_link = '(.*?)<\/a>'; if ($content =~ s/.*?${re_date}.*?${re_subj}.*?${re_link}(.*?)${re_desc}(.*?)$//is) { my ($time, $subj, $link, $name, $imgs, $desc, $comm) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9, $10, $11); ($desc, $subj) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($desc, $subj); my $item = { 'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $res->request->uri->as_string, 'images' => [], 'comments' => [] , 'name' => $name, 'name_link' => $self->absolute_url($link, $base)}; foreach my $image ($imgs =~ /'; my $re_subj = ''; my $re_desc = ''; my $re_c_date = '.*?${re_date}.*?${re_subj}(.*?)${re_desc}(.+)//is) { my ($time, $subj, $imgs, $desc, $comm) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9); my $level = { 'description' => $self->rewrite($2), 'link' => $self->absolute_url($1, $base) } if ($content =~ /([^/); ($desc, $subj) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($desc, $subj); my $item = { 'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $res->request->uri->as_string, 'images' => [], 'comments' => [], 'level' => $level }; foreach my $image ($imgs =~ /'; my $re_subj = ''; my $re_link = '(.*?)<\/a>'; my $re_hold = ''; my $re_dead = ''; my $re_desc = '
\n(.*?)\n(.*?)<\/td>//is) { my ($link, $img, $name, $rel, $desc) = ($1, $2, $3, $4, $5); $rel =~ s/関係：(.+?)
/$1/; my $intro = ($desc =~ /edit_intro.pl\?id=.+?\&type=edit/) ? "1" : "0"; my $delete = ($desc =~ s/削除<\/a>//s) ? "1" : "0"; $name = $self->rewrite($name); $rel = $self->rewrite($rel); $desc = $self->rewrite($desc); $desc =~ s/この友人を紹介する//; $desc =~ s/[\r\n]+//ig; $link = $self->absolute_url($link, $base); my $item = {'link' => $link, 'name' => $name, 'image' => $img, 'relation' => $rel, 'description' => $desc, 'introduction' => $intro, 'detele' => $delete}; push(@items, $item); } } return @items; } sub parse_show_log { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '(\d{4})年(\d{2})月(\d{2})日 (\d{1,2}):(\d{2})'; my $re_link = '(.+?)<\/a>'; if ($content =~ /(.+?)<\/table>/s) { $content = $1 ; while ($content =~ s/${re_date} ${re_link}
//is) { my $time = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5); my $name = $self->rewrite($7); my $link = $self->absolute_url($6, $base); push(@items, {'time' => $time, 'name' => $name, 'link' => $link}); } } return @items; } sub parse_show_log_count { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my $count = ($content =~ /ページ全体のアクセス数：(\d+)<\/b> アクセス/) ? $1 : 0; return $count; } sub parse_view_album { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /概要ここから(.+?)/s) { my $img = $1 if ($content =~ /width=250><\/td>/); my $name = $1 if ($content =~ /(.*?)さんのフォトアルバム/); my $subj = $1 if ($content =~ /タイトル.*?(.*?)<\/b>/s); my $desc = $1 if ($content =~ /説明.*?CLASS=h120>(.*?)<\/td>/s); my $level = $1 if ($content =~ /公開レベル.*?'; my $re_subj = ''; my $re_desc = '
(.*?)
/s); my $time = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $5, $5) if ($content =~ /作成日時.*?		(\d{4})年(\d{2})月(\d{2})日 (\d{2}):(\d{2})<\/td>/s); my $comm = $1 if ($content =~ />コメント\((\d+)\)/); my $number = $1 if ($content =~ /写真一覧.*?\ (\d+)枚/); $name = $self->rewrite($name); $subj = $self->rewrite($subj); $desc = $self->rewrite($desc); my $item = { 'image' => $self->absolute_url($img, $base), 'name' => $name, 'subject' => $subj, 'description' => $desc, 'level' => $level, 'time' => $time, 'comment_number' => $comm, 'photo_number' => $number}; push(@items, $item); } return @items; } sub parse_view_album_comment { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /写真一覧ここまで(.*?)/s) { $content = $1; while ($content =~ s/\n(\d{4})年(\d{2})月(\d{2})日
(\d{2}):(\d{2})\n<\/td>.*?(.+?)<\/a>.*?		(.*?)<\/td>//s) { my ($time, $link, $name, $desc) = ((sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5)), $6, $7, $8); my $item = { 'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $self->rewrite($name), 'description' => $self->rewrite($desc)}; push(@items, $item); } } return @items; } sub parse_view_album_photo { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($content =~ /写真一覧ここから(.*?)写真一覧ここまで/s) { $content = $1; while ($content =~ s/(.+?)<\/a><\/td>//) { my ($alt, $thumb, $link, $subj) = ($1, $2, $3, $4); my $item = { 'description' => $alt, 'thumb_link' => $self->absolute_url($thumb, $base), 'link' => $self->absolute_url($link, $base), 'subject' => $self->rewrite($subj)}; push(@items, $item); } } return @items; } sub parse_view_bbs { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '(\d{4})年(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})		 (.+?)
(.+?)		\n(\d{4})年(\d{2})月(\d{2})日
\n(\d{1,2}):(\d{2})'; my $re_c_desc = '		(.+?)\n]*>(.*?)<\/td>/g) { next unless ($image =~ /]*'show_picture.pl\?img_src=(.*?)'[^<>]*>/); push(@{$item->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($2, $base)}); } while ($comm =~ s/.*?${re_c_date}.*?${re_link}.*?${re_c_desc}.*?<\/table>//is){ my ($time, $link, $name, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8); ($name, $desc) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($name, $desc); push(@{$item->{'comments'}}, {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc}); } push(@items, $item); } return @items; } sub parse_view_diary { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '		(\d{4})年(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})		 (.+?)(.+?)\n(\d{4})年(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})'; my $re_link = '(.+?)<\/a>'; if ($content =~ s/
]*>(.*?)<\/td>/g) { next unless ($image =~ /]*'show_picture.pl\?img_src=(.*?)'[^<>]*>/); push(@{$item->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($2, $base)}); } while ($comm =~ s/.*?${re_c_date}.*?${re_link}.*?${re_desc}.*?<\/table>//is){ my ($time, $link, $name, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8); ($name, $desc) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($name, $desc); push(@{$item->{'comments'}}, {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc}); } push(@items, $item); } return @items; } sub parse_view_event { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '		(\d{4})年(\d{2})月(\d{2})日
(\d{1,2}):(\d{2})		 (.+?)\n (.*?)\n (.*?)
(.*?)'; my $re_c_date = ''; if ($content =~ s/
\n(\d{1,2}):(\d{2})
\n'; my $re_c_desc = '		(.*?)\n
.*?${re_date}(.*?)${re_subj}.*?${re_link}.*?${re_hold}.*?${re_hold}.*?${re_desc}.*?${re_dead}(.*?)(.*?)//is) { my ($time, $imgs, $subj, $link, $name, $date, $location, $desc, $deadline, $join, $comm) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8, $9, $10, $11, $12, $13, $14, $15); if ($join =~ /VALUE="　イベントに参加する　"/i) { $join = 1; } elsif ($join =~ /VALUE="　参加をキャンセルする　"/i) { $join = 2; } else { $join = 0; } ($desc, $subj) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($desc, $subj); my $item = { 'time' => $time, 'description' => $desc, 'subject' => $subj, 'link' => $res->request->uri->as_string, 'images' => [], 'comments' => [] , 'name' => $name, 'name_link' => $self->absolute_url($link, $base), 'date' => $date, 'location' => $location, 'deadline' => $deadline, 'join' => $join}; foreach my $image ($imgs =~ /
]*>(.*?)<\/td>/g) { next unless ($image =~ /]*'show_picture.pl\?img_src=(.*?)'[^<>]*>/); push(@{$item->{'images'}}, {'link' => $self->absolute_url($1, $base), 'thumb_link' => $self->absolute_url($2, $base)}); } while ($comm =~ s/${re_c_date}.*?${re_link}.*?${re_c_desc}//is) { my ($time, $link, $name, $desc) = (sprintf('%04d/%02d/%02d %02d:%02d', $1,$2,$3,$4,$5), $6, $7, $8); my $imgs; ($imgs, $desc) = ($1, $2) if ($desc =~ /(.+?)<\/table>.*?(.+?)<\/td>/); ($name, $desc) = map { s/[\r\n]+//g; s/
/\n/g; $_ = $self->rewrite($_); } ($name, $desc); push(@{$item->{'comments'}}, {'time' => $time, 'link' => $self->absolute_url($link, $base), 'name' => $name, 'description' => $desc}); } push(@items, $item); } return @items; } sub parse_view_message { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; my $item = undef; my $re_link = '(.+?)<\/'; my $re_date = '(\d{4})年(\d{2})月(\d{2})日  (\d{1,2}):(\d{2})'; if ($content =~ /
(.*?)<\/table>/s) { my $message = $1; my @rows = split(/<\/tr>/, $message, 4); my $image = $1 if ($rows[0] =~ /
.*?.*?<\/td>/i); my ($link, $name) = ($1, $2) if ($rows[0] =~ /.*?${re_link}.*?td>/i); my $time = sprintf('%04d/%02d/%02d %02d:%02d', $1, $2, $3, $4, $5) if ($rows[1] =~ /${re_date}/); my $subj = $1 if ($rows[2] =~ /<\/font> : (.*)<\/td>/); my $desc = $1 if ($rows[3] =~ /(.*?)<\/td>/); unless (grep { not $_ } ($image, $link, $name, $time, $subj, $desc)) { $item = { 'subject' => $self->rewrite($subj), 'time' => $time, 'name' => $self->rewrite($name), 'link' => $self->absolute_url($link, $base), 'image' => $self->absolute_url($image, $base), 'description' => $self->rewrite($desc), }; } } return $item; } sub parse_view_message_form { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; my @items = (); while ($content =~ s/]*>(.*?)<\/form>//s) { my $action = $1; my $submit = $2; $submit = ($submit =~ //) ? $1 : undef; my $command = $1 if ($action =~ /([^\/\?]+)\.pl(\?[^\/]*)?$/); my $item = { 'action' => $self->absolute_url($action), 'submit' => $submit, 'command' => $command, }; push(@items, $item); } return @items; } sub parse_add_diary_preview { my $self = shift; my @items = grep { $_ and $_->{'__action__'} =~ /\Qadd_diary.pl\E/ } $self->parse_standard_form(); return @items; } sub parse_add_diary_confirm { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $succeed = '作成が完了しました。'; if ($content =~ /(.*?)<\/form>/s) { $content = $1; if (index($content, $succeed) != -1) { my $link = ($content =~ //) ? $self->absolute_url($1, $base) : undef; my $subj = $self->rewrite($content); $subj =~ s/[\r\n]+//g; push(@items, {'subject' => $subj, 'result' => 1, 'link' => $link }); } } return @items; } sub parse_delete_diary_preview { my $self = shift; my @items = grep { $_ and $_->{'__action__'} =~ /\Q_diary.pl\E/ } $self->parse_standard_form(); return @items; } sub parse_delete_diary_confirm { my $self = shift; return $self->parse_list_diary(@_); } sub parse_edit_diary_preview { my $self = shift; my @items = grep { $_ and $_->{'__action__'} =~ /\Q_diary.pl\E/ } $self->parse_standard_form(); return @items; } sub parse_edit_diary_image { my $self = shift; my @items = (); my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; foreach my $photo ($content =~ /[^\n]*?(.*?)<\/tr>/s) { $content = $1; if (index($content, $succeed) != -1) { my $item = { 'subject' => $self->rewrite($succeed), 'result' => 1 }; if ($content =~ /]*? alt='([^']*)'>/) { #'{ $item->{'banner'} = { 'link' => $self->absolute_url($1, $base), 'image' => $self->absolute_url($2, $base), 'subject' => $self->rewrite($3), }; } push(@items, $item) } } return @items; } sub get_main_menu { my $self = shift; my $url = (@_) ? shift : undef; if ($url) { $self->set_response($url, @_) or return; } else { return unless ($self->response); return unless ($self->response->is_success); } return $self->parse_main_menu(); } sub get_banner { my $self = shift; my $url = (@_) ? shift : undef; if ($url) { $self->set_response($url, @_) or return; } else { return unless ($self->response); return unless ($self->response->is_success); } return $self->parse_banner(); } sub get_tool_bar { my $self = shift; my $url = (@_) ? shift : undef; if ($url) { $self->set_response($url, @_) or return; } else { return unless ($self->response); return unless ($self->response->is_success); } return $self->parse_tool_bar(); } sub get_information { my $self = shift; return $self->get_standard_data('parse_information', 'home.pl', @_); } sub get_home_new_album { my $self = shift; return $self->get_standard_data('parse_home_new_album', 'home.pl', @_); } sub get_home_new_bbs { my $self = shift; return $self->get_standard_data('parse_home_new_bbs', 'home.pl', @_); } sub get_home_new_comment { my $self = shift; return $self->get_standard_data('parse_home_new_comment', 'home.pl', @_); } sub get_home_new_friend_diary { my $self = shift; return $self->get_standard_data('parse_home_new_friend_diary', 'home.pl', @_); } sub get_home_new_review { my $self = shift; return $self->get_standard_data('parse_home_new_review', 'home.pl', @_); } sub get_ajax_new_diary { my $self = shift; my $url = 'ajax_new_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'friend_id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'friend_id'}) and length($param{'friend_id'}) and $url !~ /[\?\&]friend_id=/) { $url .= ($url =~ /\?/) ? "&friend_id=$param{'friend_id'}" : "?friend_id=$param{'friend_id'}"; } return $self->get_standard_data('parse_ajax_new_diary', qr/ajax_new_diary\.pl/, $url, $refresh); } sub get_community_id { my $self = shift; return $self->get_standard_data('parse_community_id', qr/view_community\.pl/, @_); } sub get_list_bbs { my $self = shift; my $url = 'list_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } return $self->get_standard_data('parse_list_bbs', qr/list_bbs\.pl/, $url, $refresh); } sub get_list_bbs_next { my $self = shift; my $url = 'list_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } $self->set_response($url, $refresh) or return; return $self->parse_list_bbs_next(); } sub get_list_bbs_previous { my $self = shift; my $url = 'list_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } $self->set_response($url, $refresh) or return; return $self->parse_list_bbs_previous(); } sub get_list_bookmark { my $self = shift; my $url = 'list_bookmark.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_bookmark(); } sub get_list_comment { my $self = shift; my $url = 'list_comment.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_comment(); } sub get_list_community { my $self = shift; my $url = 'list_community.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_community(); } sub get_list_community_next { my $self = shift; my $url = 'list_community.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_community_next(); } sub get_list_community_previous { my $self = shift; my $url = 'list_community.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_community_previous(); } sub get_list_diary { my $self = shift; my $url = 'list_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_diary(); } sub get_list_diary_capacity { my $self = shift; my $url = 'list_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_diary_capacity(); } sub get_list_diary_next { my $self = shift; my $url = 'list_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_diary_next(); } sub get_list_diary_previous { my $self = shift; my $url = 'list_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_diary_previous(); } sub get_list_diary_monthly_menu { my $self = shift; my $url = 'list_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_diary_monthly_menu(); } sub get_list_friend { my $self = shift; my $url = 'list_friend.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_friend(); } sub get_list_friend_next { my $self = shift; my $url = 'list_friend.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_friend_next(); } sub get_list_friend_previous { my $self = shift; my $url = 'list_friend.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_friend_previous(); } sub get_list_member { my $self = shift; my $url = 'list_member.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } return $self->get_standard_data('parse_list_member', qr/list_member\.pl/, $url, $refresh); } sub get_list_member_next { my $self = shift; my $url = 'list_member.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } $self->set_response($url, $refresh) or return; return $self->parse_list_member_next(); } sub get_list_member_previous { my $self = shift; my $url = 'list_member.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } $self->set_response($url, $refresh) or return; return $self->parse_list_member_previous(); } sub get_list_message { my $self = shift; my $url = 'list_message.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_message(); } sub get_list_outbox { my $self = shift; my $url = 'list_message.pl?box=outbox'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_outbox(); } sub get_list_request { my $self = shift; my $url = 'list_request.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_list_request(); } sub get_new_album { my $self = shift; my $url = 'new_album.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_album(); } sub get_new_bbs { my $self = shift; my $url = 'new_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_bbs(); } sub get_new_bbs_next { my $self = shift; my $url = 'new_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_bbs_next(); } sub get_new_bbs_previous { my $self = shift; my $url = 'new_bbs.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_bbs_previous(); } sub get_new_comment { my $self = shift; my $url = 'new_comment.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_comment(); } sub get_new_friend_diary { my $self = shift; my $url = 'new_friend_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_friend_diary(); } sub get_new_friend_diary_next { my $self = shift; my $url = 'new_friend_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_friend_diary_next(); } sub get_new_friend_diary_previous { my $self = shift; my $url = 'new_friend_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_friend_diary_previous(); } sub get_new_review { my $self = shift; my $url = 'new_review.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_new_review(); } sub get_release_info { my $self = shift; my $url = 'release_info.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_release_info(); } sub get_self_id { my $self = shift; my $url = 'show_profile.pl'; $self->set_response($url, @_) or return; return $self->parse_self_id(); } sub get_search_diary { my $self = shift; my $url = 'search_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'keyword'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'keyword'}) and length($param{'keyword'}) and $url !~ /[\?\&]keyword=/) { $param{'keyword'} =~ s/([^\w ])/'%' . unpack('H2', $1)/eg; $param{'keyword'} =~ tr/ /+/; $url .= ($url =~ /\?/) ? "&keyword=$param{'keyword'}" : "?keyword=$param{'keyword'}"; } @_ = grep { defined($_) } ($url, $refresh); $self->set_response(@_) or return; return $self->parse_search_diary(); } sub get_search_diary_next { my $self = shift; my $url = 'search_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'keyword'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'keyword'}) and length($param{'keyword'}) and $url !~ /[\?\&]keyword=/) { $param{'keyword'} =~ s/([^\w ])/'%' . unpack('H2', $1)/eg; $param{'keyword'} =~ tr/ /+/; $url .= ($url =~ /\?/) ? "&keyword=$param{'keyword'}" : "?keyword=$param{'keyword'}"; } $self->set_response($url, $refresh) or return; return $self->parse_search_diary_next(); } sub get_search_diary_previous { my $self = shift; my $url = 'search_diary.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'keyword'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'keyword'}) and length($param{'keyword'}) and $url !~ /[\?\&]keyword=/) { $param{'keyword'} =~ s/([^\w ])/'%' . unpack('H2', $1)/eg; $param{'keyword'} =~ tr/ /+/; $url .= ($url =~ /\?/) ? "&keyword=$param{'keyword'}" : "?keyword=$param{'keyword'}"; } $self->set_response($url, $refresh) or return; return $self->parse_search_diary_previous(); } sub get_show_calendar { my $self = shift; my $url = 'show_calendar.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_calendar(); } sub get_show_calendar_term { my $self = shift; my $url = 'show_calendar.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_calendar_term(); } sub get_show_calendar_next { my $self = shift; my $url = 'show_calendar.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_calendar_next(); } sub get_show_calendar_previous { my $self = shift; my $url = 'show_calendar.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_calendar_previous(); } sub get_show_intro { my $self = shift; my $url = 'show_intro.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_intro(); } sub get_show_log { my $self = shift; my $url = 'show_log.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_log(); } sub get_show_log_count { my $self = shift; my $url = 'show_log.pl'; $url = shift if (@_ and $_[0] ne 'refresh'); $self->set_response($url, @_) or return; return $self->parse_show_log_count(); } sub get_show_friend_outline { my $self = shift; my $url = shift or return undef; $self->set_response($url, @_) or return undef; return $self->parse_show_friend_outline(); } sub get_show_friend_profile { my $self = shift; my $url = shift or return undef; $self->set_response($url, @_) or return undef; return $self->parse_show_friend_profile(); } sub get_view_album { my $self = shift; my $url = 'view_album.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } return $self->get_standard_data('parse_view_album', qr/view_album\.pl/, $url, $refresh); } sub get_view_album_comment { my $self = shift; my $url = 'view_album.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}&mode=comment"; } return $self->get_standard_data('parse_view_album_comment', qr/view_album\.pl/, $url, $refresh); } sub get_view_album_photo { my $self = shift; my $url = 'view_album.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } return $self->get_standard_data('parse_view_album_photo', qr/view_album\.pl/, $url, $refresh); } sub get_view_bbs { my $self = shift; my $url = shift or return; $self->set_response($url, @_) or return undef; return $self->parse_view_bbs(); } sub get_view_community { my $self = shift; my $url = 'view_community.pl'; $url = shift if (@_ and $_[0] ne 'refresh' and $_[0] ne 'id'); my $refresh = shift if (@_ and $_[0] eq 'refresh'); my %param = @_; if (defined($param{'id'}) and length($param{'id'}) and $url !~ /[\?\&]id=/) { $url .= ($url =~ /\?/) ? "&id=$param{'id'}" : "?id=$param{'id'}"; } return $self->get_standard_data('parse_view_community', qr/view_community\.pl/, $url, $refresh); } sub get_view_diary { my $self = shift; my $url = shift or return; $self->set_response($url, @_) or return undef; return $self->parse_view_diary(); } sub get_view_event { my $self = shift; my $url = shift or return; $self->set_response($url, @_) or return undef; return $self->parse_view_event(); } sub get_view_message { my $self = shift; my $url = shift or return undef; $self->set_response($url, @_) or return undef; return $self->parse_view_message(); } sub get_view_message_form { my $self = shift; my $url = shift or return; $self->set_response($url, @_) or return; return $self->parse_view_message_form(); } sub get_add_diary_preview { my $self = shift; my %form = @_; $form{'submit'} = 'main'; my $response = $self->post_add_diary(%form); return if ($@ or not $response); return $self->parse_add_diary_preview(); } sub get_add_diary_confirm { my $self = shift; my %form = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_; my $url = 'add_diary.pl'; my @files = qw(photo1 photo2 photo3); # POSTキー未取得、または写真があればプレビュー投稿 if (not $form{'post_key'} or grep { $form{$_} } @files) { my @forms = grep {$_->{'submit'} eq 'confirm'} $self->get_add_diary_preview(%form); return 0 if ($self->response->is_error); return 0 unless (@forms); %form = %{$forms[0]}; $self->log("[info] プレビューページを取得しました。\n"); $self->dumper_log(\%form); } # 投稿 $form{'submit'} = 'confirm'; $self->post_add_diary(%form) or return; return $self->parse_add_diary_confirm(); } sub get_delete_diary_preview { my $self = shift; my %form = @_; $self->post_delete_diary(%form) or return; return $self->parse_delete_diary_preview(); } sub get_delete_diary_confirm { my $self = shift; my %form = @_; # 投稿 $form{'submit'} = 'confirm'; $self->post_delete_diary(%form) or return; return $self->parse_delete_diary_confirm(); } sub get_edit_diary_preview { my $self = shift; my $url = shift or return undef; $self->set_response($url, @_) or return undef; return $self->parse_edit_diary_preview(); } sub get_edit_diary_image { my $self = shift; my $url = shift or return undef; $self->set_response($url, @_) or return undef; return $self->parse_edit_diary_image(); } sub get_edit_diary_confirm { my $self = shift; my %form = @_; # 投稿 $form{'submit'} = 'main'; $self->post_edit_diary(%form) or return; return $self->parse_edit_diary_confirm(); } sub get_send_message_preview { my $self = shift; my %form = @_; $form{'submit'} = 'main'; $self->post_send_message(%form) or return; return $self->parse_send_message_preview(); } sub get_send_message_confirm { my $self = shift; my %form = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_; $form{'submit'} = 'confirm'; $form{'yes'} = '　送　信　' unless ($form{'yes'}); #post key未取得ならプレビュー投稿 if (not $form{'post_key'} or not $form{'yes'}) { my @forms = grep {$_->{'submit'} eq 'confirm'} $self->get_send_message_preview(%form); return 0 if ($self->response->is_error); return 0 unless (@forms); %form = %{$forms[0]}; $self->log("[info] プレビューページを取得しました。\n"); $self->dumper_log(\%form); } # 送信 $self->post_send_message(%form) or return; return $self->parse_send_message_confirm(); } sub absolute_url { my $self = shift; my $url = shift; my $base = (@_) ? shift : $self->{'mixi'}->{'base'}; return undef unless (length($url)); $url =~ s/^"(.*)"$/$1/ or $url =~ s/^'(.*)'$/$1/; $url .= '.pl' if ($url and $url !~ /[\/\.]/); return URI->new($url)->abs($base)->as_string; } sub absolute_linked_url { my $self = shift; my $url = shift; return $url unless ($url and $self->response()); my $base = $self->response->base->as_string; return $self->absolute_url($url, $base); } sub query_sorted_url { my $self = shift; my $url = shift; return undef unless ($url); if ($url =~ s/\?(.*)$//) { my $qurey_string = join('&', map {join('=', @{$_})} map { $_->[1] =~ s/%20/+/g if @{$_} == 2; $_; } sort {$a->[0] cmp $b->[0]} map {[split(/=/, $_, 2)]} split(/&/, $1)); $url = "$url?$qurey_string"; } return $url; } sub enable_cookies { my $self = shift; unless ($self->cookie_jar) { my $cookie = sprintf('cookie_%s_%s.txt', $$, time); $self->cookie_jar(HTTP::Cookies->new(file => $cookie, ignore_discard => 1)); $self->log("[info] Cookieを有効にしました。\n"); } return $self; } sub save_cookies { my $self = shift; my $file = shift; my $info = ''; my $result = 0; if (not $self->cookie_jar) { $info = "[error] Cookieが無効です。\n"; } elsif (not $file) { $info = "[error] Cookieを保存するファイル名が指定されませんでした。\n"; } else { $info = "[info] Cookieを\"${file}\"に保存します。\n"; $result = eval "\$self->cookie_jar->save(\$file)"; $info .= "[error] $@\n" if ($@); } return $result; } sub load_cookies { my $self = shift; my $file = shift; my $info = ''; my $result = 0; if (not $file){ $info = "[error] Cookieを読み込むファイル名が指定されませんでした。\n"; } elsif (not $file) { $info = "[error] Cookieファイル\"${file}\"が存在しません。\n"; } else { $info = "[info] Cookieを\"${file}\"から読み込みます。\n"; $self->enable_cookies; $result = eval "\$self->cookie_jar->load(\$file)"; $info .= "[error] $@\n" if ($@); } return $result; } sub log { my $self = shift; return &{$self->{'mixi'}->{'log'}}($self, @_); } sub dumper_log { my $self = shift; my @logs = @_; if (not defined($self->{'mixi'}->{'dumper'})) { eval "use Data::Dumper"; $self->{'mixi'}->{'dumper'} = ($@) ? 0 : Data::Dumper->can('Dumper'); $self->log("[warn] Data::Dumper is not available : $@\n") unless ($self->{'mixi'}->{'dumper'}); } if ($self->{'mixi'}->{'dumper'}) { local $Data::Dumper::Indent = 1; my $log = &{$self->{'mixi'}->{'dumper'}}([@logs]); $log =~ s/\n/\n /g; $log =~ s/\s+$/\n/s; return $self->log(" $log"); } else { return $self->log(" [dumper] " . join(', ', @logs) . "\n"); } } sub abort { my $self = shift; return &{$self->{'mixi'}->{'abort'}}($self, @_); } sub callback_log { eval "use Jcode"; my $use_jcode = ($@) ? 0 : 1; my $self = shift; my @logs = @_; my $error = 0; foreach my $log (@logs) { eval '$log = jcode($log, "euc")->sjis' if ($use_jcode); if ($log !~ /^(\s|\[.*?\])/) { print $log; } elsif ($log =~ /^\[error\]/) { print $log; $error = 1; } elsif ($log =~ /^\[usage\]/) { print $log; } elsif ($log =~ /^\[warn\]/) { print $log; } # elsif ($log =~ /^\[info\]/) { print $log; } # useful for debugging # elsif ($log =~ /^\s/) { print $log; } # useful for debugging # else { print $log; } # useful for debugging } $self->abort if ($error); return $self; } sub callback_abort { die @_; } sub rewrite { my $self = shift; return &{$self->{'mixi'}->{'rewrite'}}($self, @_); } sub callback_rewrite { my $self = shift; my $str = shift; $str = $self->remove_tag($str); $str = $self->unescape($str); $str =~ s/\s+$//s; return $str; } sub escape { my $self = shift; my $str = shift; my %escaped = ('&' => '&', '"' => '"', '>' => '>', '<' => '<'); my $re_target = join('|', keys(%escaped)); $str =~ s/($re_target)/$escaped{$1}/g; return $str; } sub unescape { my $self = shift; my $str = shift; my %unescaped = ('amp' => '&', 'quot' => '"', 'gt' => '>', 'lt' => '<', 'nbsp' => ' ', 'apos' => "'", 'copy' => '(c)'); my $re_target = join('|', keys(%unescaped)); $str =~ s/&($re_target|#x([0-9a-z]+));/defined($unescaped{$1}) ? $unescaped{$1} : defined($2) ? chr(hex($2)) : "&$1;"/ige; return $str; } sub remove_tag { my $self = shift; my $str = shift; my $re_standard_tag = q{[^"'<>]*(?:"[^"]*"[^"'<>]*|'[^']*'[^"'<>]*)*(?:>|(?=<)|$(?!\n))}; my $re_comment_tag = '-]*(?:-[^>-]+)*?)??)*(?:>|$(?!\n)|--.*$)'; my $re_html_tag = qq{$re_comment_tag|<$re_standard_tag}; $str =~ s/$re_html_tag//g; return $str; } sub remove_diary_tag { my $self = shift; my $str = shift; my $re_diary_tag = join('|', q{}, q{}, q{写真}, q{}, q{<(?:blockquote|u|em|strong)>}, q{<\/(?:a|blockquote|u|em|span|strong)>} ); $str =~ s/$re_diary_tag//g; return $str; } sub redirect_ok { return 1; } sub get_standard_data { # default url is pased, so url is not necessary. my $self = shift; my $parser = shift; my $def_url = shift; # defined url my $url = shift if (@_ and $_[0] ne 'refresh'); # specified url if (defined($def_url) and ref($def_url) eq 'Regexp') { return unless (defined($url) and length($url)); return unless ($url =~ $def_url); } elsif (not (ref($url) eq '' and length($url))) { $url = $def_url; } $self->abort("url \"$url\" is invalid.") unless (defined($url) and length($url)); # invalid url $self->can($parser) or $self->abort("parser \"$parser\" is not available."); # invalid method $self->set_response($url, @_) or $self->abort("set_response failed."); # request can not processed return $self->$parser(); } sub parse_standard_history { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $re_date = '(?:(\d{4})年)?(\d{2})月(\d{2})日 (\d{1,2}):(\d{2})'; my $re_link = ']*href="?([^<> ]*?)"?(?: [^<>]*)?>(.*?)<\/a>'; my $re_name = '\((.*?)\)'; if ($content =~ /
.*?<\/tr>/gs) { my $subj = ($photo =~ /(.*?)<\/td>/) ? $1 : next; my ($thumb, $link) = ($photo =~ /
\n削除<\/a>/) ? ($1, $2) : next; my $item = { 'subject' => $self->rewrite($subj), 'link' => $self->absolute_url($link, $base), 'thumb_link' => $self->absolute_url($thumb, $base), }; push(@items, $item); } return @items; } sub parse_edit_diary_confirm { my $self = shift; return $self->parse_list_diary(@_); } sub parse_send_message_preview { my $self = shift; my @items = grep { $_ and $_->{'__action__'} =~ /\Qsend_message.pl\E/ } $self->parse_standard_form(); return @items; } sub parse_send_message_confirm { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); my $succeed = '送信完了しました。'; if ($content =~ /
(.+?)<\/table>/s) { $content = $1; my @today = reverse((localtime)[3..5]); $today[0] += 1900; $today[1] += 1; foreach my $row ($content =~ /(.*?)<\/tr>/isg) { $row =~ s/\s*[\r\n]\s*//gs; my @cols = ($row =~ /]*>(.*?)<\/td>/gs); my $item = {}; next unless ($cols[0] =~ s/$re_date//); my @date = ($1, $2, $3, $4, $5); next unless ($cols[1] =~ /${re_link}\s*$re_name/); $item->{'link'} = $self->absolute_url($1, $base); $item->{'subject'} = (defined($2) and length($2)) ? $self->rewrite($2) : '(削除)'; $item->{'name'} = $self->rewrite($3); $date[0] = ($date[1] > $today[1]) ? $today[0] - 1 : $today[0] if (not defined($date[0])); $item->{'time'} = sprintf('%04d/%02d/%02d %02d:%02d', @date); map { $item->{$_} =~ s/^\s+|\s+$//gs } (keys(%{$item})); if ($cols[1] =~ /(]*>)\s*(]*>)\s*<\/a>/is) { my $image = {}; my @tags = ($1, $2); if ($_ = $self->parse_standard_tag($tags[0]) and $_->{'attr'}->{'href'} or $_->{'attr'}->{'onclick'}) { $_ = ($_->{'attr'}->{'onclick'}) ? $_->{'attr'}->{'onclick'} : $_->{'attr'}->{'href'}; $_ = $1 if ($_ =~ /MM_openBrWindow\('(.*?)'/); $item->{'image'}->{'link'} = $self->absolute_url($_, $base); } $item->{'image'}->{'src'} = $self->absolute_url($_, $base) if ($_ = $self->parse_standard_tag($tags[1]) and $_ = $_->{'attr'}->{'src'}); } push(@items, $item); } } return @items; } sub parse_standard_history_next { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; return unless ($content =~ /.*? ]*\/alt.gif['" ].*?>(.*?)<\/tr>/s) { my $message = $1; $message =~ s/\n//g; $message =~ s/
|
|<\/br>/\n/g; $res->code(400); $res->message($self->rewrite($message)); return; } while ($content =~ s/(]*)*>)(.*?)<\/form>//is) { my $tag = $1; my $form = $2; my $action = ($tag =~ /\baction=("[^"]*"|'[^']*'|[^'"<> ]*)/) ? $1 : ""; $action =~ s/^"(.*)"$/$1/s or $action =~ s/^'(.*)'$/$1/s; my $item = {'__action__' => $self->absolute_url($action, $base)}; foreach my $tag ($form =~ /]*)*>/g) { my $name = ($tag =~ /\bname=("[^"]*"|'[^']*'|[^'"<> ]*)/) ? $1 : ""; my $value = ($tag =~ /\bvalue=("[^"]*"|'[^']*'|[^'"<> ]*)/) ? $1 : ""; ($name, $value) = map { s/^"(.*)"$/$1/s or s/^'(.*)'$/$1/s; $_ } ($name, $value); $item->{$name} = $self->rewrite($value) if (length($name)); } while ($form =~ s/
[^\r\n]*?]+?)['"]?>([^<>]+)<\/a><\/td><\/tr>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $next = {'link' => $link, 'subject' => $2}; return $next; } sub parse_standard_history_previous { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->request->uri->as_string; my $content = $res->content; return unless ($content =~ /([^<>]+)<\/a>[^\r\n]*?<\/td><\/tr>/); my $subject = $2; my $link = $self->absolute_url($1, $base); my $previous = {'link' => $link, 'subject' => $2}; return $previous; } sub parse_standard_form { my $self = shift; my $res = (@_) ? shift : $self->response(); return unless ($res and $res->is_success); my $base = $res->base->as_string; my $content = $res->content; my @items = (); if ($res->is_success and $content =~ /