#
#
# calendar.pl -- A CGI script to display a calendar of events
#
# ----------------------------------------------------------------------
# Version 2.3, written by Collin Forbes in February, 1998.
# Version 2.2, written by Collin Forbes in August, 1996.
#
# Use this script as the GET action to a form with the following fields.
# You can also hard-code the parameters into a URL instead of using a form.
#
# <input name=file> (sort-of-required) The "nickname" of the configuration
#       file to use.  This file contains configuration information as well
#       as dates or events in the following format:
#               "year<tab>month<tab>day<tab>event<newline>"
#       You can use the keyword "any" in any of the fields to make an
#       event repeat.  You can also use ranges, such as 1996-1997 or 12-14 to
#       make an event run during a range of dates.
#
# <input name=month> (optional) The month to display.  Use "current", "next",
#       "previous", the name of the month (eg "august") or the number of the
#	month (eg 8).  The default behavior is to display the current month.
#
# <input name=year> (optional) The year of the month to display.  Use
#       "current", "next", "previous", or the four-digit year between
#       1970 and 2049.  The default is the current year.
#
# configuration section ------------------------------------------------

%CONFIGURATION_FILE = (
    '' => 'd:/http/aspenhealing/config.txt',
    'calendar' => 'd:/http/aspenhealing/config.txt',
	'kathy' => 'c:/webshare/wwwroot/aspenhealing/kconfig.txt'
);

# %CONFIGURATION_FILE = (
#	'' => 'c:/webshare/wwwroot/aspenhealing/config.txt',
#	'calendar' => 'c:/webshare/wwwroot/aspenhealing/config.txt'
# ) ;

#   
# You can use the keys of the %configuration_file array to point to
# different "nicknames" to use different configuration files.
# The '' (no text, just two quotes) key will be the default.
#

$VERSION = "v2.4";
$RELEASE_MONTH = 'August 1999';
#
# Version 2.3 was released 9 February 1998
# Version 2.2 was released 19 August 1996
#
# global varray section ------------------------------------------------

@MONTH_NAMES = ( 
    'null', 'january', 'february', 'march', 'april', 'may', 'june',
    'july', 'august', 'september', 'october', 'november', 'december'
);
@DAYS_IN_MONTH = ( 0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31,);
#
# @MONTH_NAMES stores the names of the months.
# @DAYS_IN_MONTH keeps track of the days in each month.
#
# Thirty-one days hath Jan, March, May, July, Aug, Oct, and Dec.
# Leap years are handled in the &perpetual_calendar subroutine.
#
# the 'null' and 0 values at the beginning of each list are placeholders
# to let the month names run from 1-12 rather than 0-11.
#
# executable section ---------------------------------------------------

%F = &receive_form_information;
# $fyear = shift ;
# $fmonth = shift ;
( $YEAR, $MONTH, $DAY ) = &sensible_dates( $F{'year'}, $F{'month'} );
# ( $YEAR, $MONTH, $DAY ) = &sensible_dates ( $fyear, $fmonth ) ;

# DAY is never used for anything in the program

# print "at top, [$YEAR] [$MONTH] [$DAY]\n" ;
# print "original [$XYEAR] [$XMONTH] [$XDAY]\n" ;

@parray ;

@DATA = &read_file( $CONFIGURATION_FILE{ $F{'file'} } );
%CONFIG = &parse_configuration_information( @DATA );
%EVENTS = &parse_date_information( $YEAR, $MONTH, @DATA );

if ($ENV{'HTTP_USER_AGENT'} =~ /lynx/i) { 
    $HTML .= &calendar_list($YEAR,$MONTH,%EVENTS); 
}
else { $HTML .= &calendar_table($YEAR,$MONTH,%EVENTS);
#		$HTML .= &calendar_details($YEAR,$MONTH,@parray); 
	}

&print_html( &insert_into_template( $CONFIG{'template'}, $HTML ) );


exit;

# subroutine section ---------------------------------------------------

