package HTML::Controls::Date;
use strict;
use vars '$VERSION';
use warnings;
use base 'HTML::Controls::Base';
use Date::Parse;

$VERSION='0.1';

=head1 NAME

HTML::Controls::Date - class for a date control

=head1 SYNOPSIS

   my $date = HTML::Controls::Date->new('name');

This class implements a control for entering dates. At the moment it
uses three C<input> fields, and L<Date::Parse|Date::Parse> for the
validation.

=head1 VALUE FORMAT

The internal representation of a date is a hash reference, with three
keys:

=over 4

=item C<y>

for the year

=item C<m>

for the month

=item C<d>

for the day

=back

So you should do:

  $date->setData({y=>2005,m=>9,d=>21});

and expect C<getData> to return such a hash reference.

=head1 REDEFINED PUBLIC METHODS

=head2 C<setDataFromPost>

Since this control uses three fields, this method had to be
redefined. It uses L</_get_fields> to access the C<POST>ed values, and
L</_pack_date> to make the hash.

=cut

sub setDataFromPost {
  my ($self,$request)=@_;
  $self->{value}=
    $self->_pack_date($self->_get_fields($self->{name},$request));
  $self->_validate_value();
}

=head1 REDEFINED PROTECTED METHODS

=head2 C<_body_template_name>

Returns C<'date.wt'>.

=cut

sub _body_template_name {
  'date.wt';
}

=head2 C<_body_template_parms>

Calls the
L<inherited method|HTML::Controls::Base/_body_template_parms>,
then adds to the hash the three values, with keys C<year>, C<month>,
C<day>.

=cut

sub _body_template_parms {
  my ($self)=@_;
  my %ret=%{$self->SUPER::_body_template_parms()};
  my ($year,$month,$day)=$self->_unpack_date($self->{value});
  %ret=(%ret,
        year=>$year,month=>$month,day=>$day
       );
  return \%ret;
};

=head2 C<_validate_value>

Calls the L<inherited method|HTML::Controls::Base/_validate_value>,
then calls L</_unpack_date> to get the current three values, and
passes them to L<str2time|Date::Parse/str2time> to check their
validity.

=cut

sub _validate_value {
  my ($self)=@_;
  $self->SUPER::_validate_value();
  my ($y,$m,$d)=$self->_unpack_date($self->{value});
  unless (str2time("$y-$m-$d")) {
    push @{$self->{errors}},'data non valida';
  }
}

=head1 ADDITIONAL METHODS

=head2 C<_unpack_date>

Given a date in internal representation, returns a list with year,
month, day.

=cut

sub _unpack_date {
  my ($self,$struct)=@_;
  return ($struct->{y},$struct->{m},$struct->{d});
}

=head2 C<_unpack_date>

Given a list with year, month, day, returns a date in internal
representation.

=cut

sub _pack_date {
  my ($self,$y,$m,$d)=@_;
  return +{y=>$y,m=>$m,d=>$d};
}

=head2 C<_get_fields>

Given a base name (i.e. the control's name) and a request object,
returns a list with year, month, day values.

I<NOTE>: this has to be kept in sync with the names generated by the
template.

=cut

sub _get_fields {
  my ($self,$name,$data)=@_;
  my @ret;
  no warnings;
  for (qw(y m d)) {
    push @ret,int($data->param("${name}_$_"));
  }
  return @ret;
}


=head1 COPYRIGHT

Copyright 2005 Gianni Ceccarelli, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;
