#!/usr/local/bin/perl #Change these to locations appropriate for your system! $birthdayPath = "/home/boutell/birthday_data"; $birthdayProgramUrl = "/~boutell/wbw2.cgi"; require "cgi-lib.pl"; %monthIndexes = ( "january", 0, "february", 1, "march", 2, "april", 3, "may", 4, "june", 5, "july", 6, "august", 7, "september", 8, "october", 9, "november", 10, "december", 11 ); @monthNames = ( "january", "february", "march", "april", "may", "june", "july", "august", "september", "october", "november", "december" ); print "Content-type: text/html\n\n"; print "\n\n"; #Look for requests for particular days #and submissions of new entries. If #the PATH_INFO indicates neither, #display today's birthdays. In all #three cases, present the user's #next choices afterward. $pathInfo = $ENV{"PATH_INFO"}; #Clobber the leading / , if any $pathInfo =~ s/^\///; #Handles the content type print &PrintHeader; #Fetch the values &ReadParse(*values); if ($pathInfo eq "day") { &DayRequested(); } elsif ($pathInfo eq "submit") { &AcceptSubmission(); } else { &TodayRequested(); } &PresentOptions(); print "\n\n"; exit 0; sub TodayRequested { #Output today's birthdays local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(time); &OutputDay($mon, $mday); } sub DayRequested { local($monthName, $month, $day); $monthName = $values{"month"}; $month = $monthIndexes{$monthName}; $day = $values{"day"}; if ($day < 1) { # Constrain the day to a reasonable value $day = 1; } print $day, " ", $month, "\n"; &OutputDay($month, $day); } sub AcceptSubmission { local($monthName, $month, $day, $name, $url, $email, $path, $out); $monthName = $values{"month"}; $month = $monthIndexes{$monthName}; $day = $values{"day"}; if ($day < 1) { $day = 1; } $name = $values{"name"}; $url = $values{"url"}; $email = $values{"email"}; if ($name eq "") { # Complain. print "Missing Fields\n"; print "\n

Missing Fields

\n"; print "Please fill out your name, your month of birth,\n"; print "and your day of birth, at a minimum.\n"; return; } # All is well; add the data to the database. $path = ">>" . $birthdayPath . "/" . ($month + 1) . "/" . $day; if (!open (OUT, $path)) { # We can't access the data file to add to it. print "Can't Access Data File\n"; print "\n

Can't Access Data File

\n"; print "Please contact the administrator.\n"; return; } print OUT $name, "\n", $url, "\n", $email, "\n"; close(OUT); print "WBW: Birthday added successfully.\n"; print "\n

WBW: Birthday added successfully.

\n"; } sub OutputDay { local($month, $day) = @_; $birthdayCount = 0; print "WBW: Birthdays for ", $day, " ", $monthNames[$month], "\n"; print "

WBW: Birthdays for ", $day, " ", $monthNames[$month], "

\n"; $filename = $birthdayPath . "/" . ($month + 1) . "/" . $day; open(file, $filename); while (1) { if (!($name = )) { last; } chop $name; if (!($url = )) { last; } chop $url; if (!($email = )) { last; } chop $email; if (!($birthdayCount)) { print "

Birthdays for: ", ($month+1), "/", $day, "

\n"; } $birthdayCount++; print "

"; if ($url ne "") { print ""; } print $day, " ", $monthNames[$month], ": "; print "", $name, " "; if ($email ne "") { print "", $email, ""; } if ($url ne "") { print ""; } print "

\n"; } if ($birthdayCount) { print "\n"; print "

Remember, the Birthday Server"; print "runs on Greenwich Mean Time.\n"; } else { print "No birthdays have been entered "; print "for this day.\n"; } } sub PresentOptions { local($i); print "

\n"; print "

Global Birthday Navigator (GBN)

\n"; # Make sure that PATH_INFO will distinguish this form from others print "\n"; print "

\n"; print "

Universal Birthday Form (UBF)

\n"; #Make sure that PATH_INFO will distinguish this form from others print "\n"; }