sub calendar_details {
    local( $cyear,$cmonth,$parray ) = @_;

    #
    # Let's figure out the table decorations.
    # Stylesheets are the preferred method, but there are some luddite
    # fools who will prefer to use bgcolor in the table cells.  Let them
    # make their pages unviewable in certain browsing conditions.
    #
    if ( $CONFIG{'stylesheet'} ) {
	# figure out stylesheet classes --------------------------------
	if ($CONFIG{'head_style'}) { 
	    $head_style = qq|CLASS="$CONFIG{'head_style'}"|; 
	}
	else { $head_style = ''; }
	if ($CONFIG{'event_style'}) {
	    $event_style = qq|CLASS="$CONFIG{'event_style'}"|;
	}
	else { $event_style = ''; }
	if ($CONFIG{'cell_style'}) {
	    $cell_style = qq|CLASS="$CONFIG{'cell_style'}"|; 
	}
	else { $cell_style = ''; }
    }
    else {
	# blech, table background colors -------------------------------
	if ( $CONFIG{'head_bgcolor'} ) { 
	    $head_style = qq|BGCOLOR="$CONFIG{'head_bgcolor'}"|;
	}
	else { $head_style = ''; }
	if ( $CONFIG{'event_bgcolor'} ) {
	    $event_style = qq|BGCOLOR="$CONFIG{'event_bgcolor'}"|;
	}
	else { $event_style = ''; }
	if ( $CONFIG{'cell_bgcolor'} ) {
	    $cell_style = qq|BGCOLOR="$CONFIG{'cell_bgcolor'}"|;
	}
	else { $cell_style = ''; }
    }

    # find the cellpadding and cellspacing, if desired -----------------
    if ( $CONFIG{'cellpadding'} ne '' ) { 
	$cellpadding = qq|CELLPADDING="$CONFIG{'cellpadding'}"|;
    }
    if ( $CONFIG{'cellspacing'} ne '' ) {
	$cellspacing = qq|CELLSPACING="$CONFIG{'cellspacing'}"|;
    }

    # find the table and cell sizes if desired -------------------------
    if ( $CONFIG{'table_width'} =~ /^\d+$/ ) { 
	$cell_width = qq|WIDTH="| . int($CONFIG{'table_width'}/7) . qq|"|;
	$table_width = qq|WIDTH="| . int($CONFIG{'table_width'}/7)*7 . qq|"|;
    }
    if ( $CONFIG{'cell_height'} =~ /^\d+$/ ) {
	$cell_height .= qq|HEIGHT="$CONFIG{'cell_height'}"|;
    }

    # put together the heading of the table ----------------------------
    $html .= qq|<P><H2 ALIGN=CENTER>Calendar Details</H2><TABLE $table_width $cellpadding $cellspacing BORDER=0>\n|;
    $html .= qq|<TR VALIGN=top>\n<TH $head_style>Date</TH>\n|;
    $html .= qq|<TH $head_style>Time</TH><TH $head_style>Location</TH><TH $head_style>Details</TH></TR>\n|;

    # Show the "meat" of table -----------------------------------------

	for (sort @parray) {
		($year, $month, $day, $time, $loc, $event) = split(/\|/, $_) ;
		if ($year == $cyear && $month == $cmonth) {
			$html .= qq|<TR><TD ALIGN=CENTER COLSPAN=4><HR></TD></TR>\n| ;
			$html .= qq|<TR><TD $style VALIGN=top WIDTH=100>$month/$day/$year</TD>\n| ;
			$html .= qq|<TD $style VALIGN=top WIDTH=70>$time</TD>\n|;
			$html .= qq|<TD $style VALIGN=top WIDTH=130>$loc</TD>\n|;
			$html .= qq|<TD $style VALIGN=top>$event</TD></TR>\n|;
			}
		}
	$html .= qq|</TABLE>\n|;

    $html;			# return value for subroutine
}

