#!/usr/bin/perl ###################################################################### # Programmer: Al Nguyen # # At the command prompt do "perldoc [name of this program] to see # user documentation. ###################################################################### ############################## # Include these libraries. ############################## use strict; use CGI; $CGI::POST_MAX = 1024 * 100; #100K max post $CGI::DISABLE_UPLOADS = 1; use CGI::Carp qw( fatalsToBrowser ); use Data::Dumper; my $VERSION = 1.0.2; ################################################# # Main function. Main logic of program. ################################################# main(); sub main { my %form = form2hash(); $form{dtype} = untaint( $form{dtype}, 'begin|end', qq(Invalid date type parameter) ); $form{appID} = untaint( $form{appID}, '\w+', qq(Invalid appID parameter) ) if ! $form{curMonth}; $form{date} = untaint( $form{date}, '\d\d\d\d-\d\d-\d\d', qq(Invalid date parameter) ) if $form{date}; $form{curMonth} = untaint( $form{curMonth}, '\d+', qq(Invalid month parameter) ) if $form{curMonth}; $form{year} = untaint( $form{year}, '\d\d\d\d', qq(Invalid year parameter) ) if $form{year}; my $q = new CGI; if ( ! $q->param('date') ) { ( $q->param('dtype') eq 'begin' ) ? showCalendar( 'begin', 0, $form{curMonth}, $form{appID}, $form{year} ) : showCalendar( 'end', 0, $form{curMonth}, $form{appID}, $form{year} ); } date2cookie( $form{date}, $form{dtype}, $form{appID} ); confDateSelected( $form{date} ); } ########################################################### # Write the date selected to a session cookie. ########################################################### sub date2cookie { my( $date, $type, $appID ) = @_; my $q = new CGI; my $name = ( $type eq 'begin' ) ? "beginDate-$appID" : "endDate-$appID"; my $c = $q->cookie( -name => $name, -value => $date, ); print $q->header( -cookie => $c ); return( 1 ); } ###################################################################### # Read the date cookie to confirm that it was set properly. # This function is useful for debugging. ###################################################################### sub readDateCookie { my( $cookieName ) = @_; my $q = new CGI; my $c = $q->cookie( $cookieName ); return( $c ); } ########################################################### # Show a calendar displaying the current month. ########################################################### sub showCalendar { my( $type, $dont_send_type_flag, $current_month, $appID, $year ) = @_; my( $curYear, $curMonth, $curDay ) = get_system_date(); my $current_date = "$curYear-$curMonth-$curDay"; $current_month = $curMonth if ! $current_month; $current_month =~ s/^0//; $curDay =~ s/^0//; my $whichYear = { '2005' => \&getCalendar2005, '2004' => \&getCalendar2004, '2003' => \&getCalendar2003, }; $year = $curYear if ! $year; my $show4year = $whichYear->{ $year }; my $calendar = $show4year->( $current_month, $type, $appID, $year ); print "Content-type: text/html\n\n" if ! $dont_send_type_flag; my @lines = split( /\n/, $calendar ); foreach ( @lines ) { $_ =~ s/\(\$curDay\<\/a\>\<\/td\>)/\$1/; print $_, "\n"; } exit; } ############################################################################### # Put the HTML form input data into a hash. Returns a hash of form elements # in key/value pairs. ############################################################################### sub form2hash { my $q = new CGI; my( $name, $value, %form ); foreach $name ( $q->param() ) { $value = $q->param( $name ); $form{$name} = $value; } return( %form ); } ############################################################################ # Untaint the HTML form input data. Value is the form value. Pattern is # a regular expression. Returns whatever matches the regular expression. ############################################################################ sub untaint { my( $value, $pattern, $error_message ) = @_; ( $value =~ m|($pattern)| ) ? return( $1 ) : errorMes( $error_message ); } ################################################################################## # Output data structures for debugging if necessary. $data is a reference to # some kind of data structure. ################################################################################## sub dumpData { my( $data ) = @_; my $data_as_string = Dumper( $data ); my $html = '
'; $data_as_string =~ s|\n|$html|sg; my $q = new CGI; print $q->header( -type => 'text/html', -expires => 'now' ); print < Data Dump

 

