1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#!/usr/bin/perl
#
# 請註意！
# 本程式版權屬於 PttBBS ,
# 但只表示您可以公開免費取得本程式,
# 並不表示您可以使用本程式.
#
# 本程式將直接連至 udnnews網站取得當前新聞,
# 而新聞內容的版權是屬於 聯合新聞網 所有.
# 亦即, 您若沒有聯合新聞網之書面授權,
# 您並「不能」使用本程式下載該網新聞.
#
use lib '/home/bbs/bin/';
use LocalVars;
use strict;
use vars qw/@titles/;
chdir '/home/bbs';
getudnnewstitle(\@titles);
foreach( @titles ){
postout({brdname => 'udnnews',
title => strreplace(FormatChinese($_->[1])),
owner => 'udnnews.',
content => getudnnewscontent("http://www.udn.com/NEWS/FOCUSNEWS/$_->[0]")});
}
sub strreplace
{
my($str) = @_;
$str =~ s/十/十/g;
$str =~ s/卅/卅/g;
$str =~ s/游錫\&\#22531\;/游揆/g;
return $str;
}
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;
$content = strreplace($content);
undef $ret;
foreach( split(/\n/, $content) ){
s/ //g;
$ret .= FormatChinese($_, 60). "\n" if( $_ );
}
return "※ [轉錄自 $url ]\n\n$ret\n\n".
"--\n感謝 http://www.udn.com/ 熱情贊助";
}
sub getudnnewstitle($)
{
my($ra_titles) = @_;
my($url, $title);
open FH, "$LYNX -source http://www.udn.com/NEWS/FOCUSNEWS/ | $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);
}
}
if( $length ){
$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.$$";
}
|
