#!/usr/bin/perl ############################################ ## ## ## WebCal ## ## by Darryl Burgdorf ## ## (e-mail burgdorf@awsd.com) ## ## ## ## version: 1.21 ## ## last modified: 1/4/00 ## ## license modified: 4/13/06 ## ## copyright (c) 2000 ## ## ## ## latest version is available from ## ## http://awsd.com/scripts/ ## ## ## ############################################ # COPYRIGHT NOTICE: # # Copyright 2000 Darryl C. Burgdorf. # # This program is free software. You can redistribute it and/or # modify it under the terms of either: # # a) the GNU General Public License as published by the Free Software # Foundation, either version 1 or (at your option) any later version, # # or # # b) the "Artistic License" which comes with this program. # # You should have received a copy of the Artistic License with this # module, in the file artistic.txt. If you did not, I'll be glad to # provide one. # # You should have received a copy of the GNU General Public License # along with this program. If you did not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307. # # This program is distributed "as is" and without warranty of any # kind, either express or implied. (Some states do not allow the # limitation or exclusion of liability for incidental or consequential # damages, so this notice may not apply to you.) In no event shall # the liability of Darryl C. Burgdorf and/or Affordable Web Space # Design for any damages, losses and/or causes of action exceed the # total amount paid by the user for this software. # VERSION HISTORY: # # 1.21 01/04/00 Corrected add script's handling of 4-digit years # Changed deliter used in delete script from :: to | # 1.20 12/30/99 Allowed for use of multiple data files # Made display of "day counter" optional # Added (optional) calculation of lunar phases # Changed "annual" code to "x" to allow 0 for 2000 # Short year entries now 1950-2049 # Extended one-year limit on "day each week" entries # Squashed "day each week / MonSunWeek" entry bug # Added check for entry dir validity before using # Added line/paragraph parsing to "data dir" entries # Added separate header/footer for "data dir" entries # Improved checks on entry validity # Replaced "reload to add another" with FORM button # Added $CalendarTitle and $TableFont # Added $HourOffset # Lots of minor tweaks, after two years.... ;) # 1.11 01/30/98 Corrected small problem with some versions of Perl 5 # 1.10 01/29/98 FIRST SHAREWARE RELEASE # Moved configuration variables to separate file # Added configurable table colors # Added "Small Table" option (with or without text) # Stripped "empty" entries from text listing # Allowed for "Monday-Sunday" weeks # Allowed for two-digit year entry (1900s) # Allowed for "date range" entries # Added option to allow HTML in calendar data entries # Limited basic event entries to 80 characters # Added optional "data dir" for more extensive entries # Allowed disabling of user choice of style # Fixed bug that made some entries "undeletable" # 1.00 01/05/98 Initial "public" release require "/hsphere/local/home/alwynall/radnornurseryschool.com/cgi-bin/webcal.config.pl"; # NOTHING BELOW THIS LINE NEEDS TO BE ALTERED! $DefaultUsed = 0; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); #print "Here is \$buffer: $buffer
\n"; #print "Here is \$ENV{'QUERY_STRING'}: $ENV{'QUERY_STRING'}
\n"; if ($buffer eq "") { $buffer = $ENV{'QUERY_STRING'} } #print "Now here is \$buffer: $buffer
\n"; @pairs = split(/&/, $buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $INPUT{$name} = $value; } if ($INPUT{'Year'} =~ /\D/) { $INPUT{'Year'} = 0; } elsif ($INPUT{'Year'} < 50) { $INPUT{'Year'} += 2000; } elsif ($INPUT{'Year'} < 100) { $INPUT{'Year'} += 1900; } if (($INPUT{'Year'} < 1601) || ($INPUT{'Year'} > 2899)) { &Header("Date Out of Range!"); print "

Date Out of Range!

\n"; print "

