wassr-post.pl #

Wassr に、terminal からワサワサする
wassr2growl.pl は WebService::Simple 使ったので、今日はNet::Wassr 使ってみた

初めて実行した時に ID と PW を入力し ~/.wassr-post.yaml を生成
#higemaru で始まる時はチャンネル higemaru に投稿
@higemaru で始まる時は最近の友達の発言を取得して
- 最近の higemaru の発言を取得できたらその発言にレス
- 取得できなかったら普通に発言
それ以外は全部普通に発言

Terminal が UTF-8 の時しか考慮してません。あしからず

 #!/usr/bin/perl
 
 use strict;
 use warnings;
 
 use Net::Wassr;
 
 use YAML;
 use File::HomeDir qw(home);
 use File::Spec;
 use IO::Prompt;
 use Encode;
 
 my $VERSION = '0.1';
 
 my $conf_file = File::Spec->catfile(home, '.wassr-post.yaml');
 
 my $conf = {};
 unless ( -e $conf_file ) {
     $conf->{user} = prompt('user: ').'';
     $conf->{passwd} = prompt('passwd: ',-echo => '*').'';
     YAML::DumpFile($conf_file, $conf);
     chmod 0600, $conf_file;
 }
 $conf = YAML::LoadFile($conf_file);
 
 my $wassr = Net::Wassr->new(
                             user => $conf->{user},
                             passwd => $conf->{passwd}
                            );
 
 my $status = prompt('mes: ').'';
 
 if ( $status ) {
     if ( utf8::is_utf8($status) ) {
         $status = encode('utf8', $status);
     }
     $status =~ s/[\\x00-\\x1f]//g;
 
     if ( index($status,'#') == 0 ) {
         my @tmps = split /\\s+/, $status, 2;
         if ( scalar(@tmps) == 2 ) {
             my $mes = {
                        body => $tmps[1],
                        name_en => $tmps[0],
                       };
             $mes->{name_en} =~ s/^#//;
 
             my $s = $wassr->channel_update($mes);
             warn Dump $s;
         }
     }
     else {
         my $mes = {
                    source => 'Net::Wassr',
                    status => $status,
                   };
         if ( index($status,'@') == 0 ) {
             my @tmps = split /\\s+/, $status, 2;
             if ( scalar(@tmps) == 2 ) {
                 $mes->{status} = $tmps[1];
                 $tmps[0] =~ s/^@//;
 
                 my $f_timeline = $wassr->friends_timeline();
                 for (@$f_timeline) {
                     if ( $_->{user_login_id} eq $tmps[0] ) {
                         $mes->{reply_status_rid} = $_->{rid};
                         last;
                     }
                 }
             }
         }
         my $s = $wassr->update($mes);
         warn Dump $s;
     }
 }

wassr-post.pl #

See Also