$data_as_string

heredoc exit; } ################################################ # Display an error message page if necessary. ################################################ sub errorMes { my( $message ) = @_; print "Content-type: text/html\n\n"; print <Error

 

$message

heredoc exit; } ###################################################################### # Calculate today's date according to the current host computer. ###################################################################### sub get_system_date { my( $year, $month, $day ) = ( localtime() )[ 5, 4, 3 ]; $year += 1900; $month += 1; $month = 0 . $month if $month < 10; $day = 0 . $day if $day < 10; return( $year, $month, $day ); } #################################################### # Give user confirmation that a date was selected. #################################################### sub confDateSelected { my( $date ) = @_; print <Date Selected

 

You selected:

$date

Close Window

heredoc exit; } #################################################### # Fetch a calendar for the year 2005. #################################################### sub getCalendar2005 { my( $current_month, $type, $appID, $year ) = @_; ######################## # JANUARY ######################## my $jan = <Select a Date

<<   January 2005   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31

Close Window

heredoc ######################## # FEBRUARY ######################## my $feb = <Select a Date

<<   February 2005   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28

Close Window

heredoc ######################## # MARCH ######################## my $mar = <Select a Date

<<   March 2005   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31

Close Window

heredoc ######################## # APRIL ######################## my $apr = <Select a Date

<<   April 2005   >>

SMTWTFS
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30

Close Window

heredoc ######################## # MAY ######################## my $may = <Select a Date

<<   May 2005   >>

SMTWTFS
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31

Close Window

heredoc ######################## # JUNE ######################## my $jun = <Select a Date

<<   June 2005   >>

SMTWTFS
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30

Close Window

heredoc ######################## # JULY ######################## my $jul = <Select a Date

<<   July 2005   >>

SMTWTFS
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31

Close Window

heredoc ######################## # AUGUST ######################## my $aug = <Select a Date

<<   August 2005   >>

SMTWTFS
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31

Close Window

heredoc ######################## # SEPTEMBER ######################## my $sep = <Select a Date

<<   September 2005   >>

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30

Close Window

heredoc ######################## # OCTOBER ######################## my $oct = <Select a Date

<<   October 2005   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31

Close Window

heredoc ######################## # NOVEMBER ######################## my $nov = <Select a Date

<<   November 2005   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30

Close Window

heredoc ######################## # DECEMBER ######################## my $dec = <Select a Date

<<   December 2005  

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31

Close Window

heredoc my $months = { '1' => $jan, '2' => $feb, '3' => $mar, '4' => $apr, '5' => $may, '6' => $jun, '7' => $jul, '8' => $aug, '9' => $sep, '10' => $oct, '11' => $nov, '12' => $dec, }; return( $months->{ $current_month } ); } #################################################### # Fetch a calendar for the year 2004. #################################################### sub getCalendar2004 { my( $current_month, $type, $appID, $year ) = @_; ######################## # JANUARY ######################## my $jan = <Select a Date

<<   January 2004   >>

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31

Close Window

heredoc ######################## # FEBRUARY ######################## my $feb = <Select a Date

<<   February 2004   >>

SMTWTFS
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29

Close Window

heredoc ######################## # MARCH ######################## my $mar = <Select a Date

<<   March 2004   >>

SMTWTFS
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31

Close Window

heredoc ######################## # APRIL ######################## my $apr = <Select a Date

<<   April 2004   >>

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30

Close Window

heredoc ######################## # MAY ######################## my $may = <Select a Date

<<   May 2004   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31

Close Window

heredoc ######################## # JUNE ######################## my $jun = <Select a Date

<<   June 2004   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30

Close Window

heredoc ######################## # JULY ######################## my $jul = <Select a Date

<<   July 2004   >>

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31

Close Window

heredoc ######################## # AUGUST ######################## my $aug = <Select a Date

<<   August 2004   >>

