package Date::Calendar;
require 5.002;
# COMMENT OUT THIS LINE IF YOU ARE NOT USING THE SELF LOADER.
# ALSO COMMENT OUT THE LINE BEGINNING WITH __DATA__ A BIT FURTHER DOWN
#use SelfLoader;
use Date::Calc qw(Day_of_Week Days_in_Month Month_to_Text Day_of_Week_to_Text);
# See the bottom of this file for the POD documentation. Search for the
# string '=head'.
# You can run this file through either pod2man or pod2html to produce pretty
# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).
# Copyright (c) 1997-1998 Matthew Darwin. All rights reserved. This program is
# free software; you can redistribute it and/or modify it under the same
# terms as Perl itself.
# The most recent version and complete documentation are available at:
# http://www.davin.ottawa.on.ca/~matthew/perl/
$VERSION='0.04';
# ---------------------------------------------------------------------------
# START OF THE LIBRARY
sub new {
my ($class) = @_;
my $self = {};
bless $self, $class;
$self->initialize;
return $self;
}
# We provide a DESTROY method that does nothing so that the
# autoloader doesn't bother searching for one if it isn't defined
sub DESTROY {}
# Initialize the receiver
sub initialize {
my ($self) = @_;
%{$self->{'data'}} = ();
$self->attributes_cal1;
return 1
}
# COMMENT OUT THIS LINE IF YOU ARE NOT USING THE SELF LOADER
#__DATA__
# Everything below here is autoloaded
sub attributes {
my ($self) = shift;
my %params = @_;
my ($key, $key1);
foreach $key (keys %params) {
$key1 = $key;
$key1 =~ s/^-//g;
$self->{$key1} = $params{$key};
}
# common speling in Canada/UK:
(defined ($params{'-title_centre'}))
&& ($self->{'title_center'} = $params{'-title_centre'});
}
sub data {
my ($self) = shift;
my ($yyyy, $mm, $dd, $what) = @_;
${$self->{'data'}}{$yyyy}{$mm}{$dd} = $what;
1;
}
# null attributes
sub attributes_null {
my ($self) = shift;
$self->attributes (
-month_header => '',
-title_start => '',
-title_end => '',
-title_center => 0,
-row_start => '',
-row_end => '',
-space_start => '',
-space_char => '',
-space_end => '',
-highlight_start => '',
-highlight_end => '',
-digit_start => '',
-digit_end => '',
-dow_start => '',
-dow_end => '',
-dow_length => 99,
-month_footer => '',
-data_use => 0,
-data_start => '',
-data_end => '',
-data_null => '',
-data_place => 0
);
return 1;
}
# attributes to look like the cal(1) command
sub attributes_cal1 {
my ($self) = shift;
$self->attributes (
-month_header => '',
-title_start => '',
-title_end => "\n",
-title_center => 1,
-row_start => '',
-row_end => "\n",
-space_start => '',
-space_char => ' ',
-space_end => ' ',
-highlight_start => '',
-highlight_end => ' ',
-digit_start => '',
-digit_end => ' ',
-dow_start => '',
-dow_end => ' ',
-dow_length => 2,
-month_footer => "\n",
-data_use => 0,
-data_start => '',
-data_end => '',
-data_null => '',
-data_place => 0
);
return 1;
}
# an example layout (used for testing)
sub attributes_ex1 {
my ($self) = shift;
$self->attributes (
-month_header => '-' x 40 . "\n",
-title_start => '-> > > > >',
-title_end => "< < < < <-\n",
-title_center => 1,
-title_text => "(ex)",
-row_start => '-> ',
-row_end => "<-\n",
-space_start => '[',
-space_char => 'XX',
-space_end => '] ',
-highlight_start => '<',
-highlight_end => '> ',
-digit_start => '[',
-digit_end => '] ',
-dow_start => ' ',
-dow_end => ' ',
-dow_length => 3,
-month_footer => '-' x 40 . "\n\n",
-data_use => 1,
-data_start => '<*',
-data_end => '*>',
-data_null => 'X',
-data_place => 1
);
return 1;
}
sub attributes_html_table {
my ($self) = shift;
$self->attributes (
-month_header => "\n",
-title_start => '| ',
-title_end => " |
\n",
-title_center => 0,
-title_text => undef,
-row_start => ' ',
-row_end => "
\n",
-space_start => ' ',
-space_char => '',
-space_end => ' | ',
-highlight_start => ' ',
-highlight_end => ' | ',
-digit_start => ' ',
-digit_end => ' | ',
-dow_start => ' ',
-dow_end => ' | ',
-dow_length => 3,
-month_footer => "
\n",
-data_use => 0,
-data_start => '',
-data_end => '',
-data_null => '',
-data_place => 1
);
return 1;
}
sub print_month_current {
my ($self) = @_;
my ($yy, $mm, $dd) = (localtime(time))[5,4,3];
$mm++;
$yy+=1900;
$self->print_month ($yy, $mm, $dd);
}
sub print_month {
my ($self, $yy, $mm, $dd) = @_;
my ($weekday, $days, $day);
$weekday = Day_of_Week ($yy, $mm, 1);
($weekday = 0) if ($weekday == 7);
$days = Days_in_Month ($yy, $mm);
$day = 1;
print $self->{'month_header'};
$self->print_month_title (Month_to_Text ($mm), $yy, undef);
$self->print_dows;
(print $self->{'row_start'}) if ($weekday != 0);
$self->print_spacer ($weekday);
while ($day < ($days + 1)) {
(print $self->{'row_start'}) if ($weekday == 0);
if ($day == $dd) {
$self->print_highlight_day ($yy, $mm, $day);
} else {
$self->print_day ($yy, $mm, $day);
}
$day++;
(print $self->{'row_end'}) if ($weekday == 6);
$weekday = ($weekday + 1) % 7;
}
if ($weekday != 0) {
$self->print_spacer (7 - $weekday);
print $self->{'row_end'};
}
print $self->{'month_footer'};
}
# ---------------------------------------------------------------------------
# PRIVATE subroutines
sub print_dows {
my ($self) = @_;
my ($i, $name);
print $self->{'row_start'};
for $i (7, 1, 2, 3, 4, 5, 6) {
$name = Day_of_Week_to_Text ($i);
print $self->{'dow_start'},
substr($name,0,$self->{'dow_length'}),
$self->{'dow_end'};
}
print $self->{'row_end'};
}
sub print_day {
my ($self, $yy, $mm, $dd) = @_;
print $self->{'digit_start'};
$self->print_X_day ($yy, $mm, $dd);
print $self->{'digit_end'};
}
sub print_highlight_day {
my ($self, $yy, $mm, $dd) = @_;
print $self->{'highlight_start'};
$self->print_X_day ($yy, $mm, $dd);
print $self->{'highlight_end'};
}
sub print_X_day {
my ($self, $yy, $mm, $dd) = @_;
my ($data) = ${$self->{'data'}}{$yy}{$mm}{$dd};
# if we don't have data, but the start/end borders should be printed,
# then I'll throw in the null data
if ((! defined ($data)) && ($self->{'data_use'} == 2)) {
$data = $self->{'data_null'}
}
if (($self->{'data_use'} == 1) || ((defined $data) && ($self->{'data_use'} == 2))) {
if ($self->{'data_place'} == 1) {
print sprintf ("%2d", $dd);
}
if (($self->{'data_use'} == 2) || (defined $data)) {
print $self->{'data_start'};
}
if (defined $data) {
print $data;
} else {
if ($self->{'data_use'} == 2) {
print $self->{'data_null'}
}
}
if (($self->{'data_use'} == 2) || (defined $data)) {
print $self->{'data_end'};
}
if ($self->{'data_place'} == 0) {
print sprintf ("%2d", $dd);
}
} else {
print sprintf ("%2d", $dd)
}
}
sub print_spacer {
my ($self, $number) = @_;
my ($i);
for ($i = 0; $i < $number; $i++) {
print $self->{'space_start'}, $self->{'space_char'}, $self->{'space_end'};
}
}
sub print_month_title {
my ($self, $month, $year) = @_;
my ($string, $length, $space_l, $space_r);
if (defined ($self->{'title_text'})) {
$string = "$month $year $self->{'title_text'}";
} else {
$string = "$month $year";
}
if ($self->{'title_center'} == 1) {
# ok, now we need to figure out how many spaces to print
$length = length ($self->{'row_start'})
+ length ($self->{'row_end'})
+ ( 7 * length ($self->{'dow_start'}))
+ ( 7 * length ($self->{'dow_end'}))
+ ( 7 * $self->{'dow_length'})
- length ($self->{'title_start'})
- length ($self->{'title_end'});
$space_l = ($length / 2) - (int (length ($string)) / 2);
$space_r = $length - $space_l - (length ($string));
((int (length ($string) / 2 ) * 2) == length ($string)) || $space_r++;
print $self->{'title_start'}, " " x $space_l, $string, " " x $space_r, $self->{'title_end'}
} else {
print $self->{'title_start'}, $string, $self->{'title_end'};
}
return 1;
}
__END__
=head1 NAME
Date::Calendar - A calendar display module.
=head1 ABSTRACT
This perl library uses perl5 objects to make it easy to create a
simple calendar in plain text or HTML.
The current version of Date::Calendar is available at
http://www.davin.ottawa.on.ca/~matthew/perl/
=head1 INSTALLATION
To install this package, just change to the directory in which this
file is found and type the following:
perl Makefile.PL
make
make install
This will copy the libary to your perl library directory for use by all
perl scripts. You probably must be root to do this. Now you can
load the routines in your Perl scripts with the line:
use Date::Calendar;
If you don't have sufficient privileges to install this library in the
Perl library directory, you can put it into some convenient spot, such as
your home directory and prefix all Perl scripts that call it with
something along the lines of the following preamble:
use lib "$ENV{'HOME'}/lib";
use Date::Calendar;
=head1 SYNOPSIS
use Date::Calendar;
$calendar = new Date::Calendar;
# set attributes
$calendar->attributes ( -param => value, ...);
# use the pre-made calendar attributes
$calendar->attributes_ex1;
$calendar->attributes_cal1;
$calendar->attributes_html_table;
# print the result
$calendar->print_month_current;
$calendar->print_month ($yy, $mm, $dd);
=head1 DESCRIPTION
=head2 Creating a new object
$calendar = new Date::Calendar
This will create a new calendar object. The default attribute settings
are the make the calendar prinout look like L.
=head2 Setting attributes
$calendar->attributes ( -param => value, ...);
This will allow you to set the attributes of the display. Valid
attributes are described below.
There are also some pre-made selections of attributes:
$calendar->attributes_cal1;
This is a set of attributes which will make the output look like that
of L. It is also currently the default set of attributes,
although this should not be depended on as the default may change in
later revisions.
$calendar->attributes_html_table;
This is a set of attributes which will make the output print well in
a table compliant web browser. It also works in the Lynx text browser.
$calendar->attributes_ex1;
This is an example attribute setup. It is meant for testing purposes.
$calendar->attributes_null;
This is an empty set of attributes. It is meant to reset things to
default, so you can build your own definitions without needing to specify
all the values. This may become the default at some point.
If you have created a set of attributes which you feel are particularly
clever, feel free to send them to the author so that they may be included
in later revisions of the Date::Calendar module.
=head2 Printing output
There are currently two methods to print the output:
$calendar->print_month_current;
$calendar->print_month ($yy, $mm, $dd);
The first, prints a calendar of the current month. The later prints a
calendar of the month specified. $yy is the 4 digit year. $mm is the 2
digit month, from 1 to 12. $dd is the day of the month. The day specified
by $dd is highlighted.
=head1 ATTRIBUTES
The following attributes are defined:
=over 4
=item -month_header
printed before the calendar
=item -title_start
printed before the month title
=item -title_end
printed after the month title
=item -title_center
determines if title should be centered using spaces (0 = no, 1 = yes)
=item -row_start
printed before every row in the calendar (excluding title)
=item -row_end
printed at the end of every row in the calendar (excuding title)
=item -space_start
printed before a blank
=item -space_char
blank character to print
=item -space_end
printed after a blank
=item -highlight_start
printed before current day
=item -highlight_end
printed after current day
=item -digit_start
printed before each digit
=item -digit_end
printed after each digit
=item -dow_start
printed before each day of the week
=item -dow_end
printed after each day of the week
=item -dow_length
number of letters of the day of the week to print
=item -month_footer
printed after the calendar
=item -data_use
determines if data associated with each date should be printed (0 = no,
1 = yes/don't print nulls, 2 = yes/print nulls)
=item -data_null
data printed if no data associcated with date
=item -data_start
printed before data item
=item -data_end
printed after data item
=item -data_place
determines where data item should be placed (0 = before, 1 = after)
=back
In addition, subclasses may define their own attributes.
=head1 EXAMPLE
This simple piece of code will create a calendar for the current
month.
use Date::Calendar;
$calendar = new Date::Calendar;
$calendar->attributes_cal1;
$calendar->print_month_current;
For an example of an HTML calendar, see
http://www.davin.ottawa.on.ca/site/calendar.phtml.
=head1 BUGS
Probably.
=head1 AUTHOR
Matthew Darwin
=head1 SEE ALSO
L
L
L
=cut