[deb_pkgs/libhtml-calendarmonth-perl.git] / lib / HTML / CalendarMonth.pm

package HTML::CalendarMonth;
BEGIN {
  $HTML::CalendarMonth::VERSION = '1.25';
}

use strict;
use warnings;
use Carp;

BEGIN { $HTML::CalendarMonth::VERSION = 1.25 }

use HTML::ElementTable 1.18;
use HTML::CalendarMonth::Locale;
use HTML::CalendarMonth::DateTool;

use base qw( Class::Accessor HTML::ElementTable );

my %Objects;

# default complex attributes
my %Calmonth_Attrs = (
  head_m      => 1,     # month heading mode
  head_y      => 1,     # year heading mode
  head_dow    => 1,     # DOW heading mode
  head_week   => 0,     # weak of year
  year_span   => 2,     # default col span of year

  today       => undef, # DOM, if not now
  week_begin  => 1,     # what DOW (1-7) is the 1st DOW?

  historic    => 1,     # if able to choose, use ncal/cal
                        # rather than Date::Calc, which
                        # blindly extrapolates Gregorian

  alias       => {},    # what gets displayed if not
                        # the default item

  month       => undef, # these will get initialized
  year        => undef,

  locale      => 'en_US',
  full_days   => 0,
  full_months => 1,

  datetool    => undef,

  enable_css   => 1,
  semantic_css => 0,

  # internal muckety muck
  _cal      => undef,
  _itoch    => {},
  _ctoih    => {},
  _caltool  => undef,
  _weeknums => undef,
  _today    => undef,

  dow1st   => undef,
  lastday  => undef,
  loc      => undef,

  # deprecated
  row_offset => undef,
  col_offset => undef,
);

__PACKAGE__->mk_accessors(keys %Calmonth_Attrs);

# Class::Accessor overrides

sub set {
  my($self, $key) = splice(@_, 0, 2);
  if (@_ == 1) {
    $Objects{$self}{$key} = $_[0];
  }
  elsif (@_ > 1) {
    $Objects{$self}{$key} = [@_];
  }
  else {
    Carp::confess("wrong number of arguments received");
  }
}

sub get {
  my $self = shift;
  if (@_ == 1) {
    return $Objects{$self}{$_[0]};
  }
  elsif ( @_ > 1 ) {
    return @{$Objects{$self}{@_}};
  }
  else {
    Carp::confess("wrong number of arguments received.");
  }
}

sub _is_calmonth_attr { shift; exists $Calmonth_Attrs{shift()} }

sub _set_defaults {
  my $self = shift;
  foreach (keys %Calmonth_Attrs) {
    $self->$_($Calmonth_Attrs{$_});
  }
  $self;
}

sub DESTROY { delete $Objects{shift()} }

# last dow col, first week row

use constant LDC => 6;
use constant FWR => 2;

# alias

sub item_alias {
  my($self, $item) = splice(@_, 0, 2);
  defined $item or croak "item name required";
  $self->alias->{$item} = shift if @_;
  $self->alias->{$item} || $item;
}

sub item_aliased {
  my($self, $item) = splice(@_, 0, 2);
  defined $item or croak "item name required.\n";
  defined $self->alias->{$item};
}

# header toggles

sub _head {
  # Set/test entire heading (month,year,and dow headers) (does not
  # affect week number column). Return true if either heading active.
  my $self = shift;
  $self->head_m(@_) && $self->head_dow(@_) if @_;
  $self->_head_my || $self->head_dow;
}

sub _head_my {
  # Set/test month and year header mode
  my($self, $mode) = splice(@_, 0, 2);
  $self->head_m($mode) && $self->head_y($mode) if defined $mode;
  $self->head_m || $self->head_y;
}

sub _initialized {
  my $self = shift;
  @_ ? $self->{_initialized} = shift : $self->{_initialized};
}

# circa interface

sub _date {
  # set target month, year
  my $self = shift;
  if (@_) {
    my ($month, $year) = @_;
    $month && defined $year || croak "date method requires month and year";
    croak "Date already set" if $self->_initialized();

    # get rid of possible leading 0's
    $month += 0;
    $year  += 0;

    $month <= 12 && $month >= 1 or croak "Month $month out of range (1-12)\n";
    $year > 0 or croak "Negative years are unacceptable\n";

    $self->month($self->monthname($month));
    $self->year($year);
    $month = $self->monthnum($month);

    # trigger _gencal...this should be the only place where this occurs
    $self->_gencal;
  }
  return($self->month, $self->year);
}

# class factory access

use constant CLASS_HET      => 'HTML::ElementTable';
use constant CLASS_DATETOOL => 'HTML::CalendarMonth::DateTool';
use constant CLASS_LOCALE   => 'HTML::CalendarMonth::Locale';