The date you provided is out of range."; print "
It must be between 1601 and 2899 A.D.\n"; &Footer; exit; } foreach $datafile (@datafiles) { open (DATA,$datafile); while ($line=) { push (@unsorteddata,$line); } close (DATA); } @data = sort {$a <=> $b} (@unsorteddata); foreach $line (@data) { if ($line =~ /\n$/) { chop ($line); } ($date,$desc,$URL) = split (/\|/, $line); ($dateyear,$datemonth,$dateday) = $date =~ m#(\d\d\d\d)(\d\d)(\d\d)#o; if ((int($dateyear) == int($INPUT{'Year'})) || (int($dateyear) < 1)) { if (int($datemonth) == int($INPUT{'Month'})) { $textdesc = $desc; $textdesc =~ s/<([^>]|\n)*>//g; if ($URL) { $Table{int($dateday)} .= "

"; $Table{int($dateday)} .= "$desc"; $SmallTable{int($dateday)} .= "

"; $SmallTable{int($dateday)} .= "$desc"; $Text{int($dateday)} .= " "; $Text{int($dateday)} .= ""; $Text{int($dateday)} .= "$textdesc\n"; } else { $Table{int($dateday)} .= "

$desc"; $SmallTable{int($dateday)} .= "

$desc"; $Text{int($dateday)} .= " "; $Text{int($dateday)} .= "$textdesc\n"; } } } $SmallTable{int($dateday)} =~ s/^
//; $Text{int($dateday)} =~ s/^ //; } &PerpetualCalendar(int($INPUT{'Month'}),1,int($INPUT{'Year'})); $xmonth = @months[int($INPUT{'Month'})-1]; $heading = "  $xmonth $INPUT{'Year'}  "; unless ($SSI_Output) { &Header("$heading"); if ($CalendarTitle) { print "

$CalendarTitle

\n"; } } if ($INPUT{'Type'} eq "Text") { print "

$heading

\n"; print "

\n";
	foreach $key (1..$perp_eom) {
		$weekday = ($key+$perp_dow)-(int(($key+$perp_dow)/7)*7);
		if ($weekday < 1) { $weekday = 7; }
		if ($DisplayPhases) {
			if (int((int((($perp_days-5.36945)/29.53031)+.5)*29.53031)+5.36945) == $perp_days) {
				if ($Text{$key}) { $Text{$key} .= "                    "; }
				$Text{$key} .= "New Moon\n";
			}
			if (int((int((($perp_days-12.75202)/29.53031)+.5)*29.53031)+12.75202) == $perp_days) {
				if ($Text{$key}) { $Text{$key} .= "                    "; }
				$Text{$key} .= "First Quarter Moon\n";
			}
			if (int((int((($perp_days-20.13460)/29.53031)+.5)*29.53031)+20.13460) == $perp_days) {
				if ($Text{$key}) { $Text{$key} .= "                    "; }
				$Text{$key} .= "Full Moon\n";
			}
			if (int((int((($perp_days-27.51718)/29.53031)+.5)*29.53031)+27.51718) == $perp_days) {
				if ($Text{$key}) { $Text{$key} .= "                    "; }
				$Text{$key} .= "Last Quarter Moon\n";
			}
		}
		$perp_days++;		
		if ($Text{$key}) {
			if ($key < 10) { print "0"; }
			print "$key ";
			$xshortmonth = @shortmonths[$INPUT{'Month'}-1];
			print "$xshortmonth ";
			print "$INPUT{'Year'} ";
			$xshortday = @shortdays[$weekday-1];
			print "($xshortday)   ";
			print "$Text{$key}";
		}
		if (($weekday == 7) && !($key == $perp_eom)) {
			print "\n                    ---------------\n\n";
		}
	}
	print "
\n"; } elsif ($INPUT{'Type'} eq "Table") { unless ($SSI_Output) { print "

\n"; print "

\n"; } print "\n"; print "\n"; foreach $key (1..7) { print ""; } print "\n\n"; if ($perp_dow > 0) { print ""; } foreach $key (1..$perp_eom) { if ($DisplayPhases) { if (int((int((($perp_days-5.36945)/29.53031)+.5)*29.53031)+5.36945) == $perp_days) { $Table{$key} .= "

New Moon"; } if (int((int((($perp_days-12.75202)/29.53031)+.5)*29.53031)+12.75202) == $perp_days) { $Table{$key} .= "