sub calendar_table {
#
# Prints the calendar for the given month and year as a HTML table.
# The heading and table cells might be specially styled if the %CONFIG
# keys allow.
#
# global variables	uses '@MONTH_NAMES', '@DAYS_IN_MONTH' and '%CONFIG'
#
    local( $year, $month, %events ) = @_;
    local($style,$head_style,$event_style,$cell_style );
    local($table_width,$cell_width,$cell_height,$cellpadding,$cellspacing);
    local($html,$days_in_this_month,$first_day,$count,$week_count,$days_left);
    #
    # Let's figure out the table decorations.
    # Stylesheets are the preferred method, but there are some luddite
    # fools who will prefer to use bgcolor in the table cells.  Let them
    # make their pages unviewable in certain browsing conditions.
    #
    if ( $CONFIG{'stylesheet'} ) {
	# figure out stylesheet classes --------------------------------
	if ($CONFIG{'head_style'}) { 
	    $head_style = qq|CLASS="$CONFIG{'head_style'}"|; 
	}
	else { $head_style = ''; }
	if ($CONFIG{'event_style'}) {
	    $event_style = qq|CLASS="$CONFIG{'event_style'}"|;
	}
	else { $event_style = ''; }
	if ($CONFIG{'cell_style'}) {
	    $cell_style = qq|CLASS="$CONFIG{'cell_style'}"|; 
	}
	else { $cell_style = ''; }
    }
    else {
	# blech, table background colors -------------------------------
	if ( $CONFIG{'head_bgcolor'} ) { 
	    $head_style = qq|BGCOLOR="$CONFIG{'head_bgcolor'}"|;
	}
	else { $head_style = ''; }
	if ( $CONFIG{'event_bgcolor'} ) {
	    $event_style = qq|BGCOLOR="$CONFIG{'event_bgcolor'}"|;
	}
	else { $event_style = ''; }
	if ( $CONFIG{'cell_bgcolor'} ) {
	    $cell_style = qq|BGCOLOR="$CONFIG{'cell_bgcolor'}"|;
	}
	else { $cell_style = ''; }
    }

    # find the cellpadding and cellspacing, if desired -----------------
    if ( $CONFIG{'cellpadding'} ne '' ) { 
	$cellpadding = qq|CELLPADDING="$CONFIG{'cellpadding'}"|;
    }
    if ( $CONFIG{'cellspacing'} ne '' ) {
	$cellspacing = qq|CELLSPACING="$CONFIG{'cellspacing'}"|;
    }

    # find the table and cell sizes if desired -------------------------
    if ( $CONFIG{'table_width'} =~ /^\d+$/ ) { 
	$cell_width = qq|WIDTH="| . int($CONFIG{'table_width'}/7) . qq|"|;
	$table_width = qq|WIDTH="| . int($CONFIG{'table_width'}/7)*7 . qq|"|;
    }
    if ( $CONFIG{'cell_height'} =~ /^\d+$/ ) {
	$cell_height .= qq|HEIGHT="$CONFIG{'cell_height'}"|;
    }

    # find the first day of the month ----------------------------------
    $first_day = &perpetual_calendar($month, $year);

    # put together the heading of the table ----------------------------
    $html .= qq|<TABLE $table_width $cellpadding $cellspacing BORDER=1>\n|;
    $html .= qq|<TR VALIGN=top>\n<TH $head_style $table_width COLSPAN="7">\n|;
    $html .= qq|<B>\u$MONTH_NAMES[$month] $year</B></TH></TR>\n|;

    # the cell headings with the days of the week ----------------------
    $html .= qq|<TR VALIGN=top>\n|;
    $html .= qq|<TH $head_style $cell_width>Sunday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Monday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Tuesday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Wednesday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Thursday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Friday</TH>\n|;
    $html .= qq|<TH $head_style $cell_width>Saturday</TH></TR>\n|;

    #
    # the space before the first day of the table
    #
    if ( $first_day > 0 ) {
	$style = $cell_style;
	$html .= qq|<TD $style $cell_height COLSPAN="$first_day">&nbsp;</TD>\n|;
    }

    # variables for the table ------------------------------------------
    $week_count = $first_day;
    if (($month == 2) and (&leap_year($year) eq 'true')) {
	$days_in_this_month = 29;
    }
    else { $days_in_this_month = $DAYS_IN_MONTH[$month]; }

    # Show the "meat" of table -----------------------------------------
    for ($count = 1; $count <= $days_in_this_month; $count++) {
		if ($events{ join('.',$year,$month,$count)} ) 
			{ $style = $event_style; }
		else { $style = $cell_style; }

        $html .= qq|<TD $style $cell_width $cell_height VALIGN=top>\n|;
        $html .= qq|<B>$count</B><BR>\n|;
		$html .= $events{ join('.', $year, $month, $count) };
		$html .= qq|</TD>\n|;

		$week_count++;
		if ( ($week_count == 7) and ($count < $days_in_this_month)) { 
	    	$html .= qq|</TR>\n<TR VALIGN=top>\n|; $week_count = 0;
			}
	    }

    if ( $week_count < 7 ) {
        $days_left = 7 - $week_count;
        $html .= qq|<TD $cell_style COLSPAN="$days_left">&nbsp;</TD></TR>\n|;
        # "&nbsp;" is to keep the browser from collapsing an empty cell
    }

    #
    # put monthly notices (those with 'any') into a row at the end
    #
    if ($events{ join('.',$year,$month,'any') } ) {
        $html .= qq|<TR VALIGN=top $event_style $cell_height>\n|;
        $html .= qq|<TD $table_width $event_style COLSPAN="7">|;
        $html .= $events{ join('.', $year, $month, 'any') } . qq|</TD></TR>\n|;
    }

    $html .= qq|</TABLE>\n|;
    $html .= &credits;

    $html;			# return value for subroutine
}


