10 if (exists $ENV{"QUERY_STRING"}) {
11 $BASE=($ENV{"QUERY_STRING"}=~m{^url=([^&]*)})[0];
12 $BASE=URI::Escape::uri_unescape($BASE);
13 0==@ARGV or die "ARGV count != 0";
17 1==@ARGV or die "ARGV count != 1";
21 # Somehow Perl modules started reencoding windows-1250 -> utf-8.
23 if ($ENV{"GATEWAY_INTERFACE"}) {
24 my $future=HTTP::Date::time2str(2000000000);
25 my $past =HTTP::Date::time2str(1000000000);
27 Content-type: text/html; charset=utf-8
36 <title>iDNES foto@{[ (!$BASE ? "" : ": $BASE") ]}</title>
37 <meta http-equiv="Content-Type" content="text/html; charset=utf-8">
39 <form action="idnes-foto" method="get">
40 <input type="text" name="url" size="50" value="$BASE">
44 $BASE=~m{^http://\w+\Q.idnes.cz/foto.asp?\E(?:r=[-_\w]+&c=[-_\w]+|c=[-_\w]+&r=[-_\w]+)$} or $BASE="";
50 my $pageurl=$BASE.'&strana='.$pageno;
51 my $page=LWP::Simple::get($pageurl) or die $pageurl;
53 while ($page=~m{<img src="http://(?:\Qi.idnes.cz\E/\d{2}/\d{3}|\Qimgs.idnes.cz\E/\w+)(?:/\w+)?/([-.\w]+.jpg)" }gi) {
56 last PAGES if $seen{$base}++;
57 my $infourl=$BASE.'&styl=zoom&foto='.$base;
58 my $info=LWP::Simple::get($infourl) or die $infourl;
59 $info=~m{<img\s+id="fotka"\s+src="([^<>"]+)" }is
60 or die "No image found: $infourl";
64 <img src="$img_src" border="0">
68 $info=~m{<span>(.*?)</span>}s,
69 $info=~m{<p>([^<>]*)</p>},
70 $info=~m{<div class="text"><!--google_ad_section_start--><h4>([^<>]*)</h4><p>([^<>]*)<!--google_ad_section_end--></p><p>Autor:\s+(.*?)(?:, <a target="_blank" href="http://www.idnes.cz">iDNES.cz</a>)?</p></div>}s,
77 print <<"EOH" if !$seen_p_text{$text}++;
81 warn "No text found: $infourl" if !$hit;
83 die $pageurl if !$did;