1 package HTML::CalendarMonth::DateTool::Ncal;
3 $HTML::CalendarMonth::DateTool::Ncal::VERSION = '1.25';
6 # Interface to linux 'ncal' command
12 use base qw( HTML::CalendarMonth::DateTool );
14 sub dow1st_and_lastday {
15 my($self, $month, $year) = @_;
16 $month ||= $self->month;
17 $year ||= $self->year;
18 if (my $r = $self->{_res}{$year}{$month}) {
21 my $cmd = $self->_ncal_cmd or croak "ncal command not found\n";
22 my @cal = grep(!/^\s*$/,`$cmd -w $month $year`);
23 shift @cal if $cal[0] =~ /\D+/;
25 if ($cal[-1] =~ /^\s*\d+/) {
26 @woy = (pop @cal) =~ /(\d+)/g;
28 my($dow1st, %woy, %dow);
30 for my $di (0 .. $#cal) {
31 my $dow_row = $cal[$di];
34 $dow_row =~ s/\s{3,}/ 0 /g;
35 $dow_row =~ s/\D+/ /g;
37 my @days = split(/\s+/, $dow_row);
38 $dow1st = ($di + 1) % 7 if !$dow1st && $days[0];
39 for my $i (0 .. $#days) {
40 my $d = $days[$i] || next;
41 $last_day = $d if $d > $last_day;
46 # catch switchover from Julian to Gregorian
48 if ($month == 9 && $year == 1752) {
50 grep(++$skips{$_}, 3 .. 13);
51 $self->_skips(\%skips);
56 $self->{_woy}{$year}{$month} = \%woy if %woy;
57 $self->{_dow}{$year}{$month} = \%dow if %dow;
58 $self->{_res}{$year}{$month} = [$dow1st, $last_day];
63 my($self, $day, $month, $year) = @_;
64 $month ||= $self->month;
65 $year ||= $self->year;
66 croak "week of year not supported by ncal prior to 10/1752"
67 if $year < 1752 || ($year == 1752 && $month < 10);
68 $self->dow1st_and_lastday unless $self->{_woy}{$year}{$month};
69 $self->{_woy}{$year}{$month}{$day};
73 my($self, $day, $month, $year) = @_;
74 $month ||= $self->month;
75 $year ||= $self->year;
76 $self->dow1st_and_lastday unless $self->{_dow}{$year}{$month};
77 $self->{_dow}{$year}{$month}{$day};
81 my($self, $delta, $day, $month, $year) = @_;
82 $month ||= $self->month;
83 $year ||= $self->year;
87 return($day - $delta, $month, $year);
90 my @days = reverse 1 .. $day;
91 while (@days < $delta) {
96 my($dow1st, $last_day) = $self->dow1st_and_lastday($month, $year);
97 push(@days, reverse 1 .. $last_day);
99 return($days[$delta], $month, $year);
104 if (my $res = $self->{_res}{$year}{$month}) {
105 $last_day = $res->[1];
108 $last_day = ($self->dow1st_and_lastday($month, $year))[1];
110 if ($delta + $day <= $last_day) {
111 return($day + $delta, $month, $year);
113 my @days = $day .. $last_day;
114 while (@days < $delta) {
119 my($dow1st, $last_day) = $self->dow1st_and_lastday($month, $year);
120 push(@days, 1 .. $last_day);
122 return($days[$delta], $month, $year);