#! /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=('*/*'=>1,'text/html'=>1,'application/xml'=>1,'text/xml'=>1,'application/rss+xml'=>1,'text/plain'=>1);
my $timeout=15;
$|=1;


alarm($ttl*60-30);


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

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

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

my $fail=0;

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

my $ad1=q(
<script type="text/javascript"><!--
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";
//--></script>
<script type="text/javascript"
  src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
);

my $ad2=q(
<script type="text/javascript"><!--
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";
//--></script>
<script type="text/javascript"
  src="http://pagead2.googlesyndication.com/pagead/show_ads.js">
</script>
);

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

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

my %all;

my %goo=(
''=>{q=>join($or_,qqq(@or))},
'de'=>{q=>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'=>{q=>join($or_,qqq('Wit-Rusland','Wit-Russisch','Wit-Rus','Wit-Russin','Wit-Russische','Bjelo-Rusland','Bjelorussisch','Bjelorussische','Bjelorus','Belarus'))},
'fr'=>{q=>join($or_,qqq('Belarus','Biélorussie','Biélorusse','Bielaroussy','Bielarouss','Biélarussie','Biélarusse'))},
'es'=>{q=>join($or_,qqq('Bielorrusia','Belarús','"Rusia+Blanca"','bielorruso','bielorrusa','Belarus'))},
'pt-PT'=>{q=>join($or_,qqq('Bielo-Rússia','Bielorússia','Bielorrússia','bielorrusso','bielorrussa','Belarus'))},
#'ja_jp'=>{ned=>'ja_jp',hl=>'ja',q=>join($or_,qqq('ベラルーシ語','ベラルーシ'))},
'ja'=>{ned=>'us',hl=>'ja',q=>join($or_,qqq('ベラルーシ語','ベラルーシ'))},
'zh_cn'=>{scoring=>'',q=>join($or_,qqq('白俄羅斯'))},
'iw'=>{ned=>'iw_il',q=>join($or_,qqq('בלארוס'))},
'hi'=>{ned=>'hi_in',q=>join($or_,qqq('बेलारूसी','बेलारूस'))},
'ar'=>{ned=>'ar_me',q=>join($or_,qqq('روسيا البيضاء'))},
'ru'=>{ned=>'ru_ru',q=>join($or_,qqq(@or_ru))}
);

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


#push @lang,(
my %lang_web=('ru'=>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[$_])>=0){
  $_+=$_[1];
  $_+=12 while($_<0);
  return $month[$_]
  }
 }
}

sub arc_exit{
chdir($pub)||die $!;
while(<$xmlname.*.xml>){
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){
 &{$arcs{$arc}}($fa,$f);
 system("chmod 444 $pub/*");
 exit
}
NN:
}
}

