Changeset 15611

Show
Ignore:
Timestamp:
07/10/08 15:57:27 (6 years ago)
Author:
yappo
Message:

reply hack とりあえずコミット

Files:
1 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/misc/WassrPod/wassrpod.pl

    r15608 r15611  
    2020    isa     => 'Int', 
    2121    default => 9277; # 9277 = wassr 
     22 
     23has timeline_cache =>  
     24    is      => 'ro', 
     25    isa     => 'Int', 
     26    default => 100; 
     27 
     28my $timelines = []; 
     29sub timelines { $timelines }; 
     30my $timeline_map = {}; 
     31sub timeline_map { $timeline_map }; 
    2232 
    2333sub run { 
     
    7383    $ua->default_headers($headers); 
    7484    $ua; 
     85} 
     86 
     87sub _gen_timeline_id { $_[0]->{type}.':'.$_[0]->{rid} }; 
     88sub add_timeline { 
     89    my $self = shift; 
     90    return unless @_; 
     91    for my $data (@_) { 
     92        my $id = _gen_timeline_id $data; 
     93        next if $self->timeline_map->{$id}; 
     94        unshift @{ $self->timelines }, $data; 
     95        my $pop; 
     96        $pop = pop @{ $self->timelines } if scalar(@{ $self->timelines }) > $self->timeline_cache; 
     97        next unless $pop; 
     98        my $delete_id = _gen_timeline_id $pop; 
     99        delete $self->timeline_map->{$delete_id} if exists $self->timeline_map->{$delete_id}; 
     100    } 
    75101} 
    76102 
     
    121147        }; 
    122148        push @{ $data->{statuses}->{status} }, $tmp; 
     149 
     150        $self->add_timeline({ 
     151            type => 'friend', 
     152            user => $status->{user_login_id}, 
     153            rid  => $status->{rid}, 
     154            text => $status->{text}, 
     155        }); 
    123156    } 
    124157 
     
    127160    $xml = qq{<?xml version="1.0" encoding="UTF-8"?>\n$xml}; 
    128161    $xml; 
     162} 
     163 
     164sub _fecth_replyid { 
     165    my($self, $user, $prefix) = @_; 
     166    for my $data (@{ $self->timelines }) { 
     167        next if $user && $data->{user} ne $user; 
     168        my $text = $data->{text}; 
     169        $text =~ s/^@[\w\d\-_]+\s*//; 
     170        warn $text.'////'.$prefix; 
     171        return $data->{rid} if $text =~ /^$prefix/; 
     172    } 
     173    return; 
    129174} 
    130175 
     
    143188        return $ret->content; 
    144189    } else { 
    145         my $ret = $ua->post('http://api.wassr.jp/statuses/update.json', { 
     190        my $data = { 
    146191            status => $status, 
    147192            source => $source, 
    148         }); 
     193        }; 
     194        if (my($user, $prefix) = $status =~ /^(@[\w\d\-_]+)?.*>\s*([^>]+)$/i) { 
     195            my $rid = $self->_fecth_replyid($user, decode('utf8', $prefix)); 
     196            $data->{reply_status_rid} = $rid if $rid; 
     197            warn "REPLY ID: $rid"; 
     198        } 
     199        my $ret = $ua->post('http://api.wassr.jp/statuses/update.json', $data); 
    149200        return $ret->content; 
    150201    }