1 package HTML::CalendarMonth::DateTool;
3 $HTML::CalendarMonth::DateTool::VERSION = '1.26';
6 # Base class for determining what date calculation package to use.
12 use File::Which qw( which );
15 'Time::Local' => 'TimeLocal',
16 'Date::Calc' => 'DateCalc',
17 'DateTime' => 'DateTime',
18 'Date::Manip' => 'DateManip',
24 $Classmap{lc $Toolmap{$_}} = $_ foreach keys %Toolmap;
26 my($Cal_Cmd, $Ncal_Cmd);
31 my $tool = $Toolmap{$str};
33 foreach (values %Toolmap) {
34 if ($str =~ /^$_$/i) {
41 join('::', __PACKAGE__, $tool);
49 $self->{year} = $parms{year};
50 $self->{month} = $parms{month};
51 $self->{weeknum} = $parms{weeknum};
52 $self->{historic} = $parms{historic};
53 if (! $self->{year}) {
54 my @dmy = $self->_dmy_now;
55 $self->{year} = $dmy[2];
56 $self->{month} ||= $dmy[1];
59 if ($parms{datetool}) {
60 $self->{datetool} = $self->_toolmap($parms{datetool})
61 or croak "Sorry, didn't find a tool for datetool '$parms{datetool}'\n";
63 my $dc = $self->_summon_date_class;
64 unless (eval "require $dc") {
65 croak "Problem loading $dc ($@)\n";
67 # rebless into new class
71 sub year { shift->{year} }
72 sub month { shift->{month} }
73 sub weeknum { shift->{weeknum} }
74 sub historic { shift->{historic} }
75 sub datetool { shift->{datetool} }
79 $class = ref $class || $class;
80 lc((split(/::/, $class))[-1]);
85 if (! defined $Cal_Cmd) {
86 $Cal_Cmd = which('cal') || '';
88 my @out = grep { ! /^\s*$/ } `$Cal_Cmd 9 1752`;
96 qr/^\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s*$/,
97 qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/,
98 qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/,
99 qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/,
102 for my $i (0 .. $#out) {
103 if ($out[$i] !~ $pat[$i]) {
119 if (! defined $Ncal_Cmd) {
120 $Ncal_Cmd = which('ncal') || '';
122 my @out = grep { ! /^\s*$/ } map { s/^\s*//; $_ } `$Ncal_Cmd 9 1752`;
133 qr/^\s*\S+\s+\d+\s+\d+\s*$/,
134 qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/,
135 qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/,
136 qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/,
137 qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/,
138 qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/,
139 qr/^\s*\S+\s+\d+\s+\d+\s*$/,
142 for my $i (0 .. $#out) {
143 if ($out[$i] !~ $pat[$i]) {
158 # in case our subclasses are lazy
159 my($self, $day, $month, $year) = @_;
160 $month ||= $self->month;
161 $year ||= $self->year;
162 Time::Local::timegm(0,0,0,1,$month,$year);
167 @_ ? $self->{skips} = shift : $self->{skips};
170 sub dow1st { (shift->dow1st_and_lastday)[0] }
172 sub lastday { (shift->dow1st_and_lastday)[1] }
176 my $ts = @_ ? shift : time;
177 my($d, $m, $y) = (localtime($ts))[3,4,5];
184 my $ts = @_ ? shift : time;
186 if ($ts =~ /^\d+$/) {
187 if (length $ts <= 2) {
188 ($d, $m, $y) = ($ts, $self->month, $self->year);
189 croak "invalid day of month (1 .. " . $self->lastday . ") '$ts'"
190 unless $ts >= 1 && $ts <= $self->lastday;
193 ($d, $m, $y) = $self->_dmy_now($ts);
197 ($y, $m, $d) = $ts =~ m{^(\d+)/(\d\d)/(\d\d)$};
198 croak "invalid yyyy/mm/dd date string '$ts'" unless defined $d;
200 my($cy, $cm) = ($self->year, $self->month);
201 my $first = sprintf("%04d/%02d/%02d", $cy, $cm, 1);
202 my $last = sprintf("%04d/%02d/%02d", $cy, $cm, $self->lastday);
203 my $pivot = sprintf("%04d/%02d/%02d", $y, $m, $d);
204 return -1 if $pivot gt $last;
205 return 0 if $pivot lt $first;
209 sub _summon_date_class {
212 if (my $c = $self->datetool) {
214 die "invalid date tool $c : $@" if $@;
218 @tools = qw( timelocal datecalc datetime datemanip ncal cal );
221 for my $tool (@tools) {
222 my $method = join('_', '', lc($tool), 'fails');
223 if (my $f = $self->$method) {
224 push(@fails, [$tool, $f]);
227 $dc = $self->_toolmap($tool);
233 croak "invalid date tool " . join(': ', @{$fails[0]});
237 "no valid date tool found:",
238 map(sprintf("%11s: %s", @$_), @fails),
246 print "Time::Local : ", $self->_timelocal_fails || 1, "\n";
247 print " Date::Calc : ", $self->_datecalc_fails || 1, "\n";
248 print " DateTime : ", $self->_datetime_fails || 1, "\n";
249 print "Date::Manip : ", $self->_datemanip_fails || 1, "\n";
250 print " ncal : ", $self->_ncal_fails || 1, "\n";
251 print " cal : ", $self->_cal_fails || 1, "\n";
257 $y < 1752 || ($y == 1752 && $self->month <= 9);
260 sub _timelocal_fails {
262 return "not installed" unless $self->_timelocal_present;
263 return "week-of-year numbering unsupported" if $self->weeknum;
265 return "only years between 1970 and 2038 supported"
266 if $y < 1970 || $y >= 2038;
272 return "command not found" unless $self->_ncal_present;
273 return "week-of-year numbering not supported prior to 1752/09"
274 if $self->weeknum && $self->_is_julian;
280 return "command not found" unless $self->_cal_present;
281 return "week-of-year numbering not supported" if $self->weeknum;
285 sub _datecalc_fails {
287 return "not installed" unless $self->_datecalc_present;
288 return "historic mode prior to 1752/09 not supported"
289 if $self->historic && $self->_is_julian;
293 sub _datetime_fails {
295 return "not installed" unless $self->_datetime_present;
296 return "historic mode prior to 1752/09 not supported"
297 if $self->historic && $self->_is_julian;
301 sub _datemanip_fails {
303 return "not installed" unless $self->_datemanip_present;
304 return "historic mode prior to 1752/09 not supported"
305 if $self->historic && $self->_is_julian;
306 eval { require Date::Manip && Date::Manip::Date_Init() };
307 return "init failure: $@" if $@;
311 sub _timelocal_present { eval "require Time::Local"; return !$@ }
312 sub _datecalc_present { eval "require Date::Calc"; return !$@ }
313 sub _datetime_present { eval "require DateTime"; return !$@ }
314 sub _datemanip_present { eval "require Date::Manip"; return !$@ }
315 sub _ncal_present { shift->_ncal_cmd }
316 sub _cal_present { shift->_cal_cmd };
325 HTML::CalendarMonth::DateTool - Base class for determining which date package to use for calendrical calculations.
329 my $date_tool = HTML::CalendarMonth::DateTool->new(
331 month => $one_thru_12_month,
332 weeknum => $weeknum_mode,
333 historic => $historic_mode,
334 datetool => $specific_datetool_if_desired,
339 This module attempts to utilize the best date calculation package
340 available on the current system. For most contemporary dates this
341 usually ends up being the internal Time::Local package of perl. For more
342 exotic dates, or when week number of the years are desired, other
343 methods are attempted including DateTime, Date::Calc, Date::Manip, and
344 the linux/unix 'ncal' or 'cal' commands. Each of these has a specific
345 subclass of this module offering the same utility methods needed by
354 Constructor. Takes the following parameters:
360 Year of calendar in question (required). If you are rendering exotic
361 dates (i.e. dates outside of 1970 to 2038) then something besides
362 Time::Local will be used for calendrical calculations.
366 Month of calendar in question (required). 1 through 12.
370 Optional. When specified, will limit class excursions to those that are
371 currently set up for week of year calculations.
375 Optional. If the the ncal or cal commands are available, use one of them
376 rather than other available date modules since these utilities
377 accurately handle some specific historical artifacts such as the
378 transition from Julian to Gregorian.
382 Optional. Mostly for debugging, this option can be used to indicate a
383 specific HTML::CalendarMonth::DateTool subclass for instantiation. The
384 value can be either the actual utility class, e.g., Date::Calc, or the
385 name of the CalendarMonth handler leaf class, e.g. DateCalc. Use 'ncal'
386 or 'cal', respectively, for the wrappers around those commands.
392 There are number of methods automatically available:
406 Accessors for the parameters provided to C<new()> above.
410 Returns the day of week number for the 1st of the C<year> and C<month>
411 specified during the call to C<new()>. Relies on the presence of
412 C<dow1st_and_lastday()>. Should be 0..6 starting with Sun.
416 Returns the last day of the month for the C<year> and C<month> specified
417 during the call to C<new()>. Relies on the presence of
418 C<dow1st_and_lastday()>.
422 =head1 Overridden methods
424 Subclasses of this module must provide at least the C<day_epoch()> and
425 C<dow1st_and_lastday()> methods.
429 =item dow1st_and_lastday()
431 Required. Provides a list containing the day of the week of the first
432 day of the month (0..6 starting with Sun) along with the last day of
437 Optional unless interested in epoch values for wacky dates. For a given
438 day, and optionally C<month> and C<year> if they are different from
439 those specified in C<new()>, provide the unix epoch in seconds for that
444 If the subclass is expected to provide week of year numbers, three more
445 methods are necessary:
451 For a given day, and optionally C<month> and C<year> if they are
452 different from those specified in C<new()>, provide the day of week
454 number. (1=Sunday, 7=Saturday).
456 number. (0=Sunday, 6=Saturday).
457 >>>>>>> upstream/2.04
459 =item add_days($days, $delta, $day, [$month], [$year])
461 For a given day, and optionally C<month> and C<year> if they are
462 different from those specified in C<new()>, provide a list of year,
463 month, and day once C<delta> days have been added.
465 =item week_of_year($day, [$month], [$year])
467 For a given day, and optionally C<month> and C<year> if they are
468 different from those specified in C<new()>, provide a list with the week
469 number of the year along with the year. (some days of a particular year
470 can end up belonging to the prior or following years).
476 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
480 Copyright (c) 2010 Matthew P. Sisk. All rights reserved. All wrongs
481 revenged. This program is free software; you can redistribute it and/or
482 modify it under the same terms as Perl itself.
486 HTML::CalendarMonth(3), Time::Local(3), DateTime(3), Date::Calc(3),
487 Date::Manip(3), cal(1)