Otp.pm

   1 # WWW::SourceForge.JP\r
   2 # by hylom\r
   3 # This code is under GPL.\r
   4 #\r
   5 \r
   6 use LWP;\r
   7 use HTTP::Cookies;\r
   8 use HTTP::Request::Common;\r
   9 use otp::attach;\r
  10 \r
  11 package Otp;\r
  12 \r
  13 my $ua_string = 'Mozilla/5.0 (Windows; U; Windows NT 6.0; ja; rv:1.9.0.1) Gecko/2008070208 Firefox/3.0.1';\r
  14 my $login_url = 'http://magazine.sourceforge.jp/login.pl';\r
  15 my $logout_url = 'http://magazine.sourceforge.jp/my/logout';\r
  16 my $default_cookies = 'otp_cookies.txt';\r
  17 \r
  18 sub new {\r
  19   my $class = shift @_;\r
  20   my $self = {\r
  21                           'useragent' => $ua_string,\r
  22                           'cookies_file' => $default_cookies,\r
  23                          };\r
  24   return bless $self, $class;\r
  25 }\r
  26 \r
  27 # getter/setter\r
  28 sub useragent {\r
  29   my $self = shift @_;\r
  30   return $self->{useragent};\r
  31 }\r
  32 \r
  33 sub cookies_file {\r
  34   my $self = shift @_;\r
  35   return $self->{cookies_file};\r
  36 }\r
  37 \r
  38 sub lwp_ua {\r
  39   my $self = shift @_;\r
  40 \r
  41   my $ua = LWP::UserAgent->new( 'agent' => $self->useragent, );\r
  42   my $cookie_jar = HTTP::Cookies->new( file => $self->cookies_file, autosave => 1, ignore_discard => 1, );\r
  43   $ua->cookie_jar( $cookie_jar );\r
  44 \r
  45   return $ua;\r
  46 }\r
  47 \r
  48 sub login {\r
  49   my $self = shift @_;\r
  50   my $login_name = shift @_;\r
  51   my $password = shift @_;\r
  52 \r
  53   my $ua = $self->lwp_ua;\r
  54 \r
  55   my $form_data = {\r
  56                                    'op' => 'userlogin',\r
  57                                    'unickname' => $login_name,\r
  58                                    'upasswd' => $password,\r
  59                                    'userlogin' => 'ログイン',\r
  60                                   };\r
  61   my $resp = $ua->post( $login_url, $form_data );\r
  62 }\r
  63 \r
  64 sub logout {\r
  65   my $self = shift @_;\r
  66 \r
  67   my $ua = $self->lwp_ua;\r
  68   $ua->get( $logout_url );\r
  69 }\r
  70 \r
  71 sub Attach {\r
  72   my $self = shift @_;\r
  73 \r
  74   if ( ! defined $self->{_attach} ) {\r
  75     $self->{_attach} = Otp::Attach->new( $self );\r
  76   }\r
  77 \r
  78   return $self->{_attach};\r
  79 }\r
  80 \r
  81 1;\r