#! /usr/local/bin/perl
# ----------------------------
# a simple html-based calendar
# ----------------------------
# path and name of this program on your web server
$ourcgi="/cgi-bin/calendar.pl";
# the text used for the names of the months
@monthnames=("January","February","March","April",
"May","June","July","August","September",
"October","November","December");
# array for the days of the week.
@daynames=("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
MAIN: {
# spit out http and html headers
print "content-type: text/html\n\n";
print "A Simple Calendar\n";
# show the calendar for requested julian date or today
onemonthcalendar($ENV{'QUERY_STRING'} || juliantoday());
print "\n";
exit 0;
}
# displays a one-month calendar
# -----------------------------
# input: julian_date
# output: prints calendar
#
sub onemonthcalendar {
my($j)=shift;
my($year,$month,$day,$jstart,$jend,$jtoday,$cols,$i);
# check for a valid starting date
$j = juliantoday() unless $j > 0;
# convert the julian date
($year,$month,$day)=fromjulian($j);
# find the julian start and end values for this month
$jstart=tojulian($year,$month,1);
$jend=tojulian($year,$month+1,0);
$jtoday=juliantoday();
# links to other months
print "Last Month | ";
print "This Month | ";
print "Next Month\n";
# heading for this month's calendar
print "$monthnames[$month-1] $year
\n";
# main calendar table
print "\n";
# top row for days of the week
print "";
for $i (0..6) {
print "| $daynames[$i] | ";
}
print "
\n";
# figure out which day to start with...
$j = $jstart - ($jstart+1)%7;
$day = (fromjulian($j))[2];
# display the body of the calendar
# $j - current julian date
# $day - current day of the month (1..31)
# $jstart - julian date for first day of this month
# $jend - julian date for last day of this month
while($j <= $jend) {
# next row
print "";
# for each day of the week...
for $cols (0..6) {
# figure out how to display it
if ($j < $jstart || $j > $jend) {
# day not in this month
print "| $day | ";
} elsif ($j == $jtoday) {
# today
print "$day | ";
} else {
# normal day
print "$day | ";
}
# next day...
$day++; $j++;
# check if it's first or last day of month
if($j == $jstart || $j == $jend+1) {
$day=1;
}
}
print "
\n";
}
print "
\n";
return;
}
# calculate the julian day
# ------------------------
# input: year, month, day
# output: julian_date
#
sub tojulian {
use integer;
my($year, $month, $day) = @_;
return $day - 32075
+ 1461 * ( $year + 4800 - ( 14 - $month ) / 12 ) / 4
+ 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12
- 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4;
}
# converts julian day to year, month and day
# ------------------------------------------
# input: julian_date
# output: year, month, day
#
sub fromjulian {
use integer;
my($jd) = @_;
my($jdate_tmp,$m,$d,$y);
$jdate_tmp = $jd - 1721119;
$y = (4 * $jdate_tmp - 1) / 146097;
$jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
$d = $jdate_tmp/4;
$jdate_tmp = (4 * $d + 3)/1461;
$d = 4 * $d + 3 - 1461 * $jdate_tmp;
$d = ($d + 4)/4;
$m = (5 * $d - 3) / 153;
$d = 5 * $d - 3 - 153 * $m;
$d = ($d + 5) / 5;
$y = 100 * $y + $jdate_tmp;
if ($m < 10) {
$m += 3;
} else {
$m -= 9;
++$y;
}
return ($y, $m, $d);
}
# returns today's julian date
# ---------------------------
# output: julian_date
#
sub juliantoday {
# current date
my($sec,$min,$hour,$day,$month,$year,$wday,$yday,$isdst) =
localtime(time);
$year+=($year < 70) ? 2000 : 1900;
return tojulian($year, $month + 1, $day);
}