<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#! /usr/bin/perl
#use utf8;
use XML::Parser::Lite;
use Socket;
use Encode qw(:all);
#use threads;
#use threads::shared;

$ttl=15; # minutes

$url='http://news.eu.by/';
$subject='Belarus';
$root=substr($0,0,rindex($0,'/'));
$web="$root/html";
$pub="$web/dir";
$temp="$root/tmp";
$xmlname="newz";
$deltaname="newz";
$htmlname="newz";
#$dbname="$temp/newz";
#my $enc='.gz';
$enc='';
$title='Breaking News!';
$rotate_time=5400;  # sec;
#$proxy='195.50.2.154:8080';
@or=('Belarus','Belorussia','Byelorussia','Belarussian','Byelorussian','Bielorussia','Bielorusso','Bielorussa','Belarusse','Bjellorusi');
@or_ru=('Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÑŒ','Ð‘ÐµÐ»Ð¾Ñ€ÑƒccÐ¸Ñ','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐ¸','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐ¸Ð¸','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐºÐ¸Ð¹','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐºÐ°Ñ','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐºÐ¾Ðµ','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐºÐ¸Ðµ','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐºÐ¸Ð¹','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐºÐ°Ñ','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐºÐ¾Ðµ','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐºÐ¸Ðµ','Ð‘ÐµÐ»Ð¾Ñ€ÑƒÑÑÐºÐ¸Ñ…','Ð‘ÐµÐ»Ð°Ñ€ÑƒÑÐºÐ¸Ñ…');
my $encoding='utf8';
my $arc="7z";
my $arc_month=-1;
my @month=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
my %mime_xml=('*/*'=&gt;1,'text/html'=&gt;1,'application/xml'=&gt;1,'text/xml'=&gt;1,'application/rss+xml'=&gt;1,'text/plain'=&gt;1);
my $timeout=15;
$|=1;


alarm($ttl*60-30);


my %arcs=(
"tar.bz2"=&gt;sub{exec("tar -cjf $_[0] --remove-files $_[1]")},
"tar.gz"=&gt;sub{exec("tar -czf $_[0] --remove-files $_[1]")},
"rar"=&gt;sub{exec("rar m -m5 -ds -md4096 -s -inull $_[0] $_[1]")},
"7z"=&gt;sub{
(system("7z a -t7z -m0=lzma -mx=9 -mfb=64 -md=64m -ms=on -bd $_[0] $_[1]")==0)||return 0;
unlink &lt;$_[1]&gt; if($? == 0 &amp;&amp;-e $_[0])
}
);

&amp;install if($ARGV[0] eq 'install');

do "$root/fin.pl";
system("mv $temp/fin.xml $temp/fin.xml0");

my $fail=0;

my $heads=qq(&lt;title&gt;$title&lt;/title&gt;
&lt;meta http-equiv="Content-Type" content="text/html; charset=$encoding"&gt;
&lt;link rel="StyleSheet" type="text/css" href="/newz.css"&gt;
&lt;link rel="icon" href="n1.ico"&gt;
);

my $ad1=q(
&lt;script type="text/javascript"&gt;&lt;!--
google_ad_client = "pub-1438492991159293";
google_ad_width = 728;
google_ad_height = 15;
google_ad_format = "728x15_0ads_al_s";
//2006-09-27: newz
google_ad_channel ="1395501299";
google_color_border = "CCCCCC";
google_color_bg = "CCCCCC";
google_color_link = "000000";
google_color_text = "333333";
google_color_url = "666666";
//--&gt;&lt;/script&gt;
&lt;script type="text/javascript"
  src="http://pagead2.googlesyndication.com/pagead/show_ads.js"&gt;
&lt;/script&gt;
);

my $ad2=q(
&lt;script type="text/javascript"&gt;&lt;!--
google_ad_client = "pub-1438492991159293";
google_ad_width = 728;
google_ad_height = 90;
google_ad_format = "728x90_as";
google_ad_type = "text";
//2006-09-27: newz
google_ad_channel ="1395501299";
//--&gt;&lt;/script&gt;
&lt;script type="text/javascript"
  src="http://pagead2.googlesyndication.com/pagead/show_ads.js"&gt;
&lt;/script&gt;
);

my %cont:shared=(
'root.eu.by'=&gt;'Dzianis Kahanovich',
'www.bspu.unibel.by'=&gt;'Belarussian State Pedagogical University',
'www.belta.by'=&gt;'BELTA',
'news.google.com'=&gt;'Google News',
'finance.google.com'=&gt;'Google Finance',
'www.idealist.org'=&gt;'Idealist.org'
);

