perl-mongers.org

みんなで Perl を楽しく使えたらいいね！という目的のもと、perl-mongers.org をはじめます。

perl-mongers.org では、OpenID を持ってる人ならサインインするだけでスグに書けちゃいます。

Perl について書いてみたいことがあるヒトは、まずはこのフォームから今すぐサインイン！（詳細）

ブログ書いて Perl を盛り上げていこう！

Moose & Mouse基本文法最速マスター/The Fastest Way to Mastering Moose & Mouse

はじめまして。gardejoこと守屋と申します。

この文書はPerlの拡張モジュールMooseによるポストモダンオブジェクト指向プログラミングの文法や作法などを簡易的にまとめたものです。Perl5の基本文法に習熟していて、かつ、言語を問わず一般的なオブジェクト指向についての知識がある人を想定読者としています。

内容はMooseのバージョン0.98に基づきます。Mouseのバージョン0.50_01時点の内容も付記しています。

誤っている点, ご不明な点, 冗長すぎてかえって初学者を混乱させかねないため削除すべき点などがありましたら、コメントやトラックバックなどでお寄せいただければ幸いです。適宜改訂します。

目次/Table of Contents

• クラス/Classes
• ロール/Roles
• シュガー関数/Sugar Functions
• アトリビュート構築オプション/Attribute Constructor Options
• 型/Types
• 委譲/Delegation
• インスタンスの生成と破棄/Construction and Destruction of Instances
• その他の内容の触り/Other Tidbits
• 情報源など/See Also

明けましておめでとうございます！ mumumu です。

僕は普段 Perl を使ってないんだけど、たまに CPAN module をインストールする機会があります。その際に毎回うざいなって思うのが、依存関係にあるモジュールをインストールしますか？ って以下のように聞かれること。このときエンターキーを連打したくないわけです。

---- Unsatisfied dependencies detected during ----
----       MIYAGAWA/XML-Atom-0.37.tar.gz      ----
    XML::LibXML [requires]
    XML::XPath [requires]
Shall I follow them and prepend them to the queue
of modules we are processing right now? [yes]

つまり僕がやりたいのは、こうした CPAN の問いかけに自動で yes と答えて貰うようにしたいということ。

ちょっとぐぐったら yes コマンドを使ったりとか、PERL_AUTOINSTALL='--defaultdeps' の環境変数を設定したりだとかいろいろ出てきたけど、tokuhiromさん に教えて貰った以下の方法が一番効いたので書いておくことにしますです。

$ sudo perl -MCPAN -e shell
cpan> o conf prerequisites_policy follow
cpan> o conf commit

多分慣れた人には当然なんだろうけど、たまに使う俺はちょっと感動しますた(´ー｀; )

どうも、お久しぶりの vkgtaro です。自分の blog に書こうかと思ったんだけど、購読者数が多いこちらに書くよ！

JPA の活動とか charsbar さんの連載で Catalyst が盛り上がってきてますね。と言うことで、Catalyst::Controller::Resources を紹介したいと思います。（JPA のセミナーでは Action::REST が紹介されてたようだけど、個人的には Resources が好きです。Resources 使うために Catalyst 使ってると言っても過言じゃないくらい。）

Resources を使うと HTTP method の GET / POST / PUT / DELETE に応じた Chained がカンタンに作れます。Ruby on Rails をやったことある人だと map.resources と言えばわかるのかな？　僕は rails やったことがないのでわからないんですけれども。

使い方はこんな風に Catalyst::Controller の代わりに Catalyst::Controller::Resources を使うだけ。

package Jnsn::Controller::Articles;

use strict;
use warnings;
use parent 'Catalyst::Controller::Resources';

これで、以下のような URI / method と action のマップができる。

これは、対応する action を作らなければ実際にはチェーンされません。
なので必要ない URI は作りたくないという人も安心です。

ちなみに {article_id} は、3番めの引数として渡ってくるよ。

# PUT /articles/{article_id}
sub update {
    my ($self, $c, $article_id) = @_;
}

この id を特定して何かの操作をするものを member, そうじゃないやつを collection と REST では言うみたいですね。（内部的には member と colllection に chain してるのは起動時のデバッグログでわかりますね。）

Resources の魅力はまだあります。articles に属している comments を作りたいなぁ、URI は /articles/{article_id}/comments/{comment_id} みたくしたいなぁ、と思ったら Comments コントローラ内でこうすればいいです。