First Quarter Moon"; } if (int((int((($perp_days-20.13460)/29.53031)+.5)*29.53031)+20.13460) == $perp_days) { $Table{$key} .= "

Full Moon"; } if (int((int((($perp_days-27.51718)/29.53031)+.5)*29.53031)+27.51718) == $perp_days) { $Table{$key} .= "

Last Quarter Moon"; } } $perp_days++; $weekday = ($key+$perp_dow)-(int(($key+$perp_dow)/7)*7); $bg = $bgcolor_normal; if ($weekday == 0 || $weekday == 6) { $bg = $bgcolor_special; } if (($INPUT{'Year'} == $year) && ($INPUT{'Month'} == $month) && ($key == $mday)) { $bg = $bgcolor_today; } print "

\n"; if (($weekday == 0) && !($key == $perp_eom)) { print "\n\n"; } } if ($weekday > 0) { $leftover = 7-$weekday; print ""; } print "
"; # print ""; if($SSI_Output) { $LastYear = int($INPUT{'Year'}); $LastMonth = int($INPUT{'Month'})-1; if ($LastMonth == 0) { $LastMonth = 12; $LastYear -= 1; } print "\n\n"; print "\n"; print "\n"; print "
\n"; print "< @months[$LastMonth - 1]\n"; } print "$heading\n"; if($SSI_Output) { $NextYear = int($INPUT{'Year'}); $NextMonth = int($INPUT{'Month'})+1; if ($NextMonth == 13) { $NextMonth = 1; $NextYear += 1; } print "\n"; print "@months[$NextMonth - 1] >\n"; print "
\n"; } # print "\n"; print "
"; $xday = @shortdays[$key-1]; print "$xday
"; print "

 

"; print "$key"; # print ""; } # else { print "$bgcolor_normal\">"; } # if (($INPUT{'Year'} == $year) # && ($INPUT{'Month'} == $month) # && ($key == $mday)) { # print ""; # print "

$key"; # } # else { # print ""; # print "

$key"; # } if ($DisplayCounter) { print "
($perp_sofar/$perp_togo)"; } $perp_sofar++; $perp_togo -= 1; # print ""; if ($Table{$key}) { #print ""; print "$Table{$key}"; #print ""; } else { print "

 "; } print "

"; print "

 

\n"; unless ($SSI_Output) { print "
\n"; } } else { if ($SmallTableText) { print "

"; print "
\n"; print "

\n"; foreach $key (1..$perp_eom) { if ($DisplayPhases) { if (int((int((($perp_days-5.36945)/29.53031)+.5)*29.53031)+5.36945) == $perp_days) { if ($SmallTable{$key}) { $SmallTable{$key} .= "
"; } $SmallTable{$key} .= "New Moon\n"; } if (int((int((($perp_days-12.75202)/29.53031)+.5)*29.53031)+12.75202) == $perp_days) { if ($SmallTable{$key}) { $SmallTable{$key} .= "
"; } $SmallTable{$key} .= "First Quarter Moon\n"; } if (int((int((($perp_days-20.13460)/29.53031)+.5)*29.53031)+20.13460) == $perp_days) { if ($SmallTable{$key}) { $SmallTable{$key} .= "
"; } $SmallTable{$key} .= "Full Moon\n"; } if (int((int((($perp_days-27.51718)/29.53031)+.5)*29.53031)+27.51718) == $perp_days) { if ($SmallTable{$key}) { $SmallTable{$key} .= "
"; } $SmallTable{$key} .= "Last Quarter Moon\n"; } } $perp_days++; next unless ($SmallTable{$key}); print ""; print ""; print ""; print ""; } print "
"; print ""; $xshortmonth = @shortmonths[$INPUT{'Month'}-1]; print "$key $xshortmonth "; print "$INPUT{'Year'} "; $weekday = ($key+$perp_dow)-(int(($key+$perp_dow)/7)*7); if ($weekday < 1) { $weekday = 7; } $xshortday = @shortdays[$weekday-1]; print "($xshortday):"; print "
"; print ""; print "$SmallTable{$key}
"; print "		\n"; } print "

