NeverBlog::Likk::Unexistable;

見なかったことにして下さい

ついカッとなって WWW::Wassr書いた

Perl

まぁ、正直なところNet::Wassrがあれば全然事足りるんですが、
Net::Wassrだと最新20発言しかとって来れなかったり、レスをするのに twitterと同じく@id記法でのレスなので、「どの発言に対してレスをする」という方法ができなかったり、*1channelにヒトコト投げられなかったり*2

まぁ、そんなんで channelにヒトコト投げたいという衝動が抑えられずにキーボードを手に取った次第です。

package WWW::Wassr;
use strict;
use warnings;
use WWW::Mechanize;
use Web::Scraper;
use LWP::Simple;
use Data::Dumper;

sub new {
	my $class = shift;
	my %args = @_;
	$args{'wm'} = WWW::Mechanize->new();
	$args{'site_root'} = 'http://wassr.jp';
    return bless {%args}, $class;
}	

sub login{
	my $self = shift;
	$self->{'wm'}->get("$self->{site_root}");
	my $forms = $self->{'wm'}->forms();
	my $CSRFPROTECT = $forms->[0]->{'inputs'}->[0]->{value};
	$self->{'wm'}->submit_form(
			form_name => 'LoginForm',
			fields	=> {
				CSRFPROTECT => $CSRFPROTECT,
				login_id => $self->{user},
				login_pw => $self->{passwd},
				}
			) or die "login submitting failed $!";
}

sub logout{
	my $self = shift;
	$self->{'wm'}->get("$self->{site_root}/my");
	my $forms = $self->{'wm'}->forms();
	my $CSRFPROTECT = $forms->[0]->{'inputs'}->[0]->{value};
	$self->{'wm'}->submit_form(
			form_name => 'LogoutForm',
			fields	=> {
				CSRFPROTECT => $CSRFPROTECT,
				}
			) or die "logout submitting failed $!";
}


sub public_timeline{
	my $self = shift;
	my %args = @_;
	my $page = $args{page} || 1;
	my $data = $self->{'wm'}->get("$self->{site_root}/status/?page=$page");
	return $self->_parce($data);	
}

sub user_timeline{
	my $self = shift;
	my %args = @_;
	my $page = $args{page} || 1;
	my $user_id = $args{user_id} || $self->{user};
	my $with_friends = $args{with_friends}||0;
	my $data = $self->{'wm'}->get("$self->{site_root}/user/$user_id?page=$page&with_friends=$with_friends");
	return $self->_parce($data);
}

sub sl_timeline{
	my $self = shift;
	my %args = @_;
	my $page = $args{page} || 1;
	my $data = $self->{'wm'}->get("$self->{site_root}/status/sl_list?page=$page");
	return $self->_parce($data);	
}

sub fav_timeline{
	my $self = shift;
	my %args = @_;
	my $page = $args{page} || 1;
	my $data = $self->{'wm'}->get("$self->{site_root}/favorite/?page=$page");
	return $self->_parce($data);	
}

sub channel_timeline{
	my $self = shift;
	my %args = @_;
	my $channel_id = $args{channel_id} || '';
	(warn (q{no value channel_id; Exp channel_timeline{'channel_id' => "wassr_request"}}) and return undef) if(!defined $channel_id or $channel_id eq '');
	my $page = $args{page} || 1;
	my $data = $self->{'wm'}->get("$self->{site_root}/channel/$channel_id?page=$page");
	return $self->_channel_parce($data);
}


sub _parce{
	my $self = shift;
	my $data = shift;
	my $scraper = scraper {
		process 'div.MsgBody>p.messagefoot>a.MsgDateTime', 
					'message[]'  => '@title',
					'status[]' => '@href',
					'ymdhms[]' => 'TEXT';		
		result 'message','status','ymdhms';
	};
	my $result = $scraper->scrape($data->{_content});
	my $time_line = ();
	for  (0..$#{$result->{message}}){
		my $line = {};
		my @st = split m{/},$result->{status}->[$_];
		$line->{message} = $result->{message}->[$_];
		$line->{ymdhms} = $result->{ymdhms}->[$_];
		$line->{id} = $st[2];
		$line->{status} = $st[4];
		push @$time_line,$line
	}
	return $time_line;	
}

sub _channel_parce{
	my $self = shift;
	my $data = shift;
	my $scraper = scraper {
		process 'div.MsgBody>p.messagefoot>a.MsgDateTime', 
					'status[]' => '@href',
					'ymdhms[]' => 'TEXT';		
		process 'div.MsgBody>p.messagefoot>a.MsgUserName', 
					'id[]' => '@href',
					'name[]' => 'TEXT';		
		process 'div.MsgBody>p.message','message[]' => 'TEXT';
		result 'message','id','status','ymdhms'
	};
	my $result = $scraper->scrape($data->{_content});
	my $time_line = ();
	for  (0..$#{$result->{message}}){
		my $line = {};
		my @id = split m{/},$result->{id}->[$_];
		$line->{id} = $id[2];		
		$line->{message} = $result->{message}->[$_];
		$line->{ymdhms} = $result->{ymdhms}->[$_];
		push @$time_line,$line
	}
	return $time_line;	
}


