Perl AWKING for Beginner?

Ruby AWKING for Beginnerで書いた更新日記インデックス作成用スクリプトをPerlで書き直した。比較してみるのも一興である。[12/24/2002]

use LWP::Simple;
use Net::FTP;

# Setup your configuration.
$ftpsite = '';
$ftpaccount = '';
$ftppassword = '';
$yourdir = '';
$outfile = 'renewal_index.html';
$url = "http://homepage1.nifty.com/kazuf/";

%category = (
      "rn" => "更新履歴",
      "cw" => "Cygwin",
      "ps" => "PS2 Linux",
      "com" => "コミュニケーション",
      "ai" => "A.I.",
      "book" => "蔵書目録",
      "awking" => "AWKING Project",
      "awk" => "AWK",
      "net" => ".net",
      "os" => "Operating System",
      "tt" => "立花 隆",
      "perl" => "Perl",
      "ruby" => "Ruby",
      "tcl" => "Tcl/Tk",
      "python" => "Python",
      "prolog" => "Prolog",
      "linux" => "Linux",
      "printing" => "Printing",
      "hiroshima" => "ひろしま",
      "an" => "ArrangeNote",
      "qnx" => "QNX",
      "web" => "Web Development",
      "diary" => "日記",
      "scheme" => "Scheme",
      "tsn" => "TS Network",
      "tip" => "Tips",
      "col" => "コラム",
      "xml" => "XML",
      "vm" => "VMware",
      "freebsd" => "FreeBSD",
      "computing" => "Computing",
      "lang" => "言語",
      "card" => "カード",
      "oo" => "OpenOffice",
      "sf" => "SF",
      "wbh" => "WinBatchEh",
);
%page = (
      "cw" => "cygwin.html",
      "awk" => "awk.html",
      "awking" => "awking.html",
      "perl" => "perl.html",
      "python" => "python.html",
      "tcl" => "tcltk.html",
      "ruby" => "ruby.html",
      "scheme" => "scheme.html",
      "ps" => "ps2linux.html",
      "an" => "an.html",
);

while(<DATA>){
    chomp;
    print $_,":\n";
    $htmlfile = $url.$_;
    @content = split(/\n+/, (get $htmlfile));
    foreach $line (@content){
        if($line =~ /^<DT>(\d+)\/(\d+)\/(\d+)<DD>/i){
            if(length($1) == 1){
                $mon = "0".$1;
            }else{
                $mon = $1;
            }
            if(length($2) == 1){
                $day = "0".$2;
            }else{
                $day = $2;
            }
            $date = "$mon/$day/$3";
            print $date, ":\n";
        }
        while($line =~ /<A NAME="([^_]+)_(\d+)">([^<]*)(?:<A[^>]+>)*([^<]*)(?:<\/A>)*([^<]*)<\/A>/gi){
            $anchor{"$1:$date:$_\#$1_$2"} = $3.$4.$5;print $3.$4.$5, "\n";
        }
    }
}

open(OUT, "> $outfile");
#print "Content-type: text/html\n\n"
print OUT <<HERE1;
<HTML>
<HEAD>
  <TITLE>更新日記インデックス</TITLE>
  <META HTTP-EQUIV="Content-Type" content="text/html; charset=SHIFT_JIS">
<style type="text/css">
<!--
BODY{background:#FFFFF0}
.item{font-size:12pt;color:blue;font-weight:bold;text-decoration:underline}
//-->
</style>
</HEAD>
<BODY>
<IMG SRC="http://homepage1.nifty.com/kazuf/png/tsnetworkc3.png" ALIGN=LEFT HSPACE=20 ALT="tsnetworkc3.png">更新日記インデックス
<HR>
HERE1

print OUT "<UL>";
foreach $cat (sort keys(%category)){
    if($count % 10 == 0){
        print OUT "\n<LI><A HREF=\"$outfile\#", $cat, "\">", $category{$cat}, "</A>";
        $count = 0;
    }else{
        print OUT "   <A HREF=\"$outfile\#", $cat, "\">", $category{$cat}, "</A>";
    }
    $count++;
}
print OUT "\n</UL>\n";
print OUT "<p><a href=\"renewal_index_2001.html\">更新日記インデックス2001年版</a></p>\n<HR>\n";

foreach $key (sort keys(%anchor)){
    ($ca, $date, $anc) = split(/:/, $key);
    if($cca ne $ca){
        if($count > 0){
            print OUT "</UL><BR>\n";
        }
        if($page{$ca}){
            print OUT "<div class=\"item\"><A NAME=\"", $ca, "\"><A HREF=\"", $page{$ca}, "\">", $category{$ca}, "</A></A></div>\n<UL>\n";
        }else{
            print OUT "<div class=\"item\"><A NAME=\"", $ca, "\">", $category{$ca}, "</A></div>\n<UL>\n";
        }
        $cca = $ca;
        $count++;
    }
    print OUT "<LI><A HREF=\"", $anc, "\">", $anchor{$key}, "</A>&\#32&\#32(", $date, ")\n";
}

print OUT <<HERE2;
</UL><BR>
<HR>
 <I><A HREF="http://homepage1.nifty.com/kazuf/index.html">TS Network ☆ミ</A></I> <FONT COLOR="BLUERED">>></FONT>
<ADDRESS><A HREF="mailto:kazuf@mars.dti.ne.jp"><kazuf@mars.dti.ne.jp></A></ADDRESS><BR>
</BODY>
</HTML>
HERE2
close(OUT);

$ftp = Net::FTP->new($ftpsite);
print "$ftpsiteに接続しました。\n";
$ftp->login($ftpaccount, $ftppassword);
print "loginしました。\n";
$ftp->cwd($yourdir);
print "$yourdirディレクトリに移動しました。\n";
$ftp->ascii();
print "asciiモードにします。\n";
$ftp->put($outfile, $outfile);
print "$outfileを転送しました。\n";
$ftp->quit();
print "FTPを終了しました。\n";
sleep(1);
__END__
renewal.html
renewal_2002_11.html
renewal_2002_10.html
renewal_2002_09.html
renewal_2002_08.html
renewal_2002_07.html
renewal_2002_06.html
renewal_2002_05.html
renewal_2002_04.html
renewal_2002_03.html
renewal_2002_02.html
renewal_2002_01.html

TS Network ☆ミ >> (C)jscripter