\n"; print "\n"; print "\n"; foreach $key (1..7) { print ""; } print "\n\n"; if ($perp_dow > 0) { print ""; } foreach $key (1..$perp_eom) { print ""; $weekday = ($key+$perp_dow)-(int(($key+$perp_dow)/7)*7); if (($weekday == 0) && !($key == $perp_eom)) { print "\n\n"; } } if ($weekday > 0) { $leftover = 7-$weekday; print ""; } print "
"; print ""; print "$heading
"; print ""; $xshortday = @shortdays[$key-1]; print "$xshortday
"; print "

 

"; } else { print "$bgcolor_normal\">"; } if (($INPUT{'Year'} == $year) && ($INPUT{'Month'} == $month) && ($key == $mday)) { print ""; print "

$key"; } else { print ""; print "

$key"; } print "

"; print "

 

\n"; } unless ($SSI_Output) { print "

\n"; $LastYear = int($INPUT{'Year'}); $LastMonth = int($INPUT{'Month'})-1; if ($LastMonth == 0) { $LastMonth = 12; $LastYear -= 1; } print "\n"; $NextYear = int($INPUT{'Year'}); $NextMonth = int($INPUT{'Month'})+1; if ($NextMonth == 13) { $NextMonth = 1; $NextYear += 1; } print "\n"; print "
"; print ""; print ""; print ""; print ""; print "
"; print ""; print ""; print ""; print ""; print "
\n"; } unless ($SSI_Output) { &Footer; } exit; sub PerpetualCalendar { # This perpetual calendar routine provides accurate day/date # correspondences for dates from 1601 to 2899 A.D. It is based on # the Gregorian calendar, so be aware that early correspondences # may not always be historically accurate. The Gregorian calendar # was adopted by the Italian states, Portugal and Spain in 1582, # and by the Catholic German states in 1583. However, it was not # adopted by the Protestant German states until 1699, by England # and its colonies until 1752, by Sweden until 1753, by Japan # until 1873, by China until 1912, by the Soviet Union until 1918, # and by Greece until 1923. ($perp_mon,$perp_day,$perp_year) = @_; %day_counts = (1,0,2,31,3,59,4,90,5,120,6,151,7,181, 8,212,9,243,10,273,11,304,12,334); $perp_days = (($perp_year-1601)*365)+(int(($perp_year-1601)/4)); $perp_days += $day_counts{$perp_mon}; $perp_days += $perp_day; $perp_sofar = $day_counts{$perp_mon}; $perp_sofar += $perp_day; $perp_togo = 365-$perp_sofar; if (int(($perp_year-1600)/4) eq (($perp_year-1600)/4)) { $perp_togo++; if ($perp_mon > 2) { $perp_days++; $perp_sofar++; $perp_togo -= 1; } } foreach $key (1700,1800,1900,2100,2200,2300,2500,2600,2700) { if ((($perp_year == $key) && ($perp_mon > 2)) || ($perp_year > $key)) { $perp_days -= 1; } } $perp_dow = $perp_days - (int($perp_days/7)*7); if ($perp_dow == 7) { $perp_dow = 0; } if ($MonSunWeek) { $perp_dow -= 1; if ($perp_dow == -1) { $perp_dow = 6; } } $perp_eom = 31; if (($perp_mon == 4) || ($perp_mon == 6) || ($perp_mon == 9) || ($perp_mon == 11)) { $perp_eom = 30; } if (($perp_mon == 2)) { $perp_eom = 28; } if ((int(($perp_year-1600)/4) eq (($perp_year-1600)/4)) && ($perp_mon == 2)) { $perp_eom = 29; } foreach $key (1700,1800,1900,2100,2200,2300,2500,2600,2700) { if ($perp_year == $key) { if ($perp_mon == 1) { $perp_togo -= 1; } elsif ($perp_mon == 2) { $perp_togo -= 1; $perp_eom = 28; } else { $perp_sofar -= 1; } } } }