#! /usr/bin/perl
use strict;
use warnings;
require LWP::Simple;
require HTTP::Date;
require URI::Escape;
$|=1;
my $BASE;
if (exists $ENV{"QUERY_STRING"}) {
$BASE=($ENV{"QUERY_STRING"}=~m{^url=([^&]*)})[0];
$BASE=URI::Escape::uri_unescape($BASE);
0==@ARGV or die "ARGV count != 0";
$BASE||="";
}
else {
1==@ARGV or die "ARGV count != 1";
$BASE=$ARGV[0];
}
# Somehow Perl modules started reencoding windows-1250 -> utf-8.
if ($ENV{"GATEWAY_INTERFACE"}) {
my $future=HTTP::Date::time2str(2000000000);
my $past =HTTP::Date::time2str(1000000000);
print <<"EOH";
Content-type: text/html; charset=utf-8
Cache-Control: public
Expires: $future
Last-Modified: $past
EOH
}
print <<"EOH";
iDNES foto@{[ (!$BASE ? "" : ": $BASE") ]}
EOH
$BASE=~m{^http://\w+\Q.idnes.cz/foto.asp\Ex?[?](?:r=[-_\w]+&c=[-_\w]+|c=[-_\w]+&r=[-_\w]+)$} or $BASE="";
my $ua=LWP::UserAgent->new();
$ua->env_proxy();
$ua->requests_redirectable([]);
#sub webget($)
#{
# my($url)=@_;
#
# my $resp=$ua->get($url);
# if ($resp->is_redirect()) {
# my $relurl=$resp->header("Location");
# $relurl=~m{^foto.*[?]} or die;
# $url=~s{[^/]*$}{};
# $url.=$relurl;
# warn "Redirect to: $url\n";
# $resp=$ua->get($url);
# }
# $resp->is_success() or die $url;
# return $resp->decoded_content();
#}
if ($BASE) {
my $pageno=1;
my %seen;
my %seen_p_text;
PAGES: for (;;) {
my $pageurl=$BASE.'&strana='.$pageno;
my $page=LWP::Simple::get($pageurl) or die $pageurl;
my $did=0;
my $aspx=0;
while ($page=~m{"&]*(?:&inframe=1)?)"(?: target="foto-iframe")?>}gi) {
my $relurl=$1;
$relurl=~s{&}{&}g;
my $frameurl=$BASE;
$frameurl=~s{[?].*}{};
$frameurl.=$relurl;
my $frame=LWP::Simple::get($frameurl) or die $frameurl;
if ($frame=~m{