sub calendar_list {
#
# Prints the calendar in order list (OL) form.  For compatibility with
# lynx browsers.  It's very simple and not very burdensome. 
# The table is still sexier, using style sheets and such.
#
# global variables	uses '@MONTH_NAMES' and '@DAYS_IN_MONTH'
#
    local( $year, $month, %events ) = @_;
    local( $html, $count, $days_in_this_month );

    $html  = &credits;
    $html .= qq|<H2 ALIGN=left>\u$MONTH_NAMES[$month] $year</H2>\n|;
    #
    # Here, monthly events are just put at the top of the calendar.  Simpler.
    #
    $html .= $events{ join('.', $year, $mon, 'any' ) } . qq|<BR>\n|;
    $html .= qq|<OL>\n|;

    if (($month == 2) and (&leap_year($year) eq 'true')) {
	$days_in_this_month = 29;
    }
    else { $days_in_this_month = $DAYS_IN_MONTH[$month]; }

    for ($count = 1; $count <= $days_in_this_month; $count++) {
	$html .= qq|<LI> | . $events{ join('.',$year,$month,$count) } . qq|\n|;
    }
    $html .= qq|</OL>\n|; 
    $html .= &credits;

    $html;			# return value for subroutine
}


sub perpetual_calendar {
#
# This perpetual calendar was detailed on a wallet-sized card published
# by Arthur A. Merrill and Popular Science in 1952.
#
# This subroutine takes the month and year as arguments and returns what
# "type" of month it is [0-6].  Not coincidently, this is also the day of
# the week the month starts on, where Sunday is a "0" and Saturday is a "6".
#
    local( $month, $year ) = @_;
    local( %year_code, $calendar );
    #
    # Year codes provided for 1970-2049.  The codes repeat every 150 years.
    # The unix system clock will roll over sometime in 2038.
    #
    %year_code = (
	'1970'=>'D', '1971'=>'E', '1972'=>'M', '1973'=>'A', '1974'=>'B', 
	'1975'=>'C', '1976'=>'K', '1977'=>'F', '1978'=>'G', '1979'=>'A',

	'1980'=>'I', '1981'=>'D', '1982'=>'E', '1983'=>'F', '1984'=>'N',
	'1985'=>'B', '1986'=>'C', '1987'=>'D', '1988'=>'L', '1989'=>'G',
 
	'1990'=>'A', '1991'=>'B', '1992'=>'J', '1993'=>'E', '1994'=>'F',
	'1995'=>'G', '1996'=>'H', '1997'=>'C', '1998'=>'D', '1999'=>'E',

	'2000'=>'M', '2001'=>'A', '2002'=>'B', '2003'=>'C', '2004'=>'K',
	'2005'=>'F', '2006'=>'G', '2007'=>'A', '2008'=>'I', '2009'=>'D',

	'2010'=>'E', '2011'=>'F', '2012'=>'N', '2013'=>'B', '2014'=>'C',
	'2015'=>'D', '2016'=>'L', '2017'=>'G', '2018'=>'A', '2019'=>'B',

	'2020'=>'J', '2021'=>'E', '2022'=>'F', '2023'=>'G', '2024'=>'H',
	'2025'=>'C', '2026'=>'D', '2027'=>'E', '2028'=>'M', '2029'=>'A',

	'2030'=>'B', '2031'=>'C', '2032'=>'K', '2033'=>'F', '2034'=>'G',
	'2035'=>'A', '2036'=>'I', '2037'=>'D', '2038'=>'E', '2039'=>'F',

	'2040'=>'N', '2041'=>'B', '2042'=>'C', '2043'=>'D', '2044'=>'L',
	'2045'=>'G', '2046'=>'A', '2047'=>'B', '2048'=>'J', '2049'=>'E',
    );

    if ( $month == 1 ) {
	if ( $year_code{$year} =~ /[EL]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[GN]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[DK]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[AH]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[CJ]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[BI]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[FM]/ ) { $calendar = 6 }
    }
    elsif ( $month == 2 ) {
	if ( $year_code{$year} =~ /[BI]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[DK]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[AH]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[EL]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[GN]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[FM]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[CJ]/ ) { $calendar = 6 }
    }
    elsif ( $month == 3 ) {
	if ( $year_code{$year} =~ /[BH]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 6 }
    }
    elsif ( $month == 4 ) {
	if ( $year_code{$year} =~ /[FL]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 6 }
    }
    elsif ( $month == 5 ) {
	if ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 6 }
    }
    elsif ( $month == 6 ) {
	if ( $year_code{$year} =~ /[AN]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 6 }
    }
    elsif ( $month == 7 ) {
	if ( $year_code{$year} =~ /[FL]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 6 }
    }
    elsif ( $month == 8 ) {
	if ( $year_code{$year} =~ /[CI]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 6 }
    }
    elsif ( $month == 9 ) {
	if ( $year_code{$year} =~ /[GM]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 6 }
    }
    elsif ( $month == 10 ) {
	if ( $year_code{$year} =~ /[EK]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 6 }
    }
    elsif ( $month == 11 ) {
	if ( $year_code{$year} =~ /[BH]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[GM]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 6 }
    }
    elsif ( $month == 12 ) {
	if ( $year_code{$year} =~ /[GM]/ ) { $calendar = 5 }
	elsif ( $year_code{$year} =~ /[BH]/ ) { $calendar = 0 }
	elsif ( $year_code{$year} =~ /[FL]/ ) { $calendar = 4 }
	elsif ( $year_code{$year} =~ /[CI]/ ) { $calendar = 1 }
	elsif ( $year_code{$year} =~ /[EK]/ ) { $calendar = 3 }
	elsif ( $year_code{$year} =~ /[DJ]/ ) { $calendar = 2 }
	elsif ( $year_code{$year} =~ /[AN]/ ) { $calendar = 6 }
    }
    else { $calendar = 0; }	# an error condition

    $calendar;			# return value for subroutine
}

