昔書いたスクリプトをグレードアップした

WWW::MechanizeとWeb::ScraperでLast.fmからfreemp3をダウンロードするスクリプトを久しぶりに動かしてみたら、エラーになった。確認したところ、どうやらコンフィグ（Config::YAML）の使い方に問題があったようだ。なんとも恥ずかしい。そこで、最近使い方を覚えた小技をいくつか加えてグレードアップすることにした。 Config::Pitを使ってみたり、autodieを使ってみたり。 Config::PitはWindowsでは使えないと勝手に思い込んでいたけど、普通に使えた。スクリプトにアカウント情報を入れなくても済むので、ブログで公開するときにも気を使わなくて済むのが良いです。 Config::Pitは、getとsetが組になっていて、まずはsetでアカウント情報を記録しておきます。やり方は幾つかあるのですが、とりあえず今回のスクリプトに合わせて作ったスクリプトを晒しておきます。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13


# ｕｔｆ８
# use Acme::PerlTidy;
use strict;
use warnings;
use Config::Pit;
# 設定
Config::Pit::set(
"last.fm",
data => {
username => "username",
password => "password",
}
);

usernameとpasswordの値を、実際のアカウント情報に変更してから実行すると、私の環境では

1

C:\Users\<username>\.pit

の中に、YAMLファイルで入力した情報が保管されていました。あとは使うときにsetで使ったキー（今の場合は「last.fm」）で引いてやると、このアカウント情報がちゃんと使えます。便利ですね。 autodieは、Fatalの自動版という感じでしょうか。 use autodieとしておくだけで、色々なエラーを捕まえてdieしてくれます。例えば以下のようなスクリプトでは、ファイルがなかった時にはdieします。

1
2
3
4
5


# ｕｔｆ８
use strict;
use autodie;
open my $fh, '<:utf8', 'autodie.dat';
close $fh;

便利ですね。

ということで、本題。 Web::ScraperとWWW::Mechanizeの合わせ技です。今回は、このスクリプトでちゃんと動かして確認しているので、問題ない。はずです。 mechでリンクをたどっていく場合もそうですが、HTMLのソースを確認したいので、都度保存して解析に使っていました。そのへんの名残もそのまま置いてあります。ひょっとすると、将来の自分のためかもしれませんが。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71


# ｕｔｆ８
# use Acme::PerlTidy;
use strict;
use warnings;
use autodie;
use utf8;
use Perl6::Say;
use FindBin;
use Encode;
use Config::Pit;
my $config = pit_get(
"last.fm",
require => {
username => "username",
password => "password",
}
);
use Web::Scraper;
use WWW::Mechanize;
use File::Basename;
use List::MoreUtils qw(uniq);
my $uri = q{http://www.last.fm/};
my $mech = WWW::Mechanize->new( autocheck => 1, );
# my $history_dir = $FindBin::Bin . q{/lastfm.test};
# スタート
$mech->get($uri);
say $mech->uri;
# ログイン画面へ
sleep 1;
$mech->follow_link( id => 'loginBtn' );
my $fh;
say $mech->uri;
# open $fh, '>:utf8', $history_dir . q{/get1.html};
# print $fh $mech->content;
# $mech->dump_all($fh);
# close $fh;
# ログイン
sleep 1;
$mech->submit_form(
form_number => 2,
fields      => {
username => $config->{username},
password => $config->{password},
},
);
say $mech->uri;
# open $fh, '>:utf8', $history_dir . q{/logined.html};
# print $fh $mech->content;
# close $fh;
# フリーMP3のページ
sleep 1;
$mech->follow_link( url_regex => qr/freemp3s/ );
# open $fh, '>:utf8', $history_dir . q{/freemp3s.html};
# print $fh $mech->content;
# close $fh;
# MP3リンクを取得
sleep 1;
my ( $scraper, $result );
$scraper = scraper {
process 'a[href=~/\.mp3$/]', 'hrefs[]' => '@href';
result 'hrefs';
};
$result = $scraper->scrape( $mech->content, $mech->uri );
# mp3ファイルを取得
foreach my $mp3 ( uniq @{$result} ) {
my $filename = basename($mp3);
print "try fetch : $mp3 : ";
say $mech->mirror( $mp3, sprintf( "%s/%s", 'DownloadFiles', $filename ) )
->message;
sleep 1;
}