11
Datebooks, Calendars, and Scheduling on the Web

HyperCal--A Modular Perl5 Calendar and Datebook As the Internet and corporate intranets become more and more widespread, and we find Netscape and other browsers running on more and more PCs, Web-based applications that keep us organized are becoming more prevalent. Why use a Web-based calendar or datebook? Web-based calendars and datebooks are the ultimate way to take advantage of the Web, especially in inter-office, or intranet environments.

Let's consider an example. Your boss has given your team a new project. It is your responsibility to coordinate the schedules of each of the 10 people on your team. Do you see where this is going? Each member could access a Web-based scheduling mechanism, update his or her schedule, see what everyone else is doing, easily communicate with each other, make comments, and so on. In addition to being a convenient and efficient way to coordinate people and manage resources, once the data has been entered, you can easily use Perl to generate reports, calculate efficiency of work cycles, and so on. The possibilities are endless. Furthermore, using Perl and the Web, the system is accessible anywhere Netscape is running and is totally extensible and scaleable. You could manage and track the schedules of everyone in your entire organization.

HyperCalA Modular Perl5 Calendar and Datebook

In the pages that follow, we will explore HyperCal, a Calendar/Datebook program written for Perl5 by Richard Bowen. HyperCal can be obtained from Richard Bowen's Web site at

http://www.rcbowen.com/perl/HyperCal.html

I recommend installing HyperCal on your Web server before proceeding any further. To install HyperCal, download the HyperCal_2.x.tar file to your server, place it in a directory under CGI-bin, and extract the tar archive.

I encourage you to use your understanding of this example as a stepping stone to implementing a complete Web-based scheduling system customized for your needs. HyperCal consists of eight pieces of code that perform specific tasks related to the calendar. This chapter is intended to show how Perl5 can be used to maintain a Web-based datebook and calendar. I encourage you to look over the source code and its output as you read through the chapter. I also encourage you to set HyperCal up on your server and play with the source code and see how it affects the output.

The power of Perl lies in the capability to easily and quickly reuse and modify existing code to suit your needs. With this in mind, let's discuss "style" for a minute. Every programmer has his or her own "style" or way he or she likes to organize the logical flow of code. It makes sense to take advantage of Perl5's object oriented, modular design whenever you write a Perl5 CGI. The power and prominence of CGI.pm and other modules discussed in this book are a testament to this. As you begin to conceptualize your Perl5 program, consider the following questions:

  1. Is it modular? Major functions should be broken out into separate autonomous modules that can be used in other programs.

  2. Is it configurable? Configuration settings or variables should be located in a separate file.

  3. Is it understandable? Break your code down into subroutines that do specific tasks. Major tasks that might be useful in other programs you write should be broken out into modules. Program logic should consist of making calls to subroutines. Use whitespace to make your code easier to read. Place comments where it is not obvious what your code is doing.

  4. Is it upgradeable? If you follow the first three directives, this one comes easy.

  5. Is it portable? Avoid hard-coded references to resources only available on specific hardware platforms. If this is not possible, specify them in a separate config file instead of in the main code. Examples include pathnames and flock routines.

If you follow these five directives, you will save yourself considerable amounts of time and grief, both as you write your code and as you try to maintain and upgrade it in the future.

Listing 11.1 contains the main hypercal.cgi Perl5 CGI script. This script is responsible for actually displaying the calendar itself.

Listing 11.1. hypercal.cgi

#!/usr/bin/perl

#  HyperCal   by   Richard Bowen

#  A HTML datebook.

#

#  This part draws the calendar and links it to the other scripts.

#  Can be called as http://URL/hypercal, or with arguments

#  as http://URL/hypercal?month&year

require `httools.pl';

require `variables';

