#!/usr/bin/perl my $rcsid = '$Id: htmlcal,v 1.5 2004/03/25 22:07:58 vogelke Exp $'; =head1 NAME htmlcal =head1 SYNOPSIS htmlcal [-tv] [-hx,y...] [month [year]] =head1 DESCRIPTION Print an HTML calendar for a given month and year. The month ranges from 1-12, and the year is 1970 or greater. Both month and year default to the current date. A stylesheet is included to make it easier to highlight given days or tailor other parts of the display. Change to alter display of ------------------------------------------------------------ th.c1 month and year th.c2 days of the week td.c1 regular days td.c2 days which should be emphasized =head1 OPTIONS -hx,y... highlight days x,y... -t prints the table without stylesheet or tag. -v prints the version and exits. =head1 EXAMPLES htmlcal 4 2004 prints calendar for April 2004 htmlcal -h5,8,15-17 6 2005 prints calendar for June 2005, highlighting the 5th, 8th, 15th, 16th, and 17th. =head1 AUTHOR Karl Vogel Sumaria Systems, Inc. =cut # To generate manpage: # pod2man -c 'User docs' -r "`date`" -d version htmlcal use strict; use warnings; use POSIX; use File::Basename; use subs qw/usage validmonth validyear version/; $ENV{"PATH"} = "/bin:/usr/bin:/usr/local/bin"; my $myname = basename ($0, ".pl"); my ($emptycell); # HTML for empty table cell. my ($endrow); # either '' or blank. my ($class); # "c1" for non-highlighted day, "c2" otherwise. my ($curmon); # current month, default if not entered. my ($curyr); # current year, default if not entered. my ($dow); # day of the week (1-7). my ($fullday); # seconds per day. my ($k); # loop. my ($mon); # month we're interested in. my ($newmon); # check if we run past the end of the month. my ($startrow); # shorthand for ''. my ($time_t); # time as we walk through the month. my ($yr); # year we're interested in. my (@months); # month names. my (%hi) = (); # dates to highlight. # constants. my $sunday = 0; my $saturday = 6; @months = qw/January February March April May June July August September October November December/; # # Get current month and year. # ($curmon, $curyr) = (localtime (time))[4,5]; $curmon++; $curyr += 1900; # # Get desired month and year from optional arguments. # my $style = 1; $mon = ''; $yr = ''; ARG: while (@ARGV) { $_ = shift @ARGV; next ARG unless length; # Highlight certain dates. Numeric range code taken from # http://sial.org/code/perl/scripts/ssn_lookup.pl /^-h/ and do { s/^-h//; length || usage "-h needs some numbers"; s/[^0-9,-]//; # sanitize # loop over , groups, if any... for my $group (split ',', $_) { # pull apart hyphened ranges my ($min, $max) = split '-', $group; # see whether a range to deal with exists... if (defined $max) { for my $n ($min .. $max) { $hi{$n} = 1; } } else { $hi{$min} = 1; } } next ARG; }; # Skip stylesheet? /^-t/ and do { $style = 0; next ARG; }; /^-v/ and do { my $vers = version(); warn "$vers\n"; exit (0); }; /^-.*/ and do { usage ("unrecognized option: [$_]"); }; if (length ($mon) == 0) { $mon = "$_"; } elsif (length ($yr) == 0) { $yr = "$_"; } else { usage ("extra arg: [$_]"); } } $mon = $curmon unless length ($mon); $yr = $curyr unless length ($yr); validmonth($mon) || die "$mon: not a valid month\n"; validyear($yr) || die "$yr: not a valid year\n"; # # Move to the first of that month at 12:01 pm, # and get that day of the week: # mktime(sec, min, hour, mday, mon, year) # $time_t = POSIX::mktime( 0, 1, 12, 1, $mon-1, $yr-1900 ); defined ($time_t) or die "mktime failed, month=[$mon], yr=[$yr]: $!\n"; $dow = (localtime ($time_t))[6]; # # Print the stylesheet if desired. # print <<"StyleSheet" if $style; $months[$mon-1] $yr StyleSheet print <<"CalStart"; CalStart # # If the first of the month doesn't fall on a Sunday, we # print blank table cells up to but not including the first. # $emptycell = ' '; if ($dow > 0) { for ($k = 0; $k < $dow; $k++) { print "$emptycell\n"; } } # # We've printed everything up to but not including the # first of the month. Print to the last day of the month. # $fullday = 86400; $k = 1; $startrow = ' '; $endrow = ' '; while (1) { # Write current day with appropriate shading. $class = (defined $hi{$k}) ? "c2" : "c1"; print " \n"; if ($dow == $saturday) { print "$endrow\n"; $endrow = ''; } # Increment time, get new day of the week and month. $time_t += $fullday; ($newmon, $dow) = (localtime ($time_t))[4,6]; $newmon++; # If new month is not current month, we don't have # to print any more days. last if $newmon != $mon; # If we get this far and it's Sunday, start a new row. # We'll need to write one or more blank cells to # fill out this row. if ($dow == $sunday) { print "$startrow\n"; $endrow = ' '; } $k++; } # # Do we have to fill out a row with blank cells? # if (length ($endrow)) { print "$emptycell\n" while $dow++ <= $saturday; print "$endrow\n"; } # # Cleanup. # print "
$months[$mon-1] $yr
Su Mo Tu We Th Fr Sa
 
$k

\n"; print "\n\n" if $style; exit (0); #--------------------------------------------------------------------- # Check for valid month or year. # sub validmonth { my ($m) = @_; return ($m >= 1 && $m <= 12) ? 1 : 0 } sub validyear { my ($y) = @_; return ($y >= 1970) ? 1 : 0 } #--------------------------------------------------------------------- # Print a usage message from the comment header and exit. sub usage { my ($emsg) = @_; require Pod::Text; import Pod::Text; my $formatter = 'Pod::Text'; my $parser = $formatter->new (); warn "$emsg\n"; $parser->parse_from_file ($0); exit (1); } #--------------------------------------------------------------------- # Return the current version. sub version { $_ = $rcsid; s/,v / /; @_ = split; return "$_[1] v$_[2] $_[3] $_[4]"; }