my $or_='+OR+';
#my $or_='+%7C+';
my $mimes=join(',',keys(%mime_xml));

my %all;

my %goo=(
''=&gt;{q=&gt;join($or_,qqq(@or))},
'de'=&gt;{q=&gt;join($or_,qqq('WeiÃŸrussland','Belarus','Belorussland','WeiÃŸruÃŸland','BeloruÃŸland','weiÃŸrussisch','belarussich','weiÃŸruthenisch','Belarusse','WeiÃŸrusse','Belarussin','WeiÃŸrussin','WeiÃŸrussische'))},
'nl_nl'=&gt;{q=&gt;join($or_,qqq('Wit-Rusland','Wit-Russisch','Wit-Rus','Wit-Russin','Wit-Russische','Bjelo-Rusland','Bjelorussisch','Bjelorussische','Bjelorus','Belarus'))},
'fr'=&gt;{q=&gt;join($or_,qqq('Belarus','BiÃ©lorussie','BiÃ©lorusse','Bielaroussy','Bielarouss','BiÃ©larussie','BiÃ©larusse'))},
'es'=&gt;{q=&gt;join($or_,qqq('Bielorrusia','BelarÃºs','"Rusia+Blanca"','bielorruso','bielorrusa','Belarus'))},
'pt-PT'=&gt;{q=&gt;join($or_,qqq('Bielo-RÃºssia','BielorÃºssia','BielorrÃºssia','bielorrusso','bielorrussa','Belarus'))},
#'ja_jp'=&gt;{ned=&gt;'ja_jp',hl=&gt;'ja',q=&gt;join($or_,qqq('ãƒ™ãƒ©ãƒ«ãƒ¼ã‚·èªž','ãƒ™ãƒ©ãƒ«ãƒ¼ã‚·'))},
'ja'=&gt;{ned=&gt;'us',hl=&gt;'ja',q=&gt;join($or_,qqq('ãƒ™ãƒ©ãƒ«ãƒ¼ã‚·èªž','ãƒ™ãƒ©ãƒ«ãƒ¼ã‚·'))},
'zh_cn'=&gt;{scoring=&gt;'',q=&gt;join($or_,qqq('ç™½ä¿„ç¾…æ–¯'))},
'iw'=&gt;{ned=&gt;'iw_il',q=&gt;join($or_,qqq('×‘×œ××¨×•×¡'))},
'hi'=&gt;{ned=&gt;'hi_in',q=&gt;join($or_,qqq('à¤¬à¥‡à¤²à¤¾à¤°à¥‚à¤¸à¥€','à¤¬à¥‡à¤²à¤¾à¤°à¥‚à¤¸'))},
'ar'=&gt;{ned=&gt;'ar_me',q=&gt;join($or_,qqq('Ø±ÙˆØ³ÙŠØ§ Ø§Ù„Ø¨ÙŠØ¶Ø§Ø¡'))},
'ru'=&gt;{ned=&gt;'ru_ru',q=&gt;join($or_,qqq(@or_ru))}
);

my $ya=join('%7C',qqq(@or_ru));


#push @lang,(
my %lang_web=('ru'=&gt;1);
my @lang=('ru');
#'es_AR','au','nl_be','fr_be','en_bw','ca','fr_ca','cs_cz','es_cl','es_co','es_cu','es_us','en_et','en_gh','in','en_ie','en_il','en_ke','hu_hu','en_my','es_mx','en_na','nz','en_ng','no_no','de_at','en_pk','es_pe','en_ph','pl_pl','de_ch','fr_sn','en_sg','en_za','fr_ch','sv_se','en_tz','tr_tr','uk','us','en_ug','es_ve','vi_vn','en_zw','el_gr','ru_ua','uk_ua','iw_il','ar_ae','ar_sa','ar_me','ar_lb','ar_eg','hi_in','ta_in','te_in','ml_in','kr','cn','tw','hk'
for('en','es','fr','de','nl_nl','it','pt-PT_pt','pt-BR_br','ja','zh_cn','iw','hi','ar'){
	push @lang,$_;
	$lang_web{$_}=2;
}
my $langs=join(',','be',@lang,'en-us');

my $results=0;

sub mon{
for(0..$#month){
 if(index($_[0],$month[$_])&gt;=0){
  $_+=$_[1];
  $_+=12 while($_&lt;0);
  return $month[$_]
  }
 }
}

