get_news.pl

基本的にはVersion Checkerと同じ構造を持つPerlスクリプトである。__END__以下に記述されたタブ区切りのサイト名とURLから各サイトを訪れ、htmlファイルを取得する。そのページに含まれるURLを抽出し、リンクされている見出しとともに取り出してリストアップする。その際に省略されているURLの部分を補完する。各サイト毎に表にまとめてHTMLファイルを作成し、FTPでWebサイトにアップロードする。[5/5/2001]


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

# Setup your configuration.
$ftpsite = '';
$ftpaccount = '';
$ftppassword = '';
$yourdir = '';
$newsfile = '';

($scriptfilename = $0) =~ s/^([^.]+)\.pl$/$1/i;
$| = 1;
while(<DATA>){
    ($site,$target)=split(/\s+/,$_);
    @urllist = ((get $target) =~ m!<a +[^>]*href="?(?:http://|/|\.)[^>]*>(?:<[bi]>)?[^<>]+(?:</[bi]>)?</a>!gsi);
    $sitedata{"$site\t$target"} = join("\t", @urllist);
}
open(OUT,"> $newsfile");
print OUT <<EOB;
<HTML>
<HEAD>
<TITLE>News on Major Scripting Language Sites</TITLE>
<META HTTP-EQUIV="Content-Type" content="text/html; charset="EUC-JP">
<style type="text/css">
<!--
BODY{background:#FFFFF0}
.title{font-size:16pt;color:#336666;font-weight:bold}
.item{font-size:14pt;color:#FFFFFF;font-weight:bold;background:#FF9900}
.content{font-size:10pt;color:#336666;font-family:SANS-SERIF,Palatino,Times,FANTASY,SERIF,MONOSPACE,Arial}
.header{font-size:12pt;color:#CC0000;font-weight:bold;text-indent:15px}
.footer{font-size:12pt;color:#336666;font-weight:bold}
//-->
</style>
</HEAD>
<BODY>
<div class="title">News on Major Scripting Language Sites</div>
<HR>
EOB

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
$thismonth = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
print OUT "<div class=\"header\">Last updated : $hour:$min:$sec $thismonth $mday ($thisday) ", $year+1900,"\n</div>\n";

print OUT <<EOM;
<TABLE BORDER>
<TR>
    <TH><div class="item">Scripting Language Site</div></TH>
    <TH><div class="item">News</div></TH>
    <TH><div class="item">Source</div></TH>
</TR>
EOM

foreach $key (keys %sitedata){
    @urllist = split(/\t/, $sitedata{$key});
    ($site, $target) = split(/\t/, $key);
    print OUT "<TR>\n\t<TH VALIGN=TOP><div class=\"content\">$site</div></TH>\n\t<TH ALIGN=LEFT><div class=\"content\"><OL>";
    $mark = "";
    foreach $url (sort { $a cmp $b } @urllist){
        if($url ne $mark){
            if($site =~ /perl/i){
                ($modifiedurl = $url) =~ s!^(<a +)[^>]*(href="?)\.?((?:/|[^h][^t][^t][^p])[^>]+>.+</a>)$!$1$2http://www.perl.com$3!is;
            }elsif($site =~ /activestate/){
                ($modifiedurl = $url) =~ s!^(<a +)[^>]*(href="?)\.?((?:/|[^h][^t][^t][^p])[^>]+>.+</a>)$!$1$2http://www.activeperl.com$3!is;
            }elsif($site =~ /python/i){
                ($modifiedurl = $url) =~ s!^(<a +)[^>]*(href="?)\.?((?:/|[^h][^t][^t][^p])[^>]+>.+</a>)$!$1$2http://www.python.org$3!is;
            }elsif($site =~ /scriptics/i){
                ($modifiedurl = $url) =~ s!^(<a +)[^>]*(href="?)\.?((?:/|[^h][^t][^t][^p])[^>]+>.+</a>)$!$1$2http://dev.scriptics.com$3!is;
            }elsif($site =~ /ruby/i){
                ($modifiedurl = $url) =~ s!^(<a +)[^>]*(href="?)\.?((?:/|[^h][^t][^t][^p])[^>]+>.+</a>)$!$1$2http://www.ruby-lang.org$3!is;
            }
            print OUT "<LI>$modifiedurl\n";
        }
        $mark = $url;
    }
    print OUT "</OL></div></TH>\n\t<TH VALIGN=TOP><A HREF=\"$target\"><div class=\"content\">$target</div></A></TH>\n</TR>\n";
}
print OUT "</div></TABLE>\n";
print OUT <<"EOE";
<HR>
<div class=\"footer\">
This table is generated by <A HREF=\"${scriptfilename}.html\">$0</A><BR>
This HTML is transported by Net::FTP module.<BR>
<I><A HREF=\"index.html\">TS Network</A></I>
\ <FONT COLOR=\"ORANGERED\">\>\></FONT>
</div>
</BODY>
</HTML>
EOE
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($newsfile, $newsfile);
print "$newsfile を転送しました。\n";
$ftp->quit();
print "FTPを終了しました。\n";

__END__
www.perl.com(O'REILLY)	http://www.perl.com/pub/
www.ruby-lang.org	http://www.ruby-lang.org/en/
www.python.org	http://www.python.org/
dev.scriptics.com	http://dev.scriptics.com/
www.activestate.com	http://www.activestate.com/