sub leap_year {
#
# So here's the leap year kludge.  Instead of figuring out leap years
# mathematically (and trusting my math), it's a lookup table for 1970-2048.
#
    local( $year ) = @_;
    local( %leaps ) = (
	1972 => 1972, 1976 => 1976, 1980 => 1980, 1984 => 1984,
	1988 => 1988, 1992 => 1992, 1996 => 1996, 2000 => 2000,
	2004 => 2004, 2008 => 2008, 2012 => 2012, 2016 => 2016,
	2020 => 2020, 2024 => 2024, 2028 => 2028, 2032 => 2032,
	2036 => 2036, 2040 => 2040, 2044 => 2044, 2048 => 2048,
    );

    if ( $leaps{ $year } ) { $leap_year = 'true'; }
    else { $leap_year = 'false'; }

    $leap_year;			# return value for subroutine
}

sub credits {
#
# Returns credits as a comment.  Please don't remove or change the comment.
#
# global variables	uses '$VERSION' and '$RELEASE_MONTH'
#
    local( $comment );
 
$comment = <<COMMENT;
<!-- calendar.pl ($VERSION) was written by Collin Forbes in $RELEASE_MONTH -->
COMMENT

    $comment;			# return value for subroutine 
}

# ----------------------------------------------------------------------

