diff options
| -rw-r--r-- | util/Makefile | 4 | ||||
| -rw-r--r-- | util/udnnews.pl | 100 |
2 files changed, 102 insertions, 2 deletions
diff --git a/util/Makefile b/util/Makefile index b4e8fb2c..2a56cc0e 100644 --- a/util/Makefile +++ b/util/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.16 2002/08/15 09:44:12 in2 Exp $ +# $Id: Makefile,v 1.17 2002/08/15 09:44:36 in2 Exp $ BBSHOME?=$(HOME) OSTYPE!=uname @@ -35,7 +35,7 @@ CPROGS= bbsmail BM_money post account birth deluserfile expire mandex\ PROGS= $(CPROGS) BM_money.sh backpasswd.sh mailog.sh opendice.sh\ openticket.sh stock.sh topsong.sh weather.sh stock.perl weather.perl\ toplazyBM.sh toplazyBBM.sh dailybackup.pl tarqueue.pl waterball.pl \ - filtermail.pl getbackup.pl + filtermail.pl getbackup.pl udnnews.pl all: $(PROGS) diff --git a/util/udnnews.pl b/util/udnnews.pl new file mode 100644 index 00000000..68a56c03 --- /dev/null +++ b/util/udnnews.pl @@ -0,0 +1,100 @@ +#!/usr/bin/perl +# +# 請註意！ +# 本程式版權屬於 PttBBS , +# 但只表示您可以公開免費取得本程式, +# 並不表示您可以使用本程式. +# +# 本程式將直接連至 udnnews網站取得當前新聞, +# 而新聞內容的版權是屬於 聯合新聞網 所有. +# 亦即, 您若沒有聯合新聞網之書面授權, +# 您並「不能」使用本程式下載該網新聞. +# + +use LocalVars; +use strict; +use vars qw/@titles/; + +chdir '/home/bbs'; +getudnnewstitle(\@titles); +foreach( @titles ){ + postout({brdname => 'udnnews', + title => $_->[1], + owner => 'udnnews.', + content => getudnnewscontent("http://www.udnnews.com/NEWS/TODAYNEWS/$_->[0]")}); +} + +sub getudnnewscontent($) +{ + my($url) = @_; + my($buf, $content, $ret); + $buf = `$LYNX -source '$url'`; + ($content) = $buf =~ m|<p><font class="text12" color=#CC0033><br>(.*?)<tr valign="top">|s; + ($content) = $buf =~ m|<p><font color="#CC0033" class="text12">(.*?)<tr valign="top">|s if( !$content ); + $content =~ s/<br>/\n/g; + $content =~ s/<p>/\n/gi; + $content =~ s/<.*?>//g; + $content =~ s/\r//g; + $content =~ s/\n\n\n/\n\n/g; + $content =~ s/\n\n\n//g; + undef $ret; + foreach( split(/\n/, $content) ){ + s/ //g; + $ret .= FormatChinese($_, 60). "\n" if( $_ ); + } + return "※ [轉錄自 $url ]\n\n$ret\n\n". + "--\n感謝 http://www.udnnews.com/NEWS/ 熱情贊助"; +} + +sub getudnnewstitle($) +{ + my($ra_titles) = @_; + my($url, $title); + open FH, "$LYNX -source http://www.udnnews.com/NEWS/TODAYNEWS/ | $GREP '<font color=\"#FF9933\">' |"; + while( <FH> ){ + ($url, $title) = $_ =~ m|<font color="#FF9933">．</font><a href="(.*?)"><font color="#003333">(.*?)</font></a><font color="#003333">|; + $title =~ s/<.*?>//g; + push @{$ra_titles}, [$url, $title]; + } + close FH; + return @{$ra_titles}; +} + +sub FormatChinese +{ + my($str, $length) = @_; + my($i, $ret, $count, $s); + return if( !$str ); + for( $i = 0 ; $i < length($str) ; ++$i ){ + if( ord(substr($str, $i, 1)) > 127 ){ + $ret .= substr($str, $i, 2); + ++$i; + } + else{ + for( $count = 0, $s = $i ; $i < length($str) ; ++$i, ++$count ){ + last if( ord(substr($str, $i, 1)) > 127 ); + } + --$i; + $ret .= ' ' if( $count % 2 == 1); + $ret .= substr($str, $s, $count); + } + } + $str = $ret; + undef $ret; + while( $str ){ + $ret .= substr($str, 0, $length)."\n"; + $str = substr($str, $length); + } + return $ret; +} + +sub postout +{ + my($param) = @_; + open FH, ">/tmp/postout.$$"; + print FH $param->{content}; + close FH; + + system("bin/post '$param->{brdname}' '$param->{title}' '$param->{owner}' /tmp/postout.$$"); + unlink "/tmp/postout.$$"; +} |