Flickrから素敵な壁紙を自動で収集

技術

ネタフルのFliclkrで壁紙を探そう！を読んで、このWallpaperグループからずるずると壁紙をひっぱってきて使えたら素敵じゃないかと思ったので、そんなPerlスクリプトを書いた。

$ perl flickr_collect ~/Desktop/flickr_wallpapers

とかやると、指定したディレクトリにFlickrの Wallpapers (1024x768 minimum)グループの最新壁紙30件をダウンロードしてくれる。

画像サイズは、だいたい指定した壁紙サイズに近いやつを落とすようになってるので、とんでもなく大きかったり小さかったりする画像は落ちてこないようになっている。ダウンロードする壁紙の枚数やサイズは、スクリプト内のの定数を変更すればできる。

あとは、煮るなりやくなり。Cronでまわせばどんどん新しいのがおちてくるようにできるし、Mac OS Xではディレクトリを指定すれば、ディレクトリ内の画像をランダムで表示してくれる機能があるので、それと組み合わせればなかなか良いかも。たまにノイズがまじって、アレな壁紙が表示されたりしますが。

Macで壁紙の設定をしてみると以下のような感じ。
Desktop Pictures with Flickr Wallpapers

今回は習作をかねて、0から自分で作ってみた。フレームワークに頼りきりだと、自分でなんにもできない子になりかねないしな、ってPlaggerでどうやるかはきいてねーよ！

ソースコードは以下に。

#!/opt/local/bin/perl
use warnings;
use strict;

use Readonly;
use DirHandle;
use File::Spec;
use Flickr::API;
use XML::LibXML;

Readonly my $GROUP_ID         => '40961104@N00'; # Wallpapers (1024x768 minimum)
Readonly my $API_KEY          => 'Your Flickr API key';
Readonly my $WALLPAPER_NUMS   => 30;
Readonly my $WALLPAPER_WIDTH  => 1024;
Readonly my $WALLPAPER_HEIGHT => 768;

my $output_dir = shift || '/tmp/';

# Make an output_dir if it does not exist
unless (-e $output_dir && -d _) {
    print STDERR "Making a directory $output_dir.\n";
    mkdir $output_dir, 0777;
}

# Prepare Flickr::API
my $flickr = Flickr::API->new({
    key    => $API_KEY,
});

my @urls = get_group_photos_from($GROUP_ID, $flickr);
for my $url (@urls) {
    my ($output_file) = $url =~ m!^.*/(.*)$!; 
    my $output_path = File::Spec->catfile($output_dir, $output_file);

    unless (-f $output_path ) {
        # Fetch using wget
        system("curl -o $output_path $url");
        if ($@) {
            die "Error while downloading $url\n";
        }
    }
}

## Delete old file
#my $dh = DirHandle->new($output_dir)
#    or die "Cannot open $output_dir: $!";
#my @stored_photos = sort {(stat($a))[9] <=> (stat($b))[9]}
#                    map  {File::Spec->catfile($output_dir, $_)}
#                    grep { $_ =~ m/^\d+_/ }
#                    $dh->read;
#
#my $old_photos_range = (scalar @stored_photos) - $WALLPAPER_NUMS -1;
#
#if ($old_photos_range >= 0) {
#    for my $photo (@stored_photos[0..$old_photos_range]) {
#        print STDERR "$photo is old! Remove it.\n";
#        unlink $photo
#            or die "Cannot unlink $photo: $!";
#    }
#}


print "Complete.\n";


sub get_group_photos_from {
    my ($group_id, $flickr) = @_;
    
    my @photo_urls;

    # Get list of group of Wallpapers 
    my $response = $flickr->execute_method(
        'flickr.groups.pools.getPhotos',
        {
            group_id => $group_id,
            per_page => $WALLPAPER_NUMS,
        },
    );
    unless ($response->{success}) {
        die("Flickr API error: $response->{error_message}");
    }

    # Retrieve Photo URLs
    my $parser = XML::LibXML->new;
    my $result_doc =  $parser->parse_string($response->content);
    for my $photo ($result_doc->findnodes('/rsp/photos/photo')) {
        my $photo_id  = $photo->findvalue('@id');
        my $photo_url = get_photo_url($photo_id, $flickr);
        push @photo_urls, $photo_url;
    }

    return @photo_urls;
}

sub get_photo_url {
    my ($photo_id, $flickr) = @_;

    my $response = $flickr->execute_method(
        'flickr.photos.getSizes',
        {
            photo_id => $photo_id,
        }
    );
    unless ($response->{success}) {
        die("Flickr API error: $response->{error_message}");
    }

    # Get the suitable size image url
    my $parser = XML::LibXML->new;
    my $result_doc = $parser->parse_string($response->content);
    my $url;
    for my $size ($result_doc->findnodes('/rsp/sizes/size')) {
        my $width  = $size->findvalue('@width');
        my $height = $size->findvalue('@height');

        if ($width >= $WALLPAPER_WIDTH || $height >= $WALLPAPER_HEIGHT) {
            $url = $size->findvalue('@source');
            last
        }

        $url = $size->findvalue('@source');
    }

    return $url;
}