sub _gencal {
  # generate internal calendar representation
  my $self = shift;

  # new calendar...clobber day-specific settings
  my $itoc = $self->_itoch({});
  my $ctoi = $self->_ctoih({});

  # figure out dow of 1st day of the month as well as last day of the
  # month (uses date calculator backends)
  $self->_anchor_month();

  # row count for weeks in grid
  my $wcnt = 0;

  my ($dowc) = $self->dow1st;
  my $skips  = $self->_caltool->_skips;

  # for each day
  foreach (1 .. $self->lastday) {
    next if $skips->{$_};
    my $r = $wcnt + FWR;
    my $c = $dowc;
    # this is a bootstrap until we know the number of rows in the month.
    $itoc->{$_} = [$r, $c];
    $dowc = ++$dowc % 7;
    ++$wcnt unless $dowc || $_ == $self->lastday;
  }

  $self->{_week_rows} = $wcnt;

  my $row_extent = $wcnt + FWR;
  my $col_extent = LDC;
  $col_extent += 1 if $self->head_week;

  $self->SUPER::extent($row_extent, $col_extent);

  # table can contain the days now, so replace our bootstrap coordinates
  # with references to the actual elements.
  foreach (keys %$itoc) {
    my $cellref = $self->cell(@{$itoc->{$_}});
    $self->_itoc($_, $cellref);
    $self->_ctoi($cellref, $_);
  }

  # week num affects month/year spans
  my $width = $self->head_week ? 8 : 7;

  # month/year headers
  my $cellref = $self->cell(0, 0);
  $self->_itoc($self->month, $cellref);
  $self->_ctoi($cellref, $self->month);
  $cellref = $self->cell(0, $width - $self->year_span);
  $self->_itoc($self->year,  $cellref);
  $self->_ctoi($cellref, $self->year);

  $self->item($self->month)->replace_content($self->item_alias($self->month));
  $self->item($self->year)->replace_content($self->item_alias($self->year));

  if ($self->_head_my) {
    if ($self->head_m) {
      $self->item($self->month)->attr('colspan',$width - $self->year_span);
    }
    else {
      $self->item($self->month)->mask(1);
      $self->item($self->year)->attr('colspan', $width);
    }
    if ($self->head_y) {
      $self->item($self->year)->attr('colspan',$self->year_span);
    }
    else {
      $self->item($self->year)->mask(1);
      $self->item($self->month)->attr('colspan', $width);
    }
  }
  else {
    $self->row(0)->mask(1);
  }

  # DOW headers
  my $trans;
  my $days = $self->loc->days;
  foreach (0..$#$days) {
    # Transform for week_begin 1..7
    $trans = ($_ + $self->week_begin - 1) % 7;
    my $cellref = $self->cell(1, $_);
    $self->_itoc($days->[$trans], $cellref);
    $self->_ctoi($cellref, $days->[$trans]);
  }
  if ($self->head_dow) {
    grep($self->item($_)->replace_content($self->item_alias($_)), @$days);
  }
  else {
    $self->row(1)->mask(1);
  }

  # week number column
  if ($self->head_week) {
    # week nums can collide with days. Use "w" in front of the number
    # for uniqueness, and automatically alias to just the number (unless
    # already aliased, of course).
    $self->_gen_week_nums();
    my $ws;
    my $row_count = FWR;
    foreach ($self->_numeric_week_nums) {
      $ws = "w$_";
      $self->item_alias($ws, $_) unless $self->item_aliased($ws);
      my $cellref = $self->cell($row_count, $self->last_col);
      $self->_itoc($ws, $cellref);
      $self->_ctoi($cellref, $ws);
      $self->item($ws)->replace_content($self->item_alias($ws));
      ++$row_count;
    }
  }

  # fill in days of the month
  my $i;
  foreach my $r (FWR .. $self->last_row) {
    foreach my $c (0 .. LDC) {
      $self->cell($r,$c)->replace_content($self->item_alias($i))
        if ($i = $self->item_at($r,$c));
    }
  }

  # css classes
  if ($self->enable_css) {
    $self                             ->push_attr(class => 'hcm-table'     );
    $self->item_row($self->dayheaders)->push_attr(class => 'hcm-day-head'  );
    $self->item    ($self->year)      ->push_attr(class => 'hcm-year-head' );
    $self->item    ($self->month)     ->push_attr(class => 'hcm-month-head');
    $self->item    ($self->week_nums) ->push_attr(class => 'hcm-week-head' )
      if $self->head_week;
  }

  if ($self->semantic_css) {
    my $today = $self->today;
    if ($today < 0) {
      $self->item($self->days)->push_attr(class => 'hcm-past');
    }
    elsif ($today == 0) {
      $self->item($self->days)->push_attr(class => 'hcm-future');
    }
    else {
      for my $d ($self->days) {
        if ($d < $today) {
          $self->item($d)->push_attr(class => 'hcm-past');
        }
        elsif ($d > $today) {
          $self->item($d)->push_attr(class => 'hcm-future');
        }
        else {
          $self->item($d)->push_attr(class => 'hcm-today');
        }
      }
    }
  }

  $self;
}

