#!/usr/bin/perl -w # Perl Calendar # Terrence Ma # Modified from ftls.org (http://www.ftls.org/en/examples/cgi/Calendar.shtml) # 07/20/2000 ###################################################################### # Basic Calendar Version 1.01 # # Copyright 1999 Frederic TYNDIUK (FTLS) All Rights Reserved. # # E-Mail: tyndiuk@ftls.org Script License: GPL # # Created 05/30/99 Last Modified 07/15/99 # # Scripts Archive at: http://www.ftls.org/cgi/ # ###################################################################### # Function : # # calentar.cgi : print calendar of current month... # # calendar.cgi?MM-YYYY : print calendar of the MM-YYYY (01-2000) # # (Changed to calendar.cgi?month=MM&year=YYYY) # # You can use this Script as SSI (Server Side Include) or Not, whith # # $SSI var. # # Your can chose size of tabe border with $Border = Size # ###################################################################### ##################### license & copyright header ##################### # # # Copyright (c) 1999 TYNDIUK Frederic # # # # This program is free software; you can redistribute it and/or # # modify it under the terms of the GNU General Public License as # # published by the Free Software Foundation; either version 2 of # # the License, or (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program in the file 'COPYING'; if not, write to # # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, # # Boston, MA 02111-1307, USA, or contact the author: # # # # TYNDIUK Frederic # # # # # ################### end license & copyright header ################### use 5; use strict; use CGI; my $cgi = new CGI; my ($CalCMD, $SSI, $Border, $Days, $Query_String, @date, $Today, $yearcount); ###################################################################### # Necessary Variables: # # The following variables should be set to define the locations # # and URLs of various files, as explained in the documentation. # $CalCMD = "/usr/bin/cal"; # En: PATH of cal. # Fr: Chemin de cal. $SSI = 0; # 0 NO SSI (print ...) # 1 SSI (En: print only Calandar / Fr: N'affiche que le calendrier) $Border = 1; # En: Size of table Border. # Fr: Taille des Tables. $Days = "Su Mo Tu We Th Fr Sa"; # En: Days #$Days = "Di Lu Ma Me Je Ve Sa"; # Fr: Jours en Francais # Nothing Below this line needs to be altered! # ###################################################################### # $Query_String = $ENV{QUERY_STRING}; # $Query_String =~ s/%([0-9A-F][0-9A-F])/pack("C",oct("0x$1"))/ge; # $Query_String =~ tr/+/ /; # # print "Content-type: text/html\n\n"; # if (! $SSI) { print "Calendar

Calendar

\n"; } # print &RetCal($CalCMD, $Query_String, $Border); # if (! $SSI) { print ""; } if ($cgi->param()) { my $month = $cgi->param("month"); my $year = $cgi->param("year"); $Query_String = $month . "-" . $year; } else { $Query_String = ""; }; if (!$SSI) { print("Content-Type: text/html\n\n"); print("\n"); print("Perl Calendar\n"); print("\n\n"); print("

Perl Calendar


\n"); print("
\n\n"); } print &RetCal($CalCMD, $Query_String, $Border); if (!$SSI) { print("
\n\n"); print('
'); print("\n\n"); print("Month : \n"); print('\n"); print(" \n\n"); print("Year : \n"); print('\n"); print(" \n\n"); print(''); print("\n"); print("
\n\n"); print("
\n\n"); print("
\n"); print(''); print("Program Source
\n"); print("\n"); } # En: Sub routine return calendar. # Fr: Sous-routine retournant le calendrier. sub RetCal { my($CalCMD, $Args, $Border) = @_; my($ret, @Result, $Month, $dy, $line, $no); if ( -x "$CalCMD" ) { if (($Args !~ /^\d\d?-\d\d\d\d$/) || ($Args eq "")) { $Args = ""; @date = localtime(time); $Today = $date[3]; } else { $Args =~ s/-/ /g; $Today = "0"; } open(CAL, "$CalCMD $Args|"); @Result = ; close(CAL); $Month = $Result[0]; shift(@Result); $Month =~ s/\s\s\s*//g; $ret = "\n"; $ret .= "\n"; $ret .= ""; shift(@Result); foreach $dy (split(/ /, $Days)) { $ret .= ""; } $ret .= "\n"; foreach $line (@Result) { $line =~ s/\n//; $line =~ s/ /ccs/g; $line =~ s/ /sc/g; $line =~ s/ /s/g; $line =~ s/^s//g; $line =~ s/ss/s/g; $line =~ s/c//g; $ret .= ""; foreach $no (split(/s/, $line)) { if ($no eq $Today) { $ret .= ""; } else { $ret .= ""; } } $ret .= "\n"; } $ret .= "
\n"; $ret .= ""; $ret .= "$Month
$dy
$no$no
\n"; } else { $ret = "Cannot find Unix command 'cal' on this system. Sorry !"; } return $ret; }