Perl Archive

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

初回実行時に、id と pw の入力をうながすようにした

Wassrの、自分が購読中の人のヒトコト (friends_timeline) をGrowlに通知する

初めて実行した時に ~/.wassr2growl.yaml が生成されるので、そこに wassr の ID と PW を記入して、後は cron でよしなにまわすとよろし

2008-08-01 Net::Wassr で書き直し & friends_timeline だけでなく channel_timeline も取得するようにしました
2008-07-31 初回実行時に、id と pw の入力をうながすようにしました

#!/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;
use HTTP::Date;

use Mac::Growl;

my $VERSION = '0.4';

my $app = (File::Spec->splitpath($0))[2];
my $conf_file = File::Spec->catfile(home, '.wassr2growl.yaml');

my $conf = { lastupdate => 0 };
unless ( -e $conf_file ) {
    $conf->{user} = prompt('user: ').'';
    $conf->{passwd} = prompt('passwd: ', -echo => '*').'';
    YAML::DumpFile($conf_file, $conf);
    chmod 0600, $conf_file;
    Mac::Growl::RegisterNotifications(
                                      $app,
                                      ['all-timeline'],
                                      ['all-timeline']
                                     );
}
$conf = YAML::LoadFile($conf_file);

my $wassr = Net::Wassr->new(
                            user => $conf->{user},
                            passwd => $conf->{passwd}
                           );

# Friend TimeLine
my $messages = $wassr->friends_timeline();

# Channel TimeLine
my $clist = $wassr->channel_user();
for my $c ( @{$clist->{channels}} ) {
    my $r = $wassr->channel_timeline($c);
    for ( @$r ) {
        push @$messages, {
                          name_en => $c->{name_en},
                          epoch => HTTP::Date::str2time( $_->{created_on} ),
                          user => {
                                   screen_name => $_->{user}->{nick}
                                  },
                          text => $_->{body},
                         };
    }
}

# sort by epoch
my @mes = sort { $b->{epoch} <=> $a->{epoch} } @$messages;

my @allmes = ();
for my $re ( @mes ) {
    last if $re->{epoch} <= $conf->{lastupdate};

    my $str .= sprintf('(%02d:%02d:%02d) ',reverse((gmtime($re->{epoch}+9*3600))[0..2]));
    if ( $re->{reply_message} ) {
        $str .= '> '.$re->{reply_message};
        $str .= ' by '. $re->{reply_user_nick} if  $re->{reply_user_nick};
        $str .= "\n";
    }
    elsif ( $re->{name_en} ) {
        $str .= '[#'.$re->{name_en}.'] ';
    }
    $str .= $re->{text} . ' by ' . $re->{user}->{screen_name};
    if ( utf8::is_utf8($str) ) {
        $str = encode('utf8', $str);
    }
    $str =~ s/[\x00-\x1f]//g;
    push @allmes, $str;
}

if ( scalar(@allmes) ) {
    $conf->{lastupdate} = $mes[0]->{epoch};
    YAML::DumpFile($conf_file, $conf);
    chmod 0600, $conf_file;

    Mac::Growl::PostNotification(
                                 $app,
                                 'all-timeline',
                                 $conf->{user}.'@Wassr',
                                 join("\n----\n",@allmes),
                                 1
                                );
}

exit;

つうか、整理する

ぜんぜん Minimal でなくなったので、テストケースも肥大化
　↓
途中で面倒になってテケトウなテスト
　↓
こりゃ配布できんわ <= 今ここ

というわけで、書き始めたわけでも整理し始めたわけでもなくて、整理しようと決心しただけ

• Cookie 食べたりするのに手で書くのが面倒になったので、CGI::Cookie ぽい何か 07/01 完了
• ついでに Session 管理っぽいこともできると楽しいかな
• db 関連は C::M::A::DBI として実装したので、C::M::App からはバッサリ消す
• ところどころにある日本語コメントをなんとかする
• C::M::A::Util の整理

ドキュメントには

truncate text not the number of bytes but the number of characters

って書いてるのに、ネーミングが「Truncate by word」って。。。意味が変 orz

Template::Plugin::TruncateByWord を公開

[% "あいうえお" | truncate_by_word(3, "。。。") %]
# result あいう。。。

って感じ。こういうものの英語ドキュメントは困るなぁ。UTF8 で書いて、ひらがないれてしまってもいいのかな

