File Coverage

blib/lib/HTML/Widget/Constraint/Date.pm
Criterion Covered Total %
statement 27 27 100.0
branch 3 6 50.0
condition 9 18 50.0
subroutine 5 5 100.0
pod 1 1 100.0
total 45 57 78.9


line stmt bran cond sub pod time code
1             package HTML::Widget::Constraint::Date;
2              
3 88     88   90257 use warnings;
  88         232  
  88         3615  
4 88     88   2888 use strict;
  88         214  
  88         4375  
5 88     88   532 use base 'HTML::Widget::Constraint';
  88         457  
  88         12916  
6 88     88   549 use Date::Calc;
  88         202  
  88         36681  
7              
8             =head1 NAME
9              
10             HTML::Widget::Constraint::Date - Date Constraint
11              
12             =head1 SYNOPSIS
13              
14             my $c = $widget->constraint( 'Date', 'year', 'month', 'day' );
15              
16             =head1 DESCRIPTION
17              
18             Date Constraint.
19              
20             =head1 METHODS
21              
22             =head2 process
23              
24             =cut
25              
26             sub process {
27 2     2 1 10 my ( $self, $w, $params ) = @_;
28              
29 2         19 return []
30 2 50 33     9 unless ( $self->names && @{ $self->names } == 3 );
31              
32 2         16 my ( $year, $month, $day ) = @{ $self->names };
  2         6  
33 2         12 my $y = $params->{$year};
34 2         4 my $m = $params->{$month};
35 2         5 my $d = $params->{$day};
36 2 50 33     15 return [] unless ( $y && $m && $d );
      33        
37 2         10 my $results = [];
38              
39 2 50 66     37 unless ( $y =~ /^\d+$/
      66        
      66        
40             && $m =~ /^\d+$/
41             && $d =~ /^\d+$/
42             && Date::Calc::check_date( $y, $m, $d ) )
43             {
44 1         13 push @$results, HTML::Widget::Error->new(
45             { name => $year, message => $self->mk_message } );
46 1         17 push @$results, HTML::Widget::Error->new(
47             { name => $month, message => $self->mk_message } );
48 1         14 push @$results, HTML::Widget::Error->new(
49             { name => $day, message => $self->mk_message } );
50             }
51 2         37 return $results;
52             }
53              
54             =head1 AUTHOR
55              
56             Sebastian Riedel, C
57              
58             =head1 LICENSE
59              
60             This library is free software, you can redistribute it and/or modify it under
61             the same terms as Perl itself.
62              
63             =cut
64              
65             1;