sub sensible_dates {
#
# returns sensible values for the year, month, and day
# the 'sensible values' are based on the current time, plus modifiers 
# to the year and month.
#
    local( $mod_year, $mod_month ) = @_;
    local( $month, $year );

    local($sec,$min,$hr,$mday,$mon,$annum,$wday,$yday,$isdst);
    ($sec,$min,$hr,$mday,$mon,$annum,$wday,$yday,$isdst) = localtime(time);

    $month = 1 + $mon;		# we want months to go from 1-12
    $year = 1900 + $annum;	# and we want to use four-digit years

    # adjust the month according to the desired month or modifier
    if ( $mod_month =~ /jan/i ) { $month = 1; }
    elsif ( $mod_month =~ /feb/i ) { $month = 2; }
    elsif ( $mod_month =~ /mar/i ) { $month = 3; }
    elsif ( $mod_month =~ /apr/i ) { $month = 4; }
    elsif ( $mod_month =~ /may/i ) { $month = 5; }
    elsif ( $mod_month =~ /jun/i ) { $month = 6; }
    elsif ( $mod_month =~ /jul/i ) { $month = 7; }
    elsif ( $mod_month =~ /aug/i ) { $month = 8; }
    elsif ( $mod_month =~ /sep/i ) { $month = 9; }
    elsif ( $mod_month =~ /oct/i ) { $month = 10; }
    elsif ( $mod_month =~ /nov/i ) { $month = 11; }
    elsif ( $mod_month =~ /dec/i ) { $month = 12; }
    if ( $mod_month =~ /next/i ) {
	if ( $month == 12 ) { $month = 1; $year += 1; }
	else { $month += 1; }
    }
    elsif ( $mod_month =~ /prev/i ) { 
	if ( $month == 1 ) { $month = 12; $year -= 1; }
	else { $month -= 1; }
    }
    elsif ( $mod_month =~ /^\d+$/ ) { 
	if (($mod_month > 0) and ($mod_month < 13)) { $month = $mod_month; }
    }

    # adjust the year according to the modifiers
    if ( $mod_year =~ /next/i ) { $year += 1; }
    elsif ( $mod_year =~ /prev/i ) { $year -= 1; }
    elsif ( $mod_year =~ /^\d{4}$/ ) { $year = $mod_year; }

    ( $year, $month, $mday );	# return value for subroutine
}


sub read_file {
#
# reads from the specified filename and returns the contents as a list
# lines beginning with # and ; are considered to be comments and are ignored
#
    local( $filename ) = @_;
    local( @data );

    open(FILE, $filename ) || &error("file: $filename");
    while(<FILE>) { 
	next if $_ =~ /^#/;
	next if $_ =~ /^;/;
	chomp;					# strip newlines
	push(@data, $_);
    }
    close(FILE);

    @data;			# return value for subroutine
}


sub parse_configuration_information {
#
# Takes the input from the configuration file (in list form) and looks for
# lines that aren't dates/events.  Then it puts this information into an
# associative array (global) for later use.
#
    local( @lines ) = @_;
    local( $line, $name, $value );

    foreach $line ( @lines ) {
	if ( $line =~ m/^\w+\=/ ) { # look for lines with configuration info
	    ($name, $value) = split(/=/, $line);
	    $config{ lc($name) } = $value;
	}
    }

    %config;			# return value for subroutine
}


sub parse_date_information {
# 
# Takes the input from the configuration file (in list form) and looks for
# lines that aren't configuration info.  Then it puts this information into
# an associative array (global) for later use.
#
# Dates are keys to the array in the format Year<dot>Mon<dot>Day, where
# "Year" is 1970-2049, "Mon" is 1-12, and "Day" is 1-31.
#
    local( $year, $month, @lines ) = @_;
    local( $line, %events );

    foreach $line ( @lines ) {
        if ( $line =~ m/^\w+\t/ ) {
# kdl added e_time, e_location, e_url
		    local($e_year, $e_mon, $e_day, $event, $e_time, $e_url, $e_location) = split(/\t/, $line);
		    next unless $event;				# skip if empty

# 			go ahead and parse out the line:

			if ($e_time ne "") {
				$tstrg = sprintf("<B>%s: </b> ", $e_time ) ;
				}
			else {
				$tstrg = '' ;
				}

			if ($e_url ne "") {	
				$estrg = sprintf("<A HREF=%s>%s</a> ", $e_url, $event ) ;
				}
			else {
				$estrg = $event . " " ;
				}
		
			if ($e_location ne "") {
				$lstrg = "- " . $e_location ;
				}
			else {
				$lstrg = '';
				}
						
			$eventstring = $tstrg . $estrg . $lstrg ;		

#			$eventstring = $eventstring . " xtra url " . $e_url . " loc " . $e_location ;
# end of kdl added
		
		
	    	# turn wildcards ('any') into actual values
		    if ( $e_year =~ m/any/i ) { $e_year = $year; }
		    if ( $e_mon =~ m/any/i ) { $e_mon = $month; }
	    	if ( $e_day =~ m/any/i ) { $e_day = 'any'; }

		    if (($e_year =~ /-/) or ($e_mon =~ /-/) or ($e_day =~ /-/)) {
				# interpolate the ranges for whichever years, days and months
				local( $year_part, $month_part, $day_part, $date );
				foreach $year_part ( &split_range( $e_year ) ) {
		    		foreach $month_part ( &split_range( $e_mon ) ) {
						foreach $day_part ( &split_range( $e_day ) ) {
				    		$date = join('.',$year_part,$month_part,$day_part);
							$events{ $date } .= qq|$eventstring<BR>\n|;
							}
					    }
					}
		    	}
		    else {
				$events{ join('.',$e_year,$e_mon,$e_day) } .= qq|$eventstring<BR>\n| ;

			    } # end of if date range
			}  # end of if for word match
    	}  # end of foreach
    %events;			# return value for subroutine 
}  # end of subroutine