SMTWTFS
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31

Close Window

heredoc ######################## # SEPTEMBER ######################## my $sep = <Select a Date

<<   September 2004   >>

SMTWTFS
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30

Close Window

heredoc ######################## # OCTOBER ######################## my $oct = <Select a Date

<<   October 2004   >>

SMTWTFS
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31

Close Window

heredoc ######################## # NOVEMBER ######################## my $nov = <Select a Date

<<   November 2004   >>

SMTWTFS
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30

Close Window

heredoc ######################## # DECEMBER ######################## my $dec = <Select a Date

<<   December 2004   >>

SMTWTFS
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31

Close Window

heredoc my $months = { '1' => $jan, '2' => $feb, '3' => $mar, '4' => $apr, '5' => $may, '6' => $jun, '7' => $jul, '8' => $aug, '9' => $sep, '10' => $oct, '11' => $nov, '12' => $dec, }; return( $months->{ $current_month } ); } #################################################### # Fetch a calendar for the year 2003. #################################################### sub getCalendar2003 { my( $current_month, $type, $appID, $year ) = @_; ######################## # JANUARY ######################## my $jan = <Select a Date

  January 2003   >>

SMTWTFS
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31

Close Window

heredoc ######################## # FEBRUARY ######################## my $feb = <Select a Date

<<   February 2003   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28

Close Window

heredoc ######################## # MARCH ######################## my $mar = <Select a Date

<<   March 2003   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31

Close Window

heredoc ######################## # APRIL ######################## my $apr = <Select a Date

<<   April 2003   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30

Close Window

heredoc ######################## # MAY ######################## my $may = <Select a Date

<<   May 2003   >>

SMTWTFS
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31

Close Window

heredoc ######################## # JUNE ######################## my $jun = <Select a Date

<<   June 2003   >>

SMTWTFS
1 1 1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28

Close Window

heredoc ######################## # JULY ######################## my $jul = <Select a Date

<<   July 2003   >>

SMTWTFS
1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31

Close Window

heredoc ######################## # AUGUST ######################## my $aug = <Select a Date

<<   August 2003   >>

SMTWTFS
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31

Close Window

heredoc ######################## # SEPTEMBER ######################## my $sep = <Select a Date

<<   September 2003   >>

SMTWTFS
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30

Close Window

heredoc ######################## # OCTOBER ######################## my $oct = <Select a Date

<<   October 2003   >>

SMTWTFS
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
31

Close Window

heredoc ######################## # NOVEMBER ######################## my $nov = <Select a Date

<<   November 2003   >>

SMTWTFS
1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30

Close Window

heredoc ######################## # DECEMBER ######################## my $dec = <Select a Date

<<   December 2003   >>

SMTWTFS
1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31

Close Window

heredoc my $months = { '1' => $jan, '2' => $feb, '3' => $mar, '4' => $apr, '5' => $may, '6' => $jun, '7' => $jul, '8' => $aug, '9' => $sep, '10' => $oct, '11' => $nov, '12' => $dec, }; return( $months->{ $current_month } ); } ########################################################### # This section is for more detailed documentation. ########################################################### __END__ =head1 NAME calendar.pl =head1 DESCRIPTION This program displays a calendar that allows a user to select a date. The selected date is written to a session cookie where other programs can access it. The date is in the format: yyyy-mm-dd. The program should be launched within a javascript pop-up window. It should be called with the query string parameters: calendar.pl?dtype=begin&appID=onlineCatalog. The dtype parameter should be 'begin' or 'end' depending on whether it's a beginning date to a range or the end date. The appID param can be any alpha-numeric string identifying the application that will read the cookie. This parameter allows more than one application to use the program during a browser session. If you find this program useful please send me an email at anguyen@cpan.org. I answer tech support questions at this address as well. =head1 README A little calendar that allows users to select a date. Run it in a pop-up window. Writes the date selected to a session cookie for any application to read. Works on Unix and Windows. =pod OSNAMES Unix and Windows =pod SCRIPT CATEGORIES CGI =cut