lib/HTML/CalendarMonth/DateTool.pm

   1 package HTML::CalendarMonth::DateTool;
   2
   3 # Base class for determining what date calculation package to use.
   4
   5 use strict;
   6 use Carp;
   7
   8 use vars qw($VERSION);
   9 $VERSION = '0.01';
  10
  11 my $DEBUG = 0;
  12
  13 my %Toolmap = (
  14   'Time::Local' => 'TimeLocal',
  15   'Date::Calc'  => 'DateCalc',
  16   'DateTime'    => 'DateTime',
  17   'Date::Manip' => 'DateManip',
  18   'cal'         => 'Cal',
  19 );
  20
  21 sub toolmap {
  22   shift;
  23   my $str = shift;
  24   my $tool = $Toolmap{$str};
  25   unless ($tool) {
  26     foreach (values %Toolmap) {
  27       if ($str =~ /^$_$/i) {
  28         $tool = $_;
  29         last;
  30       }
  31     }
  32   }
  33   return undef unless $tool;
  34   join('::', __PACKAGE__, $tool);
  35 }
  36
  37 sub new {
  38   my $class = shift;
  39   my $self = {};
  40   bless $self, $class;
  41   my %parms = @_;
  42   $self->{year}     = $parms{year}  or croak "missing year (YYYY)\n";
  43   $self->{month}    = $parms{month} or croak "missing month num (1-12)\n";
  44   $self->{weeknum}  = $parms{weeknum};
  45   $self->{historic} = $parms{historic};
  46   if ($parms{datetool}) {
  47     $self->{datetool} = $self->toolmap($parms{datetool})
  48       or croak "Sorry, didn't find a tool for datetool '$parms{datetool}'\n";
  49   }
  50   my $dc = $self->_summon_date_class;
  51   unless (eval "require $dc") {
  52     croak "Problem loading $dc ($@)\n";
  53   }
  54   print STDERR "Using date class $dc\n" if $DEBUG;
  55   # rebless into new class
  56   bless $self, $dc;
  57 }
  58
  59 sub year     { shift->{year}     }
  60 sub month    { shift->{month}    }
  61 sub weeknum  { shift->{weeknum}  }
  62 sub historic { shift->{historic} }
  63 sub datetool { shift->{datetool} }
  64
  65 sub cal_cmd {
  66   my $self = shift;
  67   unless (exists $self->{cal_cmd}) {
  68     my $cal;
  69     foreach (qw(/usr/bin /bin /usr/local/bin)) {
  70       if (-x "$_/cal") {
  71         $cal = "$_/cal";
  72         last;
  73       }
  74     }
  75     $self->{cal_cmd} = $cal || undef;
  76   }
  77   $self->{cal_cmd};
  78 }
  79
  80 sub day_epoch {
  81   # in case our subclasses are lazy
  82   my($self, $day, $month, $year) = @_;
  83   $month ||= $self->month;
  84   $year  ||= $self->year;
  85   Time::Local::timegm(0,0,0,1,$month,$year);
  86 }
  87
  88 sub skips {
  89   my $self = shift;
  90   @_ ? $self->{skips} = shift : $self->{skips};
  91 }
  92
  93 sub dow1st  { (shift->dow1st_and_lastday)[0] }
  94
  95 sub lastday { (shift->dow1st_and_lastday)[1] }
  96
  97 sub _summon_date_class {
  98   my $self = shift;
  99   return $self->datetool if $self->datetool;
 100   my $dc;
 101   if ( $self->_test_for_timelocal ) {
 102     $dc = __PACKAGE__ . '::TimeLocal';
 103   }
 104   elsif ( $self->_test_for_cal ) {
 105     $dc = __PACKAGE__ . '::Cal';
 106   }
 107   elsif ( $self->_test_for_datecalc ) {
 108     $dc = __PACKAGE__ . '::DateCalc';
 109   }
 110   elsif ( $self->_test_for_datetime ) {
 111     $dc = __PACKAGE__ . '::DateTime';
 112   }
 113   elsif( $self->_test_for_datemanip ) {
 114     $dc = __PACKAGE__ . '::DateManip';
 115   }
 116   else {
 117     croak <<__NOTOOL;
 118 No valid date mechanism found. Install Date::Calc, DateTime, or
 119 Date::Manip, or try using a date between 1970 and 2038 so that
 120 Time::Local can be used.
 121 __NOTOOL
 122   }
 123   $dc;
 124 }
 125
 126 sub _dump_tests {
 127   my $self = shift;
 128   print "Time::Local : ", $self->_test_for_timelocal, "\n";
 129   print "        cal : ", $self->_test_for_cal, "\n";
 130   print " Date::Calc : ", $self->_test_for_datecalc, "\n";
 131   print "   DateTime : ", $self->_test_for_datetime, "\n";
 132   print "Date::Manip : ", $self->_test_for_datemanip, "\n";
 133 }
 134
 135 sub _test_for_timelocal {
 136   my $self = shift;
 137   my $year = $self->year;
 138   my $weeknum = $self->weeknum;
 139   !$weeknum && eval "require Time::Local" &&
 140     (!defined $year || (($year >= 1970) && ($year < 2038)));
 141 }
 142
 143 sub _test_for_cal {
 144   my $self = shift;
 145   my $weeknum = $self->weeknum;
 146   my $historic = $self->historic;
 147   my $cal = $self->cal_cmd;
 148   !$weeknum && $historic && $cal;
 149 }
 150
 151 sub _test_for_datecalc  { eval "require Date::Calc";  return !$@ }
 152
 153 sub _test_for_datetime  { eval "require DateTime";    return !$@ }
 154
 155 sub _test_for_datemanip { eval "require Date::Manip"; return !$@ }
 156
 157 1;
 158
 159 __END__
 160
 161 =head1 NAME
 162
 163 HTML::CalendarMonth::DateTool - Base class for determining which date package to use for calendrical calculations.
 164
 165 =head1 SYNOPSIS
 166
 167   my $date_tool = HTML::CalendarMonth::DateTool->new(
 168                     year     => $YYYY_year,
 169                     month    => $one_thru_12_month,
 170                     weeknum  => $weeknum_mode,
 171                     historic => $historic_mode,
 172                     datetool => $specific_datetool_if_desired,
 173                   );
 174
 175 =head1 DESCRIPTION
 176
 177 This module attempts to utilize the best date calculation package
 178 available on the current system. For most contemporary dates this
 179 usually ends up being the internal Time::Local package of perl. For more
 180 exotic dates, or when week number of the years are desired, other
 181 methods are attempted including DateTime, Date::Calc, Date::Manip, and
 182 the unix 'cal' command. Each of these has a specific subclass of this
 183 module offering the same utility methods needed by HTML::CalendarMonth.
 184
 185 =head1 METHODS
 186
 187 =over
 188
 189 =item new()
 190
 191 Constructor. Takes the following parameters:
 192
 193 =over
 194
 195 =item year
 196
 197 Year of calendar in question (required). If you are rendering exotic
 198 dates (i.e. dates outside of 1970 to 2038) then something besides
 199 Time::Local will be used for calendrical calculations.
 200
 201 =item month
 202
 203 Month of calendar in question (required). 1 through 12.
 204
 205 =item weeknum
 206
 207 Optional. When specified, will limit class excursions to those that are
 208 currently set up for week of year calculations.
 209
 210 =item historic
 211
 212 Optional. If the 'cal' command is available, use it rather than other available
 213 date modules since the 'cal' command accurately handles some specific
 214 historical artifacts such as the transition from Julian to Gregorian.
 215
 216 =item datetool
 217
 218 Optional. Mostly for debugging, this option can be used to indicate a
 219 specific HTML::CalendarMonth::DateTool subclass for instantiation. The
 220 value can be either the actual utility class, e.g., Date::Calc, or the
 221 name of the CalendarMonth handler leaf class, e.g. DateCalc. For the
 222 'cal' command, use 'cal'.
 223
 224 =back
 225
 226 =back
 227
 228 There are number of methods automatically available:
 229
 230 =over
 231
 232 =item month()
 233
 234 =item year()
 235
 236 =item weeknum()
 237
 238 =item historical()
 239
 240 =item datetool()
 241
 242 Accessors for the parameters provided to C<new()> above.
 243
 244 =item dow1st()
 245
 246 Returns the day of week number for the 1st of the C<year> and C<month>
 247 specified during the call to C<new()>. Relies on the presence of
 248 C<dow1st_and_lastday()>.
 249
 250 =item lastday()
 251
 252 Returns the last day of the month for the C<year> and C<month> specified
 253 during the call to C<new()>. Relies on the presence of
 254 C<dow1st_and_lastday()>.
 255
 256 =back
 257
 258 =head1 Overridden methods
 259
 260 Subclasses of this module must provide at least the C<day_epoch()> and
 261 C<dow1st_and_lastday()> methods.
 262
 263 =over
 264
 265 =item dow1st_and_lastday()
 266
 267 Required. Provides a list containing the day of the week of the first day of the
 268 month along with the last day of the month.
 269
 270 =item day_epoch()
 271
 272 Optional unless interested in epoch values for wacky dates. For a given
 273 day, and optionally C<month> and C<year> if they are different from
 274 those specified in C<new()>, provide the unix epoch in seconds for that
 275 day at midnight.
 276
 277 =back
 278
 279 If the subclass is expected to provide week of year numbers, three more
 280 methods are necessary:
 281
 282 =over
 283
 284 =item dow()
 285
 286 For a given day, and optionally C<month> and C<year> if they are
 287 different from those specified in C<new()>, provide the day of week
 288 number. (1=Sunday, 6=Saturday).
 289
 290 =item add_days($days, $delta, $day, [$month], [$year])
 291
 292 For a given day, and optionally C<month> and C<year> if they are
 293 different from those specified in C<new()>, provide a list of year,
 294 month, and day once C<delta> days have been added.
 295
 296 =item week_of_year($day, [$month], [$year])
 297
 298 For a given day, and optionally C<month> and C<year> if they are
 299 different from those specified in C<new()>, provide a list with the week
 300 number of the year along with the year. (some days of a particular year
 301 can end up belonging to the prior or following years).
 302
 303 =back
 304
 305 =head1 AUTHOR
 306
 307 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
 308
 309 =head1 COPYRIGHT
 310
 311 Copyright (c) 2005 Matthew P. Sisk. All rights reserved. All wrongs
 312 revenged. This program is free software; you can redistribute it and/or
 313 modify it under the same terms as Perl itself.
 314
 315 =head1 SEE ALSO
 316
 317 HTML::CalendarMonth(3), Time::Local(3), DateTime(3), Date::Calc(3),
 318 Date::Manip(3), cal(1)