]> git.donarmstrong.com Git - deb_pkgs/libhtml-calendarmonth-perl.git/blob - 1.16/lib/HTML/CalendarMonth.pm
[svn-inject] Tagging upstream source version of libhtml-calendarmonth-perl
[deb_pkgs/libhtml-calendarmonth-perl.git] / 1.16 / lib / HTML / CalendarMonth.pm
1 package HTML::CalendarMonth;
2
3 use strict;
4 use vars qw($VERSION @ISA);
5
6 $VERSION = '1.16';
7
8 use Carp;
9
10 use HTML::ElementTable 1.13;
11 use HTML::CalendarMonth::Locale;
12 use HTML::CalendarMonth::DateTool;
13
14 @ISA = qw(HTML::CalendarMonth::Accessor HTML::ElementTable);
15
16 # Calmonth attribute method overrides
17
18 sub row_offset {
19   # Displace calendar how many rows into table?
20   my $self = shift;
21   if (@_) {
22     $_[0] >= 0 or croak "Offset must be zero or more";
23   }
24   $self->SUPER::row_offset(@_);
25 }
26
27 sub col_offset {
28   # Displace calendar how many columns into table?
29   my $self = shift;
30   if (@_) {
31     $_[0] >= 0 or croak "Offset must be zero or more";
32   }
33   $self->SUPER::col_offset(@_);
34 }
35
36 sub item_alias {
37   my($self, $item) = splice(@_, 0, 2);
38   defined $item or croak "Item name required";
39   $self->alias->{$item} = shift if @_;
40   $self->alias->{$item} || $item;
41 }
42
43 sub item_aliased {
44   my($self, $item) = splice(@_, 0, 2);
45   defined $item or croak "Item name required.\n";
46   defined $self->alias->{$item};
47 }
48
49 # Header Toggles
50
51 sub _head {
52   # Set/test entire heading (month,year,and dow headers) (does not
53   # affect week number column). Return true if either heading active.
54   my $self = shift;
55   $self->head_m(@_) && $self->head_dow(@_) if @_;
56   $self->_head_my || $self->head_dow;
57 }
58
59 sub _head_my {
60   # Set/test month and year header mode
61   my($self, $mode) = splice(@_, 0, 2);
62   $self->head_m($mode) && $self->head_y($mode) if defined $mode;
63   $self->head_m || $self->head_y;
64 }
65
66 sub _initialized {
67   my $self = shift;
68   @_ ? $self->{_initialized} = shift : $self->{_initialized};
69 }
70
71 # Circa Interface
72
73 sub _date {
74   # Set target month, year
75   my $self = shift;
76   if (@_) {
77     my ($month, $year) = @_;
78     $month && defined $year || croak "date method requires month and year";
79     croak "Date already set" if $self->_initialized();
80
81     # get rid of possible leading 0's
82     $month += 0;
83     $year  += 0;
84
85     $month <= 12 && $month >= 1 or croak "Month $month out of range (1-12)\n";
86     $year > 0 or croak "Negative years are unacceptable\n";
87
88     $self->month($self->monthname($month));
89     $self->year($year);
90     $month = $self->monthnum($month);
91
92     # Trigger _gencal...this should be the only place where this occurs
93     $self->_gencal;
94   }
95   return($self->month, $self->year);
96 }
97
98 # locale accessors
99 sub locales                 { shift->loc->locales          }
100 sub locale_days             { shift->loc->days             }
101 sub locale_daynum           { shift->loc->daynum(@_)       }
102 sub locale_months           { shift->loc->months           }
103 sub locale_daynums          { shift->loc->daynums          }
104 sub locale_minmatch         { shift->loc->minmatch         }
105 sub locale_monthnum         { shift->loc->monthnum(@_)     }
106 sub locale_monthnums        { shift->loc->monthnums        }
107 sub locale_minmatch_pattern { shift->loc->minmatch_pattern }
108
109 # class factory access
110
111 sub class_element_table { 'HTML::ElementTable' }
112 sub class_datetool { __PACKAGE__ . '::DateTool' }
113 sub class_locale   { __PACKAGE__ . '::Locale' }
114
115 sub _gencal {
116   # Generate internal calendar representation
117   my $self = shift;
118
119   # New calendar...clobber day-specific settings
120   my $itoc = $self->_itoc({});
121
122   # Figure out dow of 1st day of the month as well as last day of the
123   # month (uses date calculator backends)
124   $self->_anchor_month();
125
126   # row count for weeks in grid
127   my ($wcnt) = 0;
128
129   my ($dowc) = $self->dow1st;
130   my $skips  = $self->_caltool->skips;
131
132   # For each day
133   foreach (1 .. $self->lastday) {
134     next if $skips->{$_};
135     my $r = $wcnt + 2 + $self->row_offset;
136     my $c = $dowc + $self->col_offset;
137     # This is a bootstrap until we know the number of rows in the month.
138     $itoc->{$_} = [$r, $c];
139     $dowc = ++$dowc % 7;
140     ++$wcnt unless $dowc || $_ == $self->lastday;
141   }
142
143   $self->{_week_rows} = $wcnt;
144
145   my $row_extent = $wcnt + 2;
146   my $col_extent = 6;
147   $col_extent += 1 if $self->head_week;
148
149   $self->extent($row_extent + $self->row_offset,
150                 $col_extent + $self->col_offset);
151
152   # Table can contain the days now, so replace our bootstrap coordinates
153   # with references to the actual elements.
154   foreach (keys %$itoc) {
155     my $cellref = $self->cell(@{$itoc->{$_}});
156     $self->itoc($_, $cellref);
157     $self->ctoi($cellref, $_);
158   }
159
160   # week num affects month/year spans
161   my $width = $self->head_week ? 8 : 7;
162
163   # month/year headers
164   my $cellref = $self->cell($self->row_offset, $self->col_offset);
165   $self->itoc($self->month, $cellref);
166   $self->ctoi($cellref, $self->month);
167   $cellref = $self->cell($self->row_offset,
168                          $width - $self->year_span + $self->col_offset);
169   $self->itoc($self->year,  $cellref);
170   $self->ctoi($cellref, $self->year);
171
172   $self->item($self->month)->replace_content($self->item_alias($self->month));
173   $self->item($self->year)->replace_content($self->item_alias($self->year));
174
175   if ($self->_head_my) {
176     if ($self->head_m) {
177       $self->item($self->month)->attr('colspan',$width - $self->year_span);
178     }
179     else {
180       $self->item($self->month)->mask(1);
181       $self->item($self->year)->attr('colspan', $width);
182     }
183     if ($self->head_y) {
184       $self->item($self->year)->attr('colspan',$self->year_span);
185     }
186     else {
187       $self->item($self->year)->mask(1);
188       $self->item($self->month)->attr('colspan', $width);
189     }
190   }
191   else {
192     $self->row($self->first_row)->mask(1);
193   }
194
195   # DOW headers
196   my $trans;
197   my $days = $self->locale_days;
198   foreach (0..$#$days) {
199     # Transform for week_begin 1..7
200     $trans = ($_ + $self->week_begin - 1) % 7;
201     my $cellref = $self->cell(1 + $self->row_offset, $_ + $self->col_offset);
202     $self->itoc($days->[$trans], $cellref);
203     $self->ctoi($cellref, $days->[$trans]);
204   }
205   if ($self->head_dow) {
206     grep($self->item($_)->replace_content($self->item_alias($_)), @$days);
207   }
208   else {
209     $self->row($self->first_row + 1)->mask(1);
210   }
211
212   # Week number column
213   if ($self->head_week) {
214     # Week nums can collide with days. Use "w" in front of the number
215     # for uniqueness, and automatically alias to just the number (unless
216     # already aliased, of course).
217     $self->_gen_week_nums();
218     my $ws;
219     my $row_count = $self->first_week_row;
220     foreach ($self->_numeric_week_nums) {
221       $ws = "w$_";
222       $self->item_alias($ws, $_) unless $self->item_aliased($ws);
223       my $cellref = $self->cell($row_count, $self->last_col);
224       $self->itoc($ws, $cellref);
225       $self->ctoi($cellref, $ws);
226       $self->item($ws)->replace_content($self->item_alias($ws));
227       ++$row_count;
228     }
229   }
230
231   # Fill in days of the month
232   my $i;
233   foreach my $r ($self->first_week_row .. $self->last_row) {
234     foreach my $c ($self->first_col .. $self->last_week_col) {
235       $self->cell($r,$c)->replace_content($self->item_alias($i))
236         if ($i = $self->item_at($r,$c));
237     }
238   }
239
240   # Defaults
241   $self->table->attr(align => 'center');
242   $self->item($self->month)->attr(align => 'left') if $self->head_m;
243   $self->attr(bgcolor => 'white') unless defined $self->attr('bgcolor');
244   $self->attr(border => 1)        unless defined $self->attr('border');
245   $self->attr(cellspacing => 0)   unless defined $self->attr('cellspacing');
246   $self->attr(cellpadding => 0)   unless defined $self->attr('cellpadding');
247
248   $self;
249 }
250
251 sub _anchor_month {
252   # Figure out what our month grid looks like.
253   # Let HTML::CalendarMonth::DateTool determine which method is
254   # appropriate.
255   my $self = shift;
256
257   my $month = $self->monthnum($self->month);
258   my $year  = $self->year;
259
260   my $tool = $self->_caltool;
261   if (!$tool) {
262     $tool = $self->class_datetool->new(
263               year     => $year,
264               month    => $month,
265               weeknum  => $self->head_week,
266               historic => $self->historic,
267               datetool => $self->datetool,
268             );
269     $self->_caltool($tool);
270   }
271   my $dow1st  = $tool->dow1st;
272   my $lastday = $tool->lastday;
273
274   # If the first day of the week is not Sunday...
275   $dow1st = ($dow1st - ($self->week_begin - 1)) % 7;
276
277   $self->dow1st($dow1st);
278   $self->lastday($lastday);
279
280   $self;
281 }
282
283 sub _gen_week_nums {
284   # Generate week-of-the-year numbers. The first week is generally
285   # agreed upon to be the week that contains the 4th of January.
286   #
287   # For purposes of shenanigans with 'week_begin', we anchor the week
288   # number off of Thursday in each row.
289
290   my $self = shift;
291
292   my($year, $month, $lastday) = ($self->year, $self->monthnum, $self->lastday);
293
294   my $tool = $self->_caltool;
295   $tool->can('week_of_year')
296     or croak "Oops. $tool not set up for week of year calculations.\n";
297
298   my $fdow = $self->dow1st;
299   my $delta = 4 - $fdow;
300   if ($delta < 0) {
301     $delta += 7;
302   }
303   my @ft = $tool->add_days($delta, 1);
304
305   my $ldow = $tool->dow($lastday);
306   $delta = 4 - $ldow;
307   if ($delta > 0) {
308     $delta -= 7;
309   }
310   my @lt = $tool->add_days($delta, $lastday);
311
312   my $fweek = $tool->week_of_year(@ft);
313   my $lweek = $tool->week_of_year(@lt);
314   my @wnums = $fweek .. $lweek;
315
316   # Do we have days above our first Thursday?
317   if ($self->row_of($ft[0]) != $self->first_week_row) {
318     unshift(@wnums, $wnums[0] -1);
319   }
320
321   # Do we have days below our last Thursday?
322   if ($self->row_of($lt[0]) != $self->last_row) {
323     push(@wnums, $wnums[-1] + 1);
324   }
325
326   # First visible week is from last year
327   if ($wnums[0] == 0) {
328     $wnums[0] = $tool->week_of_year($tool->add_days(-7, $ft[0]));
329   }
330
331   # Last visible week is from subsequent year
332   if ($wnums[-1] > $lweek) {
333     $wnums[-1] = $tool->week_of_year($tool->add_days(7, $lt[0]));
334   }
335
336   $self->_weeknums(@wnums);
337 }
338
339 # Month hooks
340
341 sub row_items {
342   # Given a list of items, return all items in rows shared by the
343   # provided items.
344   my $self = shift;
345   my($item,$row,$col,$i,@i,%i);
346   foreach $item (@_) {
347     $row = ($self->coords_of($item))[0];
348     foreach $col ($self->first_col .. $self->last_col) {
349       $i = $self->item_at($row,$col) || next;
350       ++$i{$i};
351     }
352   }
353   @i = keys %i;
354   @i ? @i : $i[0];
355 }
356
357 sub col_items {
358   # Return all item cells in the columns occupied by the provided list
359   # of items.
360   my $self = shift;
361   $self->_col_items($self->first_row,$self->last_row,@_);
362 }
363
364 sub daycol_items {
365   # Same as col_items(), but excludes header cells.
366   my $self = shift;
367   $self->_col_items($self->first_week_row,$self->last_row,@_);
368 }
369
370 sub _col_items {
371   # Given row bounds and a list of items, return all item elements
372   # in the columns occupied by the provided items. Does not return
373   # empty cells.
374   my($self, $rfirst, $rlast) = splice(@_, 0, 3);
375   my($item, $row, $col, %i);
376   foreach $item (@_) {
377     $col = ($self->coords_of($item))[1];
378     foreach $row ($rfirst .. $rlast) {
379       my $i = $self->item_at($row,$col) || next;
380       ++$i{$i};
381     }
382   }
383   my @i = keys %i;
384   $#i ? @i : $i[0];
385 }
386
387 sub daytime {
388   # Return seconds since epoch for a given day
389   my($self, $day) = splice(@_, 0, 2);
390   $day or croak "Must specify day of month";
391   croak "Day does not exist" unless $self->_daycheck($day);
392   $self->_caltool->day_epoch($day);
393 }
394
395 sub week_nums {
396   # Return list of all week numbers
397   map("w$_", shift->_numeric_week_nums);
398 }
399
400 sub _numeric_week_nums {
401   # Return list of all week numbers as numbers
402   my $self = shift;
403   $self->head_week ? @{$self->_weeknums} : ();
404 }
405
406 sub days {
407   # Return list of all days of the month (1..$c->lastday).
408   my $self = shift;
409   my $skips = $self->_caltool->skips;
410   grep(!$skips->{$_}, (1 .. $self->lastday));
411 }
412
413 sub dayheaders {
414   # Return list of all day headers (Su..Sa).
415   shift->locale_days;
416 }
417
418 sub headers {
419   # Return list of all headers (month,year,dayheaders)
420   my $self = shift;
421   ($self->year, $self->month, $self->dayheaders);
422 }
423
424 sub items {
425   # Return list of all items (days, headers)
426   my $self = shift;
427   ($self->headers, $self->days);
428 }
429
430 sub first_col {
431   # Where is the first column of the calendar within the table?
432   shift->col_offset();
433 }
434
435 sub first_week_col { first_col(@_) }
436
437 sub last_col {
438   # What's the max col of the calendar?
439   my $self = shift;
440   $self->head_week ? $self->last_week_col + 1 : $self->last_week_col;
441 }
442
443 sub last_week_col {
444   # What column does the last DOW fall in? Should be the same as
445   # last_col unless head_week is activated
446   shift->first_col + 6;
447 }
448
449 sub first_row {
450   # Where is the first row of the calendar?
451   shift->row_offset();
452 }
453
454 sub first_week_row {
455   # Returns the first row containing days of the month. This used to
456   # take into account whether the header rows were active or not,
457   # but since masking was implemented this should always be offset 2
458   # from the first row (thereby taking into account the month/year
459   # and DOW rows).
460   my $w = 2;
461   shift->first_row + $w;
462 }
463
464 sub last_row {
465   # Last row of the calendar
466   my $self = shift;
467   return ($self->coords_of($self->lastday))[0];
468 }
469
470 sub last_week_row { last_row(@_) }
471
472 # Custom glob interfaces
473
474 sub item {
475   # Return TD elements containing items
476   my $self = shift;
477   @_ || croak "Item(s) must be provided";
478   $self->cell(grep(defined $_, map($self->coords_of($_), @_)));
479 }
480
481 sub item_row {
482   # Return a glob of the rows of a list of items, including empty cells.
483   my $self = shift;
484   $self->_item_row($self->first_col, $self->last_col, @_);
485 }
486
487 sub item_day_row {
488   # Same as item_row, but excludes possible week number cells
489   my $self = shift;
490   $self->_item_row($self->first_col, $self->last_week_col, @_);
491 }
492
493 sub _item_row {
494   # Given column bounds and a list of items, return a glob representing
495   # the cells in the rows occupied by the provided items, including
496   # empty cells.
497   my($self, $cfirst, $clast) = splice(@_, 0, 3);
498   defined $cfirst && defined $clast or croak "No items provided";
499   my($row, $col, @coords);
500   foreach $row (map($self->row_of($_), @_)) {
501     foreach $col ($cfirst .. $clast) {
502       push(@coords, $row, $col);
503     }
504   }
505   $self->cell(@coords);
506 }
507
508 sub item_week_nums {
509   # Glob of all week numbers
510   my $self = shift;
511   $self->item($self->week_nums);
512 }
513
514 sub item_col {
515   # Return a glob of the cols of a list of items, including empty cells.
516   my $self = shift;
517   $self->_item_col($self->first_row, $self->last_row, @_);
518 }
519
520 sub item_daycol {
521   # Same as item_col(), but excludes header cells.
522   my $self = shift;
523   $self->_item_col($self->first_week_row, $self->last_row, @_);
524 }
525
526 sub _item_col {
527   # Given row bounds and a list of items, return a glob representing
528   # the cells in the columns occupied by the provided items, including
529   # empty cells.
530   my($self, $rfirst, $rlast) = splice(@_, 0, 3);
531   defined $rfirst && defined $rlast or croak "No items provided";
532   my($row, $col, @coords);
533   foreach $col (map($self->col_of($_), @_)) {
534     foreach $row ($rfirst .. $rlast) {
535       push(@coords, $row, $col);
536     }
537   }
538   $self->cell(@coords);
539 }
540
541 sub item_box {
542   # Return a glob of the box defined by two items
543   my($self, $item1, $item2) = splice(@_, 0, 3);
544   defined $item1 && defined $item2 or croak "Two items required";
545   $self->box($self->coords_of($item1), $self->coords_of($item2));
546 }
547
548 sub all {
549   # Return a glob of all calendar cells, including empty cells.
550   my $self = shift;
551   $self->box( $self->first_row => $self->first_col,
552               $self->last_row  => $self->last_col   );
553 }
554
555 sub alldays {
556   # Return a glob of all cells other than header cells
557   my $self = shift;
558   $self->box( $self->first_week_row => $self->first_col,
559               $self->last_row       => $self->last_week_col );
560 }
561
562 sub allheaders {
563   # Return a glob of all header cells
564   my $self = shift;
565   $self->item($self->headers);
566 }
567
568 # Transformation Methods
569
570 sub coords_of {
571   # Convert an item into grid coordinates
572   my $self = shift;
573   my $ref = $self->itoc(@_);
574   my @pos = ref $ref ? $ref->position : ();
575   @pos ? (@pos[$#pos - 1, $#pos]) : ();
576 }
577
578 sub item_at {
579   # Convert grid coords into item
580   my $self = shift;
581   $self->ctoi($self->cell(@_));
582 }
583
584 sub itoc {
585   # Item to grid
586   my($self, $item, $ref) = splice(@_, 0, 3);
587   defined $item or croak "item required";
588   my $itoc = $self->_itoc;
589   if ($ref) {
590     croak "Reference required" unless ref $ref;
591     $itoc->{$item} = $ref;
592   }
593   $itoc->{$item};
594 }
595
596 sub ctoi {
597   # Cell reference to item
598   my($self, $refstring, $item) = splice(@_, 0, 3);
599   defined $refstring or croak "cell id required";
600   my $ctoi = $self->_ctoi;
601   if (defined $item) {
602     $ctoi->{$refstring} = $item;
603   }
604   $ctoi->{$refstring};
605 }
606
607 sub row_of {
608   my $self = shift;
609   ($self->coords_of(@_))[0];
610 }
611
612 sub col_of {
613   my $self = shift;
614   ($self->coords_of(@_))[1];
615 }
616
617 sub monthname {
618   # Check/return month...returns name. Accepts 1-12, or Jan..Dec
619   my $self = shift;
620   return $self->month unless @_;
621   my(@mn, $month);
622   my $months   = $self->locale_months;
623   my $monthnum = $self->locale_monthnums;
624   my $minmatch = $self->locale_minmatch;
625   my $mmpat    = $self->locale_minmatch_pattern;
626   
627   foreach $month (@_) {
628     if ($month =~ /^\d+$/) {
629       $month >= 1 && $month <= 12 || return 0;  
630       push(@mn, $months->[$month-1]);
631     }
632     else {
633       if (exists $monthnum->{$month}) {
634         push(@mn, $month);
635       }
636       else {
637         # Make one last attempt
638         if ($month =~ /^($mmpat)/) {
639           push(@mn, $minmatch->{$1});
640         }
641         else {
642           return undef;
643         }
644       }
645     }
646   }
647   $#mn > 0 ? @mn : $mn[0];
648 }
649
650 sub monthnum {
651   # Check/return month, returns number. Accepts 1-12, or Jan..Dec
652   my $self = shift;
653   my $monthnum = $self->locale_monthnums;
654   my @mn;
655   push(@mn, map(exists $monthnum->{$_} ?
656                 $monthnum->{$_}+1 : undef, $self->monthname(@_)));
657   $#mn > 0 ? @mn : $mn[0];
658 }
659
660 sub dayname {
661   # Check/return day...returns name. Accepts 1..7, or Su..Sa
662   my $self = shift;
663   @_ || croak "Day must be provided";
664   my(@dn, $day);
665   my $days = $self->locale_days;
666   my $daynum = $self->locale_daynums;
667   foreach $day (@_) {
668     if ($day =~ /^\d+$/) {
669       $day >= 1 && $day <= 7 || return undef;
670       # week_begin is at least 1, so skew is automatic
671       push(@dn, $days->[($day - 1 + $self->week_begin - 1) % 8]);
672     }
673     else {
674       $day = ucfirst(lc($day));
675       if (exists $daynum->{$day}) {
676         push(@dn, $day);
677       }
678       else {
679         return undef;
680       }
681     }
682   }
683   $#dn > 0 ? @dn : $dn[0];
684 }
685
686 sub daynum {
687   # Check/return day number 1..7, returns number. Accepts 1..7,
688   # or Su..Sa
689   my $self = shift;
690   my $daynum = $self->locale_daynums;
691   my @dn;
692   push(@dn, map(exists $daynum->{$_} ?
693                 $daynum->{$_}+1 : undef,$self->dayname(@_)));
694   $#dn > 0 ? @dn : $dn[0];
695 }
696
697 # Tests-n-checks
698
699 sub _dayheadcheck {
700   # Test day head names
701   my($self, $name) = splice(@_, 0, 2);
702   $name or croak "Name missing";
703   return undef if $name =~ /^\d+$/;
704   $self->daynum($name);
705 }
706
707 sub _daycheck {
708   # Check if an item is a day of the month (1..31)
709   my($self, $item) = splice(@_, 0, 2);
710   $item = shift or croak "Item required";
711   # Can't just invert _headcheck because coords_of() needs _daycheck,
712   # and _headcheck uses coords_of()
713   $item =~ /^\d{1,2}$/ && $item <= 31;
714 }
715
716 sub _headcheck {
717   # Check if an item is a header
718   !_daycheck(@_);
719 }
720
721 # Constructors/Destructors
722
723 sub new {
724   my $class = shift;
725   my %parms = @_;
726   my(%attrs, %tattrs);
727   foreach (keys %parms) {
728     if (__PACKAGE__->is_calmonth_attr($_)) {
729       $attrs{$_} = $parms{$_};
730     }
731     else {
732       $tattrs{$_} = $parms{$_};
733     }
734   }
735
736   my $self = __PACKAGE__->class_element_table->new(%tattrs);
737   bless $self, $class;
738
739   # set defaults
740   $self->set_defaults;
741
742   # Enable blank cell fill so BGCOLOR shows up by default
743   # (HTML::ElementTable)
744   $self->blank_fill(1);
745
746   my $month = delete $attrs{month};
747   my $year  = delete $attrs{year};
748   if (!$month || !$year) {
749     my ($nmonth,$nyear) = (localtime(time))[4,5];
750     ++$nmonth; $nyear += 1900;
751     $month ||= $nmonth;
752     $year  ||= $nyear;
753   }
754   $self->month($month);
755   $self->year($year);
756
757   # set overrides
758   $self->$_($attrs{$_}) foreach (keys %attrs);
759
760   $self->loc($self->class_locale->new(
761     id          => $self->locale,
762     full_days   => $self->full_days,
763     full_months => $self->full_months,
764   )) or croak "Problem creating locale " . $self->locale . "\n";
765
766   # For now, this is the only time this will every happen for this
767   # object. It is now 'initialized'.
768   $self->_date($month, $year);
769
770   $self;
771 }
772
773 {
774
775 package HTML::CalendarMonth::Accessor;
776
777 use strict;
778 use vars qw($VERSION @ISA);
779
780 $VERSION = '0.01';
781
782 use Carp;
783
784 use Class::Accessor;
785
786 @ISA = qw(Class::Accessor);
787
788 my %Objects;
789
790 # Default complex attributes
791 my %Calmonth_Attrs = (
792   head_m      => 1,  # Month heading mode
793   head_y      => 1,  # Year heading mode
794   head_dow    => 1,  # DOW heading mode
795   head_week   => 0,  # European week number mode
796   year_span   => 2,  # Default col span of year
797
798   week_begin  => 1,  # What DOW (1-7) is the 1st DOW?
799
800   historic    => 1,  # If able to choose, use 'cal'
801                      # rather than Date::Calc, which
802                      # blindly extrapolates Gregorian
803
804   row_offset  => 0,  # Displacment within table
805   col_offset  => 0,
806
807   alias       => {}, # What gets displayed if not
808                      # the default item
809
810   month       => '', # These will get initialized
811   year        => '',
812
813   locale      => 'en_US',
814   full_days   => 0,
815   full_months => 1,
816
817   datetool    => '',
818   caltool     => '',
819
820   # internal muckety muck
821   _cal      => '',
822   _itoc     => {},
823   _ctoi     => {},
824   _caltool  => '',
825   _weeknums => '',
826
827   dow1st   => '',
828   lastday  => '',
829   loc      => '',
830 );
831
832 __PACKAGE__->mk_accessors(keys %Calmonth_Attrs);
833
834 # Class::Accessor overrides
835
836 sub new {
837   my $class = shift;
838   my $self = $class->SUPER::new(@_);
839   foreach (sort keys %Calmonth_Attrs) {
840     $self->$_($Calmonth_Attrs{$_});
841   }
842   $self;
843 }
844
845 sub set {
846   my($self, $key) = splice(@_, 0, 2);
847   if (@_ == 1) {
848     $Objects{$self}{$key} = $_[0];
849   }
850   elsif (@_ > 1) {
851     $Objects{$self}{$key} = [@_];
852   }
853   else {
854     Carp::confess("Wrong number of arguments received");
855   }
856 }
857
858 sub get {
859   my $self = shift;
860   if (@_ == 1) {
861     return $Objects{$self}{$_[0]};
862   }
863   elsif ( @_ > 1 ) {
864     return @{$Objects{$self}{@_}};
865   }
866   else {
867     Carp::confess("Wrong number of arguments received.");
868   }
869 }
870
871 sub is_calmonth_attr { shift; exists $Calmonth_Attrs{shift()} }
872
873 sub set_defaults {
874   my $self = shift;
875   foreach (keys %Calmonth_Attrs) {
876     $self->$_($Calmonth_Attrs{$_});
877   }
878   $self;
879 }
880
881 } # end HTML::CalendarMonth::Accessor
882
883 # Go forth and prosper.
884 1;
885
886 __END__
887
888 =head1 NAME
889
890 HTML::CalendarMonth - Perl extension for generating and manipulating HTML calendar months
891
892 =head1 SYNOPSIS
893
894  use HTML::CalendarMonth;
895  use HTML::AsSubs;
896
897  # Using HTML::AsSubs
898  $c = HTML::CalendarMonth->new( month => 3, year => 69 );
899  $c->item($c->year, $c->month)->attr(bgcolor => 'wheat');
900  $c->item($c->year, $c->month)->wrap_content(font({size => '+2'}));
901  $c->item(12, 16, 28)->wrap_content(strong());
902  print $c->as_HTML;
903
904  # Using regular HTML::Element creation
905  $c2 = HTML::CalendarMonth->new( month => 8, year => 79 );
906  $c2->item($c2->year, $c2->month)->attr(bgcolor => 'wheat');
907  $f = HTML::Element->new('font', size => '+2');
908  $c2->item($c2->year, $c2->month)->wrap_content($f);
909  $c2->item_daycol('Su', 'Sa')->attr(bgcolor => 'cyan');
910  print $c2->as_HTML;
911
912  # Full locale support via DateTime::Locale
913  $c3 HTML::CalendarMonth->new( month => 8, year => 79, locale => 'fr' );
914  print $c3->as_HTML
915
916 =head1 DESCRIPTION
917
918 HTML::CalendarMonth is a subclass of HTML::ElementTable. See
919 L<HTML::ElementTable(3)> for how that class works, for it affects this
920 module on many levels. Like HTML::ElementTable, HTML::CalendarMonth
921 behaves as if it were an HTML::ElementSuper, which is a regular
922 HTML::Element with methods added to easily manipulate the appearance of
923 the HTML table containing the calendar.
924
925 The primary interaction with HTML::CalendarMonth is through I<items>. An
926 I<item> is merely a symbol that represents the content of the cell of
927 interest within the calendar. For instance, the element representing the
928 14th day of the month would be returned by C<$c-E<gt>item(14)>.
929 Similarly, the element representing the header for Monday would be
930 returned by C<$c-E<gt>item('Mo')>. If the year happened to by 1984, then
931 C<$c-E<gt>item(1984)> would return the cell representing the year. Since
932 years and particular months change frequently, it is probably more
933 useful to take advantage of the C<month()> and C<year()> methods, which
934 return the respective item symbol for the current calendar. In the prior
935 example, using 1984, the following is equivalent: C<$c-E<gt>item($c-
936 E<gt>year())>.
937
938 Multiple cells of the calendar can be manipulated as if they were a
939 single element. For instance, C<$c-E<gt>item(15)-E<gt>attr(bgcolor
940 =E<gt> 'cyan')> would alter the background color of the cell
941 representing the 15th. By the same token, C<$c-E<gt>item(15, 16, 17,
942 23)-E<gt>attr(bgcolor =E<gt> 'cyan')> would do the same thing for all
943 cells containing the item symbols passed to the C<item()> method.
944
945 The calendar structure is still nothing more than a table structure; the
946 same table structure provided by the HTML::ElementTable class. In
947 addition to the I<item> based access methods above, calendar cells can
948 still be accessed using row and column grid coordinates using the
949 C<cell()> method provided by the table class. All coordinate-based
950 methods in the table class are accessible to the calendar class.
951
952 The module includes support for week-of-the-year numbering, arbitrary
953 1st day of the week definitions, and aliasing so that you can express
954 any element in any language HTML can handle.
955
956 Dates that are beyond the range of the built-in time functions of perl
957 are handled either by the 'cal' command, Date::Calc, or Date::Manip. The
958 presence of any one of these utilities and modules will suffice for
959 these far flung date calculations. If you want to use week-of-year
960 numbering, then either one of the date modules is required.
961
962 Full locale support is offered via DateTime::Locale. For a full list of
963 supported locale id's, look at HTML::CalendarMonth::Locale->locales() or
964 DateTime::Locale->ids().
965
966 =head1 METHODS
967
968 All arguments appearing in [brackets] are optional, and do not represent
969 anonymous array references.
970
971 =over
972
973 B<Constructor>
974
975 =item new()
976
977 With no arguments, the constructor will return a calendar object
978 representing the current month with a default appearance. The initial
979 configuration of the calendar is controlled by special attributes. Non-
980 calendar related attributes are passed along to HTML::ElementTable. Any
981 non-table related attributes left after that are passed to HTML::Element
982 while constructing the E<lt>tableE<gt> tag. See L<HTML::ElementTable> if
983 you are interested in attributes that can be passed along to that class.
984
985 Special Attributes for HTML::CalendarMonth:
986
987 =over
988
989 =item month
990
991 1-12, or Jan-Dec.  Defaults to current month.
992
993 =item year
994
995 Four digit representation. Defaults to current year.
996
997 =item head_m
998
999 Specifies whether to display the month header. Default 1.
1000
1001 =item head_y 
1002
1003 Specifies whether to display the year header. Default 1.
1004
1005 =item head_dow
1006
1007 Specifies whether to display days of the week header. Default 1.
1008
1009 =item locale
1010
1011 Specifies a locale in which to render the calendar. Default is 'en_US'.
1012 See L<HTML::CalendarMonth::Locale> for more information. If for some
1013 reason you prefer to use different labels than those provided by
1014 C<locale>, see the C<alias> attribute below.
1015
1016 =item full_days
1017
1018 Specifies whether or not to use full day names or their abbreviated
1019 names. Default is 0, use abbreviated names.
1020
1021 =item full_months
1022
1023 Specifies whether or not to use full month names or their abbriviated
1024 names. Default is 1, use full names.
1025
1026 =item alias
1027
1028 Takes a hash reference mapping labels provided by C<locale> to any
1029 custom label you prefer. Lookups, such as C<day('Sun')>, will still use
1030 the locale string, but when the calendar is rendered the aliased value
1031 will appear.
1032
1033 =item head_week
1034
1035 Specifies whether to display the week-of-year numbering. Default 0.
1036
1037 =item week_begin
1038
1039 Specify first day of the week, which can be 1..7, starting with Sunday.
1040 Defaults to 1, or Sunday. In order to specify Monday, set this to 2,
1041 and so on.
1042
1043 =item row_offset
1044
1045 Specifies the offset of the first calendar row within the table
1046 containing the calendar. This is 0 by default, making the first row of
1047 the table the same as the first row of the calendar.
1048
1049 =item col_offset
1050
1051 Specifies the offset of the first calendar column within the table
1052 containing the calendar. This is 0 by default, making the first column
1053 of the table the same as the first row of the calendar.
1054
1055 =item historic
1056
1057 This option is ignored for dates that do not exceed the range of the built-
1058 in perl time functions. For dates that B<do> exceed these ranges, this
1059 option specifies the default calculation method. When set, if the 'cal'
1060 utility is available on your system, that will be used rather than the
1061 Date::Calc or Date::Manip modules. This can be an issue since the date
1062 modules blindly extrapolate the Gregorian calendar, whereas 'cal' takes
1063 some of these quirks into account. If 'cal' is not available on your
1064 system, this attribute is meaningless. Defaults to 1.
1065
1066 =back
1067
1068 =back
1069
1070 B<Item Query Methods>
1071
1072 The following methods return lists of item symbols that are related in
1073 some way to the provided list of items. The returned symbols may then
1074 be used as arguments to the glob methods detailed further below. When
1075 these methods deal with 'rows' and 'columns', they are only concerned
1076 with the cells in the calendar -- not the cells that might be present
1077 in the surrounding table if you have extended it. If you have not set
1078 row or column offsets, or extended the span of the containing table,
1079 then these rows and columns are functionally equivalent to the table
1080 rows and columns.
1081
1082 =over
1083
1084 =item row_items(item1, [item2, ...])
1085
1086 Returns all item symbols in rows shared by the provided item symbols.
1087
1088 =item col_items(item1, [item2, ...])
1089
1090 Returns all item symbols in columns shared by the provided item symbols.
1091
1092 =item daycol_items(col_item1, [col_item2, ...])
1093
1094 Same as col_items(), but the returned item symbols are limited to those
1095 that are not header items (month, year, day-of-week).
1096
1097 =item row_of(item1, [item2, ...])
1098
1099 Returns the row numbers of rows containing the provided item symbols.
1100
1101 =item col_of(item1, [item2, ...])
1102
1103 Returns the column numbers of columns containing the provided
1104 item symbols.
1105
1106 =item lastday()
1107
1108 Returns the number of the last day of the month.
1109
1110 =item dow1st()
1111
1112 Returns the column number for the first day of the month.
1113
1114 =item days()
1115
1116 Returns a list of all days of the month.
1117
1118 =item dayheaders()
1119
1120 Returns a list of all day headers (Su..Sa)
1121
1122 =item headers()
1123
1124 Returns a list of all headers (month, year, dayheaders)
1125
1126 =item items()
1127
1128 Returns a list of all item symbols in the calendar.
1129
1130 =item first_col()
1131
1132 Returns the number of the first column of the calendar. This could be
1133 different from that of the surrounding table if the table was extended,
1134 but otherwise should be identical.
1135
1136 =item last_col()
1137
1138 Returns the number of the last column of the calendar. This could be
1139 different from that of the surrounding table if the table was extended,
1140 but should otherwise be identical.
1141
1142 =item first_row()
1143
1144 Returns the number of the first row of the calendar. This could be
1145 different from that of the surrounding table if offsets were made.
1146
1147 =item first_week_row()
1148
1149 Returns the number of the first row of the calendar containing day items
1150 (ie, the first week). This could vary depending on table offsets and
1151 header modes.
1152
1153 =item last_row()
1154
1155 Returns the number of the last row of the calendar. This could be
1156 different from that of the surrounding table if the table was extended,
1157 but should otherwise be identical.
1158
1159 =back
1160
1161 B<Glob Methods>
1162
1163 Glob methods return references that are functionally equivalent to an
1164 individual calendar cell. Mostly, they provide item based analogues to
1165 the glob methods provided in HTML::ElementTable. In methods dealing with
1166 rows, columns, and boxes, the globs include empty calendar cells (which
1167 would otherwise need to be accessed through native HTML::ElementTable
1168 methods). The row and column numbers returned by the item methods above
1169 are compatible with the grid based methods in HTML::ElementTable.
1170
1171 For details on how these globs work, check out L<HTML::ElementTable> and
1172 L<HTML::ElementGlob>.
1173
1174 =over
1175
1176 =item item(item1, [item2, ...])
1177
1178 Returns all cells containing the provided item symbols.
1179
1180 =item item_row(item1, [item2, ...])
1181
1182 Returns all cells in all rows occupied by the provided item symbols.
1183
1184 =item item_col(item1, [item2, ...])
1185
1186 Returns all cells in all columns occupied by the provided item symbols.
1187
1188 =item item_daycol(item1, [item2, ...])
1189
1190 Same as item_col(), except limits the cells to non header cells.
1191
1192 =item item_box(item1a, item1b, [item2a, item2b, ...])
1193
1194 Returns all cells in the boxes defined by the item pairs provided.
1195
1196 =item allheaders()
1197
1198 Returns all header cells.
1199
1200 =item alldays()
1201
1202 Returns all non header cells, including empty cells.
1203
1204 =item all()
1205
1206 Returns all cells in the calendar, including empty cells.
1207
1208 =back
1209
1210 B<Transformation Methods>
1211
1212 The following methods provide ways of translating between various item
1213 symbols, coordinates, and other representations.
1214
1215 =over
1216
1217 =item coords_of(item)
1218
1219 Returns the row and column of the provided item symbol, for use with the
1220 grid based methods in HTML::ElementTable.
1221
1222 =item item_at(row,column)
1223
1224 Returns the item symbol of the item at the provided coordinates, for use
1225 with the item based methods of HTML::CalendarMonth.
1226
1227 =item monthname(monthnum)
1228
1229 Returns the name (item symbol) of the month number provided, where
1230 I<monthnum> can be 1..12.
1231
1232 =item monthnum(monthname)
1233
1234 Returns the number (1..12) of the month name provided. Only a minimal
1235 case-insensitive match on the month name is necessary; the proper item
1236 symbol for the month will be determined from this match.
1237
1238 =item dayname(daynum)
1239
1240 Returns the name (item symbol) of the day of week header for a number of
1241 a day of the week, where I<daynum> is 1..7.
1242
1243 =item daynum(dayname)
1244
1245 Returns the number of the day of the week given the symbolic name for
1246 that day (Su..Sa).
1247
1248 =item daytime(day)
1249
1250 Returns the number in seconds since the epoch for a given day. The day
1251 must be present in the current calendar.
1252
1253 =back
1254
1255 =head1 Notes On Dates And Spatial Relationships
1256
1257 One of the nice things about having a calendar represented as a table
1258 accessible with grid coordinates is that some of the trickier date
1259 calculations become trivial. You can use packages such as I<Date::Manip>
1260 or I<Date::Calc> for these sort of things, but the algorithms are often
1261 derived from a common human activity: looking at a calendar on a wall.
1262 Say, for instance, that you are interested in "the third Friday of every
1263 month". If you are using a calendar with Sunday as the first day of the
1264 week, then Fridays will always be in column 5, starting from 0.
1265 Likewise, due to the fact that supressed headers are merely I<masked> in
1266 the actual table, the first row with dates in a calendar structure will
1267 B<always> be 2, even if the month, year, or day headers are disabled.
1268 The third friday of every month therefore becomes C<$c-E<gt>cell(2,5)>,
1269 regardless of the particular month. Likewise, the "nth dayname/week of
1270 the month" can always be mapped to table coordinates.
1271
1272 The particulars of this grid mapping are affected if you have redefined
1273 what the first day of the week is, or if you have tweaked the table
1274 beyond the bounds of the calendar itself. There are methods that can
1275 help under these circumstances, though. For instance, in our example
1276 where we are interested in the 3rd Friday of the month, the row number
1277 is accessed with C<$c-E<gt>first_week_row + 2>, whereas the column
1278 number could be derived with C<$c-E<gt>last_col - 1>.
1279
1280 =head1 REQUIRES
1281
1282 HTML::ElementTable
1283
1284 =head1 OPTIONAL
1285
1286 Date::Calc or Date::Manip (only if you want week-of-year numbering or
1287 non-contemporary dates on a system without the I<cal> command)
1288
1289 =head1 AUTHOR
1290
1291 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
1292
1293 =head1 COPYRIGHT
1294
1295 Copyright (c) 1998-2005 Matthew P. Sisk. All rights reserved. All wrongs
1296 revenged. This program is free software; you can redistribute it and/or
1297 modify it under the same terms as Perl itself.
1298
1299 =head1 SEE ALSO
1300
1301 A useful page of examples can be found at
1302 http://www.mojotoad.com/sisk/projects/HTML-CalendarMonth.
1303
1304 For information on iso639 standards for abbreviations for language
1305 names, see http://www.loc.gov/standards/iso639-2/englangn.html
1306
1307 HTML::ElementTable(3), HTML::Element(3), perl(1)
1308
1309 =cut