sub fn{
substr($_[1],-3) eq '.gz'?($_[0]?"|gzip -9 >$_[1]":"gzip -dc <$_[1]|"):($_[0]?">$_[1]":"<$_[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.="<li>".url("http://$i",$c) if(index($_[0],$_)>=0 || index($_[0],$i)>=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]&&="$a[0]://";
$a1[2]&&=":$a[2]";
$a1[3]&&="/$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)&&
setsockopt(SO,SOL_SOCKET,SO_SNDTIMEO,pack('L!L!',$timeout,0))&&
setsockopt(SO,SOL_SOCKET,SO_RCVTIMEO,pack('L!L!',$timeout,0))&&
connect(SO,sockaddr_in($ad[1],inet_aton($ad[0])))&&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=<SO>)){$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 ')>=0){
	((caller(0))[3] eq (caller(3))[3]) && goto ERR;
	close(SO);
	return get_xml($h{'location'},$_[1],$_[2])
}
$s='';
if($req ne 'HEAD') {
while(defined($x=<SO>)&&((!defined($h{'content-length'}))||length($s)<$h{'content-length'})){
    if($h{'transfer-encoding'} eq 'chunked' && !$wget) {
	$x=~s/[\n\r]//gs;
	($x eq '')&&next;
	my $n=hex($x)||last;
	my $x1;
	$x='';
	while(defined($x1=<SO>)&&length($x.=$x1)<$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 >$x" || die "gzip decoding failed";
	print $F $s;
	close($F);
	open $F,"<$x" || die "gzip decoding failed";
	sysread($F,$s,-s $F);
	close($F);
	unlink $x;
}
print "\n!!! ERROR - no /rss>\n" if(index(lc($s),'/rss>')<0);
}
close(SO);
$s,%h
}

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

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

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

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

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


sub parser_event{
my $e=shift;
my $id=join('.',@block[0..$#block-($e>3)]);
#print "$id\n";
if(exists($blocks{$id})){
 my $h=$blocks{$id};
 goto ref($h)||return;
 HASH:return $h->{('Start','Char','End')[$e]}(@_);
 ARRAY:return defined(@$h[$e])?&{@$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)&&(my $s=<FF>)){$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->setHandlers(%handlers);
my ($e,$a);
$x=~s/(<\?xml.*?>)/$a.=$1;$1/es;
$e=_var($a,"encoding")||_var($h{"content-type"},"charset")||"utf-8";
$x=~s/\<\!\[CDATA\[(.*?)\]\]\>/htmlz($1);$1/gse;
from_to($x,$e,$encoding,HTMLCREF) if($e && $e ne $encoding);
undef %channel;
@items=();
if(index($x,'/rss>')<0){
 return if(($mime_xml{'*/*'}&&$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) && unlink($ff); print "Parser error: $_[0]\n"};
eval('$p->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=<$ffb.*>){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'=>'>',
'amp'=>'&',
'quot'=>'"'
);

sub dehtml{
my $s=shift;
$s=~s/\&(.*?)\;/$htm{$1}||"\&$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'=>0,'Feb'=>1,'Mar'=>2,'Apr'=>3,'May'=>4,'Jun'=>5,'Jul'=>6,'Aug'=>7,'Sep'=>8,'Oct'=>9,'Nov'=>10,'Dec'=>11);

sub nkey{$_[0]->{xlink}||$_[0]->{link}||$_[0]->{description}}

# [param_redirect[,lang[,no_sort_by_time]]]
sub addnews{
my ($l,$x);
my $u=$_[0];
for(@items){
 $l=$_->{link};
 $_->{lang}||=ref($_[1]) eq 'CODE'?&{$_[1]}($_):$_[1];
 if($u){
  $x="$l\&";
  $x=~s/[\&\?\;]$u\=(.*?)\&/$l=unesc(dehtml($1));''/gse;
  if($x ne "$l\&"){
   $l="http://$l" if(index($l,'://')==-1);
   $_->{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,$_->{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/ /\&nbsp\;/gs;
$x
}

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



if(open(FT,fn(0,"$pub/time$enc"))){
 $t0=<FT>;chomp($t0);
 $time0=<FT>;chomp($time0);
 $counter=<FT>;chomp($counter);
 $tstamp=<FT>;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' && (time-$t0>$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(<table width=100% height=0 border=0 cellpadding=0 cellspacing=0><tr><td align=left valign=top><b><font size=+2 face=times>Open&nbsp;Source&nbsp;News&nbsp;</font></b><sup>$subject</sup></td><td align=right valign=top>).
'<font size=-1>~~'.($rotate_time/3600).'h: '.time2h($time0)." - ".time2h($time)."<br>".
url("/dir/")."&nbsp;".url("/dir/".esc("$htmlname.$time0.html$enc"),"$time0&nbsp;GMT")."</font></td></tr></table>";

my $fh=qq(<html><head>$heads
</head><body>$hhead<ul>);

#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<=$results;$st+=10){
 my $x='';
 my $ll=$_;
 my %goo0=();
 my %goo1=(ie=>'UTF-8',scoring=>'d',output=>'rss',ned=>$_);
 if(!exists($goo{$ll})){
	my @ll_=();
	while(1){
		@ll_=grep(/^$ll/,sort keys %goo);
		defined($ll_[0]) && 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}->{$_} if(!defined($goo0{$_}));}
 for (keys %goo1){$goo0{$_}=$goo1{$_} if(!defined($goo0{$_}));}
 for (keys %goo0){$x.="\&$_=$goo0{$_}" if($goo0{$_} ne '');}
 $lang__=$_;
 substr($x,0,1)='';
 for('http://news.google.com/news?','http://blogsearch.google.com/blogsearch_feeds?num=300&x=399&y=12&ui=blg&'){
  get_rss("$_$x",0,'url',sub{
  my $s=$_[0]->{link};
  $s=~s/^http\:\/\/news\.google\.com.*?\;ct\=(\w+)/return $1/ge;
  $lang__
 }
 );
 }
 last if($#items<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&x=399&y=12&ui=blg&ie=utf-8&output=rss&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&rd=2&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&rd=2&text='.$ya.'&searchtarget_blogs=on',0,undef,'ru');
#get_rss('http://www.blogdigger.com/search?q=Belarus&sortby=date&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&assetTypes=Job&countries=Belarus&fetchLimit=30&languageDesignations=en&onlyFetchAssetProperties=1&siteClassifierName=idealist&sortOrderings=modificationDate&startIndex=0&types=PART_TIME&types=CONTRACT&types=TEMPORARY&types=FULL_TIME&validStatusTypes=APPROVED&validStatusTypes=UNAPPROVED&validStatusTypes=DEFERRED",0,undef,'en');
get_rss("http://www.idealist.org/if/idealist/en/SiteIndex/Search/viewAsRSS?ages=1&ages=2&ages=3&ages=4&assetTags=VOLUNTEER_OPPORTUNITY_TYPE&assetTypes=VolunteerOpportunity&countries=Belarus&fetchLimit=30&languageDesignations=en&onlyFetchAssetProperties=1&siteClassifierName=idealist&sortOrderings=modificationDate&startIndex=0&validStatusTypes=APPROVED&validStatusTypes=UNAPPROVED&validStatusTypes=DEFERRED",0,undef,'en');
#get_rss("http://www.idealist.org/if/idealist/en/SiteIndex/Search/viewAsRSS?assetTags=INTERNSHIP_TYPE&assetTypes=Internship&countries=Belarus&fetchLimit=30&languageDesignations=en&onlyFetchAssetProperties=1&siteClassifierName=idealist&sortOrderings=modificationDate&startIndex=0&validStatusTypes=APPROVED&validStatusTypes=UNAPPROVED&validStatusTypes=DEFERRED",0,undef,'en');

die "$fail failures!!" if($fail>2);

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

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

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

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

open(FF,fn(1,"$pub/$xmlname.tmp.xml$enc")) or die $!;
print FF qq(<?xml version="1.0" encoding="$encoding"?>
<rss version="2.0">
<channel>
<title>$title</title>
<link>$url</link>
<description>Open Source News</description>
<ttl>$ttl</ttl>);
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($_->{title}),dehtml($_->{description}),dehtml($_->{xlink}));
  if(substr($_->{link},0,23) eq 'http://news.google.com/'){
   $s=~s/.*?<font color.*?>(.*?)<\/font>.*?<\/font><br[^>]*><font size\="?\-1"?>(.*)<\/font>.*?<\/table>.*/for(my $i=length($1);$i>=0;$i--){if(substr($t,-$i) eq substr($1,0,$i)){substr($t,-$i)='';last}};$d=$1;"<i>$1<\/i> $2"/se;
   $s=~s/<br[^>]*><font (?:[^>]*\s)?class="?p"?(?:\s[^>]*)?>(.*?)<\/font>/length($1)?"<i> $1<\/i>":""/gse; #"
   $d=~s/\&nbsp\;\-//gs;
   $x&&add_cont($x,dehtml($d));
  }
 if($lang_web{$_->{lang}}||!exists($_->{lang})){
  $db{nkey($_)}||=0 if($dbname);
  $s=($lang_web{$_->{lang}}==2?"[$_->{lang}] ":'').' '.'<b>'.url($_->{'link'},$t)."</b> $s";
  $fh.="<li>".(exists($_->{'xlink'})?url(unesc($x),'<i>link</i>').' ':'').$s;
  push @fdelta,qm($s) if($cnt>=$cnt0);
 }
 print FF "\n<item>";
 for my $tag(keys %{$_}){print FF "<$tag>$_->{$tag}</$tag>"}
 print FF "</item>";
 }
 if($cnt==$cnt0_){
  $tstamp=time;
  $fh.='<hr>';
  @fdelta[$#fdelta].='<hr>' if($cnt>$cnt0);
 }
}
print FF "\n</channel></rss>";
close FF;
dbmclose(%db) if ($dbname);

my $cont_="<li>Contributors:<ul>".cur_cont($fh)."</ul>";

$fh.="\n<hr>\n$cont_\n</ul>$ad1$ad2</body></html>";

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

if($#fdelta>=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="<script src=\"newz$_.js\"></script>$fj"}
$fj=qq(<html><head>$heads<meta http-equiv="Content-Script-Type" content="text/javascript"><meta http-equiv="Refresh" content="300">

<noscript><meta http-equiv="Refresh" content="0; URL=/dir/newz.html"></noscript>
<script>tstamp='$tstamp';
l='$hhead';
c='$cont0'
</script>
<script src="newz.js"></script>
$fj
$ad1
</head>
<body onFocus=bodyFocus(1) onBlur=bodyFocus(0)><script>n()</script>.</body></html>);
# <table width=100% height=93 border=0 cellpadding=0 cellspacing=0><tr><td>$ad2</td></tr></table><br>.
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));

&arc_exit;

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

sub wrf1{goto &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)<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<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))<0||(j=s.indexOf(s2,i+=s1.length))<0)?'':s.substr(i,j-i)
}

l+='<ul>';
google_kw_type='broad';
google_kw='�������� ������� Belarus news';
max_kw=128;

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

function n(){document.write(l,'<li>Contributors:<ul>',c,'</ul></ul>');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