package WWW::Mixi; use strict; use Carp (); use vars qw($VERSION @ISA); $VERSION = sprintf("%d.%02d", q$Revision: 0.50$ =~ /(\d+)\.(\d+)/); require LWP::RobotUA; @ISA = qw(LWP::RobotUA); require HTTP::Request; require HTTP::Response; # use Jcode; 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, 'logcode' => exists($opt{'-logcode'}) ? $opt{'-logcode'} : undef, 'log' => exists($opt{'-log'}) ? $opt{'-log'} : \&callback_log, 'abort' => exists($opt{'-abort'}) ? $opt{'-abort'} : \&callback_abort, 'rewrite' => exists($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 = (); # parse main menu items my @tags = ($content =~ /
  • (.*?)<\/li>/gs); return $self->log("[warn] li tag is missing in main menu part.\n") unless (@tags); # parse each items foreach my $str (@tags) { my $anchor = ($str =~ /()/) ? $1 : next; my $image = ($str =~ /()/) ? $1 : next; ($anchor, $image) = map { $self->parse_standard_tag($_) } ($anchor, $image); my $item = { 'link' => $self->absolute_url($anchor->{'attr'}->{'href'}, $base), 'subject' => $self->rewrite($image->{'attr'}->{'alt'}) }; 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 = (); my @tags = ($content =~ /(