#!/usr/local/bin/perl # cgi-bin/grl4.cgi: Giant Robot Laughtron Four # The Perl Script That Makes Your Whole Day Happier # Gather comic strips from around the web, and display them on # a single page, using image tags, not stupid links to the main # sites. use IO::Socket; # Now for variable definitions: local($htmlmessages) = '
Sorry, couldn't open config file"; # Now we get to the real meat of the thing. Since ultimately # we want to be fairly customizable, I'm making this as modular # as possible. The question is whether to modulize based on # (1) Individual strips, or (2) Collection techniques. # The first is easier to write in the short term, but we choose # the second, which leaves a much smaller volume of code, and makes # the whole thing easier to extend. # This leaves us with two major sections: # 1) A main loop that reads lines from the config file and passes them to # 2) A set of subs to retrieve the filenames with various methods. # Each of the subs in (2) should return an string containing the complete # URL for the comic specified. # When (1) receives these, it should pass them to the browser inside IMG tags. # # Main Loop # # This is where we direct everything # For each line from the config file while () { chomp; # Split the line into a command and arguments ($cmd,@args) = split(/\t/,$_); # If the command is recognized, go to its sub, otherwise add an error message if ($cmd eq "simple") { simple(@args); #call the simple sub } elsif ($cmd eq "redirect") { redirect(@args); #call the redirect sub } elsif ($cmd eq "straighturl") { straighturl(@args); #call the dated sub } elsif ($cmd eq "dated") { dated(@args); #call the dated sub } else { $htmlmessages .= " Unrecognized config line:\n$_\n<\/pre>"; } } # while () { # # Closing and Cleanup # # Now that the main stuff is done, we finish off the page # Print out any messages that were collected print $htmlmessages; # Add a brief copyright note and link print(' funnies.cgi, Copyright (C) 2000 Moss Collum'); # Close the html tags print "<\/body><\/html>\n"; # # ---End of program # ---Subroutines below # # # Collection subs # # Simple sub simple { my($title,$address,$page,$baseurl,$regexp) = @_; # get arguments my($webpage); # Socket for http connection if (@_ >= 5) { print('
' . $title . '
'); $webpage = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $address, PeerPort => "http(80)", ); # open connection unless ($webpage) { $messages .= "Failed to retrieve $title<\/pre>"; print "Sorry, unable to load $title"; } else { $webpage->autoflush(1); print $webpage "GET $page HTTP/1.0\n\n"; while ( <$webpage> ) { if ( /$regexp/ ) { print('
'); } } } } } # sub simple # Redirect sub redirect { my($title,$address1,$page1,$address2,$page2base,$page2regexp,$imgbase,$imgregexp) = @_; # get arguments my($page2,$imgurl); # filename for page 2, url for image my($webpage); # Socket for http connection if (@_ >= 8) { print('' . $title . '
'); $webpage = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $address1, PeerPort => "http(80)", ); # open connection unless ($webpage) { $messages .= "Failed to retrieve $title<\/pre>"; print "Sorry, unable to load $title"; } else { $webpage->autoflush(1); print $webpage "GET $page1 HTTP/1.0\n\n"; while ( <$webpage> ) { if ( /$page2regexp/ ) { $page2 = $page2base . $1; last; } } close($webpage); $webpage = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $address2, PeerPort => "http(80)", ); # open second connection unless($webpage) { $messages .="
Failed to retrieve second page for $title<\/pre>"; print "Sorry, unable to load $title"; } else { $webpage->autoflush(1); print $webpage "GET $page2 HTTP/1.0\n\n"; while ( <$webpage> ) { if ( /$imgregexp/ ) { print('
'); } } } } } } # sub redirect # Straight Url sub straighturl { my($title,$url) = @_; # get arguments print '' . $title . '
'; print '
' } # sub straighturl # Dated sub dated { my($title,$arg) = @_; # get arguments my($comd,$url); # date command, image url $comd = "date " . $arg; $url = `$comd`; print '' . $title . '
'; print '
' } # sub dated