Module::Setupで身に付けるよい習慣
あらすじ
前回[twitter:@hachiojipm]で行われた[twitter:@norry_gogo]さんのLTで次のような発言がありました。
自分が書いたPerlコードを添削してくれる人が周りにいなくて困ってる
添削したったでー
おすすめのファイル構成について
一枚岩のスクリプトだとテストがしづらいので普段から以下のようなディレクトリ構成にする事をおすすめします。
Your-Dist/script/*.pl Your-Dist/t/*.t Your-Dist/lib/**/*.pm Your-Dist/Makefile.PL
scriptはbinでも何でも良いと思います。こんな感じのディレクトリがいいと思います。
それを簡単につくるためのcpanモジュールがいくつかあるのですが、今回はその中からModule::Setupをおすすめします。
Module::Setupをインストール
cpanからModule::Setupをinstallします。
% cpanm Module::Setup
Module::Setupをインストールするとmoudule-setupというコマンドが使えるようになります。
% which module-setup /Users/okamura/perl5/perlbrew/perls/current/bin/module-setup
Makefile.PLに次のような行が記述されているとそこにperlで書かれたスクリプトが置かれるらしいです。
install_script('bin/module-setup');
スケルトンつくる
私は$HOME/project以下で作業する習慣があるので次のようにします*1
名前空間は適当です*2
% cd ~/project % module-setup Twitter::Reader % cd Twitter-Reader
[twitter:@norry_gogo]さんが作成したコードをもってきます。
% cd ~/project/Twitter-Reader % mkdir script % curl https://raw.github.com/gist/997598/2c05441a36fa9a8b7708afd5edf75e35e97b0d94/twitter_ril.pl -o script/read_it_later.pl
とりあえず実行してみる
とりあえず生で乾杯ぐらいの気持ちで以下の作業を行います。あらら、モジュールが入ってませんでした。
% cd ~/project/Twitter-Reader % perl -cw script/read_it_later.pl Can't locate Net/Twitter.pm in @INC ...
Net::Twitterが必要なのですが、私の環境には入っていませんでした。こういう事をさけるためにはMakefile.PLを以下のように追記します
% cat Makefile.PL use inc::Module::Install; name 'Twitter-Reader'; all_from 'lib/Twitter/Reader.pm'; requires 'Net::Twitter'; requires 'URI::Find'; requires 'Web::Scraper'; tests 't/*.t'; author_tests 'xt'; test_requires 'Test::More'; auto_set_repository; auto_include; WriteAll;
cpanmでinstallします。
% cpanm installdeps . okamura% cpanm --installdeps . --> Working on .Configuring /Users/okamura/project/Twitter-Reader ... OK ==> Found dependencies: Net::Twitter--> Working on Net::Twitter Fetching http://search.cpan.org/CPAN/authors/id/M/MM/MMIMS/Net-Twitter-3.17001.tar.gz ... OK Configuring Net-Twitter-3.17001 ... OK ==> Found dependencies: DateTime, Data::Visitor::Callback, ...(中略)...
ちなみにMakefile.PLの雛形はmodule-setupを使うと作成されますので便利です。
そして依存モジュールが全てinstallされている事を確認します。
:!perl -cw script/read_it_later.pl script/read_it_later.pl syntax OK
メソッドはlib/Twitter/Reader.pmにお引っ越し
とりあえずメソッドコピペします。
package Twitter::Reader; use 5.010; use strict; use warnings; our $VERSION = '0.01'; use Net::Twitter; use URI::Find; use Web::Scraper; use LWP::UserAgent; use YAML; use Scalar::Util 'blessed'; use Encode; sub get_list_statuses { my ($list, $page) = @_; my $statuses; my $success = 1; eval { $statuses = $nt->list_statuses({ user => $list->{user}, list_id => $list->{list_id}, per_page => 200, page => $page, since_id => $list->{since_id} }); }; if (my $err = $@) { die $@ unless blessed $err && $err->isa('Net::Twitter::Error'); $success = undef; } return ($statuses, $success); } sub find_uris_from { my $text = shift; state @uris; @uris = (); state $finder = URI::Find->new(sub{ my ($uri, $orig_uri) = @_; push @uris, $orig_uri; return $orig_uri; }); $finder->find(\$text); return @uris; } sub expand_uri { my $uri = shift; my $res = $ua->head($uri); return unless $res->is_success; return $res->request->uri; } sub get_html_title { my $uri = shift; state $scraper = scraper { process 'title', 'title' => 'TEXT'; }; my $html; eval { $html = $scraper->scrape(URI->new($uri)); }; return if $@; return "-- No title --" unless $html->{title}; return $html->{title}; } 1;
syntax checkをしてみます。たくさんエラーがでてきました。元のコードではget_list_statuses(), expand_uri(), get_html_title()がそれぞれスコープ外のグローバル変数を読み込んでいたのでメソッドを移動した際にふがふがぎゃふんとなった事が原因のようです。
:!perl -cw lib/Twitter/Reader.pm
Array found where operator expected at lib/Twitter/Reader.pm line 17, at end of line
(Missing operator before ?)
Variable "$scraper" is not imported at lib/Twitter/Reader.pm line 36.
(Did you mean &scraper instead?)
Variable "$scraper" is not imported at lib/Twitter/Reader.pm line 41.
(Did you mean &scraper instead?)
syntax error at lib/Twitter/Reader.pm line 17, near "state @uris"
Global symbol "@uris" requires explicit package name at lib/Twitter/Reader.pm line 17.
Global symbol "@uris" requires explicit package name at lib/Twitter/Reader.pm line 17.
Global symbol "$finder" requires explicit package name at lib/Twitter/Reader.pm line 18.
Global symbol "@uris" requires explicit package name at lib/Twitter/Reader.pm line 20.
Global symbol "$finder" requires explicit package name at lib/Twitter/Reader.pm line 23.
Global symbol "@uris" requires explicit package name at lib/Twitter/Reader.pm line 24.
Global symbol "$ua" requires explicit package name at lib/Twitter/Reader.pm line 29.
Global symbol "$scraper" requires explicit package name at lib/Twitter/Reader.pm line 36.
Global symbol "$scraper" requires explicit package name at lib/Twitter/Reader.pm line 41.
lib/Twitter/Reader.pm had compilation errors.ひとまず引数として受け取るように改造してみます。第一引数に$classとしているのは特に意味はありません。
Twitter::Reader::find_uris_from($text,@uris)と書くよりもTwitter::Reader->find_uris_from($text,@uris)と書くのが個人的に好きだからです。
package Twitter::Reader; use 5.010; use strict; use warnings; our $VERSION = '0.01'; use Net::Twitter; use URI::Find; use Web::Scraper; use LWP::UserAgent; use YAML; use Scalar::Util 'blessed'; use Encode; sub get_list_statuses { my ( $class, $nt, $list, $page ) = @_; my $statuses; my $success = 1; eval { $statuses = $nt->list_statuses( { user => $list->{user}, list_id => $list->{list_id}, per_page => 200, page => $page, since_id => $list->{since_id} } ); }; if ( my $err = $@ ) { die $@ unless blessed $err && $err->isa('Net::Twitter::Error'); $success = undef; } return ( $statuses, $success ); } sub find_uris_from { my ( $class, $text ) = @_; state @uris; @uris = (); state $finder = URI::Find->new( sub { my ( $uri, $orig_uri ) = @_; push @uris, $orig_uri; return $orig_uri; } ); $finder->find( \$text ); return @uris; } sub expand_uri { my ( $class, $ua, $uri ) = @_; my $res = $ua->head($uri); return unless $res->is_success; return $res->request->uri; } sub get_html_title { my ( $class, $uri ) = @_; state $scraper = scraper { process 'title', 'title' => 'TEXT'; }; my $html; eval { $html = $scraper->scrape( URI->new($uri) ); }; return if $@; return "-- No title --" unless $html->{title}; return $html->{title}; } 1;
もう一回実行してみます。
:!perl -cw lib/Twitter/Reader.pm lib/Twitter/Reader.pm syntax OK
これでメソッドを外部に配置する事ができました。
script/read_it_late.plから外部モジュールのメソッドを呼ぶ
以下のようにscript/read_it_late.plを書き直します。
#!/usr/bin/env perl use 5.010; use strict; use warnings; use lib 'lib'; use Twitter::Reader; use Net::Twitter; use URI::Find; use Web::Scraper; use LWP::UserAgent; use YAML; use Scalar::Util 'blessed'; use Encode; use Data::Dumper; my $config_uri ='conf/conf.yml'; my $config = YAML::LoadFile($config_uri); my $nt = Net::Twitter->new( traits => [qw/API::REST API::Lists/], ); my $read_it_later = URI->new('https://readitlaterlist.com/v2/add'); my $ua = LWP::UserAgent->new; for my $list ( @{$config->{lists}} ) { my $page = 1; my $start_since_id = $list->{since_id}; my $new_since_id = $start_since_id; LOOP_PAGE: while (1) { my ($statuses, $success) = Twitter::Reader->get_list_statuses($nt,$list, $page); $new_since_id = $start_since_id unless $success; last LOOP_PAGE unless @$statuses; for my $status (reverse @$statuses) { warn $status->{id}; my @uris = Twitter::Reader->find_uris_from($status->{text}); for my $uri (@uris) { my $expand_uri = Twitter::Reader->expand_uri($ua,$uri); next unless $expand_uri; warn my $html_title = Twitter::Reader->get_html_title($expand_uri); next unless $html_title; $read_it_later->query_form( apikey => $config->{read_it_later}{apikey}, username => $config->{read_it_later}{username}, password => $config->{read_it_later}{password}, url => $expand_uri, title => sprintf "[TW]%s@%s / %s\n", $list->{list_name}, $status->{user}{screen_name}, $html_title, ); my $res; eval { $res = $ua->head("$read_it_later"); }; if ( $@ ) { warn $@; next; } if ($res->is_success) { printf "[TW]%s@%s / %s (%s)\n", $list->{list_name}, $status->{user}{screen_name}, encode('utf-8', $html_title), $expand_uri; } } $new_since_id = $status->{id} if $new_since_id < $status->{id}; } $page++; } $list->{since_id} = $new_since_id; } YAML::DumpFile($config_uri, $config); exit();
確認
% perl -cw script/read_it_later.pl script/read_it_later.pl syntax OK