package Jnsn::Controller::Articles::Comments;

use strict;
use warnings;

use parent 'Catalyst::Controller::Resources';

__PACKAGE__->config(
    belongs_to => 'Articles',
);

こうすることによって Articles::Comments は Catalyst のチェーン的に Articles に属します。

さらに、マップにない action を追加したいなぁと思ったら、config で追加しましょう。
article 追加時の確認画面と編集時の確認画面を追加してみます。

# Jnsn::Controller::Articles;
__PACKAGE__->config(
    collection => {
        confirm => 'post',
    },
    member => {
        confirm_edit => 'post',
    }
);

# POST /articles/confirm
sub confirm {
    my ($self, $c) = @_;
}

# POST /articles/{article_id}/confirm_edit
sub confirm_edit {
    my ($self, $c, $article_id) = @_;
}

ね、カンタンでしょう？

ブラウザーから PUT と DELETE 送れない問題は Catalyst::Request::REST::ForBrowser を使うとうまくできるよ。

（参考：Catalyst::Controller::Resources でオーバーロード POST を使いたい - Yet Another Hackadelic）

なお、この記事は Catalyst 5.80004, Catalyst::Controller::Resources 0.07 で書いてます。Cat 5.7 系で Resources 使うときは 0.04 を使うといいですよ！

こんばんは。ビンゴ中西です。

Perlでは、

__DATA__

と書いた部分より下は、

まるで、すでにファイルをopenしたかのように使えます。

例1

use strict;
use Data::Dumper;

while(<DATA>){
  print $_;
}


__DATA__
ここは、ファイルのように
扱えますよ！

結果

ここは、ファイルのように
扱えますよ！

こんな感じです。

ファイルを使って本処理を進めるまえに、ちょっとしたことを考えるのに便利です。

データ構造をどのようにするか？

たとえば、CSVのファイルをどのような構造で持つか

といったことは、

例2

use strict;
use Data::Dumper;

my @c;
while(<DATA>){
  chomp $_;
  push @c, [split ',', $_];
}
print Dumper \@c;


__DATA__
OK,bbbb,ccc
NG,eee,ffff

結果

$VAR1 = [
          [
            'OK',
            'bbbb',
            'ccc'
          ],
          [
            'NG',
            'eee',
            'ffff'
          ]
        ];

例3

use strict;
use Data::Dumper;

my $c = {};
while(<DATA>){
  chomp $_;
  my @d   = split ',', $_;
  my $key = shift @d;
  $c->{$key} = \@d;
}
print Dumper $c;


__DATA__
OK,bbbb,ccc
NG,eee,ffff

結果

$VAR1 = {
          'OK' => [
                    'bbbb',
                    'ccc'
                  ],
          'NG' => [
                    'eee',
                    'ffff'
                  ]
        };

などと書いてみて、考えることができます。

もっと考えをおし進めて

もっと考えをおし進めて、ファイルの内容と処理をどう結びつけようか

なんてことも　こんな風に考えれます。

例4

use strict;

my $f = {
         'OK' => sub { print "@_" . 'は 大丈夫です', "\n"; },
         'NG' => sub { print "@_" . 'は ダメです',   "\n"; }
        };

my $c = {};
while(<DATA>){
  chomp $_;
  my @d   = split ',', $_;
  my $key = shift @d;
  $f->{$key}->(@d);
}


__DATA__
OK,bbbb,ccc
NG,eee,ffff

結果

bbbb cccは 大丈夫です
eee ffffは ダメです

ファイルを open したりといったことを考えなくていいですし、

考えるファイルの中身も、ソースと同じファイルに入っているので、編集が容易です。

高階関数の考え方でmapを見てみる

記事の意図から外れちゃうかもしれないけど、、、

それprototypeでできるよ。

use strict;
use warnings;

sub my_map (&@) {
    my $code = shift;
    my @array;
    for my $val (@_) {
        push @array, $code->($val);
    }
    return @array;
}

my @c = 1..4;
my_map { print "aa\n"; } @c;

print "---------\n";
my @d = my_map { $_[0] ** 2 } @c;
print "@d", "\n";

print "--------\n";
my_map  { $_[0]++ } @c;
print "@c\n";

 perl ./bingo.pl 
