pics2flickr.pl

use strict;
use warnings;
use utf8;
use Unicode::RecursiveDowngrade;
use File::Temp qw(:mktemp);
use HTML::Entities;
use WWW::Mechanize;
use Web::Scraper;
use Flickr::Upload;
use Data::Dumper;
use URI;

use constant LIVEDOOR_ID   => 'your_id';
use constant PASSWORD      => 'password';
use constant FLICKR_KEY    => '0123456789abcdef0123456789abcdef';
use constant FLICKR_SECRET => 'deadbeefc0ffee99';
use constant FLICKR_TOKEN  => '0123456789abcdef0-0123456789abcdef';

my $mech = WWW::Mechanize->new;
$mech->get('http://pics.livedoor.com/home/');
$mech->submit_form(
    form_name => 'loginForm',
    fields => {
        livedoor_id => LIVEDOOR_ID,
        password    => PASSWORD,
    }
);
$mech->get('http://pics.livedoor.com/home/');
die 'login failed' unless $mech->uri =~ m{^http://pics\.livedoor\.com/};

my $picture_links = scraper {
    process 'div.photo > a', 'links[]' => '@href';
    process 'div#paging > ul > li > a[rel="prev"]', prev => '@href';
};

my $flickr = Flickr::Upload->new({
    key    => FLICKR_KEY,
    secret => FLICKR_SECRET,
});

my $urd = Unicode::RecursiveDowngrade->new;

my $picture_detail = scraper {
    process 'h1#u-pagetitle', title => 'TEXT';
    process 'div#u-photos-detail > div.block > p', description => sub {
        my $text = '';
        for my $elem (@{$_->content}) {
            if (ref $elem) {
                $text .= "\n";
            }
            else {
                $elem =~ s/^\s+//;
                $elem =~ s/\s+$//;
                $text .= $elem;
            }
        }
        return decode_entities($text);
    };
    process 'ul#sidetags > li > a.linkgray', 'tags[]' => sub {
        return decode_entities($_->content->[0]);
    };
    process 'li.open-label > a > span', is_public => 'TEXT';
    process 'form > input[name="photo_id"]', photo_id => '@value';
};

# XXX maybe p=99999999 will be responded the last page of photos.
my $list_uri = URI->new(
    sprintf 'http://pics.livedoor.com/u/%s/photos?p=99999999', LIVEDOOR_ID,
);

while (1) {
    $mech->get($list_uri->as_string);
    die $mech->res->status_line unless $mech->success;
    my $list = $picture_links->scrape($mech->content);
    for my $detail_uri (reverse @{$list->{links}}) {
        $mech->get($detail_uri);
        die $mech->res->status_line unless $mech->success;
        my $detail = $picture_detail->scrape($mech->content);
        $detail->{is_public} =
            $detail->{is_public} eq '公開' ? 1 : 0;
        $detail = $urd->downgrade($detail);
        my $download =
            sprintf 'http://pics.livedoor.com/manage/download/%d',
                $detail->{photo_id};
        my($fh, $filename) = mkstemps('/tmp/picsXXXXXX', '.jpg');
        $mech->get($download);
        die $mech->res->status_line unless $mech->success;
        print $fh $mech->content;
        close $fh;
        my $tags = ref($detail->{tags}) eq 'ARRAY' ?
            join(' ', @{$detail->{tags}}) : '';
        $flickr->upload(
            auth_token  => FLICKR_TOKEN,
            photo       => $filename,
            title       => $detail->{title},
            description => $detail->{description},
            tags        => $tags,
            is_public   => $detail->{is_public},
            is_friend   => ($detail->{is_public} ? 0 : 1), # XXX
        ) or die "failed: $filename";
        unlink $filename;
    }
    last unless $list->{prev};
    $list_uri = $list_uri->new_abs($list->{prev}, $list_uri->as_string);
}