Programming in Perl
By Randal Schwartz
Web Techniques, July 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.

LISTING ONE

#!/home/merlyn/bin/perl -Tw 
use strict; 
$|++; 
use LWP::Simple qw/get/; 
use URI::URL; 
use CGI qw/:form :html param header/; 

## configure 
my $TOP = "http://www.unitedmedia.com/comics/dilbert/archive/"; 
my $HTML_RE = '/comics/dilbert/archive/dilbert\d+.html'; 
my $GIF_RE = '/comics/dilbert/archive/images/dt\d+_\d+\.gif'; 
my $KEEP = 99; 
## end configure 
  
## return $_[0] encoded for HTML entities 
sub ent { 
  local $_ = shift; 
  $_ =~ s/["<&>"]/"&#."ord($&).";"/ge;  # entity escape 
  $_; 
} 
sub td_center { td({ align => "center" }, @_); } 
  
 BEGIN { 
   my $notes = ""; 
   sub add_note { $notes .= join "", @_; } 
   sub get_notes { $notes; } 
   sub get_ent_notes { ent $notes; } 
 } 
  
 print header, start_html("Dilbert"), h1("Recent Dilberts"), "\n"; 
 my $max = param("max"); 
 if (defined $max and $max =~ /^\d+$/) { 
   $max = $KEEP if $max > $KEEP; 
   my $top = get $TOP; 
   my @gif_urls = (); 
   if (not defined $top) { 
     add_note "cannot get $TOP"; 
   } else { 
     my @old_urls = map url($_,$TOP)->abs, $top =~ m!($HTML_RE)!og; 
  
     @old_urls = @old_urls[-$max..-1] if @old_urls > $max; 
  
     for my $url (@old_urls) { 
       my $content = get $url or (add_note "cannot get $url\n"),next; 
       my ($gif) = $content =~ m!($GIF_RE)!o; 
       push @gif_urls, url($gif,$url)->abs; 
     } 
   } 
  
   print table( 
               (map { TR(td_center($_)) } 
                map { table(TR(td_center(ent $_)), 
                            TR(td_center(img{-src => $_}))) 
                    } @gif_urls), 
               p(get_ent_notes()) 
              ); 
 } else { 
   print hr, start_form; 
   print p(submit("get this many days of back-images:"), 
           popup_menu("max", [1..45], "14")); 
   print end_form, hr; 
 } 
 print "\n", end_html;