#!/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) = '

Messages

'; # This holds messages to display at # the bottom of the page when finished my($cmd,@args); # command and arguments from config file # It's best to get my HTML opening matter out there early in the # program, so it doesn't get lost and confused. Or something. print("Content-type: text/html\n\n"); print 'The Comics Page

The Comics Page

'; # I'm also going to open my config file now, as it will need to # be open for throughout the program open(CONFIG,'/usr/home2/mcollum/html/cgi-bin/funnies.cfg') || die "
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