summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorin2 <in2@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2002-08-15 17:44:36 +0800
committerin2 <in2@63ad8ddf-47c3-0310-b6dd-a9e9d9715204>2002-08-15 17:44:36 +0800
commitfac78f38cdcfff872f9ee08a153e8f068624aec8 (patch)
treeeae29607dd242725dff076d1d42dd1fedd3a74b9
parenta0491bb711625574ebf9c9b98b9f5655e8ab7a25 (diff)
downloadpttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar.gz
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar.bz2
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar.lz
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar.xz
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.tar.zst
pttbbs-fac78f38cdcfff872f9ee08a153e8f068624aec8.zip
udnnews.pl
git-svn-id: http://opensvn.csie.org/pttbbs/pttbbs/trunk/pttbbs@470 63ad8ddf-47c3-0310-b6dd-a9e9d9715204
-rw-r--r--util/Makefile4
-rw-r--r--util/udnnews.pl100
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.$$";
+}