Show
Ignore:
Timestamp:
02/09/08 06:57:27 (6 years ago)
Author:
woremacx
Message:

lang/perl/WebService-Nowa: channel_recent

Location:
lang/perl/WebService-Nowa/trunk
Files:
2 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/WebService-Nowa/trunk/lib/WebService/Nowa.pm

    r6214 r6409  
    3939sub _login { 
    4040    my $self = shift; 
     41 
    4142    $self->{mech}->get(NOWA_HOME); 
    4243    $self->{_logged_in} = 1 if $self->{mech}->uri eq NOWA_HOME; 
     
    5152    ); 
    5253    croak("login failed.") if $self->{mech}->uri eq $uri; 
     54 
     55    if ($self->{mech}->content =~ m!<script type="text/javascript">\s+\w+\.init\(\s*"([a-f0-9]+)"!s) { 
     56        $self->{rkey} = $1; 
     57    } 
     58 
    5359    $self->{_logged_in} = 1; 
    5460} 
     
    101107} 
    102108 
     109sub channel_recent { 
     110    my $self = shift; 
     111    $self->_login unless $self->{_logged_in}; 
     112 
     113#   <li> 
     114#     <a href="http://woremacx.nowa.jp/" title="woremacx"> 
     115#       <img src="http://image.nowa.jp/icon/0000003bceb4da8eb19ca8ee838060c92294026b25fab89-s.png" width="16" height="16" alt="" /> 
     116#     </a> 
     117#     <a href="http://woremacx.nowa.jp/" class="blue-cms"> 
     118#       woremacx 
     119#     </a> 
     120#     <span class="body"> 
     121#       ヴ 
     122#       <a href='http://nowa.jp/ch/vavava/' class='blue-cms'>#vavava</a> 
     123#     </span> 
     124#     <span class="time">(<a href="http://woremacx.nowa.jp/status/177736" class="blue-cms">36分前</a>)</span> 
     125#   </li> 
     126    my $s = scraper { 
     127        process 'ul#article-list > li', 'msgs[]' => scraper { 
     128            process_first 'a.blue-cms', 
     129                'user', 'TEXT', 
     130                'userlink', '@href'; 
     131            process 'span.body', 
     132                'body', 'TEXT'; 
     133            process 'span.body > a', 
     134                'channel', 'TEXT', 
     135                'channellink', '@href'; 
     136            process 'span.time > a', 
     137                'permalink', '@href'; 
     138        }; 
     139    }; 
     140    my $res = $self->scrape($s, URI->new('http://my.nowa.jp/channel/recent')); 
     141    my @data; 
     142    for my $msg (@{ $res->{msgs} }) { 
     143        next unless $msg->{permalink}; 
     144 
     145        my $user = ($msg->{userlink} =~ m!^http://([^\.]+)\.nowa\.jp/!)[0]; 
     146        my $body = $msg->{body}; 
     147        $body =~ s/\s+#\w+$//; 
     148 
     149        push(@data, +{ 
     150            body => Encode::encode('utf-8', $body), 
     151            user => $user, 
     152            permalink => $msg->{permalink}->as_string, 
     153            channel => $msg->{channel}, 
     154        }); 
     155    } 
     156    return wantarray ? @data : \@data; 
     157} 
     158 
    103159sub _api { 
    104160    my $self = shift; 
     
    112168} 
    113169 
     170sub _internal_api { 
     171    my $self = shift; 
     172    my $method = shift; 
     173 
     174    my $uri = URI->new_abs($method, NOWA_HOME); 
     175 
     176    my($sec, $fsec) = time() =~ /^(\d+)(?:\.(\d+))?$/; 
     177    $fsec = substr($fsec, 0, 3); 
     178    $fsec .= '0' while length $fsec < 3; 
     179    my $uniqid = sprintf('%d%d', $sec, $fsec); 
     180 
     181    $uri->query_form( 
     182        rkey   => $self->{rkey}, 
     183        uniqid => $uniqid, 
     184    ); 
     185 
     186    $self->{mech}->get($uri->as_string); 
     187    my $res = JSON::Syck::Load($self->{mech}->content); 
     188    croak "fetch recent failed." if ref($res) eq 'HASH' and $res->{result} eq 'fail'; 
     189    $res; 
     190} 
     191 
    114192sub recent { 
    115193    my $self = shift; 
     
    118196    my @data; 
    119197    for my $entry (@$res) { 
     198        # skip channel messages 
     199        next if $entry->{text} =~ /^#\w+\s/; 
     200 
    120201        my $who = $entry->{user}->{nowa_id}; 
    121202        my $permalink = sprintf("http://%s.nowa.jp/status/%d", $who, (split(/_/, $entry->{id}))[1]); 
  • lang/perl/WebService-Nowa/trunk/test.pl

    r6214 r6409  
    88my $config = YAML::LoadFile(shift(@ARGV) || "config.yaml"); 
    99my $nowa = WebService::Nowa->new($config); 
    10 $nowa->update_nanishiteru('何もしてねえよ。'); 
     10# $nowa->update_nanishiteru('何もしてねえよ。'); 
     11 
    1112my $msgs = $nowa->recent; 
     13warn Dumper($msgs); 
     14 
    1215my $chans = $nowa->channels; 
     16warn Dumper($chans); 
     17 
    1318my $point = $nowa->point; 
     19print "$point nowa yen!\n"; 
     20 
     21my $msgs = $nowa->channel_recent; 
    1422warn Dumper($msgs); 
    15 warn Dumper($chans); 
    16 print "$point nowa yen!\n";