NAME
    Template::Plugin::TruncateByWord - A Template Toolkit filter to truncate
    not the number of bytes but characters

SYNOPSIS
      # result is 'ab'
      [% USE TruncateByWord %]
     [[% 'abcdefg' | truncate_by_word(2) %]] 
      # result is 'abc....'
      [% USE TruncateByWord %]
      [% FILTER truncate_by_word(3,'....') %]
      abcdefg
      [% END %]

      # default charset = 'utf8'. you can change this.
      # result is 'abcd'
      [% USE TruncateByWord 'euc-jp' %]
      [% FILTER truncate_by_word(4) %]
      abcdefg
      [% END %]

DESCRIPTION
    Template::Plugin::TruncateByWord is a filter plugin for Template Toolkit
    which truncate text not the number of bytes but the number of
    characters.

BUGS
    If found, please Email me. I tested utf8, euc-jp, shiftjis, 7bit-jis,
    big5, and euc-kr. Please send me more test cases.

SEE ALSO
    Template, Template::Plugin::Filter, and t/*.t

AUTHOR
    User & KAWABATA Kazumichi (Higemaru) <kawabata@cpan.org>

COPYRIGHT AND LICENSE
    Copyright (C) 2008- KAWABATA Kazumichi

    This library is free software; you can redistribute it and/or modify it
    under the same terms as Perl itself.

こんなもんでいいか

package Template::Plugin::TruncateByWord;

use strict;
use warnings;

our $VERSION = '0.1';

use Template::Plugin::Filter;
use base 'Template::Plugin::Filter';

use Encode;

our $FILTER_NAME_DEFAULT = 'truncate_by_word';
our $ORG_ENC_DEFAULT = 'utf8';

sub init {
    my $self = shift;
    $self->{_DYNAMIC} = 1;
    $self->install_filter($self->{_CONFIG}->{name}||$FILTER_NAME_DEFAULT);
    $self->{_CONFIG}->{enc} ||= $self->{_ARGS}->[0] || $ORG_ENC_DEFAULT;
    return $self;
}

sub filter {
    my($self, $string, $args, $conf) = @_;

    return '' unless $string;

    # decode
    my $org_enc;
    unless ( utf8::is_utf8($string) ) {
        $org_enc = $self->{_CONFIG}->{enc};
        $string = Encode::decode($org_enc, $string);
    }

    my $org_length = CORE::length($string);
    my $length = $args->[0] || $org_length;
    return if $length =~ /\D/;
    $string = CORE::substr($string, 0, $length);

    my $suffix = $args->[1]||'';
    # revive encode
    $string = Encode::encode($org_enc, $string) if $org_enc;
    return $org_length > $length ? $string.$suffix : $string ;
}

1;

喉元過ぎれば、の可能性ありなので書いておく

二年前の日記で DateTime::Format::DateParse をあつかっている
にもかかわらず、最近やった仕事でまんま二年前に「今までやってた」とかいう手法に近いことをやっている自分が気にいらない

最近の自分は「DateTime は入っていないサーバ多いのであまり使わない」という感じだったのだが、それならそれで、DateTime を使わずに同等のことをスマートに行う解を設けておくべきだ。gmtime、timegm、HTTP::Date をベタに使ってるあたりがどうにも頂けない

。。。というような事になったのは、自分用細かいものライブラリが古くて使いたくなくなってるのも一因なので、CGI::Minimal::App::Util をまじめに作っておくことにした

もうちょっと探して似たようなものがなければ、pod 書いて公開するか

とか言った手前、調べてみた
「文字数」ってのは見つからなかったので公開しようとしたが、文字コードの自動判別なんかいらなくね？　それよりも、文字コード自分で指定したいんじゃね？　って思ったのでそれをまず修正することにした

で、その途中で見つけた、いつか使いそうなものたち。全角を半角 2 文字分として truncate するもの

• Text::VisualWidth
• Template::Plugin::Filter::VisualTruncate

こちらの方が需要ありそうですね。つうか、需要があるから既に世の中にあるのですね。それにしても「文字数」で truncate するのって需要ないんでしょうか？　そういう時はみなさんフラグ付で Template-Toolkit に渡してるんでしょうか？　いろいろ地雷じゃないんでしょうか？

というような事を思ったので、しばらく TT の実験してみることにした