#!/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";
$months[$mon-1] $yr
|
Su |
Mo |
Tu |
We |
Th |
Fr |
Sa |
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 " $k | \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 "
\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]";
}