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;
    }
}