サンプルプログラム/ウェブページダウンロードの変更点

追加された行はこの色です。
削除された行はこの色です。
サンプルプログラム/ウェブページダウンロードは削除されています。
サンプルプログラム/ウェブページダウンロードの差分を削除
* ウェブファイルダウンロード [#p7202de4]

 #!/usr/local/bin/perl
 
 # ============================================================================
 # ウェブファイルダウンロードスクリプト
 # ============================================================================
 #
 # 概要：
 # ウェブサイトにログインしてエクセルファイルをダウンロードする
 #
 # 使い方：
 # 第１引数に対象となる年月を数字6桁で、第2引数にEXCELファイルを保存するディ
 # レクトリを与えて、本スクリプトを実行する
 
 use strict;
 use HTTP::Cookies;
 use LWP::UserAgent;
 
 # ----------------------------------------------------------------------------
 # 初期設定
 # ----------------------------------------------------------------------------
 my $base_url = 'http://www.example.com/order/';
 my @urls = qw(
 http://www.exapmle.com/login/loginAction.do
 http://www.exapmle.com/order/list.do
 );
 my $work_dir = "/home/taro/tmp";
 my $cookie_file = "cookie.txt";
 my $login_id = "XXX";
 my $password = "XXX";
 
 # ----------------------------------------------------------------------------
 # 引数処理
 # ----------------------------------------------------------------------------
 my $yearmon = shift;
 my $save_to_dir = shift || $yearmon;
 if ($yearmon !~ /^\d{6}$/) {
    die "usage: $0 200702 /home/foo/tmp\n",
        "this means you get excel files of 2007/2 under /home/foo/tmp\n";
 }
 mkdir $yearmon or die $!;
 
 # ----------------------------------------------------------------------------
 # ユーザエージェント生成
 # ----------------------------------------------------------------------------
 unlink "$work_dir/$cookie_file" or die $! if -f "$work_dir/$cookie_file";
 my $cookie_jar = HTTP::Cookies->new(file => $cookie_file, autosave => 1);
 my $ua = LWP::UserAgent->new;
 $ua->agent("MyApp/0.1 ");
 $ua->cookie_jar($cookie_jar);
 
 # ----------------------------------------------------------------------------
 # HTTPリクエスト実行
 # ----------------------------------------------------------------------------
 while (1) {
    my ($content, $req, $res);
 
    #
    # ログイン
    #
    $req = HTTP::Request->new(POST => $urls[0]);
    $req->content_type('application/x-www-form-urlencoded');
    $req->content("id=$login_id&password=$password");
 
    $res = $ua->request($req);
    if ($res->is_success) {
        $content = $res->content;
    }
    else {
        die "ERR: ",$res->status_line, "\n";
    }
 
    #
    # ファイル一覧取得
    #
    $req = HTTP::Request->new(GET => $urls[1]);
 
    $res = $ua->request($req);
 
    if ($res->is_success) {
        $content = $res->content;
    }
    else {
        die "ERR: ",$res->status_line, "\n";
    }
 
    my @excel_file_urls;
    my %excel_file_name_of;
    while ($content =~ m#(/order/list\.do\?fileName=((\d{6})\d{8}\.xls)&act=2)#gmsx) {
        my $url = $1;
        my $file_name = $2;
        my $_yearmon = $3;
        next if $_yearmon !~ /^$yearmon$/;
        push @excel_file_urls, $url;
        $excel_file_name_of{$url} = $file_name;
    }
    die "no suitable files in the web site\n" if ! @excel_file_urls;
 
    #
    # ファイル取得
    #
    foreach my $url (@excel_file_urls) {
        $req = HTTP::Request->new(GET => "$base_url$url");
        $res = $ua->request($req);
        if ($res->is_success) {
            print STDERR "Getting $save_to_dir/$excel_file_name_of{$url}.\n";
            open my $F, '>', "$save_to_dir/$excel_file_name_of{$url}" or die $!;
            print $F $res->content;
            close $F;
        }
        else {
            die "ERR: ",$res->status_line, "\n";
        }
    }
 
    last;
 }