aa
aa
aa
aa
---------
1 4 9 16
--------
2 3 4 5

ビンゴ中西と申します。

関数が、関数に渡せることが書かれていましたので、

mapのことを考えたいと思います。

@c = map { $_*2 } 1..3;
print "@c\n";

結果：

2 4 6

これって、

map の { } の部分に sub を付けてみると、

まあ、無名関数を map に与えたみたい！

ということで、map のように振る舞う。my_mapという関数を簡単に書いてみました。

use strict;

sub my_map{
  my @array;
  for(@{$_[1]}){
    push @array, $_[0]->($_);
  }
  return @array;
}

my @c = 1..4;
my_map( sub{ print "aa\n"; }, \@c);

print "---------\n";
my @d = my_map( sub{ $_[0] ** 2 }, \@c);
print "@d", "\n";

print "--------\n";
my_map( sub { $_[0]++ }, \@c );
print "@c\n";

結果：

aa
aa
aa
aa
---------
1 4 9 16
--------
2 3 4 5

mapに似たような機能で grep というのがありますが、おなじように

grep に与える { } の部分はなにか関数を渡しているように感じられます。

私は、関数に、関数が渡せるということを知ってmapがすんなり理解できた気がしました。

私の下手な関数は使わずに、ぜひ、map と grep　という機能をどんどん使って楽しいプログラミングを行いましょう〜

※本記事は、mapの代替品を作ったというわけや、mapを完全に再現したというわけではありません。

Perlの関数は第一級オブジェクトなので"物"として扱えます。関数オブジェクトは処理内容であり、任意のタイミングでそれを実行することができます。

Perlでは関数リファレンスと呼ばれるものによって関数オブジェクトを表します。関数リファレンスは、関数名を与えないsubで生成したり、関数名に \& をつけることで取得できます。

my $hello_function = sub {
    print "hello\n";
};

sub bye {
    print "bye\n";
};

my $bye_function   = \&bye;

$hello_function->();
$bye_function->();

関数は"物"なので、もっと自由なことができます。例えば、他の関数にお好みの関数を作ってもらうことができます。

sub greeting_function{
    my $greeting = shift;
    return sub {
        print "$greeting\n";
    };
}

my $hello_function = greeting_function('hello');
my $bye_function   = greeting_function('bye');

$hello_function->();
$bye_function->();

ここでもう一つ、関数はクロージャであると言う性質が出て来ています。greeting_functionで生成する関数の中に $greeting が登場していますが、これは外の世界の変数です。Perlの関数はクロージャとなるように実装されていますので、生成される関数は外の世界の変数 $greeting をそのまま参照し続けます。

クロージャの性質を使うと、生成されたコンテキストによって処理内容が変わる関数を作成できます。先ほどの例だと、引数が 'hello' の時は'hello'を表示する関数、引数が'bye'の時は'bye'を表示する処理がそれぞれ生成されました。

逆に、関数の呼び出しによって関数作成元のコンテキストに影響を与えることも出来ます。

sub call_with_greeting{
    my $function = shift;
    $function->('hello');
    $function->('bye');
}

my @greetings;
my $callback = sub {
    my $greeting = shift;
    push @greetings, $greeting;
}

call_with_greeting($callback);

print map {"$_\n"} @greetings;

$callbackが呼ばれる度に、@greetingsに挨拶文が加えられます。call_with_greeting関数内で$callbackを呼び出すことで、call_with_greeting関数外(生成した時のコンテキスト)に含まれる@greetingsを変化させていることに注目して下さい。

関数オブジェクトから新しい関数オブジェクトを作る関数を揃えると、以下のようなコーディングもできます。

sub greeting_function{
    my ($greeting, $print_function) = @_;
    return sub {
        $print_function->($greeting);
    }
}

sub with_newline{
    my $function = shift;
    return sub {
        $function->(map {"$_\n"} @_);
    }
}

sub print{
    print @_;
}

sub executer{
    my @functions = @_;
    $_->() foreach @functions;
}

my $hello_function = greeting_function('hello', with_newline(\&print));
my $bye_function   = greeting_function('bye'  , with_newline(\&print));

executer($hello_function, $bye_function);

与えられたwith_newline、greeting_functionといった道具を駆使して、print関数から目的の関数を作ってます。

