lib/HTML/CalendarMonth.pm

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