Proxy 環境下で Gnuwin32 をインストールする

ちょっと Windows で Unix 的コマンドが使いたいけど、Cygwin を使うほどでは・・・という自分のような中途半端な人間には、Gnuwin32*1 はいい感じのソリューションだったりするわけです。
今月から少し仕事の環境が変わりまして、新たにPCのセットアップをするにあたり Gnuwin32 のインストールが必要となったのですが、ダウンロード用のバッチファイル download.bat が上手く動いてくれなかったため http://d.hatena.ne.jp/pasela/20090528/gnuwin32 よりダウンロードスクリプトをお借りしました。
ただし Proxy 経由の場合に動かないため、Proxy を通すように パッチを当てさせてもらいました。

--- download.pl 2009-07-01 15:57:13.641929500 +0900
+++ download-p1.pl  2009-07-01 16:38:04.553677000 +0900
@@ -13,21 +13,26 @@
 my $FILELIST_FILE    = 'filelist.txt';
 my $PACKAGES_DIR     = 'packages';
 
+my $PROXY_URL        = 'http://xxx.xxx.xxx.xxx:xxxxx/';
+
 # get package list
-my $commands = scraper {
+my $page = scraper {
     process '.yui-b>table>tbody>tr',
         'commands[]' => scraper {
             process '/tr/td[1]/a', 'name' => 'TEXT';
             process '/tr/td[2]/a', 'url'  => '@href';
         };
     result 'commands';
-}->scrape(URI->new($GNUWIN32_LIST));
+};
+$page->user_agent->proxy('http', $PROXY_URL);
+my $commands = $page->scrape(URI->new($GNUWIN32_LIST));
 
 mkdir $PACKAGES_DIR if (!-e $PACKAGES_DIR);
 
 my $getlist = IO::File->new($GETGNUWIN32_FILE, 'w') || die $!;
 my $filelist = IO::File->new($FILELIST_FILE, 'w') || die $!;
-my $ua = LWP::UserAgent->new;
+my $ua = LWP::UserAgent->new();
+$ua->proxy('http', $PROXY_URL);
 
 # download packages
 eval {

修正後のソースも以下に晒しておきます。

use utf8;
use strict;
use warnings;
use URI;
use Web::Scraper;
use LWP::UserAgent;
use HTTP::Request::Common;
use Path::Class::File;
use IO::File;

my $GNUWIN32_LIST    = 'http://sourceforge.net/project/showfiles.php?group_id=23617';
my $GETGNUWIN32_FILE = 'getgnuwin32.lst';
my $FILELIST_FILE    = 'filelist.txt';
my $PACKAGES_DIR     = 'packages';

my $PROXY_URL        = 'http://xxx.xxx.xxx.xxx:xxxxx/';

# get package list
my $page = scraper {
    process '.yui-b>table>tbody>tr',
        'commands[]' => scraper {
            process '/tr/td[1]/a', 'name' => 'TEXT';
            process '/tr/td[2]/a', 'url'  => '@href';
        };
    result 'commands';
};
$page->user_agent->proxy('http', $PROXY_URL);
my $commands = $page->scrape(URI->new($GNUWIN32_LIST));

mkdir $PACKAGES_DIR if (!-e $PACKAGES_DIR);

my $getlist = IO::File->new($GETGNUWIN32_FILE, 'w') || die $!;
my $filelist = IO::File->new($FILELIST_FILE, 'w') || die $!;
my $ua = LWP::UserAgent->new();
$ua->proxy('http', $PROXY_URL);

# download packages
eval {
for my $cmd (@$commands) {
    # skip document-only package
    next if ($cmd->{name} =~ /-doc$/);

    # get zip filename and download url
    my $zips = scraper {
        process '//tbody[@id="pkg0_1"]/tr[starts-with(@id, "pkg0_1rel0_")]/td[2]/a',
            'zips[]' => {
                name => 'TEXT',
                url  => sub {
                    my $url = $_->attr('onclick');
                    $url = $1 if ($url =~ /init_download\('([^']+)'\)/);
                    $url;
                },
            };
        result 'zips';
    }->scrape($cmd->{url});

    print "package $cmd->{name}\n";
    $getlist->print(" $cmd->{name}\n");
    for my $zip (@$zips) {
#       print $zip->{name} . ': ' . $zip->{url} . "\n";
        # only bin, dep, lib, doc
        if ($zip->{name} =~ /(?:bin|dep|doc|lib)\.zip$/) {
            $getlist->print("$zip->{name}\n");
            $filelist->print("$zip->{name}\n");

            my $zip_file = Path::Class::File->new($PACKAGES_DIR, $zip->{name});
            if (-f $zip_file) {
                print "  $zip->{name} is exist. download skipped.\n";
            } else {
                print "  download $zip->{name}\n";
                my $retry = 3;
                while ($retry-- > 0) {
                    my $res = $ua->request(GET $zip->{url});
                    if ($res->is_success) {
                        my $fh = $zip_file->openw();
                        $fh->binmode();
                        $fh->print($res->decoded_content);
                        $fh->close;
                        last;
                    } else {
                        print "    failed... " . $res->status_line . "\n";
                    }
                }
            }
        }
    }
}
};
if ($@) {
    print STDERR $@;
}

$getlist->close;
$filelist->close;

なお当方は Perl ドシロウトなのであしからず。:)

*1:http://gnuwin32.sourceforge.net/