sub split_range {
#
# turns a string 'n-m' into a list containing the values n through m.
# if n and m are switched, it still tries to do the right thing and returns
# a list containing the values n through m. 
#
    local( $range ) = @_;
    local( @list, $begin, $end );
    ( $begin, $end ) = split(/-/, $range );

    if ( $end ne '' ) {
	if ( $begin < $end ) { @list = ( $begin .. $end ); } 
	elsif ( $begin > $end ) { @list = ( $end .. $begin ); }
	else { @list = $begin; }
    }
    else { @list = $begin; }

    @list;			# return value for subroutine
}

# ----------------------------------------------------------------------

sub insert_into_template {
#
# inserts the list items in the context of the specified template file.
# returns the merged file.
#
    local( $filename, @parameters ) = @_;
    local( $merger, $count, $item, %param );
    #
    # first make an associative array (%param) out of the parameter list.
    # this lets us deal with the tokens in the template in any order.
    #
    $count = 1;
    foreach $item ( @parameters ) { $param{$count} = $item; $count++; }

    open(TEMPLATE, $filename ) || &error("file: $filename");
    while( <TEMPLATE> ) {
	#
	# look for lines containing '<!-- #TOKEN n -->' where n is some number
	# (<!-- #TOKEN --> is treated like <!-- #TOKEN 1 -->)
        #
	if ( $_ =~ m/(.*?)<!--\s*#?TOKEN\s*(\d+)\s*-->(.*)/ ) {
	    $merger .= qq|$1$param{$2}$3\n|;
	}
	elsif ( $_ =~ m/(.*)<!--\s*#?TOKEN\s*-->(.*)/ ) {
	    $merger .= qq|$1$param{'1'}$2\n|;
	}
	else { $merger .= qq|$_|; }
    }
    close(TEMPLATE);

    $merger;			# return value for subroutine
}


sub print_html {
#
# A simple subroutine to take care of HTTP headers and such for printing HTML.
# Here's where you'd add a HTTP response status message ("HTTP/1.0 200 OK")
# if your WinNT server requires it.
#
    local( $html ) = @_;

    print qq|Content-type: text/html\n\n|;
    print $html;

    undef;			# return value for subroutine
}


sub receive_form_information {
#
# Gets the form information and converts it into readable form
# (returns an associative array).
#
# global variable:      Creates '%FORM'
#
    local($buffer, @pairs, $pair, $name, $value);
    #
    # Get the input depending on how it is sent
    #
    if ( $ENV{'REQUEST_METHOD'} eq 'POST' ) {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'} );
    }   # Otherwise we'll hope it's a GET
    else { $buffer = $ENV{'QUERY_STRING'}; }
    #
    # Split the name-value pairs depending on how they are encoded.
    # lynx 2.6 says it can now encode POST data as "sgml-form-urlencoded"
    #
    if ( $ENV{'CONTENT_TYPE'} eq 'application/sgml-form-urlencoded' ) {
        @pairs = split(/;/, $buffer);
    }   # otherwise we'll hope it's 'application/x-www-form-urlencoded'
    else { @pairs = split(/&/, $buffer); }

    foreach $pair (@pairs) {
        ($name, $value) = split(/=/, $pair);
        #
        # This was lifted from the "doform.cgi" from the WN server
        # distribution (http://hopf.math.nwu.edu/) by John Franks
        #
        $value =~ tr/+/ /;
        $value =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;

        $name =~ tr/+/ /;
        $name =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;

        $FORM{ $name } .= "$value\t";           # multiple items are tabbed
    }
    foreach ( keys %FORM ) { chop $FORM{$_}; }  # lose the trailing tab

    %FORM;      # return value for subroutine
}


sub error {
#
# Fatal error messages can be simple, cryptic and ugly.
#
    local ( $error ) = @_;

    print "Content-type: text/plain\n\n";
    print "ERROR: $error\n";

    exit(1);
}