]> git.donarmstrong.com Git - deb_pkgs/libhtml-calendarmonth-perl.git/blob - 1.16/lib/HTML/CalendarMonth/DateTool/DateTime.pm
[svn-inject] Tagging upstream source version of libhtml-calendarmonth-perl
[deb_pkgs/libhtml-calendarmonth-perl.git] / 1.16 / lib / HTML / CalendarMonth / DateTool / DateTime.pm
1 package HTML::CalendarMonth::DateTool::DateTime;
2
3 # Interface to DateTime
4
5 use strict;
6 use Carp;
7
8 use vars qw(@ISA $VERSION);
9
10 @ISA = qw(HTML::CalendarMonth::DateTool);
11
12 $VERSION = '0.01';
13
14 use DateTime;
15
16 sub dow1st_and_lastday {
17   my($self, $month, $year) = @_;
18   $month ||= $self->month;
19   $year  ||= $self->year;
20   my $lastday = $self->_last_dom_dt($year, $month);
21   my $dow1st = $self->dow(1);
22   ($dow1st, $lastday->day);
23 }
24
25 sub day_epoch {
26   my($self, $day, $month, $year) = @_;
27   $day || croak "Day required.\n";
28   $month ||= $self->month;
29   $year  ||= $self->year;
30   my $dt = $self->_new_dt($year, $month, $day);
31   $dt->epoch;
32 }
33
34 sub dow {
35   my($self, $day, $month, $year) = @_;
36   $day || croak "Day required.\n";
37   $month ||= $self->month;
38   $year  ||= $self->year;
39   my $dt = $self->_new_dt($year, $month, $day);
40   $dt->dow;
41 }
42
43 sub add_days {
44   my($self, $delta, $day, $month, $year) = @_;
45   $delta || croak "Delta (in days) required.\n";
46   $day   || croak "Day required.\n";
47   $month ||= $self->month;
48   $year  ||= $self->year;
49   my $dt = $self->_new_dt($year, $month, $day);
50   $dt->add(days => $delta);
51   ($dt->day, $dt->month, $dt->year);
52 }
53
54 sub week_of_year {
55   my($self, $day, $month, $year) = @_;
56   $day || croak "Day required.\n";
57   $month ||= $self->month;
58   $year  ||= $self->year;
59   my $dt = $self->_new_dt($year, $month, $day);
60   # returns ($year, $week)
61   $dt->week;
62 }
63
64 sub _new_dt {
65   my $self = shift;
66   my($year, $month, $day) = @_;
67   $year or croak "year and month required\n";
68   my %parms = (year => $year);
69   $parms{month} = $month if $month;
70   $parms{day}   = $day    if $day;
71   $parms{hour} = 0;
72   $parms{minute} = 0;
73   $parms{second} = 0;
74   DateTime->new(%parms);
75 }
76
77 sub _last_dom_dt {
78   my $self = shift;
79   my($year, $month) = @_;
80   $year && $month or croak "Year and month required.\n";
81   DateTime->last_day_of_month(year => $year, month => $month);
82 }
83
84 1;