$args=$ENV{`QUERY_STRING'};

($sub=$ENV{`PATH_INFO'})=~ s#^/##;

if ($sub=~/personal/) { &personal };

if ($sub eq "goto") { &goto }

else { &main };

sub main    {

  &header;

  ($this_month,$this_year)=split(/&/,$args);

  if ($args eq "") {    #  Defaults to current date if none specified.

    &date;   #  Calls the todays date subroutine from httools.pl

    $this_month=$month;

    $this_year=$year;}

($junksec,$junkmin,$junkhour,$today_day,$today_month,$today_year,$junkwday,

Â$junkyday,$junkisdst)=localtime(time);$today_year+=1900;$today_month+=1;

&month_txt("$this_month");

print "<html><head><title>$title - $month_txt, $this_year</title></head>\n";

print "<body";

$month_image=@month_images[$this_month-1];

($icon,$bg,$color,$text,$link,$vlink)=split(/~~/,$month_image);

print " background=\"$bg\"" unless ($bg eq "none");

print " bgcolor=\"$color\"" unless ($color eq "none");

print " text=\"$text\"" unless ($text eq "none");

print " link=\"$link\"" unless ($link eq "none");

print " vlink=\"$vlink\"" unless ($vlink eq "none");

print ">\n";

open (DATES, $datebook);

@datebook=<DATES>;

@months=("December", "January", "February", "March", "April", "May", "June",

 "July", "August", "September", "October", "November", "December");

@last_days=(31,31,28,31,30,31,30,31,31,30,31,30,31);

@days_of_week=("Sun","Mon","Tue","Wed","Thu","Fri","Sat");

@month_offset=(3,3,0,3,2,3,2,3,3,2,3,2,3);

print "<center>";

print "<table border=6 cellpadding=5 width=100%>\n";

print "<tr><td align=center colspan=7><center><h2>@months[$this_month],

 $this_year</h2>";

if ($multi_user eq "yes" && $personal_on eq "no") {

print "<form method=post action=\"$base_url$hypercal/personal\">";

print "<input type=submit value=\"Go To Personal Calendar\">";}

elsif ($personal_on eq "yes")    {

($link=$hypercal)=~s/\/personal//g;

print "<form method=post action=\"$base_url$link\">";

print "<input type=submit value=\"Go To Public Calendar\">";}

print "<img src=\"$icon\" alt=\"\" align=middle hspace=30>" unless

 ($icon eq "none");

print "</form>";

print "</center>";

$week_days=join(" <th> ",@days_of_week);

print "<tr><th>$week_days<br>\n";

for ($i=1906; $i<$this_year; $i++)    {

    $days_offset++;

    if (($i)%4==0)

        {$days_offset++}; # Leap years

    } # end for

if (($this_year%4)==0 && ($this_month>2))

    {$days_offset++}; #  Current year is leap year

for ($j=1; $j<($this_month);$j++)    {

    $days_offset+=@month_offset[$j]};

$first_day_of_month=($days_offset%7);

$last_day_in_month=@last_days[$this_month];

if (($this_month==2)&&($this_year%4==0)){$last_day_in_month=29};

$date_place=0;

while ($date_place<$last_day_in_month)    {

print "<tr>";

for ($j=0; $j<=6; $j++)    {

    if (($first_day_of_month>=0)||($date_place>=$last_day_in_month))

    {print "<td align=center>-";

    $first_day_of_month--}

    else    {

    $date_place++;

    print "<td align=center>

           <a href=\"$base_url$disp_day?$this_month 

Â&$date_place&$this_year\"> $date_place </a>";

&appoints($this_month,$date_place,$this_year);

if ($today_day==$date_place && $today_month==$this_month && 

Â$today_year==$this_year){print"<br><b><font color=red>TODAY</font></b>"};

} # end else

}    #end for

print "<br>\n";

}    #  end while

open (ANNO, "$announce");

@announce=<ANNO>;

$search=$this_month."_".$this_year;

$any_announce="no";

for $announces (@announce)    {

($mo,$msg,$aid)=split(/&&/,$announces);

if ($mo eq $search){

if ($any_announce eq "no"){print "<br><tr><td align=center colspan=7>";}

print "<center><b>$msg</b></center><br>";

$any_announce="yes";}

        }

print "</table></center><br>\n";

print "<center>Select a day to see the appointments for that day.  

       Numbers in parentheses indicate how many appointments 

       are on that day.</center>";

print "<hr>\n";

print "<center>Go to:</center><br>\n";

print "<center>";

# print "<table border=0 cellpadding=5 width=100%>";

$last_year=$this_year;

$last_month=($this_month-1);

if ($last_month == 0) {$last_month=12; $last_year=($this_year-1);}

print "[ <a href=\"$base_url$hypercal?$last_month&$last_year\">

       Previous month  </a>|\n";

$next_year=$this_year;

$next_month=($this_month+1);

if ($next_month == 13) {$next_month=1; $next_year=($this_year+1);}

print "<a href=\"$base_url$hypercal?$next_month&$next_year\">

       Next month  </a>|";

print "<a href=\"$base_url$hypercal\">  Current month  </a>]

       </center><br>\n";

print "<center><form method=get action=$base_url$hypercal/goto>";

print "<input type=submit value=\"Jump\"> to <input name=\"month\"

       size=2> \/ <input name=\"year\" size=4 value=\"$this_year\">";

print "<input type=hidden name=\"this_year\" value=\"$this_year\">";

print "</form></center><hr>";

print "<center>";

# print "<table width=100%><tr><td>";

print "[ <a href=\"$base_url$edit_announce?$this_month&$this_year\">

       Add an announcement</a> for this month. ";

print "| <a href=\"$base_url$edit_announce?$this_month&$this_year&delete\">

    Delete an announcement</a> from this month." unless ($any_announce eq "no");

print " ]";

print "</center>";

print "<center>";

print "<hr>[ <a href=\"http://www.rcbowen.com/perl/HyperCal.html\">

       About HyperCal</a>.";

foreach $item (@linkto)    {

($url, $page_title)=split(/~~/,$item);

print " | <a href=\"$url\">$page_title</a>";

            }

if ($multi_user eq "yes")    {

print " | <a href=\"$base_url$change_passwd\">Change your user password</a>"}

print " ]</center><br>\n";

print "HyperCal, Version $version, Copyright &copy; 1996, Richard Bowen.  

All rights reserved.<br>\n";

&footer;

    }    #  End of sub main

sub appoints   {

$found=0;

&julean($_[0],$_[1],$_[2]);  #  Julean date of day

for $entry (@datebook)    {

@temporary=split(/~~~/,$entry);

if (@temporary[0]==$jule)  {$found++}};

if ($found != 0) {print "   ($found)"};    }

sub goto    {

($pair1, $pair2, $pair3)=split(/&/,$args);

($junk, $month)=split(/=/, $pair1);

($junk, $year)=split(/=/, $pair2);

($junk, $this_year)=split(/=/, $pair3);

#  Need some error checking ...

if ($month eq ""){$month=1};

if ($year eq""){$year=$this_year};

if ($month>12) {$month=12};

if ($month<1) {$month=1};

if ($year<1) {$year=1};

if ($year>9999) {$year=9999};

$args="$month&$year";

&main

    }

sub personal    {

$sub=~s/personal\///;

$user_id=$ENV{`REMOTE_USER'};

$user_variables=~s/USERNAME/$user_id/;

require "$user_variables";

}

Let's take a look at how HyperCal works. HyperCal uses a library called httools.pm, which takes care of things like printing headers and parsing forms. CGI.pm could be used instead of httools.pm with a few simple modifications to HyperCal's code. The httools.pm module supports the following functions in HyperCal:

Function Usage and Description
header Prints MIME content type header.
title Prints title for HTML page: &title(`Desired title')
form_parse Parses form, places variables in $FORM{`variable_name'}.
footer Prints generic footer.
date Returns today's date in nicer format.
julean Returns Julian date with Jan 1, 1995, as day 1.
todayjulean Returns today's Julian date, calls julean.

HyperCal stores the URI encoded path info in the QUERY_STRING to a variable named $args. Path info (variables encoded in the URI) is next filtered into the variable $sub. The variable $sub is then evaluated to determine what output the program should generate.

The hypercal.cgi program will do different things based on what variables are present (or not present) in the QUERY_STRING (data appended to the URI) when it is run. The principle behind this concept is simple. The HTML output (calendar) generated by running the program contains HTML links back to the program. In other words, the HTML calendar contains links and forms whose URIs reference back to the hypercal.cgi script again. However, the links also contain variables appended to the URI. When a user clicks on the URI with the appended variables, the program is run again. This time it parses the variables in the URI and can react differently based on those self-supplied variables. This is precisely what is happening in lines 15-17. If no variables are found in the URI, the else statement instructs the program to execute the &main subroutine that prints the HTML for the calendar.

If variables are supplied to HyperCal in its URI, one of two subroutines is called first. The
&personal subroutine determines if a personal calendar is being used and alters a few variables accordingly. I'll discuss using personal calendars in more depth in a moment. The other subroutine that may be called is &goto. The &goto subroutine directs HyperCal to display a specific month. The month and year must be supplied in the URI, in the following format:

http://URI/hypercal.cgi/goto?month=9&year=1999&this_year=1996

The &goto subroutine reads the three name/value pairs, trashes the names, and stores the values to $month, $year, and $this_year. The month and year are then stored in $args, and the main subroutine is called to display the requested month. Note that if $args does not contain a prespecified month, the current month is used.

Using multiple users requires a few extra steps. In the configuration file (discussed next), the $multi_user variable must be set to yes. Note that in the &main subroutine in hypercal.cgi, if this variable is set to yes, a button Go To Personal Calendar is displayed.

Personal calendars are protected by restricting access to the user directory in which HyperCal keeps the user data using the .htgroup and .htpasswd file. The usage of .htpasswd is discussed more thoroughly in Chapter 3. The cal_admin.cgi program is used to add users and passwords to the .htpasswd file, essentially adding users to the calendar. To set up HyperCal in multi-user mode, variables in the config file need to be set.

Configuration of HyperCalThe Variables File

All of HyperCal's configuration variables are located in a separate file named "variables." By carefully reading over the configuration file, you can get an idea of what HyperCal does and how to configure it. Listing 11.2 shows the "variables" file for HyperCal.

Listing 11.2. Variables and configuration file for HyperCal.



$version="2.3";

#  Names of the various program files

#  Some sites only allow cgi's with a .cgi extension

#  so you might need to change your file names

$add_date="add_date.cgi";

$del_date="del_date.cgi";

$disp_day="disp_day.cgi";

$edit_announce="edit_announce.cgi";

$hypercal="hypercal.cgi";

$cal_admin="cal_admin.cgi";

$personal="personal.cgi";

$change_passwd="change.password";

# Other files

$datebook="datebook";

$hypercal_id="hypercal_id";

$announce="announce";

$users_dir="/www/cgi-bin/datebook/users/";

$user_variables="/www/cgi-bin/datebook/users/USERNAME/variables";

# variables

#  Are you running a secure site with personal accounts?

$multi_user="no";

$personal_on="no";

$old=370;

#  Number of days to keep past dates

# Your info goes here - dont make this me, please

$admin="Richard Bowen";

$admin_mail="rbowen\@databeam.com";

$admin_uid="rbowen";

# Person to contact with problems

$base_url="/scripts/hypercal/";

# URL of the directory in which these files live

$title="HyperCal";

# Title of the calendar.

$htpass="/www/passwd/.htpasswd";

$htgroup="/www/passwd/.htgroup";

#  Location of the .htpasswd and .htgroup files

#  This will be used only if you are running the security part

@linkto=("http://www.mk.net/~~MK.net Home Page", "/perl/~~My Perl archive");

#  Places to provide links to on each page.

#  This array contains the locations of images for the various

#  months.  The format is:

#  "url_for_icon~~url_for_background~~bgcolor~~link~~visited link"

#  This array must contain 12 elements. Any field where you have

#  no preference, indicate by "none"

@month_images=("images/january.gif~~none~~none~~none~~none~~none",

    "images/february.gif~~none~~none~~none~~none~~none",

    "images/march.gif~~none~~none~~none~~none~~none",

    "images/april.gif~~none~~none~~none~~none~~none",

    "images/may.gif~~none~~none~~none~~none~~none",

    "images/june.gif~~none~~none~~none~~none~~none",

    "images/july.gif~~none~~none~~none~~none~~none",

    "none~~none~~none~~none~~none~~none",

    "none~~none~~none~~none~~none~~none",

    "images/october.gif~~none~~none~~none~~none~~none",

    "images/november.gif~~none~~none~~none~~none~~none",

    "images/december.gif~~none~~none~~none~~none~~none");

1;

Notice which elements of the program are located in the configuration file. The first two blocks define the names of the supplementary programs and the names and locations of various configuration files. These locations are different on different software platforms and flavors of UNIX, so placing them in a configuration file instead of hard coding them into your code significantly increases your ability to easily get your CGI running on different servers. In general, anything that you might want to change, or will change based on the software environment of your CGI, should be defined in a configuration file.

Arrays are a great way to store variables with multiple elements, like the month_images in the
preceding example. Notice that the last line of code uses a return value to verify the successful loading of the file to the main program.

Displaying Appointments on a Specific Day: disp_day.cgi

Each day in the calendar is a link to disp_day.cgi, along with the date URI encoded. For example, a link to June 25, 1997, looks like this:

http://myserver.com/hypercal/disp_day.cgi?6&25&1997

The disp_day.cgi script, shown in Listing 11.3, simply reads the day from the URI, reads the datebook database, looks up the Julian date to reference the database entry, and formats an HTML page based on the contents of the database (if any) on that day.

Listing 11.3. disp_day.cgi.

#!/usr/bin/perl

#  Display Day.  Reads in database and prints appointments for the

#  selected day.  Allows option of adding new appointment.

#

require `variables';

require `httools.pl';

&header;

#  Determine if this is a personal calendar;

($sub=$ENV{`PATH_INFO'})=~s#^/##;

if ($sub=~/personal/){require $personal};

#   Read date from QUERY_STRING

$info=$ENV{`QUERY_STRING'};

($month,$day,$year)=split(/&/,$info);

#  Print titles to html page

&month_txt("$month");

&title("Appointments for $month_txt $day, $year.");

print "<h2>Appointments for $month_txt $day, $year.</h2><hr>";

#  Read in database.

$any="no";     #  Flag which determines if appts were found.

open (DATES, "$datebook");

@dates=<DATES>;

close DATES;

&julean($month,$day,$year);   #    Julean date of day in question.

#  Checks database for listings of that day.

print "<table border width=100%>";

print "<tr><th> Time <th> Event <th> Name <br>";

for $date (@dates)    {

($julean,$time,$endtime,$desc,$name,$id)=split(/~~~/,$date);

if ($julean==$jule) {

print "<tr><td>";

if ($time eq "00:00" && $endtime eq "00:00")  { print "(All day) ";}

else {

#  am/pm the time

($hr,$min)=split(/:/,$time);

if ($hr==24) {$hr="12";

        $ampm="am"}

else {

if ($hr<12) {$ampm="am"}

else {$hr-=12;

    if ($hr==0){$hr=12};

    $ampm="pm"};

}    # end else

$time=$hr.":".$min." ".$ampm;

print "$time";}

if ($endtime eq "00:00") {}

else {

#  am/pm the time

($hr,$min)=split(/:/,$endtime);

if ($hr<=12) {$ampm="am"}

else {$hr-=12; $ampm="pm"};

if ($hr==0){$hr="12"};

$endtime=$hr.":".$min." ".$ampm;

print " - $endtime ";}

print "<td> $desc <td> $name <br>";

            $any="yes";}

            }

if ($any eq "no") {print "<tr><td colspan=3><center>

                          <b>** No appointments **</b></center><br>";}

print "</table>";

print "<hr>";

print "<a href=$base_url$add_date?$month&$day&$year>Add an appointment</a><br>";

print "<a href=$base_url$del_date?$month&$day&$year> 

       Delete an appointment</a><br>" unless ($any eq "no");

print "<a href=$base_url$hypercal?$month&$year>Back</a> to the calendar.";

&footer;

Let's take a look at how disp_day.cgi works. The database file is opened as a file handle (DATES) and read line by line into an array (@dates). Once read into the array, the file handle is closed.



open (DATES, "$datebook");

@dates=<DATES>;

close DATES;

Since entries are indexed in the database by their Julian date, referred to in the code as "julean" date, the Julian date is constructed from the $month, $day, and $year submitted in the URI:

&julean($month,$day,$year);   #    Julean date of day in question.

Now that we've read in the database and know what Julian day we're looking for, the real work can be done. The code that follows sets up a HTML table, then steps through the @dates array until the specified date is reached:

#  Checks database for listings of that day.

print "<table border width=100%>";

print "<tr><th> Time <th> Event <th> Name <br>";

for $date (@dates)    {

When a line in the database is found that matches the specified date, it is broken down using the split operator into six variables: $julean, $time, $endtime, $desc, $name, and $id.

($julean,$time,$endtime,$desc,$name,$id)=split(/~~~/,$date);

From these elements, an HTML table of events for that day is generated. The variables are embedded into HTML tables. Notice that the <table> tag is set up before any looping begins. To properly create tables with loop structures in your code, define the table before the loop. Each loop should begin with <TR><TD> tags and end with </TD></TR>. The </table> tag should be placed after the loop. This is obvious once you think about it and look at the HTML generated by an improperly written program.

Adding Calendar Entries with add_date.cgi

The add_date.cgi program either outputs an HTML form to set up a new appointment or takes the post-method URI encoded data from the form and inputs it into the database (see Listing 11.4). Like hypercal.cgi, which action occurs is based on the input supplied to the program in the URI.

Listing 11.4. add_date.cgi.

#!/usr/bin/perl

#

#    Add Date

#

#    Prints html form for input of new appointment.  Sends the

#  form input to part_2 for processing.

#    Richard Bowen, 12/14/95

#    rbowen@aiclex.com

#_____________________________________________________

require `httools.pl';

require `variables';

&header;

# Determine if it is a personal calendar

($sub=$ENV{`PATH_INFO'})=~s#^/##;

if ($sub=~/personal/){require $personal};

#  Read in date from QUERY_STRING

$date=$ENV{`QUERY_STRING'};

($month,$day,$year,$command)=split(/&/,$date);

#

#    Determine which part of the script is being called

#__________________________________

if ($command eq "doit") {&part_2}

else { &part_1 };

#

#    Part One

#

#    Prints html form and sends results to part 2

#______________________________________________

sub part_1    {

#  Print some titles to browser.

&month_txt("$month");

&title ("Add an appointment for $month_txt $day, $year.");

print <<"HTML";

<h2>Add an appointment for $month_txt $day, $year.</h2>

<b>Note:</b> Only authorized users will be able to add and delete 

appointments. Please contact your web adminstrator for a username 

and password.

<hr>

<form method=post action=$base_url$add_date?$month&$day&$year&doit>

<b>Time:</b>

<input name="hour" size=2 value="00"><b>: </b>

<input name="min" value="00" size=2>

<input type=radio name="ampm" value="am" CHECKED>AM

<input type=radio name="ampm" value="pm">PM

<br>

<b>Until:</b>

<input name="hour_done" size=2 value="00"><b>: </b>

<input name="min_done" value="00" size=2>

<input type=radio name="ampm_done" value="am" CHECKED>AM

<input type=radio name="ampm_done" value="pm">PM

<br>

<i>If no beginning time is specified, the event will be listed as 

the whole day.  If no end time is entered, the event will be listed 

with only the beginning time</i>

<br>

<b>Description</b><br>

<textarea name="desc" rows=5 cols=60></textarea><br>

<table><tr><td valign=top rowspan=5><b>Event occurs:</b><br>

<td><input type=radio name="freq" value="once" CHECKED>Once<br>

<tr><td><input type=radio name="freq" value="daily">Daily for :

<input name="days" value="1" size="2"> days.<br>

<tr><td><input type=radio name="freq" value=\"weekly\">Weekly for :

<input name="weeks" value="1" size=2> weeks.<br>

<tr><td><input type=radio name="freq" value="monthly">Monthly for :

<input name="months" value="1" size=2> months.<br>

<tr><td><input type=radio name="freq" value="annual">Annually for :

<input name="years" value="1" size=2> years.<br>

</table>

Please enter your name : <input name="perp" size="20"><br>

<input type=submit value="Add Appointment">

</form><hr>

Calendar entries will expire and be deleted $old days after the event.

HTML

&footer;

    }        #  End of part 1

sub part_2    {

#    Receives the post data from add_form and adds the information

#  to the database.  Format of database is currently:

#  Julean&time&endtime&event&name&id

#

# Get data from form post.

#  Variables are:

#  hour, min, ampm, desc, freq, perp

#  hour_done, min_done, ampm_done, days, weeks, months

#  freq = one of (once, daily, weekly, monthly)

&form_parse;

# Strip returns from description field to make it one continuous string.

$FORM{`desc'} =~ s/\n//g;

#  Print titles to HTML page.

&month_txt("$month");

&title ("Appointment added to $month_txt $day, $year");

print "<h1>Appointment added to $month_txt $day, $year</h1>";

#  Read in current contents of database.

open (DATES,"$datebook") || print "Was unable to open the datebook 

                                   database for reading <br>\n";

@dates=<DATES>;

close DATES;

for (@dates){chop};

&julean($month,$day,$year);

#    Rewrite time

&time($FORM{`hour'},$FORM{`min'},$FORM{`ampm'});

$begin=$time;

&time($FORM{`hour_done'},$FORM{`min_done'},$FORM{`ampm_done'});

$done=$time;

# Get id number

open (ID, "$hypercal_id")  || print "Was unable to open the ID file for Âreading<br>\n";

@id=<ID>;

close ID;

for (@id){chop};

@id[0]++;

if (@id[0]>=999999) {@id[0]=1};

$id=@id[0];

open (NEWID,">$hypercal_id")  || print "Was unable to open the ID 

                                        file ($hypercal_id) for writing<br>\n";

for $each (@id)    {

print NEWID "$each\n";}

#  Add the new appointment to the database.

$newappt="$jule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

push (@newdates,$newappt);

if ($FORM{`freq'} ne "once") { &many };

&julean($month,$day,$year);

&todayjulean;

for $date (@dates)    {

($juldate,$apptime,$appendtime,$appdesc,$perpname,$id)=split(/~~~/,$date);

if (($today-$juldate)<=$old) {push (@newdates,$date) }

        }

@dates=sort(@newdates);

#  Write database back to disk file.

open (NEWDATES,">$datebook") || print "Was unable to open the 

                                       datebook file for writing.<br>\n";

foreach $date (@dates) {print NEWDATES "$date\n"}

close NEWDATES;

#  Links back to other pages.

print "Back to calendar for 

       <a href=$base_url$hypercal?$month&$year>$month\/$year</a><br>";

print "Back to <a href=$base_url$disp_day?$month&$day&$year>

       $month\/$day\/$year</a>.";

&footer;

        }    # End of part_2

#

#    Sub time

#  Rewrites time into 24hr format.

#

sub time    {

$time="";

$HOUR=$_[0];

$MINS=$_[1];

$merid=$_[2];

if ($merid eq "pm") {

 $HOUR+=12;

 if ($HOUR==24) {$HOUR=12}

        }

if ($HOUR==12 && $merid eq "am"){$HOUR=24};

if ($HOUR>24){$HOUR=23};

if ($MINS>59){$MINS=59};

$HOUR=sprintf "%02.00f",$HOUR;

$MINS=sprintf "%02.00f",$MINS;

$time=$HOUR.":".$MINS;

        }

#

#    If frequency is more than once ...

#____________________________________________________

sub many    {

MANY:    {

    &daily, last MANY if ($FORM{`freq'} eq "daily");

    &weekly, last MANY if ($FORM{`freq'} eq "weekly");

    &monthly, last MANY if ($FORM{`freq'} eq "monthly");

    &annual, last MANY if ($FORM{`freq'} eq "annual");

    }

open (ID, ">$hypercal_id");

@id[0]=$id;

for $each(@id)    {

print ID "$each\n";}

        }

sub daily {

#    For daily appointments for $FORM{`days'} days

$days=$FORM{`days'};

for ($i=1; $i<$days; $i++)    {

$newjule=($jule+$i);

$id++;

$newappt="$newjule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

push (@newdates, $newappt);

                }  #  endfor

}    #    End daily

sub weekly {

#    For weekly appointments for $FORM{`weeks'} weeks.

$weeks=$FORM{`weeks'};

if ($weeks>156){$weeks=156};

for ($i=1;$i<$weeks;$i++)    {

$newjule=($jule+(7*$i));

$id++;

$newappt="$newjule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

push (@newdates, $newappt);

                }  #endfor

}   #    End weekly

sub annual    {

#  for annual appointments for $FORM{`years'} years.

$years=$FORM{`years'};

if ($years>10){$years=10};

for ($i=1;$i<$years;$i++)    {

$some_year=($year+$i);

&julean($month,$day,$some_year);

$id++;

$newappt="$jule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

push (@newdates, $newappt);

                }  #end for

}   #   End annual

sub monthly {

#    For monthly appointments for $FORM{`months'} months

#    This is the more difficult one

#________________________________________

$months=$FORM{`months'};

if ($months>36) {$months=36};

$this_month=$month;

$this_year=$year;

$this_day=$day;

for ($i=1;$i<$months;$i++)    {

$this_month++;

if ($this_month==13)    {$this_month=1;

            $this_year++;}

#  Check to see if this is a last-day-of-the-month thing

$this_day=$day;

if ($this_day>=28) { &last_days };

&julean($this_month,$this_day,$this_year);

$newjule=$jule;

$id++;

$newappt="$newjule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

push (@newdates, $newappt);

                } #  Endfor

}

sub last_days    {

#

#    If the day given is more than the days in the month,

#    it is reset to the last day of the month

#______________________________________________________

SWITCH:     {

    $last=31, last SWITCH if ($this_month==1);

    $last=28, last SWITCH if ($this_month==2);

    $last=31, last SWITCH if ($this_month==3);

    $last=30, last SWITCH if ($this_month==4);

    $last=31, last SWITCH if ($this_month==5);

    $last=30, last SWITCH if ($this_month==6);

    $last=31, last SWITCH if ($this_month==7);

    $last=31, last SWITCH if ($this_month==8);

    $last=30, last SWITCH if ($this_month==9);

    $last=31, last SWITCH if ($this_month==10);

    $last=30, last SWITCH if ($this_month==11);

    $last=31, last SWITCH if ($this_month==12);

    }

if ($this_day>$last) {$this_day=$last};

}

The code is broken down into two parts. The following lines of code determine which part of the script to run based on the presence of a variable supplied to the script at runtime:

$date=$ENV{`QUERY_STRING'};

($month,$day,$year,$command)=split(/&/,$date);

if ($command eq "doit") {&part_2}

else { &part_1 };

The first part (Part 1) of the code in add_date.cgi simply prints out the HTML form used to
input a new appointment, then exits. Part 2 takes the data supplied in the HTML form in Part 1 and adds it to the database. The following code assembles a new database entry into $newappt, based on information supplied by the post of the form:



$newappt="$jule~~~$begin~~~$done~~~$FORM{`desc'}~~~$FORM{`perp'}~~~$id";

If there were multiple occurrences of the same event specified in the form, the following code would create an array @dates based on the specified frequency of the event (daily, weekly, monthly, and so on). The database file is opened as a new file handle (NEWDATES). Then, the database, contained in @dates, is sorted and saved back to disk.

push (@newdates,$newappt);

if ($FORM{`freq'} ne "once") { &many };

&julean($month,$day,$year);

&todayjulean;

for $date (@dates)    {

($juldate,$apptime,$appendtime,$appdesc,$perpname,$id)=split(/~~~/,$date);

if (($today-$juldate)<=$old) {push (@newdates,$date) }

        }

@dates=sort(@newdates);

#  Write database back to disk file.

open (NEWDATES,">$datebook") || print "Was unable to open the 

                                       datebook file for writing.<br>\n";

foreach $date (@dates) {print NEWDATES "$date\n"}

close NEWDATES;

Changing User Passwords with password.change

Passwords for the database are managed with the password.change script, shown in Listing 11.5. Passwords are managed by modifying the .htpasswd file on the server. In order for password.change script to work, permissions on the .htpasswd file must be set so that the owner of the HyperCal files can read and write to it. The password.change script looks in the variables file to locate the .htpasswd file on the server. The crypt() function is used to encrypt the user specified password before it is saved in the .htpasswd file.

Listing 11.5. password.change.

#!/www/bin/perl

#Allows a user to change their password from the web

require `variables';

require `httools.pl';

&header;

# Determine which part is being called

if ($ENV{`QUERY_STRING'} eq "change")    {&change}

else {&part_1};

sub part_1    {

#Prints the html form and collects the information

&title("Change password");

print "To change your password, please fill in the information below:<hr>\n";

print "<form method=post action=change.password?change>\n";

print "<b>User name</b><br>\n";

print "<input name=\"user\" size=15><br>\n";

print "<hr>";

print "<b>Your old password</b><br>\n";

print "<input type=\"password\" name=\"old_pass\" size=15><br>\n";

print "<hr>";

print "<b>Your new password</b><br>\n";

print "<input type=\"password\" name=\"new_pass_1\" size=15><br>\n";

print "<hr>";

print "<b>Your new password again to ensure that you 

       did not make any typing errors</b><br>\n";

print "<input type=\"password\" name=\"new_pass_2\" size=15><br>\n";

print "<hr>";

print "<input type=\"submit\" value=\"Change the password\">";

print "</form>";

print "<hr>";

}

sub change    {

#    Change the password, if everything checks out

&form_parse;

#    Read in the password file and build an assoc. array of it

open (PASS, "$htpass");

@pass=<PASS>;

foreach $pass (@pass)    {

chop ($pass);

($name,$password)=split(/:/,$pass);

$PASS{$name} = $password;    }

#    Do some checking

if ($FORM{`new_pass_1'} ne $FORM{`new_pass_2'})

                {$error=1};

if (crypt($FORM{`old_pass'},$PASS{"$FORM{`user'}"}) ne $PASS{"$FORM{`user'}"})

                {$error=2};

if ($PASS{$FORM{`user'}} eq "")

                {$error=3};

if ($error) {&error}

else    {    # Change it

open (PASS, ">$htpass");

$new_pass=crypt($FORM{`new_pass_2'},$FORM{`new_pass_2'});

$PASS{"$FORM{`user'}"}=$new_pass;

foreach $key (keys %PASS)    {

print PASS "$key:$PASS{$key}\n";    }

&title(`Password changed');

print "Your password has been changed.  You will need to 

       re-authorize when you go back to the calendar.<br>";

print "<center>";

print "[ <a href=$base_url$hypercal>Hypercal</a> ]";

&footer;

    }

sub error{

if ($error==1) {

print "Your entries for new password did not match.  

       Please <a href=change.password>try again</a><br>";}

elsif ($error==2) {

print "The password you entered is incorrect.  Please check 

       your password and <a href=change.password>try again</a><br>\n";}

elsif ($error==3) {

print "I could not find an entry for you in the password file.  

       Please have your webmaster add an entry for you.<br>";}

&footer;

}

}    # End of change

Other Supplementary Programs

Other programs included in the HyperCal distribution are cal_admin, which facilitates the creation of new users, and del_date, which allows the deletion of a datebook entry.

Summary

This chapter has introduced you to how Perl5 can be used to write CGIs that manipulate data. CGI.pm and a database module could be used to make this code even more modular and powerful. I encourage you to take principles in this chapter and play with them by enhancing them with currently available Perl5 modules. The ability to extend the features and create entirely new applications from simpler modules is what makes Perl5 the most efficient and powerful way to develop dynamic server-side Web applications.