sub default_css {
  my $hbgc = '#DDDDDD';
  my $bc   = '#888888';

  my $str = <<__CSS;
<style type="text/css">
  <!--

  table.hcm-table {
    border: thin solid $bc;
    border-collapse: collapse;
    text-align: right;
  }

  .hcm-table td, th {
    padding-left:  2px;
    padding-right: 2px;
  }

  .hcm-year-head  {
    text-align: right;
    background-color: $hbgc;
  }

  .hcm-month-head {
    text-align: left;
    background-color: $hbgc;
  }

  .hcm-day-head   {
    text-align: right;
    background-color: $hbgc;
    border-bottom: thin solid $bc;
   }

  .hcm-week-head  {
    font-size: small;
    background-color: $hbgc;
    border-left: thin solid $bc;
  }

-->
</style>
__CSS

}

sub _datetool {
  my $self = shift;
  my $ct;
  if (! ($ct = $self->_caltool)) {
    $ct = $self->_caltool(CLASS_DATETOOL->new(
      year     => $self->year,
      month    => $self->month,
      weeknum  => $self->head_week,
      historic => $self->historic,
      datetool => $self->datetool,
    ));
  }
  $ct;
}

sub _anchor_month {
  # Figure out what our month grid looks like.
  # Let HTML::CalendarMonth::DateTool determine which method is
  # appropriate.
  my $self = shift;

  my $month = $self->monthnum($self->month);
  my $year  = $self->year;

  my $tool = $self->_datetool;

  my $dow1st  = $tool->dow1st; # 0..6, starting with Sun
  my $lastday = $tool->lastday;

  # week_begin given as 1..7 starting with Sun
  $dow1st = ($dow1st - ($self->week_begin - 1)) % 7;

  $self->dow1st($dow1st);
  $self->lastday($lastday);

  $self;
}

sub _gen_week_nums {
  # Generate week-of-the-year numbers. The first week is generally
  # agreed upon to be the week that contains the 4th of January.
  #
  # For purposes of shenanigans with 'week_begin', we anchor the week
  # number off of Thursday in each row.

  my $self = shift;

  my($year, $month, $lastday) = ($self->year, $self->monthnum, $self->lastday);

  my $tool = $self->_caltool;
  croak "Oops. " . ref $tool . " not set up for week of year calculations.\n"
    unless $tool->can('week_of_year');

  my $fdow = $self->dow1st;
  my $delta = 4 - $fdow;
  if ($delta < 0) {
    $delta += 7;
  }
  my @ft = $tool->add_days($delta, 1);

  my $ldow = $tool->dow($lastday);
  $delta = 4 - $ldow;
  if ($delta > 0) {
    $delta -= 7;
  }
  my @lt = $tool->add_days($delta, $lastday);

  my $fweek = $tool->week_of_year(@ft);
  my $lweek = $tool->week_of_year(@lt);
  my @wnums = $fweek > $lweek ? ($fweek, 1 .. $lweek) : ($fweek .. $lweek);

  # do we have days above our first Thursday?
  if ($self->row_of($ft[0]) != FWR) {
    unshift(@wnums, $wnums[0] -1);
  }

  # do we have days below our last Thursday?
  if ($self->row_of($lt[0]) != $self->last_row) {
    push(@wnums, $wnums[-1] + 1);
  }

  # first visible week is from last year
  if ($wnums[0] == 0) {
    $wnums[0] = $tool->week_of_year($tool->add_days(-7, $ft[0]));
  }

  # last visible week is from subsequent year
  if ($wnums[-1] > $lweek) {
    $wnums[-1] = $tool->week_of_year($tool->add_days(7, $lt[0]));
  }

  $self->_weeknums(\@wnums);
}

# month hooks

sub row_items {
  # given a list of items, return all items in rows shared by the
  # provided items.
  my $self = shift;
  my %items;
  foreach my $item (@_) {
    my $row = ($self->coords_of($item))[0];
    foreach my $col (0 .. $self->last_col) {
      my $i = $self->item_at($row, $col) || next;
      ++$items{$i};
    }
  }
  keys %items > 1 ? keys %items : (keys %items)[0];
}

sub col_items {
  # return all item cells in the columns occupied by the provided list
  # of items.
  my $self = shift;
  $self->_col_items(0, $self->last_row, @_);
}

sub daycol_items {
  # same as col_items(), but excludes header cells.
  my $self = shift;
  $self->_col_items(FWR, $self->last_row, @_);
}

