#!/usr/bin/perl

use strict;
use warnings;

package Widget::Date;
use Moose;
use Date::Calc qw/check_date Today/;

has 'day'       =>  ( is => 'rw' );
has 'month'     =>  ( is => 'rw' );
has 'year'      =>  ( is => 'rw' );
has 'name'      =>  ( is => 'rw' );

sub set_today {
    my $self = shift;
    ($self->{'year'}, $self->{'month'}, $self->{'day'}) = Today;
}

sub is_valid {
    my $self = shift;
    return check_date($self->year, $self->month, $self->day);
}

sub as_text {
    my $self = shift;
    return $self->day . '.' . $self->month . '.' . $self->year;
}

sub from_cgi {
    my $self = shift;
    my $q = shift;
    die 'Widget::Date->from_cgi_query needs a CGI-object!' 
        unless ref $q eq 'CGI';
    $self->day($q->param($self->name . '_d'));
    $self->month($q->param($self->name . '_m'));
    $self->year($q->param($self->name . '_y'));
}

sub as_form {
    my $self = shift;
    my $o = '<select name="' . $self->name . '_d">' . "\n";
    $o .= ($_ == $self->day)  ? 
            '<option selected>' . $_ . '</option>' . "\n" :
            '<option>' . $_ . '</option>' . "\n" for 1 .. 31;
    $o .= '</select>' . "\n" . "&nbsp;" . "\n";
    
    $o .= '<select name="' . $self->name . '_m">' . "\n";
    $o .= ($_ == $self->month)  ? 
            '<option selected>' . $_ . '</option>' . "\n" :
            '<option>' . $_ . '</option>' . "\n" for 1 .. 12;
    $o .= '</select>' . "\n" . "&nbsp;" . "\n";
    
    $o .= '<select name="' . $self->name . '_y">' . "\n";
    $o .= ($_ == $self->year)  ? 
            '<option selected>' . $_ . '</option>' . "\n" :
            '<option>' . $_ . '</option>' . "\n" for 2007 .. 2020;
    $o .= '</select>' . "\n" . "&nbsp;" . "\n";
    return $o;
}

1;

#!/usr/bin/perl

use strict;
use warnings;

use CGI;
use CGI::Carp qw/warningsToBrowser fatalsToBrowser/;
use Data::Dumper;

use Widget::Date;

my $q = CGI->new;
my $wdgt = Widget::Date->new(name => 'date');
my $message = '';

if ($q->param('action') eq 'submit') {
    $wdgt->from_cgi($q);
    $message = "invalid date!" unless $wdgt->is_valid;
    
} else {
    $wdgt->set_today;
}

print   $q->header, $q->start_html, $q->h1($wdgt->as_text), $q->h2($message),
        $q->start_form, $wdgt->as_form, 
        $q->submit(-name => "action", -value => "submit"),
        $q->end_form, $q->end_html;