Programming in Perl
By Randal Schwartz
Web Techniques, November 1997

Web Techniques grants permission to use these listings for private or 
commercial use provided that credit to Web Techniques and the author is 
maintained within the comments of the source. For questions, contact
editors@web-techniques.com.

#!/home/merlyn/bin/perl -Tw
use strict;
$|++;

use LWP::UserAgent;
use CGI qw(:standard);
use HTTP::Date qw(time2str);

### constants

my $BOUNDARY = "ThisRandomString";
my $SLEEPTIME = 30;
my $URL_PREFIX = "http://www.kgw.com/images/skycam";
my $CAM_MAP = {
     'skycam-1-75.jpg' => 'Vancouver, USA [medium]',
     'skycam-2-75.jpg' => 'Portland OMSI Tower[medium]',
     'skycam-3-75.jpg' => 'Timberline/Mt. Hood[medium]',
     'skycam-4-75.jpg' => 'Cedar Hills [medium]',
     'skycam-5-75.jpg' => 'Portland International Airport [medium]',
     'skycam-6-75.jpg' => 'Oregon Coast [medium]',
     'skycam-8-75.jpg' => 'Salem State Capitol[medium]',
     'skycam-9-75.jpg' => 'Newport, Oregon [medium]',
};

### end constants

my $nph = $0 =~ /nph-/;

my $image = param("image") || "";

unless ($image =~ /^(?!\.)[-\w.]+$/) {
print header(
                        -nph => $nph,
                       -date => time2str,
             "Last-modified" => time2str,
                     -pragma => "no-cache",
                    -expires => '+0d',
            );
print start_html("Skycams!"), h1("Skycams!"), "\n";
print p("Images are courtesy of",
a({-HREF => "http://www.kgw.com/"},
"KGW Television"), " -- check there for more info.",
);
print hr, start_form("GET");
print p(submit("get this image:"),
popup_menu(-name => "image",
"values" => [sort keys %$CAM_MAP],
-labels => $CAM_MAP,
));
print end_form, hr;
exit;
}

my $AGENT = LWP::UserAgent->new;
$AGENT->agent("watcher/0.5");
$AGENT->env_proxy;

my $REQUEST = HTTP::Request->new('GET', "$URL_PREFIX/$image");

my $basetime = 0;

print header(
           -nph => $nph,
          -date => time2str,
"Last-modified" => time2str,
        -pragma => "no-cache",
       -expires => '+0d',
          -type => "multipart/x-mixed-replace;boundary=$BOUNDARY",
           );

print "--$BOUNDARY\n";
    {
      $REQUEST->if_modified_since($basetime);
       my $response = $AGENT->request($REQUEST);
       if ($response->is_success) {
       $basetime = $response->last_modified;
       print $response->headers_as_string;
       print "\n";
       print $response->content;
       print "\n--$BOUNDARY\n";
       sleep $SLEEPTIME;
       redo;
     } elsif (
      $response->code == 304 # not changed yet
       or $response->code == 500 # cannot connect for some reason             
        ) {
 sleep $SLEEPTIME;
 redo;
 } else {
  die "[" . localtime(time) . "]" .
  "$0 failure: %d %s\n", $response->code,$response->message;
  }
}