sub _col_items {
  # given row bounds and a list of items, return all item elements
  # in the columns occupied by the provided items. Does not return
  # empty cells.
  my($self, $rfirst, $rlast) = splice(@_, 0, 3);
  my %items;
  my($item, $row, $col, %i);
  foreach my $item (@_) {
    my $col = ($self->coords_of($item))[1];
    foreach my $row ($rfirst .. $rlast) {
      my $i = $self->item_at($row,$col) || next;
      ++$items{$i};
    }
  }
  keys %items > 1 ? keys %items : (keys %items)[0];
}

sub daytime {
  # return seconds since epoch for a given day
  my($self, $day) = splice(@_, 0, 2);
  $day or croak "must specify day of month";
  croak "day does not exist" unless $self->_daycheck($day);
  $self->_caltool->day_epoch($day);
}

sub week_nums {
  # return list of all week number labels
  my @wnums = map("w$_", shift->_numeric_week_nums);
  wantarray ? @wnums : \@wnums;
}

sub _numeric_week_nums {
  # return list of all week numbers as numbers
  my $self = shift;
  return unless $self->head_week;
  wantarray ? @{$self->_weeknums} : $self->_weeknums;
}

sub days {
  # return list of all days of the month (1..$c->lastday).
  my $self = shift;
  my $skips = $self->_caltool->_skips;
  my @days = grep { !$skips->{$_} } (1 .. $self->lastday);
  wantarray ? @days : \@days;
}

sub dayheaders {
  # return list of all day headers (Su..Sa).
  shift->loc->days;
}

sub headers {
  # return list of all headers (month,year,dayheaders)
  my $self = shift;
  wantarray ? ($self->year, $self->month, $self->dayheaders)
            : [$self->year, $self->month, $self->dayheaders];
}

sub items {
  # return list of all items (days, headers)
  my $self = shift;
  wantarray ? ($self->headers, $self->days)
            : [$self->headers, $self->days];
}

sub last_col {
  # what's the max col of the calendar?
  my $self = shift;
  $self->head_week ? LDC + 1 : LDC;
}

sub last_day_col { LDC }

sub last_row {
  # last row of the calendar
  my $self = shift;
  return ($self->coords_of($self->lastday))[0];
}

*last_week_row = \&last_row;

sub first_week_row { FWR };

sub past_days {
  my $self  = shift;
  my $today = $self->_today;
  if ($today < 0) {
    return $self->days;
  }
  elsif ($today == 0) {
    return;
  }
  return(1 .. $today);
}

sub future_days {
  my $self  = shift;
  my $today = $self->_today;
  if ($today < 0) {
    return;
  }
  elsif ($today == 0) {
    return $self->days;
  }
  return($today .. $self->last_day);
}

# custom glob interfaces

sub item {
  # return TD elements containing items
  my $self = shift;
  @_ || croak "item(s) must be provided";
  $self->cell(grep(defined $_, map($self->coords_of($_), @_)));
}

sub item_row {
  # return a glob of the rows of a list of items, including empty cells.
  my $self = shift;
  $self->row(map { $self->row_of($_) } @_);
}

sub item_day_row {
  # same as item_row, but excludes possible week number cells
  my $self = shift;
  return $self->item_row(@_) unless $self->head_week;
  my(%rows, @coords);
  for my $r (map { $self->row_of($_) } @_) {
    next if ++$rows{$r} > 1;
    for my $c (0 .. 6) {
      push(@coords, ($r, $c));
    }
  }
  $self->cell(@coords);
}

sub item_week_nums {
  # glob of all week numbers
  my $self = shift;
  $self->item($self->week_nums);
}

sub item_col {
  # return a glob of the cols of a list of items, including empty cells.
  my $self = shift;
  $self->_item_col(0, $self->last_row, @_);
}

sub item_daycol {
  # same as item_col(), but excludes header cells.
  my $self = shift;
  $self->_item_col(2, $self->last_row, @_);
}

sub _item_col {
  # given row bounds and a list of items, return a glob representing
  # the cells in the columns occupied by the provided items, including
  # empty cells.
  my($self, $rfirst, $rlast) = splice(@_, 0, 3);
  defined $rfirst && defined $rlast or Carp::confess "No items provided";
  my(%seen, @coords);
  foreach my $col (map { $self->col_of($_) } @_) {
    next if ++$seen{$col} > 1;
    foreach my $row ($rfirst .. $rlast) {
      push(@coords, $row, $col);
    }
  }
  $self->cell(@coords);
}

sub item_box {
  # return a glob of the box defined by two items
  my($self, $item1, $item2) = splice(@_, 0, 3);
  defined $item1 && defined $item2 or croak "Two items required";
  $self->box($self->coords_of($item1), $self->coords_of($item2));
}

sub all {
  # return a glob of all calendar cells, including empty cells.
  my $self = shift;
  $self->box( 0,0 => $self->last_row, $self->last_col );
}

sub alldays {
  # return a glob of all cells other than header cells
  my $self = shift;
  $self->box( 2, 0 => $self->last_row, 6 );
}

sub allheaders {
  # return a glob of all header cells
  my $self = shift;
  $self->item($self->headers);
}