そして、メインルーチンでは関数の作成だけに専念し、実行に関してはexecuterに任せています。このように、処理を作成する場所と実行する場所を分離することも出来ます。

クリスマス終わりましたね！ しらんけど。

ということで、年末なんで、メンテナンスもかねて、blogの整理をしているんですけれども、使っているサービスが、かつてBoxerBLOGだったTypePad.jpでして、これでblogを50こぐらい作っている状況なのですが、これらのblogで、投稿するときに設定できるカテゴリーを増やすとき、今までは50回blogのコントロールパネルでしこしこ入力していたわけですけれども、単純労働過ぎるので、スクリプトを作りました。

TypePad.jpは、その名の通り、TypePad ASPで構築されていますので、DBを直接いじれません。従って、人間が実際行うやり方をまねる方法、つまりロボットを作ることになります。

以下のスクリプトは、WWW::Mechanizeを使ったTypePad系blogの複数blogカテゴリ追加スクリプトとなります。

クリスマス前に使ったので大丈夫だと思いますが、こっちでは保証しませんのであしからず。

FileName: add_category.pl

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use Encode;
use WWW::Mechanize;
my $login_id = 'login_id';
my $password = 'password';
my $add_category_word = '便座カバー';
my $base_url = 'https://www.typepad.jp/t/app'; # TypePad.jp
# my $base_url = 'https://app.cocolog-nifty.com/t/app'; # ココログ
my $categores_url = "$base_url/weblog/configure?__mode=categories&blog_id=";
my $bloglist = [
  20721, # ブログ1。ログイン後のblog一覧のソースから取得しておこう
  26969, # ブログ2
  21919, # ブログ3
];
 
# 開始
 
my $mech = WWW::Mechanize->new();     # Mechオブジェクト用意
$mech->agent_alias( 'Windows IE 6' ); # IE6になりきる
 
# ログイン
 
$mech->get( $base_url ); # ログインする：認証ページへ
$mech->form_number( 1 ); # 認証ページの最初のフォームを選択
$mech->set_visible( $login_id, $password ); # ログイン・パスワード入力
$mech->submit(); # 送信
 
# カテゴリー追加処理
 
foreach my $blog_id (@$bloglist) { # $blog_idを$bloglistから1つずつ入力
  my $url = "$categores_url$blog_id"; # 各blogのカテゴリーメンテページURL生成
  print "$url\n";
  $mech->get($url);      # カテゴリーメンテページに移動
  $mech->form_number(1); # カテゴリーメンテページの最初のフォームを選択
  $mech->field( 'category-new'               # 新しいカテゴリー名を
    => encode('utf8', $add_category_word),); # 入力
  $mech->submit();       # 送信
}
 
exit;
 
__END__

こういうの無いかなぁと思ってました。

例えば任意のサイトのサマリを作りたい時、HTMLをテキスト化して一定文字数で削る訳ですが、どこからどこまでが本文かはそのサイト製作者の意図する所であってなかなか難しい処理かと思います。

今回ご紹介するHTML::ExtractContentはHTMLの内容を判断しコンテンツの本文らしき部分を抜き出せる凄いモジュールです。

ソースを見ましたがテキストに含めるかどうかの閾値が設定されており、かつ句読点まで判断しています。ソースはutf-8で書かれており、おそらく作者は日本人(もしくは日本通)かと思われます。

試しに先日の記事URLから本文を抜き出してみたいと思います。

use strict;
use warnings;
use HTML::ExtractContent;
use LWP::UserAgent;

my $agent = LWP::UserAgent->new;
my $res = $agent->get('http://perl-mongers.org/2008/09/template-refine.html');

my $extractor = HTML::ExtractContent->new;
$extractor->extract($res->decoded_content);
print $extractor->as_text;

コードもこれだけ。そして実行結果。

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の属性値さえ決めておけば、テンプレートの殆どをデザイナさんに任せてしまう事も出来る様になります。
すばらしいですね。

ちゃんと本文が取れています。ヘッダ部やページ右にあるナビゲータの文字は含まれていません。

すばらしいですね。他のアプリケーションにも簡単に取り込めそうですし期待が膨らみます。

どなたかこれを使ったウェブサービスを作ってみませんか。

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

というわけで、今回は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でクロネコヤマトの荷物お問い合わせが出来ればいいよね
あたりが元ネタです。