sub arc_exit{
chdir($pub)||die $!;
while(&lt;$xmlname.*.xml&gt;){
my $m=mon($_);
my $time=gmtime;
for my $mm($arc_month..0){goto NN if($m eq mon($time,$mm))}
my $x=$_;
my $y="!";
$x=~s/(\d{4})/$y=$1/ex;
my $f="*$m*$y*";
my $fa="$xmlname.$y.$m.$arc";
if(!-e $fa){
 &amp;{$arcs{$arc}}($fa,$f);
 system("chmod 444 $pub/*");
 exit
}
NN:
}
}

sub fn{
substr($_[1],-3) eq '.gz'?($_[0]?"|gzip -9 &gt;$_[1]":"gzip -dc &lt;$_[1]|"):($_[0]?"&gt;$_[1]":"&lt;$_[1]");
}

sub qqq{
my @x=(@_);
for(@x){
	$_=~s/([^a-zA-Z])/sprintf('%%%02X',ord($1))/eg;
	$all{$_}=1
}
@x
}

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

sub cur_cont{
my ($i,$r,$c);
for(sort keys %cont){
 $i=unesc($_);
 $c=unqm($cont{$_});
 $r.="&lt;li&gt;".url("http://$i",$c) if(index($_[0],$_)&gt;=0 || index($_[0],$i)&gt;=0 || $_ ne $c);
}
$r
}

