udnnews.pl

git-svn-id: http://opensvn.csie.org/pttbbs/pttbbs/trunk/pttbbs@470 63ad8ddf-47c3-0310-b6dd-a9e9d9715204

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.$$";
+}