Show
Ignore:
Timestamp:
01/29/08 23:27:00 (6 years ago)
Author:
yappo
Message:

lang/perl/WWW-HatenaLogin?:

  • add login_uri and logout_uri method
  • add username accessor
  • WWW::HatenaDiary? friendry
Location:
lang/perl/WWW-HatenaLogin/trunk
Files:
4 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/WWW-HatenaLogin/trunk/Changes

    r5807 r5810  
    11Revision history for Perl extension WWW::HatenaLogin 
     2 
     30.02     
     4        - add login_uri and logout_uri method 
     5        - add username accessor 
     6        - WWW::HatenaDiary friendry 
    27 
    380.01    2008-01-29T22:28:09+09:00 
  • lang/perl/WWW-HatenaLogin/trunk/lib/WWW/HatenaLogin.pm

    r5807 r5810  
    6464sub is_loggedin { 
    6565    my $self = shift; 
    66     $self->{mech}->get($self->{uri}->{login}); 
     66    $self->{mech}->get($self->login_uri); 
    6767    $self->has_metalink; 
    6868} 
    6969 
     70sub login_uri { shift->{uri}->{login} } 
     71 
     72sub logout_uri { shift->{uri}->{logout} } 
     73 
     74sub username { 
     75    my $self = shift; 
     76    $self->{username} = defined $_[0] ? $_[0] : $self->{username}; 
     77} 
     78 
    7079sub login { 
    71     my $self = shift; 
    72  
    73     $self->{mech}->get($self->{uri}->{login}); 
     80    my($self, $args) = @_; 
     81 
     82    if ($args) { 
     83        if ($args->{username}) { 
     84            $self->{username} = $args->{username}; 
     85        } 
     86        if ($args->{password}) { 
     87            $self->{password} = $args->{password}; 
     88        } 
     89    } 
     90 
     91    $self->{mech}->get($self->login_uri); 
    7492    $self->{mech}->submit_form( 
    7593        fields => { 
     
    85103sub logout { 
    86104    my $self = shift; 
    87     $self->{mech}->get($self->{uri}->{logout}); 
     105    $self->{mech}->get($self->logout_uri); 
    88106    $self->{logout_check} ? $self->{logout_check}->($self) : $self->has_metalink; 
    89107} 
     
    232250=back 
    233251 
    234 =head2 login () 
    235  
    236 =over 4 
    237  
    238   $session->login; 
    239  
    240 Login to Hatena. 
    241 username and password which are passed into C<new> method above will be used.  
    242  
     252=head2 login ( [I<\%args>] ) 
     253 
     254=over 4 
     255 
     256  $diary->login({ 
     257      username => $username, 
     258      password => $password, 
     259  }); 
     260 
     261Logs in to Hatena::Diary using C<username> and C<password>. If either 
     262C<username> or C<password> isn't passed into this method, the values 
     263which are passed into C<new> method above will be used. 
     264  
    243265=back 
    244266 
     
    285307=back 
    286308 
     309=head2 login_uri () 
     310 
     311=over 4 
     312 
     313  $session->login_uri; 
     314 
     315return to login uri. 
     316 
     317=back 
     318 
     319=head2 logout_uri () 
     320 
     321=over 4 
     322 
     323  $session->logout_uri; 
     324 
     325return to logout uri. 
     326 
     327=back 
     328 
     329=head2 username ('username') 
     330 
     331=over 4 
     332 
     333  $session->username; 
     334  $session->username('new_username'); 
     335 
     336username accessor 
     337 
     338=back 
     339 
    287340=head1 AUTHOR 
    288341 
  • lang/perl/WWW-HatenaLogin/trunk/t/90_01_login_with_pit.t

    r5807 r5810  
    1111use WWW::HatenaLogin; 
    1212 
    13 my $config = pit_get('hatena', require => { 
     13my $base_config = pit_get('hatena', require => { 
    1414    username => 'your username on hatena', 
    1515    password => 'your password on hatena' 
     
    3030 
    3131    ok $session->login; 
     32    ok $session->logout; 
     33 
     34    { 
     35        local $@; 
     36        eval { 
     37            $session->login({ 
     38                username => '___', 
     39                password => '___', 
     40            }); 
     41        }; 
     42        like $@, qr/Login failed. Please confirm your/; 
     43    } 
     44    ok !$session->logout; 
     45    { 
     46        local $@; 
     47        eval { 
     48            $session->login; 
     49        }; 
     50        like $@, qr/Login failed. Please confirm your/; 
     51    } 
     52    ok !$session->logout; 
     53 
     54    ok $session->login({ 
     55        username => $base_config->{username}, 
     56        password => $base_config->{password}, 
     57    }); 
     58 
     59    ok $session->logout; 
     60    ok $session->login; 
    3261 
    3362    ok $session->logout; 
    3463    ok !$session->logout; 
    3564    ok !$session->session_id; 
     65 
     66    ok $session->username, $base_config->{username}; 
     67    $session->username('username'); 
     68    ok $session->username, 'username'; 
    3669} 
    3770 
    38 hatena { %{ $config } }; 
    39 hatena { %{ $config }, com  => 1 }; 
    40 hatena { %{ $config }, labo => 1 }; 
     71hatena { %{ $base_config } }; 
     72hatena { %{ $base_config }, com  => 1 }; 
     73hatena { %{ $base_config }, labo => 1 }; 
    4174 
    4275my $session = WWW::HatenaLogin->new({ 
    43     %{ $config }, 
     76    %{ $base_config }, 
    4477    nologin => 1, 
    4578}); 
  • lang/perl/WWW-HatenaLogin/trunk/t/97_podspell.t

    r5807 r5810  
    1515jp 
    1616rk 
     17uri