Flickr からキーワードにマッチした写真を一括ダウンロードする Perl スクリプト「flickr_fetcher.pl」

昨日の夜、むしょうに「磯山さやか」の画像をたくさん見たくなって、 Flickr からキーワードにマッチした写真を一括でダウンロードする Perl のスクリプトを作ってみた。

flickr_fetcher.pl

使い方はこんな感じ。

$ ./flickr_fetcher.pl --keyword 磯山さやか --dir sayaka --api_key yourflickrapikey

すると、sayaka というディレクトリが無かったら自動的に作ってくれて、 Flickr 内でマッチした総写真枚数が表示されます。

$ ./flickr_fetcher.pl --keyword 磯山さやか --dir sayaka --api_key yourflickrapikey
search keyword : 磯山さやか
total count : 760

760枚もあるんですね。そして、勝手にダウンロード開始。

try to fetch : 200 OK : http://farm4.static.flickr.com/3285/3112920048_531a88761b_b.jpg
try to fetch : 200 OK : http://farm4.static.flickr.com/3213/3084174182_463f9bd410_b.jpg
try to fetch : 200 OK : http://farm4.static.flickr.com/3187/3067816386_f242e15580_o.jpg
try to fetch : 200 OK : http://farm4.static.flickr.com/3280/3042192731_3ca24c0a5b_o.jpg
try to fetch : 200 OK : http://farm4.static.flickr.com/3009/3042961088_cc993ba07d_b.jpg

Flickr の写真っていろいろサイズがあるけど、一番大きなサイズのものをダウンロードしています。しばらく待つとダウンロードが終わって、sayaka ディレクトリには760枚の画像が。これはいい。今いろんなグラビアアイドルの写真を取って来まくっています。ちなみに、コマンドの引数に Flickr の api_key を渡さなくてはいけませんが、環境変数に「FLICKR_API_KEY」が設定されていれば指定しなくて OK です。

磯山さやか

もちろんエロっちいーこと以外にも使えます。ダウンロードする写真のライセンスを指定できるので、例えば、CC の by アトリビュートの写真が欲しかったら以下のように license パラメータに 4 をセットします。

$ ./flickr_fetcher.pl --keyword sky --dir sky --license 4 --api_key yourflickrapikey

ある程度自由に使いたい写真を見つけたい時に便利かもね。

実装に関して、クラス作るのに Moose 、Flickr API を叩くところで WebService::Simple を利用しています。 WebService::Simple は coderepos の最新版もしくは、先ほどアップしたCPANの 0.13 というヴァージョンのものを使います（ここに登場予定）。

この flickr_fetcher.pl、CodeRepos にアップしてあるけどとりあえず現状のスクリプトを以下、全コード張りつけ。 Flickr の写真で一番大きいやつの URL を取得するのに、一度それぞれの写真に対して「flickr.photos.search」というメソッドを呼んでいるのがポイントかな。おかしなところあったらツッコミください。

 #!/usr/bin/perl

package FlickrFetcher;

use Moose;
use Moose::Util::TypeConstraints;
use Params::Coerce ();

use Digest::MD5 qw(md5_hex);
use Encode;
use LWP::UserAgent;
use Path::Class;
use POSIX qw(ceil);
use WebService::Simple;
use WebService::Simple::Parser::XML::Simple;
use XML::Simple;
use Perl6::Say;

our $VERSION = '0.01';

with 'MooseX::Getopt';

subtype 'Dir' => as 'Object' => where { $_->isa('Path::Class::Dir') };
coerce 'Dir'  => from 'Str'  => via   { Path::Class::Dir->new($_) };

MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'Dir' => '=s' );

has 'keyword' => ( is => 'rw', isa => 'Str', required => 1 );
has 'dir' => ( is => 'rw', isa => 'Dir', required => 1, coerce => 1 );
has 'api_key'  => ( is => 'rw', isa => 'Str' );
has 'license'  => ( is => 'rw', isa => 'Int' );
has '_perpage' => ( is => 'ro', isa => 'Int', default => 500 );
has '_flickr'  => ( is => 'rw', isa => 'WebService::Simple' );
has '_ua' => (
    is      => 'ro',
    isa     => 'LWP::UserAgent',
    default => sub { LWP::UserAgent->new( keep_alive => 1 ) }
);

sub BUILD {
    my ( $self, $args ) = @_;

    unless ( $self->api_key ) {
        if ( my $api_key = $ENV{FLICKR_API_KEY} ) {
            $self->api_key($api_key);
        }
        else {
            die "api_key is required\n";
        }
    }

    my $xs = XML::Simple->new( KeepRoot => 1, keyattr => [] );
    my $parser = WebService::Simple::Parser::XML::Simple->new( xs => $xs );
    my $flickr = WebService::Simple->new(
        base_url        => "http://api.flickr.com/services/rest/",
        param           => { api_key => $self->api_key },
        response_parser => $parser,
    );
    $self->_flickr($flickr);
}

__PACKAGE__->meta->make_immutable;
no Moose;

sub run {
    my $self = shift;
    mkdir $self->dir->relative if !-d $self->dir->is_absolute;
    say "search keyword : " . $self->keyword;
    my $photo_total = $self->photo_total( $self->keyword );
    say "total count : " . $photo_total;
    my $pages = ceil( $photo_total / $self->_perpage );
    for my $current_page ( 1 .. $pages ) {
        say "search page : $current_page";
        $self->search( $self->keyword, $current_page, $self->_perpage );
    }
}

sub search {
    my ( $self, $keyword, $page , $perpage) = @_;
    my $response = $self->_flickr->get(
        {
            method   => "flickr.photos.search",
            text     => $keyword,
            per_page => $perpage,
            sort     => 'date-posted-desc',
            extras   => 'date_upload',
        page  => $page,
            license => $self->license || "",
        }
    );
    my $xml = $response->parse_response;
    $self->fetch($xml->{rsp}->{photos}->{photo});
}

sub fetch {
    my ( $self, $photo_ref ) = @_;
    for my $photo ( @$photo_ref ){
        my $url  = $self->photo_url( $photo->{id} );
        my $file = $self->dir->file( md5_hex($url) . ".jpg" );
        my $res  = $self->_ua->mirror( $url, $file );
        say "try to fetch : " . $res->status_line . " : $url";
    }
}

sub photo_url {
    my ( $self, $photo_id ) = @_;
    my $response = $self->_flickr->get(
        {
            method   => "flickr.photos.getSizes",
            photo_id => $photo_id
        }
    );
    my $xml         = $response->parse_response;
    my $largest_ref = pop @{ $xml->{rsp}->{sizes}->{size} };
    return $largest_ref->{source};
}

sub photo_total {
    my ( $self, $keyword ) = @_;
    my $response = $self->_flickr->get(
        {
            method   => "flickr.photos.search",
            text     => $keyword,
            per_page => 1,
            license => $self->license || "",
        }
    );
    my $xml = $response->parse_response;
    return $xml->{rsp}->{photos}->{total};
}

package main;

my $fetcher = FlickrFetcher->new_with_options();
$fetcher->run();

__END__

=head1 NAME

flickr_fetcher.pl - Fetch Flickr photos by keyword

=head1 SYNOPSIS

./flickr_fetcher.pl --keyword hoge --dir hoge --api_key yourflickrapikey

=head1 AUTHOR

Yusuke Wada E<lt>yusuke (at) kamawada.comE<gt>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

Enjoy!