X-Git-Url: https://git.donarmstrong.com/?p=deb_pkgs%2Flibhtml-calendarmonth-perl.git;a=blobdiff_plain;f=1.26%2Flib%2FHTML%2FCalendarMonth%2FDateTool.pm;fp=1.26%2Flib%2FHTML%2FCalendarMonth%2FDateTool.pm;h=0000000000000000000000000000000000000000;hp=0e752a3d5f9456c87045ba94b1f95d73ba68cf2a;hb=ed44be48bb467d82127717d1ae2d11890aaf329b;hpb=982e2bb08f00d800e2cd9fb65b108231719c8a65 diff --git a/1.26/lib/HTML/CalendarMonth/DateTool.pm b/1.26/lib/HTML/CalendarMonth/DateTool.pm deleted file mode 100644 index 0e752a3..0000000 --- a/1.26/lib/HTML/CalendarMonth/DateTool.pm +++ /dev/null @@ -1,483 +0,0 @@ -package HTML::CalendarMonth::DateTool; -{ - $HTML::CalendarMonth::DateTool::VERSION = '1.26'; -} - -# Base class for determining what date calculation package to use. - -use strict; -use warnings; -use Carp; - -use File::Which qw( which ); - -my %Toolmap = ( - 'Time::Local' => 'TimeLocal', - 'Date::Calc' => 'DateCalc', - 'DateTime' => 'DateTime', - 'Date::Manip' => 'DateManip', - 'ncal' => 'Ncal', - 'cal' => 'Cal', -); - -my %Classmap; -$Classmap{lc $Toolmap{$_}} = $_ foreach keys %Toolmap; - -my($Cal_Cmd, $Ncal_Cmd); - -sub _toolmap { - shift; - my $str = shift; - my $tool = $Toolmap{$str}; - unless ($tool) { - foreach (values %Toolmap) { - if ($str =~ /^$_$/i) { - $tool = $_; - last; - } - } - } - return unless $tool; - join('::', __PACKAGE__, $tool); -} - -sub new { - my $class = shift; - my $self = {}; - bless $self, $class; - my %parms = @_; - $self->{year} = $parms{year}; - $self->{month} = $parms{month}; - $self->{weeknum} = $parms{weeknum}; - $self->{historic} = $parms{historic}; - if (! $self->{year}) { - my @dmy = $self->_dmy_now; - $self->{year} = $dmy[2]; - $self->{month} ||= $dmy[1]; - } - $self->{month} ||= 1; - if ($parms{datetool}) { - $self->{datetool} = $self->_toolmap($parms{datetool}) - or croak "Sorry, didn't find a tool for datetool '$parms{datetool}'\n"; - } - my $dc = $self->_summon_date_class; - unless (eval "require $dc") { - croak "Problem loading $dc ($@)\n"; - } - # rebless into new class - bless $self, $dc; -} - -sub year { shift->{year} } -sub month { shift->{month} } -sub weeknum { shift->{weeknum} } -sub historic { shift->{historic} } -sub datetool { shift->{datetool} } - -sub _name { - my $class = shift; - $class = ref $class || $class; - lc((split(/::/, $class))[-1]); -} - -sub _cal_cmd { - my $self = shift; - if (! defined $Cal_Cmd) { - $Cal_Cmd = which('cal') || ''; - if ($Cal_Cmd) { - my @out = grep { ! /^\s*$/ } `$Cal_Cmd 9 1752`; - # September 1752 - #Su Mo Tu We Th Fr Sa - # 1 2 14 15 16 - #17 18 19 20 21 22 23 - #24 25 26 27 28 29 30 - my @pat = ( - qr/^\s*\S+\s+\d+$/, - qr/^\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s*$/, - qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s*$/, - ); - if (@out == @pat) { - for my $i (0 .. $#out) { - if ($out[$i] !~ $pat[$i]) { - $Cal_Cmd = ''; - last; - } - } - } - else { - $Cal_Cmd = ''; - } - } - } - $Cal_Cmd; -} - -sub _ncal_cmd { - my $self = shift; - if (! defined $Ncal_Cmd) { - $Ncal_Cmd = which('ncal') || ''; - if ($Ncal_Cmd) { - my @out = grep { ! /^\s*$/ } map { s/^\s*//; $_ } `$Ncal_Cmd 9 1752`; - # September 1752 - #Mo 18 25 - #Tu 1 19 26 - #We 2 20 27 - #Th 14 21 28 - #Fr 15 22 29 - #Sa 16 23 30 - #Su 17 24 - my @pat = ( - qr/^\s*\S+\s+\d+$/, - qr/^\s*\S+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s+\d+\s*$/, - qr/^\s*\S+\s+\d+\s+\d+\s*$/, - ); - if (@out == @pat) { - for my $i (0 .. $#out) { - if ($out[$i] !~ $pat[$i]) { - $Ncal_Cmd = ''; - last; - } - } - } - else { - $Ncal_Cmd = ''; - } - } - } - $Ncal_Cmd; -} - -sub day_epoch { - # in case our subclasses are lazy - my($self, $day, $month, $year) = @_; - $month ||= $self->month; - $year ||= $self->year; - Time::Local::timegm(0,0,0,1,$month,$year); -} - -sub _skips { - my $self = shift; - @_ ? $self->{skips} = shift : $self->{skips}; -} - -sub dow1st { (shift->dow1st_and_lastday)[0] } - -sub lastday { (shift->dow1st_and_lastday)[1] } - -sub _dmy_now { - my $self = shift; - my $ts = @_ ? shift : time; - my($d, $m, $y) = (localtime($ts))[3,4,5]; - ++$m; $y += 1900; - ($d, $m, $y); -} - -sub _dom_now { - my $self = shift; - my $ts = @_ ? shift : time; - my($d, $m, $y); - if ($ts =~ /^\d+$/) { - if (length $ts <= 2) { - ($d, $m, $y) = ($ts, $self->month, $self->year); - croak "invalid day of month (1 .. " . $self->lastday . ") '$ts'" - unless $ts >= 1 && $ts <= $self->lastday; - } - else { - ($d, $m, $y) = $self->_dmy_now($ts); - } - } - else { - ($y, $m, $d) = $ts =~ m{^(\d+)/(\d\d)/(\d\d)$}; - croak "invalid yyyy/mm/dd date string '$ts'" unless defined $d; - } - my($cy, $cm) = ($self->year, $self->month); - my $first = sprintf("%04d/%02d/%02d", $cy, $cm, 1); - my $last = sprintf("%04d/%02d/%02d", $cy, $cm, $self->lastday); - my $pivot = sprintf("%04d/%02d/%02d", $y, $m, $d); - return -1 if $pivot gt $last; - return 0 if $pivot lt $first; - $d; -} - -sub _summon_date_class { - my $self = shift; - my @tools; - if (my $c = $self->datetool) { - eval "use $c"; - die "invalid date tool $c : $@" if $@; - @tools = $c->_name; - } - else { - @tools = qw( timelocal datecalc datetime datemanip ncal cal ); - } - my($dc, @fails); - for my $tool (@tools) { - my $method = join('_', '', lc($tool), 'fails'); - if (my $f = $self->$method) { - push(@fails, [$tool, $f]); - } - else { - $dc = $self->_toolmap($tool); - last; - } - } - return $dc if $dc; - if (@tools == 1) { - croak "invalid date tool " . join(': ', @{$fails[0]}); - } - else { - croak join("\n", - "no valid date tool found:", - map(sprintf("%11s: %s", @$_), @fails), - "\n" - ); - } -} - -sub _dump_tests { - my $self = shift; - print "Time::Local : ", $self->_timelocal_fails || 1, "\n"; - print " Date::Calc : ", $self->_datecalc_fails || 1, "\n"; - print " DateTime : ", $self->_datetime_fails || 1, "\n"; - print "Date::Manip : ", $self->_datemanip_fails || 1, "\n"; - print " ncal : ", $self->_ncal_fails || 1, "\n"; - print " cal : ", $self->_cal_fails || 1, "\n"; -} - -sub _is_julian { - my $self = shift; - my $y = $self->year; - $y < 1752 || ($y == 1752 && $self->month <= 9); -} - -sub _timelocal_fails { - my $self = shift; - return "not installed" unless $self->_timelocal_present; - return "week-of-year numbering unsupported" if $self->weeknum; - my $y = $self->year; - return "only years between 1970 and 2038 supported" - if $y < 1970 || $y >= 2038; - return; -} - -sub _ncal_fails { - my $self = shift; - return "command not found" unless $self->_ncal_present; - return "week-of-year numbering not supported prior to 1752/09" - if $self->weeknum && $self->_is_julian; - return; -} - -sub _cal_fails { - my $self = shift; - return "command not found" unless $self->_cal_present; - return "week-of-year numbering not supported" if $self->weeknum; - return; -} - -sub _datecalc_fails { - my $self = shift; - return "not installed" unless $self->_datecalc_present; - return "historic mode prior to 1752/09 not supported" - if $self->historic && $self->_is_julian; - return; -} - -sub _datetime_fails { - my $self = shift; - return "not installed" unless $self->_datetime_present; - return "historic mode prior to 1752/09 not supported" - if $self->historic && $self->_is_julian; - return; -} - -sub _datemanip_fails { - my $self = shift; - return "not installed" unless $self->_datemanip_present; - return "historic mode prior to 1752/09 not supported" - if $self->historic && $self->_is_julian; - eval { require Date::Manip && Date::Manip::Date_Init() }; - return "init failure: $@" if $@; - return; -} - -sub _timelocal_present { eval "require Time::Local"; return !$@ } -sub _datecalc_present { eval "require Date::Calc"; return !$@ } -sub _datetime_present { eval "require DateTime"; return !$@ } -sub _datemanip_present { eval "require Date::Manip"; return !$@ } -sub _ncal_present { shift->_ncal_cmd } -sub _cal_present { shift->_cal_cmd }; - - -1; - -__END__ - -=head1 NAME - -HTML::CalendarMonth::DateTool - Base class for determining which date package to use for calendrical calculations. - -=head1 SYNOPSIS - - my $date_tool = HTML::CalendarMonth::DateTool->new( - year => $YYYY_year, - month => $one_thru_12_month, - weeknum => $weeknum_mode, - historic => $historic_mode, - datetool => $specific_datetool_if_desired, - ); - -=head1 DESCRIPTION - -This module attempts to utilize the best date calculation package -available on the current system. For most contemporary dates this -usually ends up being the internal Time::Local package of perl. For more -exotic dates, or when week number of the years are desired, other -methods are attempted including DateTime, Date::Calc, Date::Manip, and -the linux/unix 'ncal' or 'cal' commands. Each of these has a specific -subclass of this module offering the same utility methods needed by -HTML::CalendarMonth. - -=head1 METHODS - -=over - -=item new() - -Constructor. Takes the following parameters: - -=over - -=item year - -Year of calendar in question (required). If you are rendering exotic -dates (i.e. dates outside of 1970 to 2038) then something besides -Time::Local will be used for calendrical calculations. - -=item month - -Month of calendar in question (required). 1 through 12. - -=item weeknum - -Optional. When specified, will limit class excursions to those that are -currently set up for week of year calculations. - -=item historic - -Optional. If the the ncal or cal commands are available, use one of them -rather than other available date modules since these utilities -accurately handle some specific historical artifacts such as the -transition from Julian to Gregorian. - -=item datetool - -Optional. Mostly for debugging, this option can be used to indicate a -specific HTML::CalendarMonth::DateTool subclass for instantiation. The -value can be either the actual utility class, e.g., Date::Calc, or the -name of the CalendarMonth handler leaf class, e.g. DateCalc. Use 'ncal' -or 'cal', respectively, for the wrappers around those commands. - -=back - -=back - -There are number of methods automatically available: - -=over - -=item month() - -=item year() - -=item weeknum() - -=item historical() - -=item datetool() - -Accessors for the parameters provided to C above. - -=item dow1st() - -Returns the day of week number for the 1st of the C and C -specified during the call to C. Relies on the presence of -C. Should be 0..6 starting with Sun. - -=item lastday() - -Returns the last day of the month for the C and C specified -during the call to C. Relies on the presence of -C. - -=back - -=head1 Overridden methods - -Subclasses of this module must provide at least the C and -C methods. - -=over - -=item dow1st_and_lastday() - -Required. Provides a list containing the day of the week of the first -day of the month (0..6 starting with Sun) along with the last day of -the month. - -=item day_epoch() - -Optional unless interested in epoch values for wacky dates. For a given -day, and optionally C and C if they are different from -those specified in C, provide the unix epoch in seconds for that -day at midnight. - -=back - -If the subclass is expected to provide week of year numbers, three more -methods are necessary: - -=over - -=item dow() - -For a given day, and optionally C and C if they are -different from those specified in C, provide the day of week -number. (1=Sunday, 7=Saturday). - -=item add_days($days, $delta, $day, [$month], [$year]) - -For a given day, and optionally C and C if they are -different from those specified in C, provide a list of year, -month, and day once C days have been added. - -=item week_of_year($day, [$month], [$year]) - -For a given day, and optionally C and C if they are -different from those specified in C, provide a list with the week -number of the year along with the year. (some days of a particular year -can end up belonging to the prior or following years). - -=back - -=head1 AUTHOR - -Matthew P. Sisk, EFE - -=head1 COPYRIGHT - -Copyright (c) 2010 Matthew P. Sisk. All rights reserved. All wrongs -revenged. This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -HTML::CalendarMonth(3), Time::Local(3), DateTime(3), Date::Calc(3), -Date::Manip(3), cal(1)