<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#! /usr/bin/perl
# working version, not documented
# news lent script (rss)
use XML::Parser::Lite;
use Socket;
use Encode 'from_to';

my $home="./dir";
my $temp=".";
my $xmlname="$home/newz";
my $htmlname="$home/newz";

$|=1;
my $proxy='195.50.2.154:8080';
my $html_enc = 'windows-1251';


my %cont=(
'mahatma.bspu.unibel.by'=&gt;1,
'www.bspu.unibel.by'=&gt;1
);

sub add_cont{
my $l=$_[0].'/';
my $x;
$l=~s/http\:\/\/(.*?)[\:\/]/$x=$1;''/gsei;
$cont{$x}=1;
}

sub esc{
local $1;
my $x=shift;
$x=~s/([\x00-\x1f,:\"\'\\\/])/sprintf('%%%02X',ord($1))/eg;
$x;
}

sub unesc{
my $x=shift;
local $1;
$x=~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$x;
}

sub get_xml{
my ($s,%h,@a,@a1,@ad);
@a=split(/:\/\//,$_[0],2);
unshift @a,'http' if(!defined($a[1]));
@a[1,3]=split(/\//,$a[1],2);
@ad=@a[1,2]=split(/:/,$a[1],2);
@a1=@a;
$ad[1]||=80;
$a1[0]&amp;&amp;="$a[0]://";
$a1[2]&amp;&amp;=":$a[2]";
$a1[3]&amp;&amp;="/$a[3]";
if($proxy){
 @ad=split(/:/,$proxy,2);
 $a1[3]=join('',@a1);
}
socket(SO,PF_INET,SOCK_STREAM,PROTO_TCP)&amp;&amp;
connect(SO,sockaddr_in($ad[1],inet_aton($ad[0])))||return;
select(SO);$|=1;select(STDOUT);
print SO qq($_[1] $a1[3] HTTP/1.1
Host: $a1[1]
User-Agent: robot
Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5
Accept-Language: ru,be;q=0.8,en-us;q=0.5,en;q=0.3
Accept-Encoding: none
$_[2]Connection: close

);
while((!eof(SO))&amp;&amp;defined(my $x=&lt;SO&gt;)){$s.=$x;$x=~s/[\r\n]*//gs;$x||last}
$s=~s/(.*?): (.*?)[\r]\n/$h{lc($1)}=$2/gise;
undef $s;
while((!eof(SO))&amp;&amp;defined(my $x=&lt;SO&gt;)){$s.=$x}
close(SO);
substr($s,index($s,'&lt;?xml')),%h
}

sub url{
my $u=$_[0];
my $t=$_[1]||$u;
"&lt;a href=\"$u\"&gt;$t&lt;/a&gt;"
}

my (@block,%item,@items);

## 'id'=&gt;[start,char,end,start1,char1.end1];
my %blocks=(
'rss.channel.item'=&gt;[
sub{%item=()},
undef,
sub{push @items,{%item};undef %item},
undef,
sub{shift;$item{$block[$#block]}=join('',@_)},
undef
],
'rss.channel.item.link'=&gt;[
]
);

#$blocks{'rdf:RDF.item'}=$blocks{'rss.channel.item'};

my %handlers=(
Start=&gt;sub{parser_event(3,@_);push @block,$_[1];unshift @_,0;goto &amp;parser_event},
Char=&gt;sub{parser_event(1,@_);unshift @_,4;goto &amp;parser_event},
End=&gt;sub{parser_event(2,@_);while($_[1] ne pop @block){};unshift @_,5;goto &amp;parser_event},
);


sub parser_event{
my $e=shift;
my $id=join('.',@block[0..$#block-($e&gt;3)]);
#print "$id\n";
if(exists($blocks{$id})){
 my $h=$blocks{$id};
 goto ref($h)||return;
 HASH:return $h-&gt;{('Start','Char','End')[$e]}(@_);
 ARRAY:return defined(@$h[$e])?&amp;{@$h[$e]}(@_):undef;
 SCALAR:return;
}
}


sub get_rss{
my ($x,%h,$ff,$ffb,$t,$p);
if(substr($_[0],0,7) eq 'file://'){
$ff=substr($_[0],7);
return if(!-e $ff);
goto FILE;
}
add_cont($_[0]);
#print "get $_[0]\n";
($x,%h)=get_xml($_[0],'HEAD');
return if(!defined(%h));
$h{'last-modified'}||=gmtime;
if(exists($h{'last-modified'})){
$ffb="$temp/newz-".esc($_[0]);
stat($ff="$ffb.".esc($h{'last-modified'}));
if(-e _){
FILE:
 open FF,"&lt;$ff" or die "$!";
 sysread(FF,$x,-s FF);
 close(FF);
}else{
 ($x,%h)=get_xml($_[0],'GET');
 return if(!defined($x));
 while(my $d=&lt;$ffb.*&gt;){unlink($d);}
 open FF,"&gt;$ff" or die "$! $ff";
 print FF $x;
 close(FF);
}
}else{($x,%h)=get_xml($_[0],'GET');
$h{'last-modified'}.=localtime;
}
$p=new XML::Parser::Lite;
$p-&gt;setHandlers(%handlers);
my ($enc,@a);
$x=~s/\&lt;\?xml(.*?)\&gt;/push @a,$1;"\&lt;\?xml$1\&gt;"/ges;
for(@a){$_=~s/ encoding\=\"(.*?)\"/$enc=lc($1);''/ges}
from_to($x,$enc,'utf-8') if(defined($enc) &amp;&amp; $enc ne 'utf-8');
$p-&gt;parse($x);
}

my %htm=(
'lt'=&gt;'&lt;',
'gt'=&gt;'&gt;',
'amp'=&gt;'&amp;',
'quot'=&gt;'"'
);

sub dehtml{
my $s=shift;
$s=~s/\&amp;(.*?)\;/$htm{$1}||"&amp;$1;"/gse;
$s
}

my (@news0,%news,%nh);
my %mm=('Jan'=&gt;0,'Feb'=&gt;1,'Mar'=&gt;2,'Apr'=&gt;3,'May'=&gt;4,'Jun'=&gt;5,'Jul'=&gt;6,'Aug'=&gt;7,'Sep'=&gt;8,'Oct'=&gt;9,'Nov'=&gt;10,'Dec'=&gt;11);

sub addnews{
my ($l,$x);
my $u=$_[0];
for(my $i=$#items;$i&gt;=0;$i--){
 $l=$items[$i]-&gt;{link};
 if($u){
  $x=$l.'&amp;';
  $x=~s/[\&amp;\?\;]$u\=(.*?)\&amp;/$l=dehtml($1);''/gse;
  $l="http://$l" if(index($l,'://')==-1);
  $items[$i]-&gt;{xlink}=$l;
 };
 if(!exists($nh{$l})){
  $nh{$l}=$items[$i];
  my $t=$items[$i]-&gt;{pubDate};
  my $t1=0;
  $t=~s/([0-9]{2})\:([0-9]{2})\:([0-9]{2})/$t1=$3+($2+$1*60)*60;''/e;
  $t=~s/([0-9]{1,2}) ([a-zA-Z]{3}) ([0-9]{4})/$t1+=($1+$mm{$2}*31+$3*365)*24*60*60;''/e;
  $t=~s/\+0([0-9])00/$t1-=$1*60*60;''/ex;
  $t=~s/\-0([0-9])00/$t1+=$1*60*60;''/ex;
  $news{$t1}=$items[$i];
  add_cont($l);
 }
}
undef @items;
}



my $time=gmtime;
#print qq(Content-type: text/html; codepage=utf-8
#Last-modified: $time
#
my $time1=$time;
$time1=~s/ /&amp;nbsp;/gs;

my $fh=qq(&lt;html&gt;&lt;head&gt;&lt;title&gt;Breaking News!&lt;/title&gt;
&lt;STYLE type="text/css"&gt;
body{margin-left:2em;margin-right:2em;text-align:justify;text-indent:2em;margin-top:0px;margin-bottom:0px;}
table{margin-left:0em;margin-right:0em;text-indent:0em;margin-top:0px;margin-bottom:0px;}
li{text-align:justify;text-indent:0em;margin-top:3px;margin-bottom:3px;}
&lt;/STYLE&gt;
&lt;/head&gt;&lt;body&gt;&lt;table width=100% height=0 border=0 cellpadding=0 cellspacing=0&gt;&lt;tr&gt;&lt;td align=left valign=top&gt;&lt;b&gt;&lt;font size=+2 face=times&gt;Open Source News&lt;/font&gt;&lt;/b&gt;&lt;/td&gt;&lt;td align=right valign=top&gt;$time1&lt;br&gt;).
url("dir/")."&lt;/td&gt;&lt;/tr&gt;&lt;/table&gt;&lt;ul&gt;";

get_rss("file://$xmlname.xml");&amp;addnews;
#get_rss('http://newsrss.bbc.co.uk/rss/russian/institutional/pda/rss.xml');
get_rss('http://news.google.com/news?hl=en&amp;ned=tus&amp;ie=UTF-8&amp;scoring=d&amp;q=Belarus+OR+Belorussia+OR+Belarussian&amp;output=rss');&amp;addnews('url');
#get_rss('http://www.afn.by/news/rss/'); &amp;addnews;
get_rss('http://news.tut.by/rss/all.rss');&amp;addnews;
get_rss('http://www.charter97.org/export/index.xml');&amp;addnews;
#get_rss('http://www.euronews.net/rss/euronews_ru.xml');&amp;addnews;
get_rss('http://news.yandex.ru/Belarus/index.rss'); addnews('cl4url');

#get_rss('http://www.cnews.ru/news.xml');


for(sort keys %news){
unshift @news0,$news{$_}
}

open FF,"&gt;$xmlname.xml" or die "$!";

print FF q(&lt;?xml version="1.0" encoding="utf-8"?&gt;
&lt;rss version="2.0"&gt;
&lt;channel&gt;
&lt;title&gt;Breaking News!&lt;/title&gt;
&lt;link&gt;http://news.eu.by/&lt;/link&gt;
&lt;description&gt;Open Source News&lt;/description&gt;);

for(@news0){
 $fh.="\n&lt;li&gt;".(exists($_-&gt;{'xlink'})?url(unesc($_-&gt;{'xlink'}),'&lt;i&gt;link&lt;/i&gt;')." - &lt;b&gt;":'').url($_-&gt;{'link'},dehtml($_-&gt;{'title'})).'&lt;/b&gt; '.dehtml($_-&gt;{'description'});
 print FF "\n&lt;item&gt;";
 for my $tag(keys %{$_}){print FF "&lt;$tag&gt;$_-&gt;{$tag}&lt;/$tag&gt;"}
 print FF "&lt;/item&gt;";
}
print FF "\n&lt;/channel&gt;&lt;/rss&gt;";
close FF;

$fh.="\n&lt;/ul&gt;&lt;hr&gt;Contributors:&lt;br&gt;";

for(sort keys %cont){
 $fh.=url("http://".unesc($_)).'&lt;br&gt;';
}

from_to($fh,'utf-8',$html_enc);
open FH,"&gt;$htmlname.tmp.html" or die "$! $htmlname.tmp.html";
print FH $fh;
close(FH);

print FH "\n&lt;/ul&gt;&lt;/body&gt;&lt;/html&gt;\n";
close(FH);

if($ARGV[0] eq 'rotate'){
 for('xml','html'){
  my $x=eval("\$".$_."name");
  my $f0="$x.$_";
  my $f1="$x.".quotemeta($time).".$_";
  `mv -f $f0 $f1` if(-e $f0);
 }
}
`mv -f $htmlname.tmp.html $htmlname.html`;
</pre></body></html>