Strawberry Perl for Windows ってポータブル版があるんですねぇ。便利!
nyaos http://www.nyaos.org/index.cgi?p=FrontPage.ja
===ダウンロードする部分===
use strict; use warnings; use autodie; use utf8; use Encode; use LWP::UserAgent?; binmode STDIN, ':encoding(cp932)'; binmode STDOUT, ':encoding(cp932)'; binmode STDERR, ':encoding(cp932)';
# Windows 8.1 32bit
# Mozilla/5.0 (Windows NT 6.3; rv:31.0) Gecko/20100101 Firefox/31.0
my $USERAGENT='Mozilla/5.0 (Windows NT 6.3; rv:31.0) Gecko/20100101 Firefox/31.0'; my $HTTP_PROXY="http://proxy.nex.west.ntt.co.jp:8080";
# 天窓 .comfort
# http://www.otonami.com/comfort/schedule/1408.htm
my $URL="http://www.otonami.com/comfort/schedule/1408.htm";
# $URL = 'http://www.ugtop.com/spill.shtml';
my $ua = LWP::UserAgent?->new(); USERAGENT); $ua->timeout( 30 ); HTTP_PROXY);
#
# ホスト名部分を抽出
# ホスト名の後ろに、必ず / が入っていることを仮定 $URL =~ m%^.*//([^/]+)/.*%;
print "URL $URL\n"; print "ホスト部分 $1\n";
my ua->get($URL , ":content_file" => "Comfort.txt");
print "HTTP レスポンスコード $http_res\n";
===ダウンロードしたファイルをパースする部分===
# perl use strict; use warnings; use autodie; use utf8; use Encode; use Encode::Guess qw(euc-jp cp932 iso-2022-jp); use HTML::Entities ();
my $_ = find_encoding('cp932'); binmode STDIN, ':encoding(cp932)'; binmode STDOUT, ':encoding(cp932)'; binmode STDERR, ':encoding(cp932)';
my %day_of_week = (
sun => "日", mon => "月", tue => "火", wed => "水", thu => "木", fri => "金", sat => "土"
); my %day_or_night = (
day => '昼', night => '夜'
); my $do_print = 0; my (wday) = (); my $d_or_n = "";
while(<>){
if (m#day_week_image/([0-3][0-9]).gif#){ $day = $1; } if (m#day_week_image/([a-w]{3}).gif#){ $wday = $day_of_week{$1}; }; if (m#contents_image/(day|night).gif#){ $d_or_n = $day_or_night{$1}; }; if ( s#.* class="style20">## ){ if (defined($day) or $d_or_n ne ""){ printf("\n\n%d日 (%s) %s\n", $day, $wday, $d_or_n); ($day, $wday) = (); $d_or_n = ""; } $do_print = 1; } if ( m# valign="middle".*<hr.*/>|<div align="right"># ){ $do_print = 0; next; } $_ = HTML::Entities::decode($_); s#<[^>]*>##g; s#\s\s+# #g; s#^\s*(.*)\s*$#\1#; if ( m#^$# ){ next; } if ( $do_print ){ print "$_\n"; next; }
}
&color():Invalid color: #123;