ch11.htm

Web_Programming_with_Perl5,一个不错的Perl语言教程。

$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};

}

</FONT></PRE>

<P>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:</P>

<PRE><FONT COLOR="#0066FF">$date=$ENV{`QUERY_STRING'};

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

if ($command eq &quot;doit&quot;) {&amp;part_2}

else { &amp;part_1 };

</FONT></PRE>

<P>The first part (Part 1) of the code in add_date.cgi simply prints out the HTML

form used to <BR>

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 <TT>$newappt</TT>, based on information supplied by the post of the form:</P>

<PRE><FONT COLOR="#0066FF">

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

</FONT></PRE>

<P>If there were multiple occurrences of the same event specified in the form, the

following code would create an array <TT>@dates</TT> based on the specified frequency

of the event (daily, weekly, monthly, and so on). The database file is opened as

a new file handle (<TT>NEWDATES</TT>). Then, the database, contained in <TT>@dates</TT>,

is sorted and saved back to disk.</P>

<PRE><FONT COLOR="#0066FF">push (@newdates,$newappt);

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

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

&amp;todayjulean;

for $date (@dates)    {

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

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

        }

@dates=sort(@newdates);

#  Write database back to disk file.

open (NEWDATES,&quot;&gt;$datebook&quot;) || print &quot;Was unable to open the 

                                       datebook file for writing.&lt;br&gt;\n&quot;;

foreach $date (@dates) {print NEWDATES &quot;$date\n&quot;}

close NEWDATES;

</FONT></PRE>

<CENTER>

<H4><A NAME="Heading14"></A><FONT COLOR="#000077">Changing User Passwords with password.change</FONT></H4>

</CENTER>

<P>Passwords for the database are managed with the password.change script, shown

in Listing 11.5. Passwords are managed by modifying the <TT>.htpasswd</TT> file on

the server. In order for password.change script to work, permissions on the <TT>.htpasswd</TT>

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 <TT>.htpasswd</TT>

file on the server. The <TT>crypt()</TT> function is used to encrypt the user specified

password before it is saved in the <TT>.htpasswd</TT> file.

<CENTER>

<H3><A NAME="Heading15"></A><FONT COLOR="#000077">Listing 11.5. password.change.</FONT></H3>

</CENTER>

<PRE><FONT COLOR="#0066FF">#!/www/bin/perl

#Allows a user to change their password from the web

require `variables';

require `httools.pl';

&amp;header;

# Determine which part is being called

if ($ENV{`QUERY_STRING'} eq &quot;change&quot;)    {&amp;change}

else {&amp;part_1};

sub part_1    {

#Prints the html form and collects the information

&amp;title(&quot;Change password&quot;);

print &quot;To change your password, please fill in the information below:&lt;hr&gt;\n&quot;;

print &quot;&lt;form method=post action=change.password?change&gt;\n&quot;;

print &quot;&lt;b&gt;User name&lt;/b&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;input name=\&quot;user\&quot; size=15&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;hr&gt;&quot;;

print &quot;&lt;b&gt;Your old password&lt;/b&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;input type=\&quot;password\&quot; name=\&quot;old_pass\&quot; size=15&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;hr&gt;&quot;;

print &quot;&lt;b&gt;Your new password&lt;/b&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;input type=\&quot;password\&quot; name=\&quot;new_pass_1\&quot; size=15&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;hr&gt;&quot;;

print &quot;&lt;b&gt;Your new password again to ensure that you 

       did not make any typing errors&lt;/b&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;input type=\&quot;password\&quot; name=\&quot;new_pass_2\&quot; size=15&gt;&lt;br&gt;\n&quot;;

print &quot;&lt;hr&gt;&quot;;

print &quot;&lt;input type=\&quot;submit\&quot; value=\&quot;Change the password\&quot;&gt;&quot;;

print &quot;&lt;/form&gt;&quot;;

print &quot;&lt;hr&gt;&quot;;

}

sub change    {

#    Change the password, if everything checks out

&amp;form_parse;

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

open (PASS, &quot;$htpass&quot;);

@pass=&lt;PASS&gt;;

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{&quot;$FORM{`user'}&quot;}) ne $PASS{&quot;$FORM{`user'}&quot;})

                {$error=2};

if ($PASS{$FORM{`user'}} eq &quot;&quot;)

                {$error=3};

if ($error) {&amp;error}

else    {    # Change it

open (PASS, &quot;&gt;$htpass&quot;);

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

$PASS{&quot;$FORM{`user'}&quot;}=$new_pass;

foreach $key (keys %PASS)    {

print PASS &quot;$key:$PASS{$key}\n&quot;;    }

&amp;title(`Password changed');

print &quot;Your password has been changed.  You will need to 

       re-authorize when you go back to the calendar.&lt;br&gt;&quot;;

print &quot;&lt;center&gt;&quot;;

print &quot;[ &lt;a href=$base_url$hypercal&gt;Hypercal&lt;/a&gt; ]&quot;;

&amp;footer;

    }

sub error{

if ($error==1) {

print &quot;Your entries for new password did not match.  

       Please &lt;a href=change.password&gt;try again&lt;/a&gt;&lt;br&gt;&quot;;}

elsif ($error==2) {

print &quot;The password you entered is incorrect.  Please check 

       your password and &lt;a href=change.password&gt;try again&lt;/a&gt;&lt;br&gt;\n&quot;;}

elsif ($error==3) {

print &quot;I could not find an entry for you in the password file.  

       Please have your webmaster add an entry for you.&lt;br&gt;&quot;;}

&amp;footer;

}

}    # End of change

</FONT></PRE>

<CENTER>

<H4><A NAME="Heading17"></A><FONT COLOR="#000077">Other Supplementary Programs</FONT></H4>

</CENTER>

<P>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.

<CENTER>

<H3><A NAME="Heading18"></A><FONT COLOR="#000077">Summary</FONT></H3>

</CENTER>

<P>This chapter has introduced you to how Perl5 can be used to write CGIs that manipulate

data. <TT>CGI.pm</TT> 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.<BR>



<CENTER>

<H2><A HREF="ch10.htm" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/ch10.htm"><IMG SRC="blanprev.gif" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/blanprev.gif" WIDTH="37" HEIGHT="37" ALIGN="BOTTOM"

BORDER="2"></A><A HREF="index-1.htm" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/index-1.htm"><IMG SRC="blantoc.gif" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/blantoc.gif" WIDTH="42" HEIGHT="37" ALIGN="BOTTOM"

BORDER="2"></A><A HREF="ch12.htm" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/ch12.htm"><IMG SRC="blannext.gif" tppabs="http://210.32.137.15/ebook/Web%20Programming%20with%20Perl%205/blannext.gif" WIDTH="45" HEIGHT="37"

ALIGN="BOTTOM" BORDER="2"></A><BR>



</CENTER>





</BODY>



</HTML>