sub update{
	my $self = shift;
	my %args = @_;
	my $message = $args{status}||'';
	(warn (q{no value status; update{'status' => "message"}}) and return 0) if(!defined $message or $message eq '');
	my $id = $args{user_id}||'';
	my $rid = $args{reply_status_rid}||'';
	if(defined $id and $id ne ''
		and defined $rid and $rid ne ''){
		$self->{'wm'}->get("$self->{site_root}/user/$id/statuses/$rid");			
		my $forms = $self->{'wm'}->forms();
		my $CSRFPROTECT = $forms->[1]->{'inputs'}->[0]->{value};
		my $reply_status_id = $forms->[1]->{'inputs'}->[2]->{value};
	
		$self->{'wm'}->form_number(2);
		$self->{'wm'}->set_fields(
					'CSRFPROTECT' => $CSRFPROTECT,
					'reply_status_id' =>$reply_status_id,
					'message' => $message
					);
		$self->{'wm'}->submit or die($!);
	}else{
		$self->{'wm'}->get("$self->{site_root}/my");
		my $forms = $self->{'wm'}->forms();
		my $CSRFPROTECT = $forms->[1]->{'inputs'}->[0]->{value};
	
		$self->{'wm'}->form_number(2);
		$self->{'wm'}->set_fields(
					'CSRFPROTECT' => $CSRFPROTECT,
					'message' => $message
					);
		$self->{'wm'}->submit or die "update submitting failed $!";
	}
}

sub channel_update{
	my $self = shift;
	my %update = @_;
	my $channel_id = $update{channel_id};
	my $message = $update{message};
	$self->{'wm'}->get("$self->{site_root}/channel/$channel_id");
	my $forms = $self->{'wm'}->forms();
	my $CSRFPROTECT = $forms->[1]->{'inputs'}->[0]->{value};
	my $channel_rid = $forms->[1]->{'inputs'}->[2]->{value};
	$self->{'wm'}->form_number(2);
	$self->{'wm'}->set_fields(
				'CSRFPROTECT' => $CSRFPROTECT,
				'body' => $message,
				'channel_rid' =>$channel_rid
				);
	$self->{'wm'}->submit or die "channel_update submitting failed $!";
}
1;

出来るだけ、Net::Wassrに近い感覚で使えるように…と思ったけど、出来なかったのは内緒。

ログイン〜自分の最新の発言30を取るのは以下な感じ

use strict;
use warnings;
user WWW::Wassr;
use Data::Dumper;

my $w = WWW::Wassr::TrainInfo->new(    	#ID/PW指定して
 	'user' => 'userid',
	'passwd' => 'password',
);
$w->login();   	   	   	   	#ログインして
my $t = $w->user_timeline(); 	 	#timelineを取得
print Dumper $t;
}

user_timeline() はデフォルトで自分のID,そのIDの発言のみ,Webの1ページ目を取得します。
id:likkとその購読者を含む2ページ目というのであれば、
my $t = $w->user_timeline(
'user_id' => "likk",
'with_friends' => 1,
'page' => 2);
となります。
public_timeline,sl_timeline,fav_timelineも取り揃えています。
channelの発言取得は、
channel_timeline(
'channel_id' => 'wassr_request',
#'page' => 1);
という感じで、channel_idを指定して下さい。

ヒトコト発言する場合は以下な感じ

use strict;
use warnings;
user WWW::Wassr;
use Data::Dumper;

my $w = WWW::Wassr::TrainInfo->new(    	#ID/PW指定して
 	'user' => 'userid',
	'passwd' => 'password',
);
$w->login();   	   	   	   	#ログインして
$w->update(
	'status' => '発言したい内容'
	#レスであれば以下を指定(両方とも timelineで取得できます)
	'user_id' => 'レスするユーザのID'
	'reply_status_rid' => 'レスする発言のID');
};#ヒトコト発言/ツッコミ

$w->channel_update(
	"channel_id" => 'wassr_request',
	"message" => "発言したい内容"
);#ワッサー要望channelにヒトコト
#チャンネルへの発言は、そのチャンネルに参加してないと発言できません

まぁ、WWW::Wassrに無い機能も、ある機能もNet::Wassrが大体持ってますので、両方使うとより幸せな使い方が出来るかもしれません。

#TODOとして、TODOを可能にする、(自分の)繋がりを取得、新着レスの取得を追加したいな…。作りっぱな可能性が大きいですが。

*1:Web上からなら、特定のuserの特定の発言に対してレスが出来ます。

*2:20080421現在これを書いた時点でAPIが更新されているので、いずれNet::Wassr経由でも可能になると思います。