Perlスクリプト改良

id:tamago_girai:20080430で作って使っていたC-iのやつがクッキー対応のページではうまく動いてくれないので修正。LWPってなんかすごいけど、やたら沢山オプションがあってよく分からん。User-Agentも指定したので、大概のページでうまくいくはず。

見るもおぞましいPerlスクリプトになった。

#!/usr/bin/env perl -w
# urlcopy.pl
use Win32::Clipboard;
use HTTP::Cookies;
use LWP::UserAgent;
use Encode;

my $title;
my $clip;
my $url = undef;
$clipflag = undef;
unless ($url = shift) {        # コマンドラインからでなければ
    $clipflag = 1;
    $clip = Win32::Clipboard;   # あとでつかう
    $url = Win32::Clipboard::GetText();
}
my $file = q(C:\ROOT\TEXT_F\Perl_F\WebBrowser\temp.txt);

my $webpage;
my $cookiefile = "nt000LWP.cookiefile";

# cookie_jarの生成
my $cookiejar = HTTP::Cookies->new(file => $cookiefile, autosave => 1);
# UserAgentの生成と、cookie_jarのセット
my $ua = LWP::UserAgent->new; $ua->cookie_jar($cookiejar);


#タイムアウトを設定
$ua->timeout(10);

#ユーザエージェントを設定
$ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)');

#GET、PUT、POST、DELETE、HEADのいずれかを指定（httpsの場合はhttpsにするだけ）
my $req = HTTP::Request->new(GET => "$url" );

#リファラーを設定
$req->referer( "$url" );

#リクエスト結果を取得
#requestメソッドではリダイレクトも自動的に処理するため、そうしたくない場合はsimple_requestメソッドを使用するとよい。
my $res = $ua->request($req);

if ($res->is_success) {
    $webpage = $res->content;
} else{
    $webpage = $res->status_line . "\n";
}

open MYFILE, ">$file";
print MYFILE $webpage;
close MYFILE;

system("C:\\ROOT\\tool\\nkf\\nkf.exe -Lw -s --overwrite $file");
system("C:\\ROOT\\tool\\sed\\sed.exe --ctype=SJIS -f C:\\ROOT\\TEXT_F\\sed_F\\html.sed  < $file > $file.tmp");

open IN, "<$file.tmp";

while (my $line = <IN>) {
    if ( $line =~ m{\<title\>(.*?)\<\ title\>}i ) { # タイトルがあれば
        $title = $1;
        last;
    }
}
$title .= " : \n\n- $url\n\n";
decode('shiftjis', $title);
if ($clipflag) {
    $clip->Set($title);
} else {
    print ($title);
}
# urlcopy.pl ends here.