最近からかもしれないけど、Last.fmでmp3の無料ダウンロードをやっているようだ。
参考：Last.fm からのおすすめ無料mp3 - Last.fm
ちょうどWWW::Mechanizeを試していたので、それとWeb::Scraperを組み合わせてダウンロードするスクリプトを作った。
アカウントを持っているのが前提です。
アカウント情報は以下のように、YAMLで記述しておきます。
ソースコードをこのまま使う場合は、スクリプトのあるディレクトリに「lastfm.freemp3.yaml」という名前で保存しておきます。
1
2
3
4
|
---
config:
id: xxxxxxxx
pw: ********
|
最後は改行で終了しておく必要があります。たぶん。
ソースコードをこのまま使う場合は、スクリプトのあるディレクトリに「lastfm」というディレクトリが必要です。
実行すると、そのディレクトリにダウンロードしていきます。
また、保存する時に「mirror」を使うと、通常はファイルの比較をして再ダウンロードを防いでくれるのですが、Last.fmのサーバーの仕様なのかわかりませんが、その機能が効いていません。
その辺はもう少しどうにかしたいですね。
結構ダウンロードに時間がかかるので
。
ソースコード。
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
|
use strict;
use warnings;
use utf8;
use Perl6::Say;
use Encode;
use Config::YAML;
my $config = Config::YAML->new( config => './lastfm.freemp3.yaml' );
use Web::Scraper;
use WWW::Mechanize;
use File::Basename;
use List::MoreUtils qw(uniq);
my $uri = q{https://www.last.fm/login};
my $mech = WWW::Mechanize->new(
autocheck => 1,
agent =>
q{Mozilla/5.0 (Windows; U; Windows NT 5.1; ja; rv:1.9.0.6) Gecko/2009011913 Firefox/3.0.6 (.NET CLR 3.5.30729)},
);
# スタート
$mech->get($uri);
# ログイン
sleep 1;
$mech->form_number(2);
$mech->set_fields(
username => $config->{id},
password => $config->{pw},
);
$mech->submit;
# フリーMP3のページ
sleep 1;
$uri = q{http://www.last.fm/home/freemp3s};
$mech->get($uri);
# MP3リンクを取得
sleep 1;
my ( $scraper, $result );
$scraper = scraper {
process 'a[href=~/\.mp3$/]', 'hrefs[]' => '@href';
result 'hrefs';
};
$result = $scraper->scrape( $mech->content, $mech->uri );
foreach my $mp3 ( uniq @{$result} ) {
my $filename = basename($mp3);
print "try fetch : $mp3 : ";
say $mech->mirror( $mp3, sprintf( "%s/%s", 'lastfm', $filename ) )->message;
sleep 1;
}
|