# transformation Methods

sub coords_of {
  # convert an item into grid coordinates
  my $self = shift;
  croak "undefined value passed to coords_of()" if @_ && ! defined $_[0];
  my $ref = $self->_itoc(@_);
  my @pos = ref $ref ? $ref->position : ();
  @pos ? (@pos[$#pos - 1, $#pos]) : ();
}

sub item_at {
  # convert grid coords into item
  my $self = shift;
  $self->_ctoi($self->cell(@_));
}

sub _itoc {
  # item to grid
  my($self, $item, $ref) = splice(@_, 0, 3);
  defined $item or croak "item required";
  my $itoc = $self->_itoch;
  if ($ref) {
    croak "Reference required" unless ref $ref;
    $itoc->{$item} = $ref;
  }
  $itoc->{$item};
}

sub _ctoi {
  # cell reference to item
  my($self, $refstring, $item) = splice(@_, 0, 3);
  defined $refstring or croak "cell id required";
  my $ctoi = $self->_ctoih;
  if (defined $item) {
    $ctoi->{$refstring} = $item;
  }
  $ctoi->{$refstring};
}

sub row_of {
  my $self = shift;
  ($self->coords_of(@_))[0];
}

sub col_of {
  my $self = shift;
  ($self->coords_of(@_))[1];
}

sub monthname {
  # check/return month...returns name. Accepts month number or string.
  my $self = shift;
  return $self->month unless @_;
  my $loc = $self->loc;
  my @names;
  for my $m (@_) {
    $m = ($m - 1) % 12 if $m && $m =~ /^\d+$/;
    $m = $loc->monthname($m) || croak "month not found " . join(', ', @_);
    return $m if @_ == 1;
    push(@names, $m);
  }
  @names;
}

sub monthnum {
  # check/return month, returns number. Accepts month number or string.
  my $self   = shift;
  my @months = @_ ? @_ : $self->month;
  my $loc = $self->loc;
  my @nums;
  for my $m (@months) {
    $m = ($m - 1) % 12 if $m && $m =~ /^\d+$/;
    $m = $loc->monthnum($m);
    croak "month not found ", join(', ', @_) unless defined $m;
    $m += 1;
    return $m if @_ == 1;
    push(@nums, $m);
  }
  @nums;
}

sub dayname {
  # check/return day...returns name. Accepts 1..7, or Su..Sa
  my $self = shift;
  @_ || croak "day string or num required";
  my $loc = $self->loc;
  my @names;
  for my $d (@_) {
    if ($d =~ /^\d+$/) {
      $d = (($d - 1) % 7) + $self->week_begin - 1;
    }
    $d = $loc->dayname($d) || croak "day not found ", join(', ', @_);
    return $d if @_ == 1;
    push(@names, $d);
  }
  @names;
}

sub daynum {
  # check/return day number 1..7, returns number. Accepts 1..7,
  # or Su..Sa
  my $self = shift;
  @_ || croak "day string or num required";
  my $loc  = $self->loc;
  my @nums;
  for my $d (@_) {
    if ($d =~ /^\d+$/) {
      $d = (($d - 1) % 7) + $self->week_begin - 1;
    }
    $d = $loc->daynum($d);
    croak "day not found ", join(', ', @_) unless defined $d;
    $d += 1;
    return $d if @_ == 1;
    push(@nums, $d);
  }
  @nums;
}

# tests-n-checks

sub _dayheadcheck {
  # test day head names
  my($self, $name) = splice(@_, 0, 2);
  $name or croak "name missing";
  return if $name =~ /^\d+$/;
  $self->daynum($name);
}

sub _daycheck {
  # check if an item is a day of the month (1..31)
  my($self, $item) = splice(@_, 0, 2);
  croak "item required" unless $item;
  # can't just invert _headcheck because coords_of() needs _daycheck,
  # and _headcheck uses coords_of()
  $item =~ /^\d{1,2}$/ && $item <= 31;
}

sub _headcheck {
  # check if an item is a header
  !_daycheck(@_);
}

# constructors/destructors

sub new {
  my $class = shift;
  my %parms = @_;
  my(%attrs, %tattrs);
  foreach (keys %parms) {
    if (__PACKAGE__->_is_calmonth_attr($_)) {
      $attrs{$_} = $parms{$_};
    }
    else {
      $tattrs{$_} = $parms{$_};
    }
  }

  my $self = CLASS_HET->new(%tattrs);
  bless $self, $class;

  # set defaults
  $self->_set_defaults;

  my $month = delete $attrs{month};
  my $year  = delete $attrs{year};
  if (!$month || !$year) {
    my ($nmonth,$nyear) = (localtime(time))[4,5];
    ++$nmonth; $nyear += 1900;
    $month ||= $nmonth;
    $year  ||= $nyear;
  }
  $self->month($month);
  $self->year($year);

  # set overrides
  for my $k (keys %attrs) {
    $self->$k($attrs{$k}) if defined $attrs{$k};
  }

  my $loc = CLASS_LOCALE->new(
    id          => $self->locale,
    full_days   => $self->full_days,
    full_months => $self->full_months,
  ) or croak "Problem creating locale " . $self->locale . "\n";
  $self->loc($loc);

  my $dt = CLASS_DATETOOL->new(
      year     => $self->year,
      month    => $self->month,
      weeknum  => $self->head_week,
      historic => $self->historic,
      datetool => $self->datetool,
  );
  $self->_caltool($dt);

  $self->week_begin($loc->first_day_of_week + 1)
    unless defined $attrs{week_begin};

  my $dom_now = defined $attrs{today} ? $dt->_dom_now(delete $attrs{today})
                                      : $dt->_dom_now;
  $self->_today($dom_now);
  $self->today($dom_now) if $dom_now > 0;

  my $alias = $attrs{alias} || {};
  if ($self->full_days < 0) {
    my @full   = $self->loc->days;
    my @narrow = $self->loc->narrow_days;
    for my $i (0 .. $#narrow) {
      $alias->{$full[$i]} = $narrow[$i];
    }
  }
  if ($self->full_months < 0) {
    my @full   = $self->loc->months;
    my @narrow = $self->loc->narrow_months;
    for my $i (0 .. $#narrow) {
      $alias->{$full[$i]} = $narrow[$i];
    }
  }
  $self->alias($alias) if keys %$alias;

  # for now, this is the only time this will every happen for this
  # object. It is now 'initialized'.
  $self->_date($month, $year);

  $self;
}

### overrides (our table is static)

sub extent { }
sub maxrow { shift->SUPER::maxrow }
sub maxcol { shift->SUPER::maxcol }

### deprecated

use constant row_offset     => 0;
use constant col_offset     => 0;
use constant first_col      => 0;
use constant first_row      => 0;
use constant first_week_col => 0;
use constant last_week_col  => 6;

###

1;

__END__

=head1 NAME

HTML::CalendarMonth - Generate and manipulate HTML calendar months

=head1 SYNOPSIS

 use HTML::CalendarMonth;

 # Using regular HTML::Element creation
 my $c = HTML::CalendarMonth->new( month => 8, year => 2010 );
 print $c->as_HTML;

 # Full locale support via DateTime::Locale
 my $c2 = HTML::CalendarMonth->new(
   month  => 8,
   year   => 2010,
   locale => 'zu_ZA'
 );
 print $c2->as_HTML;

 # Full locale support via DateTime::Locale
 $c3 = HTML::CalendarMonth->new( month => 8, year => 79, locale => 'fr' );
 print $c3->as_HTML

 # HTML-Tree integration
 my $tree = HTML::TreeBuilder->parse_file('cal.html');
 $tree->find_by_attribute(class => 'hcm-calendar')->replace_with($c);
 print $tree->as_HTML;

 # clean up if you're not done, HTML::Element structures must be
 # manually destroyed
 $c->delete; $c2->delete;

=head1 DESCRIPTION

HTML::CalendarMonth is a subclass of HTML::ElementTable. See
L<HTML::ElementTable(3)> for how that class works, for it affects this
module on many levels. Like HTML::ElementTable, HTML::CalendarMonth is
an enhanced HTML::Element with methods added to facilitate the
manipulation of the calendar table elements as a whole.

The primary interaction with HTML::CalendarMonth is through I<items>
rather than cell coordinates like HTML::ElementTable uses. An I<item> is
merely a string that represents the content of the cell of interest
within the calendar. For instance, the element representing the 14th day
of the month would be returned by C<$c-E<gt>item(14)>. Similarly, the
element representing the header for Monday would be returned by C<$c-
E<gt>item('Mo')>. If the year happened to by 2010, then C<$c-
E<gt>item(2010)> would return the cell representing the year. Since
years and particular months change frequently, it is probably more
useful to take advantage of the C<month()> and C<year()> methods, which
return their respective values. The following is therefore the same as
explicitly referencing the year: C<$c-E<gt>item($c- E<gt>year())>.

Multiple cells of the calendar can be manipulated as if they were a
single element. For instance, C<$c-E<gt>item(15)-E<gt>attr(class =E<gt>
'fancyday')> would alter the class of the cell representing the 15th. By
the same token, C<$c-E<gt>item(15, 16, 17,
23)-E<gt>attr(class =E<gt> 'fancyday')> would do the same thing for all
cells containing the days passed to the C<item()> method.

Underneath, the calendar is still nothing more than a table structure,
the same as provided by the HTML::ElementTable class. In addition to the
I<item> based access methods above, calendar cells can still be accessed
using row and column grid coordinates using the C<cell()> method
provided by the table class. All coordinate-based methods in the table
class are accessible to the calendar class.

The module includes support for week-of-the-year numbering, arbitrary
1st day of the week definitions, and locale support.

Dates that are beyond the range of the built-in time functions of perl
are handled either by the ncal/cal command, Date::Calc, DateTime, or
Date::Manip. The presence of any one of these utilities and modules will
suffice for these far flung date calculations. One of these utilities
(with the exception of 'cal') is also required if you want to use week-of-
year numbering.

Full locale support is offered via DateTime::Locale. For a full list of
supported locale id's, look at HTML::CalendarMonth::Locale->locales().

=head1 METHODS

All arguments appearing in [brackets] are optional, and do not represent
anonymous array references.

=head2 Constructor

=over

=item new()

With no arguments, the constructor will return a calendar object
representing the current month with a default appearance. The initial
configuration of the calendar is controlled by special attributes. Non-
calendar related attributes are passed along to HTML::ElementTable. Any
non-table related attributes left after that are passed to HTML::Element
while constructing the E<lt>tableE<gt> tag. See L<HTML::ElementTable> if
you are interested in attributes that can be passed along to that class.

Special Attributes for HTML::CalendarMonth:

=over

=item month

1-12, or Jan-Dec.  Defaults to current month.

=item year

Four digit representation. Defaults to current year.

=item head_m

Specifies whether to display the month header. Default 1.

=item head_y 

Specifies whether to display the year header. Default 1.

=item head_dow

Specifies whether to display days of the week header. Default 1.

=item locale

Specifies the id of the locale in which to render the calendar. Default
is 'en_US'. By default, this will also control determine which day is
considered to be the first day of the week. See
L<HTML::CalendarMonth::Locale> for more information. If for some reason
you prefer to use different labels than those provided by C<locale>, see
the C<alias> attribute below.

=item full_days

Specifies whether or not to use full day names or their abbreviated
names. Default is 0, use abbreviated names. Use -1 for 'narrow' mode,
the shortest (not guaranteed to be unique) abbreviations.

=item full_months

Specifies whether or not to use full month names or their abbreviated
names. Default is 1, use full names. Use -1 for 'narrow' mode, the
shortest (not guaranteed to be unique) abbreviations.

=item alias

Takes a hash reference mapping labels provided by C<locale> to any
custom label you prefer. Lookups, such as C<day('Sun')>, will still use
the locale string, but when the calendar is rendered the aliased value
will appear.

=item head_week

Specifies whether to display the week-of-year numbering. Default 0.

=item week_begin

Specify first day of the week, which can be 1..7, starting with Sunday.
In order to specify Monday, set this to 2, and so on. By default, this
is determined based on the locale.

=item enable_css

Set some handy CSS class attributes on elements, enabled by default.
Currently the classes are:

  hcm-table       Set on the <lt>table<gt> tag of the calendar
  hcm-day-head    Set on the day-of-week <lt>tr<gt> or <lt>td<gt> tags
  hcm-year-head   Set on the <lt>td<gt> tag for the year
  hcm-month-head  Set on the <lt>td<gt> tag for the month
  hcm-week-head   Set on the <lt>td<gt> tags for the week-of-year

=item semantic_css

Sets some additional CSS class attributes on elements, disabled by
default. The notion of 'today' is taken either from the system clock
(default) or from the 'today' parameter as provided to new(). Currently
these classes are:

  hcm-today    Set on the <lt>td<gt> tag for today, if present
  hcm-past     Set on the <lt>td<gt> tags for prior days, if present
  hcm-future   Set on the <lt>td<gt> tags for subsequent days, if present

=item today

Specify the value for 'today' if different from the local time as
reported by the system clock (the default). If specified as two or less
digits, it is assumed to be one of the days of the month in the current
calendar. If more than two digits, it is assumed to be a epoch time in
seconds. Otherwise it must be given as a string of the form 'YYYY-mm-
dd'. Note that the default value as determined by the system clock uses
localtime rather than gmtime.

=item historic

This option is ignored for dates that do not exceed the range of the built-
in perl time functions. For dates that B<do> exceed these ranges, this
option specifies the default calculation method. When set, if the 'ncal'
or 'cal' command is available on your system, that will be used rather
than the Date::Calc or Date::Manip modules. This can be an issue since
the date modules blindly extrapolate the Gregorian calendar, whereas
ncal/cal will revert to the Julian calendar during September 1752. If
either ncal or cal are not available on your system, this attribute is
meaningless. Defaults to 1.

=back

=back

=head2 Item Query Methods

The following methods return lists of item *symbols* (28, 29, 'Thu',
...) that are related in some way to the provided list of items. The
returned symbols may then be used as arguments to the glob methods
detailed further below.

=over

=item row_items(item1, [item2, ...])

Returns all item symbols in rows shared by the provided item symbols.

=item col_items(item1, [item2, ...])

Returns all item symbols in columns shared by the provided item symbols.

=item daycol_items(col_item1, [col_item2, ...])

Same as col_items(), but the returned item symbols are limited to those
that are not header items (month, year, day-of-week).

=item row_of(item1, [item2, ...])

Returns the row indices of rows containing the provided item symbols.

=item col_of(item1, [item2, ...])

Returns the column indices of columns containing the provided
item symbols.

=item lastday()

Returns the day number (symbol) of the last day of the month.

=item dow1st()

Returns the column index for the first day of the month.

=item days()

Returns a list of all days of the month as numbers.

=item week_nums()

Returns a list of week-of-year numbers for this month.

=item dayheaders()

Returns a list of all day headers (Su..Sa)

=item headers()

Returns a list of all headers (month, year, dayheaders)

=item items()

Returns a list of all item symbols (day number, header values) in
the calendar.

=item last_col()

Returns the index of the last column of the calendar (note that this
could be the week-of-year column if head_week is enabled).

=item last_day_col()

Returns the index of the last column of the calendar containing days of
the month (same as last_col() unless week-of-year is enabled).

=item first_week_row()

Returns the index of the first row of the calendar containing day items
(ie, the first week).

=item last_row()

Returns the index of the last row of the calendar.

=item today()

Returns the day of month for 'today', if present in the current
calendar.

=item past_days()

Returns a list of days prior to 'today'. If 'today' is in a future
month, all days are returned. If 'today' is in a past month, no days
are returned.

=item future_days()

Returns a list of days after 'today'. If 'today' is in a past
month, all days are returned. If 'today' is in a future month, no
days are returned.

=back

=head2 Glob Methods

Glob methods return references that are functionally equivalent to an
individual calendar cell. Mostly, they provide item based analogues to
the glob methods provided in HTML::ElementTable. In methods dealing with
rows, columns, and boxes, the globs include empty calendar cells (which
would otherwise need to be accessed through native HTML::ElementTable
methods). The row and column numbers returned by the item methods above
are compatible with the grid based methods in HTML::ElementTable.

For details on how these globs work, check out L<HTML::ElementTable> and
L<HTML::ElementGlob>.

=over

=item item(item1, [item2, ...])

Returns all cells containing the provided item symbols.

=item item_row(item1, [item2, ...])

Returns all cells in all rows occupied by the provided item symbols.

=item item_day_row(item1, [item2, ...])

Same as item_row() except excludes week-of-year cells, if present.

=item item_col(item1, [item2, ...])

Returns all cells in all columns occupied by the provided item symbols.

=item item_daycol(item1, [item2, ...])

Same as item_col() except limits the cells to non header cells.

=item item_week_nums()

Returns all week-of-year cells, if present.

=item item_box(item1a, item1b, [item2a, item2b, ...])

Returns all cells in the boxes defined by the item pairs provided.

=item allheaders()

Returns all header cells.

=item alldays()

Returns all non header cells, including empty cells.

=item all()

Returns all cells in the calendar, including empty cells.

=back

=head2 Transformation Methods

The following methods provide ways of translating between various item
symbols, coordinates, and other representations.

=over

=item coords_of(item)

Returns the row and column coordinates of the provided item symbol, for
use with the grid based methods in HTML::ElementTable.

=item item_at(row,column)

Returns the item symbol of the item at the provided coordinates, for use
with the item based methods of HTML::CalendarMonth.

=item monthname(monthnum)

Returns the name (item symbol) of the month number provided, where
I<monthnum> can be 1..12.

=item monthnum(monthname)

Returns the number (1..12) of the month name provided. Only a minimal
case-insensitive match on the month name is necessary; the proper item
symbol for the month will be determined from this match.

=item dayname(daynum)

Returns the name (item symbol) of the day of week header for a number of
a day of the week, where I<daynum> is 1..7.

=item daynum(dayname)

Returns the number of the day of the week given the symbolic name for
that day (Su..Sa).

=item daytime(day)

Returns the number in seconds since the epoch for a given day. The day
must be present in the current calendar.

=back

=head2 Other Methods

=over

=item default_css()

Returns a simple style sheet as a string that can be used in an HTML
document in conjunction with the classes assigned to elements when css
is enabled.

=back

=head1 REQUIRES

HTML::ElementTable

=head1 OPTIONAL

Date::Calc, DateTime, or Date::Manip (only if you want week-of-
year numbering or non-contemporary dates on a system without the
I<cal> command)

=head1 AUTHOR

Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>

=head1 COPYRIGHT

Copyright (c) 1998-2010 Matthew P. Sisk. All rights reserved. All wrongs
revenged. This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

A useful page of examples can be found at
http://www.mojotoad.com/sisk/projects/HTML-CalendarMonth.

For information on iso639 standards for abbreviations for language
names, see http://www.loc.gov/standards/iso639-2/englangn.html

HTML::ElementTable(3), HTML::Element(3), perl(1)

=for Pod::Coverage col_offset row_offset item_alias item_aliased last_week_row