lib/HTML/CalendarMonth.pm

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