■

寝ぼけて書いたものなので、と、先に言い訳しときます。
LWPを使ってみる目的で作った、データベース論のpdfを落としてくるスクリプト。
参考 : http://homepage3.nifty.com/hippo2000/perltips/LWP.html

#!/usr/bin/perl
use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Cookies;
use URI;

# formを含んだhtmlをgetするためのurl。
my $login_url = 'http://ldear.ex.nii.ac.jp/~aihara/uec/db2005/student/signin.php';
# idとパスワードを送信する先。
my $form_url = 'http://ldear.ex.nii.ac.jp/~aihara/uec/db2005/student/signin.php';
# ログイン後に取り出すファイルへのリンクのあるhtml。
my $data_url = 'http://ldear.ex.nii.ac.jp/~aihara/uec/db2005/lecture/schedule.php';

my $id;
my $pass;

unless( $id ){
    print "id : ";
    $id = <STDIN>;
}
unless( $pass ){
    print "pass : ";
    $pass = <STDIN>;
}

# UA準備。
my $ua = new LWP::UserAgent;
# $ua->cookie_jar( new HTTP::Cookies );
$ua->cookie_jar( HTTP::Cookies->new( file => 'cookies.txt', autosave => 1 ) );
$ua->env_proxy;

# formの値をget。
my $req = HTTP::Request->new( GET => $login_url );

print '受信中(', $req->uri, ')';
my $res = $ua->request( $req );
print "。\n";

# getしてきたデータから、formの値を取り出す。
die $res->error_as_HTML if $res->is_error;
my @querys;
$_ = $res->content;
while( /<input ([^>]*)>/g ){
    my $keys = $1;
    my( $name ) = ( $keys =~ /name="([^"]*)"/ );
    my( $value ) = ( $keys =~ /value="([^"]*)"/ );
    my( $type ) = ( $keys =~ /type="([^"]*)"/ );
    if( $type and $type eq 'password' ){
        $value = $pass;
    }elsif( $name eq 'email' ){
        $value = $id;
    }
    push @querys, $name.'='.$value;
}

# idとパスワードを送信。
$req = HTTP::Request->new( POST => $form_url );
$req->content_type( 'application/x-www-form-urlencoded' );
$req->content( join( '&', @querys ) );

print '受信中(', $req->uri, ')';
$res = $ua->request( $req );
print "。\n";

die $res->error_as_HTML if $res->is_error;

# ログイン成功。

$req = HTTP::Request->new( GET => $data_url );
print '受信中(', $req->uri, ')';
$res = $ua->request( $req );
print "。\n";

die $res->error_as_HTML if $res->is_error;

$_ = $res->content;
my $base = $res->base;
while( /<a [^>]*href="([^"]*.pdf)"/g ){
    $req = HTTP::Request->new( GET => URI->new_abs( $1, $base ) );
    my( $filename ) = ( $1 =~ m!([^/]*)$! );
    next if -e "data/$filename";
    print '受信中(', $req->uri, ')';
    $res = $ua->request( $req, "data/$filename" );
    print "。\n";
    die $res->error_as_HTML if $res->is_error;
}