■http://anond.hatelabo.jp/20080821224627

おー、使ってくれてる奇特な奴がいるとはうれしいねぇ。

感謝の気持ちを込めて実はアレから少しバージョンアップしてるのでそれを公開しますよ！

改善点は2点。

終了判定の変更

で、以前取得したことのある画像にぶつかるとそこでプログラム終了。

これを修正。これ微妙なんだよね。4u.pl動かしてる最中に画像が投稿されるとページングしたときに既に取得した画像にぶつかってしまって止まっちゃうんだよねー。

なので、最後に取得した画像にぶつかったらプログラム終了するように変更した。

元画像が無い場合の挙動

元のURLの画像が削除されてしまって取得できなかった場合に、今までは.plainとかいうダミーデータが保存されてしまっていたが、それを4Uの画像を取得するように変更。

これで元画像が消えてても一応4Uから取得できるので取りこぼしが無くてヤッターって感じだねー。

でわでわコードは以下。

#!/usr/local/bin/perl -w
use strict;
use warnings;

use Web::Scraper;
use URI;
use Perl6::Say;
use MIME::Type;
use LWP::UserAgent;
use Path::Class;
use Data::Dumper;sub p { print Data::Dumper::Dumper(@_) };

my $page = shift || 10000;
unless ( $page =~ /^\d+$/ ) {
    die 'perl 4u.pl [page as int]';
}

my @files = dir('./img/')->children;
my $cache = {};
my $end_file = { mtime => 0 , file => '' };
for my $file (@files) {
    if ( $file->basename =~ /^(.+)\.(.+)$/ ) {
        $cache->{$1} = $2;
    }
    if ( $end_file->{mtime} < $file->stat->mtime ) {
        $end_file->{mtime} = $file->stat->mtime;
        $end_file->{file} = $file;
    }
}

for my $i (1..$page) {
    
    my $url = sprintf 'http://4u.straightline.jp/?page=%s' , $i;
    
    say "request url>".$url;
    
    my $tmp = scraper {
        process 'ul.entry-list>li>div.entry-body>div.entry-photo>a', 'link[]' => '@href';
        process 'ul.entry-list>li>div.entry-footer>div.wrapper-entry-description>div.entry-description>p.entry-img-src', 'img[]' => 'TEXT';
        result 'link','img';
    }->scrape(URI->new($url));
    
    my $links = $tmp->{link};
    my $imgs  = $tmp->{img};
    
    if ( ref $links ne 'ARRAY' ) {
        say "end program.";
        exit;
    }
    
    for my $link (@$links) {
        $link =~ m{/([^/]+)$};
        my $sesid = $1;
        
        if ( $end_file->{file} &amp;&amp; $end_file->{file}->basename =~ /^$sesid\./ ) {
            say "file exsits end program >".$sesid;
            exit;
        }
        
        if ( $cache->{$sesid} ) {
            say "file exsits next >".$sesid;
            next;
        }
        
        sleep 1;
        
        my $image_url = shift @$imgs || next;
        $image_url = 'http://'.$image_url;
        
        say "get image url    >".$image_url;
        
        my $ua = LWP::UserAgent->new;
        my $req = HTTP::Request->new(GET => $image_url);
        my $res = $ua->request($req);
        my $content = $res->content;
        my $content_type = $res->headers->header('content-type');
        my $ext = MIME::Type->new( type => $content_type )->subType || 'bin';
        
        if ( $ext eq 'plain' ) {
            say "not found image  >".$image_url;
            # 本家の画像が消えてたら4Uの奴を保存する。
            my $image_url = 'http://www.straightline.jp/html/found/static/upload/l/l_'.$sesid.'.jpg';
            say "get 4u image url >".$image_url;
            my $req = HTTP::Request->new(GET => $image_url);
            my $res = $ua->request($req);
            $content = $res->content;
            $ext = 'jpeg';
        }
        
        my $write_path = './img/'.$sesid.'.'.$ext;
        
        open my $FH, '>', $write_path;
        binmode $FH;
        print $FH $content;
        close $FH;
        
        say "write image      >".$write_path;
    }
}

言わずもかなコードはカオスなのでよろしゅうたのんます。

Permalink | 記事への反応(2) | 14:26

ツイートシェア