public_html/cgi-bin/idnes-foto

   1 #! /usr/bin/perl
   2 use strict;
   3 use warnings;
   4 require LWP::Simple;
   5 require URI::Escape;
   6
   7 $|=1;
   8 my $BASE;
   9 if (exists $ENV{"QUERY_STRING"}) {
  10         $BASE=($ENV{"QUERY_STRING"}=~m{^url=([^&]*)})[0];
  11         $BASE=URI::Escape::uri_unescape($BASE);
  12         0==@ARGV or die "ARGV count != 0";
  13         $BASE||="";
  14         }
  15 else {
  16         1==@ARGV or die "ARGV count != 1";
  17         $BASE=$ARGV[0];
  18         }
  19
  20 if ($ENV{"GATEWAY_INTERFACE"}) {
  21         print <<"EOH";
  22 Content-type: text/html; charset=windows-1250
  23
  24 EOH
  25         }
  26 print <<"EOH";
  27 <html><head>
  28 <title>iDNES foto@{[ (!$BASE ? "" : ": $BASE") ]}</title>
  29 <meta http-equiv="Content-Type" content="text/html; charset=windows-1250">
  30 </head><body>
  31 <form action="idnes-foto" method="get">
  32         <input type="text" name="url" size="50" value="$BASE">
  33         <input type="submit">
  34 </form>
  35 EOH
  36 $BASE=~m{^http://\w+\Q.idnes.cz/foto.asp?\E(?:r=\w+&c=\w+|c=\w+&r=\w+)$} or $BASE="";
  37 if ($BASE) {
  38         my $pageno=1;
  39         my %seen;
  40         my %seen_p_text;
  41 PAGES:  for (;;) {
  42                 my $pageurl=$BASE.'&strana='.$pageno;
  43                 my $page=LWP::Simple::get($pageurl) or die $pageurl;
  44                 my $did=0;
  45                 while ($page=~m{<img src="(http://(?:\Qi.idnes.cz\E/\d{2}/\d{3}|\Qimgs.idnes.cz\E/\w+))(/midi)?/([-\w]+.jpg)" }gi) {
  46                         $did=1;
  47                         my($start,$mid,$base)=($1,$2,$3);
  48                         last PAGES if $seen{$base}++;
  49                         # FIXME: Sometimes "/maxi" does not exist.
  50                         $mid&&="/maxi";
  51                         $base=~s/_1M.JPG$/_V.JPG/;
  52                         my $maxi=$start.($mid||"")."/".$base;
  53                         print <<"EOH";
  54 <hr>
  55 <img src="$maxi" border="0">
  56 EOH
  57                         my $infourl=$BASE.'&styl=zoom&foto='.$base;
  58                         my $info=LWP::Simple::get($infourl) or die $infourl;
  59                         $info=~m{<p>[^<]*</p>} or die "No text found: $infourl";
  60                         my $p_text=$&;
  61                         print <<"EOH" if !$seen_p_text{$p_text}++;
  62 $p_text
  63 EOH
  64                         }
  65                 die $pageurl if !$did;
  66                 $pageno++;
  67                 }
  68         }
  69 print <<"EOH";
  70 <hr>
  71 <p>EOF</p>
  72 </body></html>
  73 EOH