- YouTube動画
- Yahooオークション情報
ソースはそれ程難しくもなく
#!/usr/bin/perl
use strict;
use warnings;
use URI;
use URI::Escape qw(uri_escape_utf8 uri_unescape);
use Web::Scraper;
use YAML::Syck;
my $artist = shift || 'Ozzy Ozbourne';
my $uri = URI->new('http://www.veena.jp/srch_artist.php?artist_name='
. uri_escape_utf8($artist));
my $youtube_list = scraper {
process '//table[@class="info_tbl"]/tr/td',
'video[]' => scraper {
process '//a[1]', url => sub {
my $url = shift->attr('href');
$url =~ s/^.*\?url=(.*)$/$1/;
uri_unescape($url);
};
process '//a[2]', title => 'TEXT';
process '//img', image => '@src';
};
result 'video';
};
my $auction_list = scraper {
process '//table[@class="info_tbl"]/tr/td',
'auction[]' => scraper {
process '//a[1]', url => '@href';
process '//a[2]', title => 'TEXT';
process '//img', image => '@src';
};
result 'auction';
};
my $artist_list = scraper {
process '//a[contains(@href, "artist.php")]',
'artists[]' => scraper {
process 'a', id => sub {
my $url = shift->attr('href');
$url =~ s/^.*id=(.*)$/$1/;
$url;
};
process 'a', 'youtube' => sub {
my $url = shift->attr('href');
$url =~ s/artist\.php/http:\/\/veena.jp\/list_youtube\.php/;
my $list = $youtube_list->scrape(URI->new($url));
\@$list;
};
process 'a', 'auction' => sub {
my $url = shift->attr('href');
$url =~ s/artist\.php/list_auction\.php/;
my $list = $auction_list->scrape(URI->new_abs($url, $uri));
\@$list;
};
process 'a', name => 'TEXT';
}
};
my $result = $artist_list->scrape($uri);
warn Dump $result;
って感じ。YouTube動画情報一覧とYahooオークション情報はアーティスト情報にぶら下がる形で出力したかったので検索結果一覧用のscraperとその結果を取得するscraperを親子関係にしてあります。結構一覧としてはキレイに出力されているかと思います。
---
artists:
-
auction:
-
image: !!perl/scalar:URI::http http://ac.c.yimg.jp/7/1026/1783/000/img305.auctions.yahoo.co.jp/users/6/4/6/7/rosiertrueblue-thumb-119657918759294.jpg
title: Ozzy Osbourne
url: !!perl/scalar:URI::http http://page.auctions.yahoo.co.jp/jp/auction/108393777
-
image: !!perl/scalar:URI::http http://ac.c.yimg.jp/7/1022/1783/000/img245.auctions.yahoo.co.jp/users/6/4/6/7/rosiertrueblue-thumb-119657997018368.jpg
title: Ozzy Osbourne
url: !!perl/scalar:URI::http http://page11.auctions.yahoo.co.jp/jp/auction/n61267094
-
image: !!perl/scalar:URI::http http://a1017.lm.a.yimg.com/7/1017/1783/000/img257.auctions.yahoo.co.jp/users/8/2/8/3/kokita74-thumb-119486785113507.jpg
title: Ozzy Osbourne
url: !!perl/scalar:URI::http http://page8.auctions.yahoo.co.jp/jp/auction/h52088580
...
id: 216546
name: Randy Rhoads (Ozzy Ozbourne)
youtube:
-
image: !!perl/scalar:URI::http http://img.youtube.com/vi/MEUbYkLe_wo/default.jpg
title: Ozzy Ozbourne's top 10 songs
url: http://www.youtube.com/watch?v=MEUbYkLe_wo
-
image: !!perl/scalar:URI::http http://img.youtube.com/vi/GLtjWi4qkIY/default.jpg
title: Goodbye to Romance - Ozzy/Randy Rhoads (solo)
url: http://www.youtube.com/watch?v=GLtjWi4qkIY
-
image: !!perl/scalar:URI::http http://img.youtube.com/vi/AQqbNHhBWcI/default.jpg
title: iron man
url: http://www.youtube.com/watch?v=AQqbNHhBWcI
...
Ozzy OzbourneのキーワードでRandy Rhoadsも引っかかってウハウハです。で、このYAMLをどうするか...
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->agent('Mozilla');
for my $artist (@{$result->{artists}}) {
for my $video (@{$artist->{youtube}}) {
my $url = $video->{url};
my $req = HTTP::Request->new(GET => $url);
$req->header('Accept-Encoding', 'identity');
my $res = $ua->request($req);
if ($res->is_error) {
if ((my $verify_url = $res->request->uri) =~ /\/verify_age\?/) {
my $verify_req = HTTP::Request->new(POST => $verify_url, {action_confirm => 'Confirm'});
$res = $ua->request($verify_req);
$res = $ua->request($req) if $res->is_success;
}
}
if ($res->content =~ /video_id=([^&]+)&l=\d+&t=([^&]+)/gms) {
my $flv = "http://youtube.com/get_video?video_id=$1&t=$2";
print "Downloading $flv\n";
my $download_req = HTTP::Request->new(GET => $flv);
$download_req->referer($url);
my $res = $ua->request($download_req);
if ($res->is_success) {
open FH, ">$2.flv";
binmode FH;
print FH $res->content;
close FH;
print "Downloaded $2.flv\n";
} else {
print "Failed to download $2.flv\n";
}
} else {
print "Not found flv file\n";
}
}
}
やっぱこうなりますわね...mattn the crazy