#!/usr/bin/perl
# This code unsafe by default and published only as query source
use URI::Escape;

$temp||='tmp';
@or=('Belarus','Belorussia','Byelorussia') if(!@or);

my %htm1=(
'<'=>'lt',
'>'=>'gt',
'&'=>'amp',
'"'=>'quot'
);
sub htmlz{
my $s=shift;
for('&','<','>','"'){$s=~s/$_/\&$htm1{$_}\;/gs}
$s
}

my %classes=(
	'gf-table'=>'margin:12px 0 8px 0',
	'localName'=>'',
	'exch'=>'',
	'symbol'=>'width:25%;text-align:left',
	'price'=>'width:23%;text-align:right',
	'asterisk'=>'',
	'lft'=>'text-align:left',
	'change'=>'width:37%;text-align:right',
	'rgt'=>'text-align:right',
	'mktCap'=>'text-align:right',
	'nwp'=>'white-space:nowrap',
	'prg'=>'color:green',
	'chg'=>'color:green',
	'chr'=>'color:#a03',
	'chb'=>'color:#000'
);

sub classes{
	my @c=();
	my @cc=();
	for (@_){
		push @c,$classes{$_} if(defined($classes{$_}));
		next if(exists($classes{$_}));
		system("grep -qF '>$_<' $temp/classes.xxx||echo '>$_<' >>$temp/classes.xxx");
		push @cc,$_;
	}
	my $r=join(';',@c);
	$r='style="'.$r.'"' if($r ne '');
	my $r1=join(' ',@cc);
	$r1=' class="'.$r1.'"' if($r1 ne '');
	"$r$r1";
}

sub get_tab{
my ($s,$tab)=(@_);
my @a;
$s=~s/.*<table.*?$tab.*?>(.*?)<\/table>.*/$1/s;
$s=~s/<font.*?>//gs;
$s=~s/<\/font.*?>//gs;
$s=~s/\n/ /gs;
$s=~s/\&nbsp\;/ /gs;
$s=~s/<a href=\"(.*?)\">[ ]*(.*?)[ ]*<\/a>/<a href=\"$_[2]$1\">$2<\/a>/gs;
$s=~s/<tr.*?>(.*?)<\/tr>/push @a,$1;''/gse;
for(0..$#a){
my $x=$a[$_];
$a[$_]=[];
$x=~s/<td.*?>[ ]*(.*?)[ ]*<\/td>/push @{$a[$_]},($1 eq ''?undef:$1);''/gse;
}
@a;
}

sub strip{
	my $x=$_[0];
	$x=~s/\;ei=[a-zA-Z0-9]+//;
	$x;
}

my $htab;

sub get_tab1{
my ($s,$tab)=(@_);
my (@a,@d);
$s=~s/.*(<table.*?$tab.*?>)(.*)$/$htab=$1;$2/es;
$s=~s/(<table[\s>].*?<\/table>|<\/table>.*$)/substr($1,1,1) eq '\/'?'':$1/gse;
return if(!$htab);
$s=~s/<a href=\"[\/]?(.*?)\">[ ]*(.*?)[ ]*<\/a>/<a href=\"$_[2]$1\">$2<\/a>/gs;
$s=~s/(<tr\s+class=\"snippet\".*?<\/tr>(?:<tr>.*?<table[\s>].*?<\/table>.*?<\/tr>)?)/push @a,uri_escape($1);''/gse;
@a;
}

sub get_tab2{
my ($s,$tab)=(@_);
$s=~s/.*(<table\s[^>]*$tab[^>]*>)/$htab=$1;''/se or die;
while($s=~s/<table[\s>].*?<\/table>//gs){};
$s=~s/<\/table>.*//gs;
$s=~s/\shref=\"[\/]?(.*?)\"/ href=\"$_[2]$1\"/gs;
my @a;
$s=~s/(<tr\s+class=\"snippet\".*?<\/tr>)/push @a,uri_escape($1);''/gse;
@a;
}

my $charset;

print "@or\n$root\n";

my $q=join('%7C',@or);
#my $s="http://finance.google.com/finance?q=$q&restype=company&num=16000";
my $s="http://www.google.com/finance?q=$q&restype=company&num=16000";
$s=quotemeta($s);
#$s=`wget -N -t2 -Y0 -O$temp/fin0 $s --save-headers`;
$s="wget -t2 -O - $s --save-headers";
$s.=$proxy?" -Y1 -e http_proxy=$proxy":' -Y0';
print "$s\n";
$s=`$s`;
#$s=`cat $temp/fin0`;
$s=~s/charset=(.*?)[ \n\r]/$charset=" encoding=\"$1\""/se;
$s=~s/highlightGrey/highlightWhite/gs;
$s=~s/class="([^\">]*?)"/classes(split(" ",$1))/gse;
$s=~s/class=([^\s\">]*)/classes(split(" ",$1))/gse;
my @a=get_tab2($s,'company_results','http://finance.google.com/');
goto EX if(!@a);
$s='';
my $n=shift @a;

my (%h,%h1);

open FF,"<$temp/fin_save";
while(<FF>){chomp;$h{strip($_)}=0}
close(FF);

my $res=qq(<?xml version="1.0"$charset?>
<rss version="2.0">
<channel>
<title>Finance!</title>
<link>http://news.eu.by/</link>
<description>Open Source News</description>
);
my $ch;
for(@a){$ch.=$_ if(!exists($h{strip($_)}));$h1{$_}++}
if(defined($ch)){
 $ch=uri_unescape("<br>$htab$n$ch</table>");
 while($ch=~s/(<td(?:\s[^>]*)?>)\s*(<\/?(?:tr|td|table)(?:\s[^>]*)?>)/$1\&nbsp;$2/gs){}; # respect html
 $ch=htmlz($ch);
 $res.="<item><title>".htmlz("<a href=\"http://finance.google.com\">Finance:</a>")."</title><description>$ch</description></item>";
}
my $i=1;
$res=~s/highlightWhite/('highlightWhite','highlightGrey')[$i=!$i]/gse;
open FF,">$temp/fin.xml";
print FF "$res</channel></rss>";
close(FF);

#map($h{$_}||delete($h{$_}),keys %h);

open FF,">$temp/fin_save";
print FF join("\n",keys %h1,'');
close(FF);


EX:
__END__
License: Anarchy.

Все стихийные (включая социальные (включая юридические, моральные и т.д.))
аспекты существования и использования данного кода являются форс-мажорными
обстоятельствами и автора не интересуют.

Money are welcome.

(c) mahatma, 29.09.2006
