September 2008 Archives

仕事をしていると、荷物を宅配便で送る業務っていうのがあるんですけれども、宅配便業者さんに引き渡した後、ちゃんと届いたか確認したいってことありますよね。

というわけで、今回はPerlでクロネコヤマトの荷物照会のページをスクレイピングして、荷物の状況表示を回収するPerlスクリプトです。

応用すると、未配達の荷物を追跡して問い合わせるロボットなんかが作れるかもしれません。

今回は、モジュールにしてみましたので、ディレクトリをしっかり掘って使ってみてください。

Filename: WebService/KuronekoYamato.pm

package WebService::KuronekoYamato;
 
use warnings;
use strict;
use Carp;
 
use version; our $VERSION = qv('0.0.1');
 
# Other recommended modules (uncomment to use):
#  use IO::Prompt;
#  use Perl6::Export;
#  use Perl6::Slurp;
#  use Perl6::Say;
use Encode;
use WWW::Mechanize;
use Web::Scraper;
use YAML::Syck;
 
 
# Module implementation here
 
# コンストラクタ
sub new {
  my ( $class ) = shift;
  my $mech = WWW::Mechanize->new();
  $mech->agent_alias( 'Windows IE 6' );
  $mech->get('http://toi.kuronekoyamato.co.jp/cgi-bin/tneko?init');
  my $self = { mech => $mech, };
  bless $self;
}
 
# ヤマト運輸に問い合わせ
sub check {
  my $self    = shift;
  my $numbers = shift; # 荷物問い合わせ番号のリストのリファレンス
  # フォームの問い合わせは10件ごとなので10件ごとのリストのリストにする
  my $list; # 10件ごとに分割されたリストのリストが入る
  my $j = -1; #添え字調整
  foreach ( my $i = 0; $i < $#$numbers + 1; $i++ ) {
    $j++ unless $i % 10;
    push @{$list->[$j]}, $numbers->[$i];
  }
  # _requestを呼んで実際にWebアクセスする
  my $result = [];
  foreach my $item( @$list ) {
    my $res = _request($self, $item);
    push @$result, @$res; # 返答は最大10件なので、$resultにためていく
  }
  return $result; # 集まったリストを返す
}
 
# 実際にリストからアクセスする
sub _request {
  my $self = shift;
  my $list = shift;
  $self->{mech}->form_number(1);
  for ( my $i = 0; $i < $#$list + 1; $i++) {
    my $field = sprintf "number%02d", $i+1;
    $self->{mech}->set_fields( $field => $list->[$i]);
  }
  $self->{mech}->submit;
  
  # Web::Scraper による解析
  my $s = scraper {
    process '//tr/td[1]/input/../../td[2][contains(. , "-")]/..',
    'tneko[]' => scraper {
      process '//td[2]',
      number => 'TEXT',
      process '//td[3]',
      date => 'TEXT',
      process '//td[4]',
      status => 'TEXT',
    },
  };
  my $res = $s->scrape( # Shift_JISをUTF-8に変換
              encode('utf8', decode('cp932', $self->{mech}->content() ) )
            );
  # 得られた結果をリストで返す
  return $res->{tneko};
}
 
sub dump {
  my $self = shift;
  print Dump($self);
  return;
}
 
1; # Magic true value required at end of module
__END__

#!/usr/bin/perl
 
use lib qw(lib/);
package main;
use strict;
use warnings;
use YAML::Syck;
use WebService::KuronekoYamato;
use utf8;
 
 
my $n = WebService::KuronekoYamato->new();
my $res = $n->check([
  240000000000,
  240000000011,
]);
 
print Dump($res);
exit;

こんな感じで使うといいんじゃないでしょうか。身の回りにあるクロネコヤマトの発送伝票で試してみてください。

ねえよ。

今回のは、CoreReposにも置いてあります。正直言ってPerlのモジュールやらオブジェクト指向がよくわかっていないっぽいので、修正してもらえればなあとも思ってたり。

http://svn.coderepos.org/share/lang/perl/WebService-KuronekoYamato/

～～～

このようなスクリプトがあったところで、大事なのは、荷物が動いていなかったときの交渉と手配だったりすることは言うまでもありません。

今回のエントリは、
M.C.P.C.: クロネコヤマトの荷物お問い合わせシステムでテキストボックスへフォーカスを合わせるUser Script（Opera用）
M.C.P.C.: Plaggerでクロネコヤマトの荷物お問い合わせが出来ればいいよね
あたりが元ネタです。

大阪から、こんばんはこんばんは！

perlはモジュールが素敵なんだよ。たぶん、あなたの隣の席の、白い歯が似合うハンサムボーイより素敵だよ！

NIrvanaのRape Meの歌詞が見たい！とか急に思うよね。　思っちゃうよね。そういうときは、もちろんcpan 検索だね。

モジュール探す

http://search.cpan.org/search?query=lyrics

色々みつかったね！そのうちの一つをピックアップしたよ！

モジュールインストール

インストール！

sudo cpan install Lyrics::Fetcher::LyricWiki

ソース

歌詞をプリントアウトするよ

#!/usr/bin/perl

use strict;
use warnings;
use Lyrics::Fetcher::LyricWiki;
print Lyrics::Fetcher::LyricWiki->fetch('nirvana' , 'rape me');

良い子のみんな、表示できたよね！　結果貼付けると、著作権的に怒られるかもしれないから、

自粛したよ。よくわかってないけどね！

最後に

普通にgoogleで検索するより何か、ワクワクするでしょ。　こういった面白モジュールがたくさんみつかるのはperlが一番じゃないかな！　

ワクワクモジュールみつけたら、perl-mongers.orgに記事書くと良いと思うよ！

:wq!

Template::Refineというモジュールを見つけました。リンク先にある通り、ruleを使うことで簡単にテンプレートの値を置き換える事が出来ます。このモジュールの良い所は、テンプレートファイルにテンプレートエンジン専用の識別子を記述しなくて良い所。どうやって指定するかというと、XPathを使います。リンク先から引用すると

my $username = 'Test User';
my $rule = simple_replace {
    my $node = shift;
    return replace_text $node, $username;
} '//*[@class="username"]';

といった感じにルールを決め

$frag = $frag->process($rule);
say $frag->render;

と実行する事でテンプレートへの反映が行われます。まるでWeb::Scraperの様ですね。

今日はサンプルとして、美輪明宏のチンコの有無を返すAPIから得た結果をテンプレートに反映してみたいと思います。

まずテンプレート

<p>美輪明宏にチンコは...<span class="miwa">...</span>。</p>

確かにテンプレート専用の識別子は使用していません。そしてperlのコード

use strict;
use warnings;
use Encode;
use Perl6::Say;
use LWP::Simple;
use JSON;
use Template::Refine::Fragment;
use Template::Refine::Utils qw(replace_text simple_replace);

my $miwa = from_json(get "http://dzfl.jp/mojo/");
my $rule = simple_replace {
    my $node = shift;
	return replace_text $node, encode_utf8($miwa->{miwa} ? 'ある' : 'ない');
} '//*[@class="miwa"]';

my $frag = Template::Refine::Fragment->new_from_file('template.html');
print $frag->process($rule)->render;

HTMLのmiwaというクラス属性を持ったノードに対して"ある"/"ない"というテキストで置換しています。

簡単ですね。テンプレートエンジン専用の識別子を使用しないので、HTMLの属性値さえ決めておけば、テンプレートの殆どをデザイナさんに任せてしまう事も出来る様になります。

すばらしいですね。