#!/usr/bin/perl
# Last updated: <2005/10/18 04:26:05 +0900>
#
# 某お絵かき掲示板のバックアップを取るスクリプト
#
# by mieki256
#
# 2005/10/17    0.01    とりあえず作成
#
# ----------------------------------------
# usage: perl oekakibkup.pl URLLISTFILE
#
# ----------------------------------------
# URLLISTFILE format:
#
# // commnet
# http://hogehoge/pic.cgi?sort=1&page=<<num>><>start=0<>end=90<>step=10<>picurldir=http://hogehoge/
#
# <<num>> が、指定した数字に置き換わる。
# start=xx  開始番号
# end=xx    終了番号
# step=xx   ステップ数
# picurldir=xxx     画像ファイルが入ってるであろうディレクトリURL
#
# 行頭が「http」から始まってない行は、コメント行として扱われる。
#


use strict;
use POSIX 'strftime';
use LWP::UserAgent;

my $brw_ua  = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)";

my $listfile = '';


# 引数チェック

foreach my $a (@ARGV) {
    if ( $a eq '-h' ) {
        usage();
    } else {
        if ( -e $a ) {
            $listfile = $a;
        } else {
            print "$a not found\n";
            exit (-1);
        }
    }
}

if ( $listfile eq '' ) { usage(); }


# URLリスト取得

my @urllist = ();
open(IN,$listfile) || die ("Can't open $listfile");
while(<IN>) {
    chomp;
    if ( /^http/ ) {
        push(@urllist,$_);
    }
}
close(IN);


# 現在時刻でディレクトリ作成

my $dirname = strftime "%Y%m%d_%H%M%S", localtime;
mkdir $dirname;


# URLリストを順々に処理

foreach my $l (@urllist) {

    my %parm = (
        "url","",
        "start","0",
        "end","0",
        "step","1",
        "picurldir","",
        );

    # url , page start , page end , page step 等を取得
    foreach ( split(/<>/,$l) ) {
        if ( /^http:/ ) {
            $parm{"url"} = $_;
        } elsif ( /(\w+)=(.+)/ ) {
            $parm{"$1"} = $2;
        }
    }

    my $ua = LWP::UserAgent->new;
    $ua->agent($brw_ua);

    my $picurl = $parm{"picurldir"};
    my $count = 1;
    for ( my $i = $parm{"start"}; $i <= $parm{"end"}; $i += $parm{"step"} ) {

        # 取得URLを生成
        my $uri = $parm{"url"};
        $uri =~ s/<<num>>/$i/;

        # 出力ファイル名を生成

        my $fn;
        $fn .= strftime "%y%m%d", localtime;
        $fn .= "_oekaki_#";
        $fn .= sprintf("%02d",$count);
        $fn .= ".html";

        print "# $uri\t\t$fn";

        # web page 取得

        my $req = HTTP::Request->new(GET => $uri);
        $req->header('Accept' => 'text/html');

        # リクエスト送信
        my $res = $ua->request($req);

        # 出力のチェック
        if ($res->is_success) {
            # 取得成功。ファイルとして保存。

            my @body = split(/\n/,$res->content);

            # html 本文中の、<IMG SRC="〜"> を書き換える
            my @nbody;
            my @piclist = ();
            my $snum = 0;

            foreach my $n (@body) {

                # ハードコーディングでスレNo・画像ファイル名を等取得

                if ( $n =~ /<B>\[(\d+)\]<\/B>/ ) {
                    # スレ No 取得
                    $snum = $1;
                } elsif ( $n =~ /<IMG SRC=\"\.\/(\d+)\.([a-z]{3})\">/ ) {
                    # オリジナルの画像ファイル名を取得
                    my $nn = $1;    # 数字
                    my $ext = $2;   # 拡張子

                    # 保存する際の画像ファイル名を生成
                    my $newfname = "oekaki_$snum.$ext";

                    # 画像ファイル名対応リストを配列にpush
                    push(@piclist,"$picurl$nn.$ext<>$newfname");

                    # html本文書き換え
                    $n =~ s/$nn\.$ext/$newfname/;
                }
                push(@nbody,$n);
            }

            # html 本文をファイルとして保存
            open(OUT,"> $dirname/$fn") || die "Can't open $fn";
            foreach my $n (@nbody) {
                print OUT $n,"\n";
            }
            close(OUT);

            print " ... ok.\n";

            # 画像ファイル取得
            &getpic($dirname,@piclist);

        } else {
            # 取得失敗
            print " ... Error: " . $res->status_line . "\n";
        }

        $count++;
    }

}

exit 0;


# ヘルプ表示
sub usage {
    print "usage: perl $0 URL_LIST_FILE\n";
    exit (-1);
}

# 画像ファイルを取得・保存
sub getpic {
    my($dirname,@piclist) = @_;

    my $ua = LWP::UserAgent->new;
    $ua->agent($brw_ua);

    foreach my $u (@piclist) {
        my($uri,$fn) = split(/<>/,$u);

        print "# $uri ";
        my $req = HTTP::Request->new(GET => $uri);
        my $res = $ua->request($req);

        if ($res->is_success) {

            open(OUT,"> $dirname/$fn") || die "Can't open $fn";
            binmode(OUT);
            print OUT $res->content;
            close(OUT);

            print " ... ok.\n";
        } else {
            # 取得失敗
            print " ... Error : " . $res->status_line . "\n";
        }
    }
}