package HTML::Widget::Constraint::DateTime; use warnings; use strict; use base 'HTML::Widget::Constraint'; use Date::Calc; =head1 NAME HTML::Widget::Constraint::DateTime - DateTime Constraint =head1 SYNOPSIS my $c = $widget->constraint( 'DateTime', 'year', 'month', 'day', 'hour', 'minute', 'second' ); =head1 DESCRIPTION DateTime Constraint. =head1 METHODS =head2 process =cut sub process { my ( $self, $w, $params ) = @_; # PS: Commented out. What if I don't want to provide time? I could use # 'Date', but, all these fields are allowed to be 0 anyway. And I may # not want to check seconds or minutes. So we'll change this to #3 # return [] # unless ( $self->names && @{ $self->names } == 6 ); return [] unless ( $self->names && @{ $self->names } >= 3 ); my ( $year, $month, $day, $hour, $min, $sec ) = @{ $self->names }; my $y = $params ->{$year}; # 0 is a valid year, but Date::Calc doesn't support it my $mo = $params->{$month}; my $d = $params->{$day}; my $h = $params->{$hour} || 0; my $mi = $params->{$min} || 0; my $s = $params->{$sec} || 0; # PS: Commented out. This is silly. Hour, minute, and second # can all be validly 0. # return [] unless ( $y && $mo && $d && $h && $mi && $s ); return [] unless ( $y && $mo && $d ); my $results = []; unless ( $y =~ /^\d+$/ && $mo =~ /^\d+$/ && $d =~ /^\d+$/ && $h =~ /^\d+$/ && $mi =~ /^\d+$/ && $s =~ /^\d+$/ && Date::Calc::check_date( $y, $mo, $d ) && Date::Calc::check_time( $h, $mi, $s ) ) { push @$results, HTML::Widget::Error->new( { name => $year, message => $self->mk_message } ); push @$results, HTML::Widget::Error->new( { name => $month, message => $self->mk_message } ); push @$results, HTML::Widget::Error->new( { name => $day, message => $self->mk_message } ); push @$results, HTML::Widget::Error->new( { name => $hour, message => $self->mk_message } ); push @$results, HTML::Widget::Error->new( { name => $min, message => $self->mk_message } ); push @$results, HTML::Widget::Error->new( { name => $sec, message => $self->mk_message } ); } return $results; } =head1 AUTHOR Sebastian Riedel, C =head1 LICENSE This library is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;