sub esc{
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 qm{
#quotemeta($_[0])
my $x=shift;
$x=~s/([\'\\])/\\$1/gs;
$x=~s/\r/\\r/gs;
$x=~s/\n/\\n/gs;
$x;
}

sub unqm{
my $x=shift;
$x=~s/\\(.)/$1/g;
$x;
}

sub get_xml{
my ($gurl,$req,$opt,$wget)=(@_);
$wget=0;
my ($s,%h,@a,@a1,@ad,$x);
@a=split(/:\/\//,$gurl,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);
}
print "+";
if ($wget) {
	open SO, "wget --save-headers --timeout=$timeout -t1 ".($proxy?"-Y1 -e http_proxy=$proxy":"-Y0")." -O - ".quotemeta($gurl)." |" || goto ERR;
} else {
socket(SO,PF_INET,SOCK_STREAM,PROTO_TCP)&amp;&amp;
setsockopt(SO,SOL_SOCKET,SO_SNDTIMEO,pack('L!L!',$timeout,0))&amp;&amp;
setsockopt(SO,SOL_SOCKET,SO_RCVTIMEO,pack('L!L!',$timeout,0))&amp;&amp;
connect(SO,sockaddr_in($ad[1],inet_aton($ad[0])))&amp;&amp;goto OK;
ERR:
close(SO);
$fail++;
return;
OK:
select(SO);$|=1;select(STDOUT);
vec($vec_in='',fileno(SO),1)=1;
$x=qq($req $a1[3] HTTP/1.1
Host: $a1[1]
User-Agent: robot $url
Accept: $mimes
Accept-Language: $langs
Accept-Encoding: gzip
${opt}Connection: close

);
$x=~s/\n/\r\n/gs; # yandex lighthttp bug
print(SO $x)||goto ERR;
}
while(defined($x=&lt;SO&gt;)){$s.=$x;$x=~s/[\r\n]*//gs;$x||last}
for(split(/[\r]\n/,$s)) {
	$_=~s/^(.*?): (.*?)$/$h{lc($1)}=$2;''/gise;
	$s=$_ if($_);
}
if(index($s,' moved ')&gt;=0){
	((caller(0))[3] eq (caller(3))[3]) &amp;&amp; goto ERR;
	close(SO);
	return get_xml($h{'location'},$_[1],$_[2])
}
$s='';
if($req ne 'HEAD') {
while(defined($x=&lt;SO&gt;)&amp;&amp;((!defined($h{'content-length'}))||length($s)&lt;$h{'content-length'})){
    if($h{'transfer-encoding'} eq 'chunked' &amp;&amp; !$wget) {
	$x=~s/[\n\r]//gs;
	($x eq '')&amp;&amp;next;
	my $n=hex($x)||last;
	my $x1;
	$x='';
	while(defined($x1=&lt;SO&gt;)&amp;&amp;length($x.=$x1)&lt;$n){}
	defined($x1)||last;
	$x=substr($x,0,$n);
    }
    $s.=$x;
}
if(lc($h{'content-encoding'}) eq 'gzip'){
	$x="$temp/__gzip";
	open my $F,"|gzip -dc &gt;$x" || die "gzip decoding failed";
	print $F $s;
	close($F);
	open $F,"&lt;$x" || die "gzip decoding failed";
	sysread($F,$s,-s $F);
	close($F);
	unlink $x;
}
print "\n!!! ERROR - no /rss&gt;\n" if(index(lc($s),'/rss&gt;')&lt;0);
}
close(SO);
$s,%h
}

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

my (@block,%item,%channel,@items,$cnt0,$cnt0_);

## 'id'=&gt;[start,char,end,start1,char1.end1];
my %blocks=(
'rss.channel'=&gt;[
sub{%channel=()},
undef,
undef,
undef,
sub{shift;$channel{$block[$#block]}=join('',@_)}
],
'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 _var{
 my($s,$v,$r)=(@_);
 $s=~s/[\s\t\r\n]$v\=['"]?([^\s\t\r\n'"]*)/$r=$1/es; #'"
 $r;
}

sub get_rss{
my $url=shift;
my $head=shift;
my $retry=2;
RETRY:
my ($x,%h,$ff,$ffb,$t,$p,$lm);
print "get $url\n";
if(substr($url,0,7) eq 'file://'){
$ff=substr($url,7);
return if(!-e $ff);
goto FILE;
}
add_cont($url);
if($head){
 ($x,%h)=get_xml($url,'HEAD');
 return if(!defined(%h));
}
if(exists($h{'last-modified'})){
$ffb="$temp/newz-".esc($url);
stat($ff="$ffb.".esc($h{'last-modified'}));
if(-e _){
FILE:
 print "== $ff\n";
 open(FF,fn(0,$ff)) or die "$! $ff";
 $x='';
 while(!eof(FF)&amp;&amp;(my $s=&lt;FF&gt;)){$x.=$s}
 close(FF);
}else{
 ($x,%h)=get_xml($url,'GET',undef,$_[2]);
 return if(!defined($x));
}
}else{($x,%h)=get_xml($url,'GET',undef,$_[2]);
}
$p=new XML::Parser::Lite;
$p-&gt;setHandlers(%handlers);
my ($e,$a);
$x=~s/(&lt;\?xml.*?&gt;)/$a.=$1;$1/es;
$e=_var($a,"encoding")||_var($h{"content-type"},"charset")||"utf-8";
$x=~s/\&lt;\!\[CDATA\[(.*?)\]\]\&gt;/htmlz($1);$1/gse;
from_to($x,$e,$encoding,HTMLCREF) if($e &amp;&amp; $e ne $encoding);
undef %channel;
@items=();
if(index($x,'/rss&gt;')&lt;0){
 return if(($mime_xml{'*/*'}&amp;&amp;$h{'content-type'})||$mime_xml{lc((split(/;/,$h{'content-type'}))[0])});
 print "\nERROR: $h{'content-type'} $url\n";$retry--?goto RETRY:return
}
my $OLDDIE=$SIG{__DIE__};
$SIG{__DIE__}=sub{defined($ff) &amp;&amp; unlink($ff); print "Parser error: $_[0]\n"};
eval('$p-&gt;parse($x)');
$SIG{__DIE__}=$OLDDIE;

## debug:
#$ff=substr(($ffb="$temp/newz-".esc($url)).".".esc($h{'last-modified'}||=gmtime),0,128);

if(exists($h{'last-modified'})){
 while(my $d=&lt;$ffb.*&gt;){unlink($d)}
 wrf($ff,$x) if($ff);
}
$x=$channel{title};
$x=~s/[\:\n].*//s;
#add_cont($channel{link},quotemeta($x)) if($channel{link});
add_cont($channel{link},$x) if($channel{link});
addnews(@_);
1
}

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
}

sub htmlz{
my $s=shift;
for(keys %htm){$s=~s/$htm{$_}/$_/gs}
}

my @news0:shared;
my %news:shared;
my %nh:shared;
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 nkey{$_[0]-&gt;{xlink}||$_[0]-&gt;{link}||$_[0]-&gt;{description}}

# [param_redirect[,lang[,no_sort_by_time]]]
sub addnews{
my ($l,$x);
my $u=$_[0];
for(@items){
 $l=$_-&gt;{link};
 $_-&gt;{lang}||=ref($_[1]) eq 'CODE'?&amp;{$_[1]}($_):$_[1];
 if($u){
  $x="$l\&amp;";
  $x=~s/[\&amp;\?\;]$u\=(.*?)\&amp;/$l=unesc(dehtml($1));''/gse;
  if($x ne "$l\&amp;"){
   $l="http://$l" if(index($l,'://')==-1);
   $_-&gt;{xlink}=$l;
  }
 };
 $l=nkey($_);
 if(exists($nh{$l})){$nh{$l}++}
 else{
  if($_[2]){
   $nh{$l}=0;
   push @news0,$_;
  }else{
   $nh{$l}=1;
   my ($t1,$t)=(0,$_-&gt;{pubDate});
   $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;
   $t1++ while(exists($news{$t1}));
   $news{$t1}=$_
  }
  add_cont($l)
 }
}
}

sub mv{rename($_[0],$_[1])||`mv -f $_[0] $_[1]`}

my $time=gmtime;

sub time2h{
my $x="$_[0] GMT";
$x=~s/ /\&amp;nbsp\;/gs;
$x
}

my ($t0,$time0,$tstamp,$counter,$rotate);



if(open(FT,fn(0,"$pub/time$enc"))){
 $t0=&lt;FT&gt;;chomp($t0);
 $time0=&lt;FT&gt;;chomp($time0);
 $counter=&lt;FT&gt;;chomp($counter);
 $tstamp=&lt;FT&gt;;chomp($tstamp);
 close FT;
 print "time: ",time-$t0,"\n";
};

$tstamp||=time;

sub cp{
my $x=quotemeta($_[0]);
my $y=quotemeta($_[1]);
`cp -f $x $y`
}

if($ARGV[0] eq 'test'){$web=$pub=$temp;}

get_rss("file://$pub/$xmlname.xml$enc",0,undef,'ru',1);$cnt0_=$cnt0=$#news0;

if($ARGV[0] ne 'test' &amp;&amp; (time-$t0&gt;$rotate_time || $ARGV[0] eq 'rotate')){
 cp("$pub/$xmlname.xml$enc","$pub/$xmlname.$time.xml$enc");
 cp("$pub/$htmlname.html$enc","$pub/$htmlname.$time.html$enc");
 undef $t0;
 $rotate=1;
 $cnt0=-1;
}

if(!defined($t0)){($t0,$time0,$counter)=(time,$time,0)}

my $hhead=qq(&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&amp;nbsp;Source&amp;nbsp;News&amp;nbsp;&lt;/font&gt;&lt;/b&gt;&lt;sup&gt;$subject&lt;/sup&gt;&lt;/td&gt;&lt;td align=right valign=top&gt;).
'&lt;font size=-1&gt;~~'.($rotate_time/3600).'h: '.time2h($time0)." - ".time2h($time)."&lt;br&gt;".
url("/dir/")."&amp;nbsp;".url("/dir/".esc("$htmlname.$time0.html$enc"),"$time0&amp;nbsp;GMT")."&lt;/font&gt;&lt;/td&gt;&lt;/tr&gt;&lt;/table&gt;";

my $fh=qq(&lt;html&gt;&lt;head&gt;$heads
&lt;/head&gt;&lt;body&gt;$hhead&lt;ul&gt;);

#get_rss('http://newsrss.bbc.co.uk/rss/russian/institutional/pda/rss.xml');

if($ARGV[0] eq 'test'){get_rss("file://$temp/fin.xml",0,undef,'en');goto noget;}

goto noget if($ARGV[0] eq 'html');

for(@lang){
for(my $st=0;$st&lt;=$results;$st+=10){
 my $x='';
 my $ll=$_;
 my %goo0=();
 my %goo1=(ie=&gt;'UTF-8',scoring=&gt;'d',output=&gt;'rss',ned=&gt;$_);
 if(!exists($goo{$ll})){
	my @ll_=();
	while(1){
		@ll_=grep(/^$ll/,sort keys %goo);
		defined($ll_[0]) &amp;&amp; last;
		my $ll1=$ll;
		$ll1=~s/[-_][^-_]*?$//;
		last if($ll1 eq $ll);
		$ll=$ll1;
	}
	$ll=$ll_[0];
	$goo0{ned}=$_;
 }
 $goo1{start}=$st if($st);
 for (keys %{$goo{$ll}}){$goo0{$_}=$goo{$ll}-&gt;{$_} if(!defined($goo0{$_}));}
 for (keys %goo1){$goo0{$_}=$goo1{$_} if(!defined($goo0{$_}));}
 for (keys %goo0){$x.="\&amp;$_=$goo0{$_}" if($goo0{$_} ne '');}
 $lang__=$_;
 substr($x,0,1)='';
 for('http://news.google.com/news?','http://blogsearch.google.com/blogsearch_feeds?num=300&amp;x=399&amp;y=12&amp;ui=blg&amp;'){
  get_rss("$_$x",0,'url',sub{
  my $s=$_[0]-&gt;{link};
  $s=~s/^http\:\/\/news\.google\.com.*?\;ct\=(\w+)/return $1/ge;
  $lang__
 }
 );
 }
 last if($#items&lt;0);
}
}
#get_rss('http://www.afn.by/news/rss/',0,undef,'ru');
#get_rss('http://www.euronews.net/rss/euronews_ru.xml',0,undef,'ru');

#get_rss("http://search.blogger.com/blogsearch_feeds?num=300&amp;x=399&amp;y=12&amp;ui=blg&amp;ie=utf-8&amp;output=rss&amp;q=".join($or_,keys %all));


get_rss("file://$temp/fin.xml",0,undef,'en');
get_rss('http://news.tut.by/rss/all.rss',0,undef,'ru');
#get_rss('http://www.charter97.org/export/index.xml',1,undef,'ru');
#get_rss('http://blogs.yandex.ru/search.rss?how=tm&amp;rd=2&amp;text='.$ya,undef,'ru');
get_rss('http://news.yandex.ru/Belarus/index.rss',1,'cl4url','ru');
get_rss('http://blogs.yandex.ru/search.rss?how=tm&amp;rd=2&amp;text='.$ya.'&amp;searchtarget_blogs=on',0,undef,'ru');
#get_rss('http://www.blogdigger.com/search?q=Belarus&amp;sortby=date&amp;type=rss',0,undef,undef);
#get_rss('http://www.belta.by/by/belta.rss',0,undef,'by');
get_rss('http://www.belta.by/ru/belta.rss',0,undef,'ru');
#get_rss('http://www.alibaba.com/rss/tradelead_search/Belarus.rss',0,undef,'en');
get_rss('http://www.alibaba.com/rss/buyinglead_search/Belarus.rss',0,undef,'en');
#get_rss("http://www.idealist.org/if/idealist/en/SiteIndex/Search/viewAsRSS?assetTags=JOB_TYPE&amp;assetTypes=Job&amp;countries=Belarus&amp;fetchLimit=30&amp;languageDesignations=en&amp;onlyFetchAssetProperties=1&amp;siteClassifierName=idealist&amp;sortOrderings=modificationDate&amp;startIndex=0&amp;types=PART_TIME&amp;types=CONTRACT&amp;types=TEMPORARY&amp;types=FULL_TIME&amp;validStatusTypes=APPROVED&amp;validStatusTypes=UNAPPROVED&amp;validStatusTypes=DEFERRED",0,undef,'en');
get_rss("http://www.idealist.org/if/idealist/en/SiteIndex/Search/viewAsRSS?ages=1&amp;ages=2&amp;ages=3&amp;ages=4&amp;assetTags=VOLUNTEER_OPPORTUNITY_TYPE&amp;assetTypes=VolunteerOpportunity&amp;countries=Belarus&amp;fetchLimit=30&amp;languageDesignations=en&amp;onlyFetchAssetProperties=1&amp;siteClassifierName=idealist&amp;sortOrderings=modificationDate&amp;startIndex=0&amp;validStatusTypes=APPROVED&amp;validStatusTypes=UNAPPROVED&amp;validStatusTypes=DEFERRED",0,undef,'en');
#get_rss("http://www.idealist.org/if/idealist/en/SiteIndex/Search/viewAsRSS?assetTags=INTERNSHIP_TYPE&amp;assetTypes=Internship&amp;countries=Belarus&amp;fetchLimit=30&amp;languageDesignations=en&amp;onlyFetchAssetProperties=1&amp;siteClassifierName=idealist&amp;sortOrderings=modificationDate&amp;startIndex=0&amp;validStatusTypes=APPROVED&amp;validStatusTypes=UNAPPROVED&amp;validStatusTypes=DEFERRED",0,undef,'en');

die "$fail failures!!" if($fail&gt;2);

noget:
alarm(0);
system("mv $temp/fin.xml0 $temp/fin.xml");

my $cont0;
for(sort keys %cont){
 $i=unesc($_);
 $cont0.="&lt;li&gt;".url("http://$i",$cont{$_}) if($cont{$_} &amp;&amp; $_ ne $cont{$_});
}

if(defined(&amp;threads::list)){my @l=threads-&gt;list;for(@l){$_-&gt;join}}

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

open(FF,fn(1,"$pub/$xmlname.tmp.xml$enc")) or die $!;
print FF qq(&lt;?xml version="1.0" encoding="$encoding"?&gt;
&lt;rss version="2.0"&gt;
&lt;channel&gt;
&lt;title&gt;$title&lt;/title&gt;
&lt;link&gt;$url&lt;/link&gt;
&lt;description&gt;Open Source News&lt;/description&gt;
&lt;ttl&gt;$ttl&lt;/ttl&gt;);
my @fdelta=();

my %db;
if ($dbname){
	dbmopen(%db,$dbname,600);
	for(keys %db){delete($db{$_}) if(!$db{$_=nkey($_)})}
}
my $cnt=$#news0;
print "CNT: $cnt, $cnt0\n";
for(@news0){
 $cnt--;
 if((!$rotate)||$nh{nkey($_)}){
  my ($t,$s,$x,$d)=(dehtml($_-&gt;{title}),dehtml($_-&gt;{description}),dehtml($_-&gt;{xlink}));
  if(substr($_-&gt;{link},0,23) eq 'http://news.google.com/'){
   $s=~s/.*?&lt;font color.*?&gt;(.*?)&lt;\/font&gt;.*?&lt;\/font&gt;&lt;br[^&gt;]*&gt;&lt;font size\="?\-1"?&gt;(.*)&lt;\/font&gt;.*?&lt;\/table&gt;.*/for(my $i=length($1);$i&gt;=0;$i--){if(substr($t,-$i) eq substr($1,0,$i)){substr($t,-$i)='';last}};$d=$1;"&lt;i&gt;$1&lt;\/i&gt; $2"/se;
   $s=~s/&lt;br[^&gt;]*&gt;&lt;font (?:[^&gt;]*\s)?class="?p"?(?:\s[^&gt;]*)?&gt;(.*?)&lt;\/font&gt;/length($1)?"&lt;i&gt; $1&lt;\/i&gt;":""/gse; #"
   $d=~s/\&amp;nbsp\;\-//gs;
   $x&amp;&amp;add_cont($x,dehtml($d));
  }
 if($lang_web{$_-&gt;{lang}}||!exists($_-&gt;{lang})){
  $db{nkey($_)}||=0 if($dbname);
  $s=($lang_web{$_-&gt;{lang}}==2?"[$_-&gt;{lang}] ":'').' '.'&lt;b&gt;'.url($_-&gt;{'link'},$t)."&lt;/b&gt; $s";
  $fh.="&lt;li&gt;".(exists($_-&gt;{'xlink'})?url(unesc($x),'&lt;i&gt;link&lt;/i&gt;').' ':'').$s;
  push @fdelta,qm($s) if($cnt&gt;=$cnt0);
 }
 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;";
 }
 if($cnt==$cnt0_){
  $tstamp=time;
  $fh.='&lt;hr&gt;';
  @fdelta[$#fdelta].='&lt;hr&gt;' if($cnt&gt;$cnt0);
 }
}
print FF "\n&lt;/channel&gt;&lt;/rss&gt;";
close FF;
dbmclose(%db) if ($dbname);

my $cont_="&lt;li&gt;Contributors:&lt;ul&gt;".cur_cont($fh)."&lt;/ul&gt;";

$fh.="\n&lt;hr&gt;\n$cont_\n&lt;/ul&gt;$ad1$ad2&lt;/body&gt;&lt;/html&gt;";

wrf("$pub/$htmlname.tmp.html$enc",$fh);

if($#fdelta&gt;=0){
 $counter++;
 open FH,fn(1,"$web/$deltaname$counter.js$enc");
 print FH "d([";
 my $c='';
 for(@fdelta){print FH "$c'".$_."'";$c=','};
 print FH "])";
 close(FH);

 my $fj;
 for(1..$counter){$fj="&lt;script src=\"newz$_.js\"&gt;&lt;/script&gt;$fj"}
$fj=qq(&lt;html&gt;&lt;head&gt;$heads&lt;meta http-equiv="Content-Script-Type" content="text/javascript"&gt;&lt;meta http-equiv="Refresh" content="300"&gt;

&lt;noscript&gt;&lt;meta http-equiv="Refresh" content="0; URL=/dir/newz.html"&gt;&lt;/noscript&gt;
&lt;script&gt;tstamp='$tstamp';
l='$hhead';
c='$cont0'
&lt;/script&gt;
&lt;script src="newz.js"&gt;&lt;/script&gt;
$fj
$ad1
&lt;/head&gt;
&lt;body onFocus=bodyFocus(1) onBlur=bodyFocus(0)&gt;&lt;script&gt;n()&lt;/script&gt;.&lt;/body&gt;&lt;/html&gt;);
# &lt;table width=100% height=93 border=0 cellpadding=0 cellspacing=0&gt;&lt;tr&gt;&lt;td&gt;$ad2&lt;/td&gt;&lt;/tr&gt;&lt;/table&gt;&lt;br&gt;.
wrf("$web/index-j.html$enc",$fj);
for(my $i=$counter+1;unlink "$web/$deltaname$i.js$enc";$i++){}
}


close(FH);

mv("$pub/$htmlname.tmp.html$enc","$pub/$htmlname.html$enc");
mv("$pub/$xmlname.tmp.xml$enc","$pub/$xmlname.xml$enc");

wrf("$pub/time$enc",join("\n",$t0,$time0,$counter,$tstamp));

&amp;arc_exit;

sub wrf{
 my $f=shift;
 open(FT,fn(1,$f)) or die "ERROR: $! $f\n";
 print FT @_;
 close FT
}

sub wrf1{goto &amp;wrf if(!-e $_[0])}

###################################
sub install{
for($web,$pub,$temp){mkdir $_}
wrf1("$web/newz.js",q(if(document.getElementsByTagName){
l_m="date="+tstamp;ico=1;
function bodyFocus(x){
if(document.cookie.indexOf(l_m)&lt;0){if(!x)document.cookie=l_m}else{x=1}
if(ico!=x){ico=x;var i=document.getElementsByTagName("link");for(var j=0;j&lt;i.length;j++)if(i[j].rel=="icon"){i[j].href='n'+x+'.ico';document.getElementsByTagName("head")[0].appendChild(i[j]);break}}
}
bodyFocus(0)
}else{function bodyFocus(x){}}

function s2(s,s1,s2,p){
var i,j;
return ((i=s.indexOf(s1,p))&lt;0||(j=s.indexOf(s2,i+=s1.length))&lt;0)?'':s.substr(i,j-i)
}

l+='&lt;ul&gt;';
google_kw_type='broad';
google_kw='Áåëàðóñü íîâîñòè Belarus news';
max_kw=128;

function d(x){
var i,j;
if(google_kw.length&lt;max_kw){
 google_kw+=' '+x.join(' ').replace(/&lt;.*?&gt;|\&amp;nbsp\;|  |[\n\r]/g,' ');
 if((i=google_kw.indexOf(' ',max_kw))&gt;0){google_kw=google_kw.substr(0,i);max_kw=0}
}
for(i=0;i&lt;x.length;i++){
 var u0=s2(x[i],'href="','"'),u=s2(u0,'http://','/'),s='';
 if(u=='news.google.com'||u=='news.yandex.ru'){
  s=s2(x[i],'&lt;/b&gt; &lt;i&gt;','&amp;nbsp;-&lt;/i&gt;');
  if((j=unescape(s2(u0+'&amp;','url=','&amp;')))!=''){
   u0=j;
   if(u0.indexOf('://')&lt;0) u0='http://'+u0;
   x[i]='&lt;a href="'+u0+'"&gt;&lt;i&gt;link&lt;/i&gt;&lt;/a&gt; '+x[i];
   u=s2(u0,'http://','/')
  }
 }
 u=u==''?u0:"http://"+u;
 u0='&lt;li&gt;&lt;a href="'+u+'"&gt;';
 if(c.indexOf(u0)&lt;0) c+=u0+(s==''?u:s)+'&lt;/a&gt;'
}
l+='&lt;li&gt;'+x.join('&lt;li&gt;')+'&lt;hr&gt;'
}

function n(){document.write(l,'&lt;li&gt;Contributors:&lt;ul&gt;',c,'&lt;/ul&gt;&lt;/ul&gt;');c=l=''}
));

wrf1("$web/newz.css",q(body{margin-left:1em;margin-right:1em;text-align:justify;text-indent:1em;margin-top:0px;margin-bottom:0px;}
table{margin-left:0em;margin-right:0em;text-indent:0em;margin-top:3px;margin-bottom:0px;}
li{text-align:justify;text-indent:0em;margin-top:3px;margin-bottom:3px;}
.highlightWhite td { background-color:#FFFFFF; }
.highlightGrey td { background-color:#EFEFEF; }
.highlightGreyRelated td { background-color:#EFEFEF; }
));
symlink("index-j.html","$web/index.html");
exit
}

__END__
License: Anarchy.

Âñå ñòèõèéíûå (âêëþ÷àÿ ñîöèàëüíûå (âêëþ÷àÿ þðèäè÷åñêèå, ìîðàëüíûå è ò.ä.))
àñïåêòû ñóùåñòâîâàíèÿ è èñïîëüçîâàíèÿ äàííîãî êîäà ÿâëÿþòñÿ ôîðñ-ìàæîðíûìè
îáñòîÿòåëüñòâàìè è àâòîðà íå èíòåðåñóþò.

Money are welcome.

(c) mahatma, 29.09.2006
</pre></body></html>