File Coverage

blib/lib/DateTime/Format/PGN.pm
Criterion Covered Total %
statement 54 65 83.0
branch 42 62 67.7
condition 43 69 62.3
subroutine 9 9 100.0
pod 3 3 100.0
total 151 208 72.6


line stmt bran cond sub pod time code
1 5     5   439757 use strict;
  5         5  
  5         172  
2 5     5   37 use warnings;
  5         6  
  5         264  
3              
4             package DateTime::Format::PGN;
5             # ABSTRACT: a Perl module for parsing and formatting date fields in chess game databases in PGN format
6              
7             our $VERSION = '0.03';
8              
9 5     5   2648 use DateTime::Incomplete 0.08;
  5         573724  
  5         198  
10 5     5   48 use Params::Validate 1.23 qw( validate BOOLEAN );
  5         61  
  5         3955  
11              
12              
13             sub new {
14 6     6 1 2670 my( $class ) = shift;
15              
16             my %args = validate( @_,
17             {
18             fix_errors => {
19             type => BOOLEAN,
20             default => 0,
21             callbacks => {
22             'is 0, 1, or undef' =>
23 3 50 33 3   40 sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 },
24             },
25             },
26             use_incomplete => {
27             type => BOOLEAN,
28             default => 0,
29             callbacks => {
30             'is 0, 1, or undef' =>
31 4 50 33 4   61 sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 },
32             },
33             },
34             }
35 6         185 );
36              
37 6   33     64 $class = ref( $class ) || $class;
38              
39 6         20 my $self = bless( \%args, $class );
40              
41 6         18 return( $self );
42             }
43              
44              
45              
46             sub parse_datetime {
47 42     42 1 72 my ( $self, $date ) = @_;
48 42         72 my @matches = ( '????', '??', '??' );
49            
50 42 100       138 if ($date =~ m/^(\?{4}|[1-2]\d{3})\.(\?{2}|0[1-9]|1[0-2])\.(\?{2}|0[1-9]|[1-2]\d|3[0-1])$/) {
51            
52 17         57 @matches = ( $1,$2,$3 );
53             }
54             else {
55            
56             # We can try to fix frequently occuring faults.
57 25 100       55 if ($self->{ fix_errors }) {
58            
59             # if we find a year, we can try to parse the wrong date.
60 24 50 33     160 if ($date =~ /(\A|\D)([1-2]\d{3})(\D|\Z)/ && $2 > 0) {
61            
62 24         34 $matches[0] = $2;
63            
64             # Try to find month and day.
65 24 100       93 if ($date =~ /(\A|\D)(\d{1,2})\D+(\d{1,2})(\D|\Z)/) {
    100          
66 22 100 100     234 if (($2 < 13 && $3 > 12 && $3 < 32 && $2 > 0 && $3 > 0) || ($2 == $3 && $2 < 13 && $2 > 0)) {
    100 66        
      100        
      66        
      33        
      33        
      66        
      100        
      66        
      66        
      33        
67 16         18 $matches[1] = $2;
68 16         17 $matches[2] = $3;
69             }
70             elsif ($3 < 13 && $2 > 12 && $2 < 32 && $2 > 0 && $3 > 0) {
71 2         4 $matches[1] = $3;
72 2         6 $matches[2] = $2;
73             }
74             }
75             elsif ($date =~ /(January|February|March|April|May|June|July|August|September|October|November|December)/) {
76            
77 1 50       13 if (index($1,'January') > -1) {$matches[1] = 1}
  0 50       0  
    50          
    50          
    50          
    50          
    0          
    0          
    0          
    0          
    0          
78 0         0 elsif (index($1,'February') > -1) {$matches[1] = 2}
79 0         0 elsif (index($1,'March') > -1) {$matches[1] = 3}
80 0         0 elsif (index($1,'April') > -1) {$matches[1] = 4}
81 0         0 elsif (index($1,'May') > -1) {$matches[1] = 5}
82 1         2 elsif (index($1,'June') > -1) {$matches[1] = 6}
83 0         0 elsif (index($1,'July') > -1) {$matches[1] = 7}
84 0         0 elsif (index($1,'August') > -1) {$matches[1] = 8}
85 0         0 elsif (index($1,'September') > -1) {$matches[1] = 9}
86 0         0 elsif (index($1,'October') > -1) {$matches[1] = 10}
87 0         0 elsif (index($1,'November') > -1) {$matches[1] = 11}
88 0         0 else {$matches[1] = 12}
89              
90 1 50 33     13 $matches[2] = $2 if $date =~ /(\A|\D)(\d{1,2})(\D|\Z)/ && $2 < 32 && $2 > 0;
      33        
91             }
92            
93             # check month length
94 24 100 66     81 if (index($matches[1],'?') == -1 && index($matches[2],'?') == -1) {
95 19 100 100     144 if ($matches[2] == 31 && ($matches[1] == 4 || $matches[1] == 6 || $matches[1] == 9 || $matches[1] == 9 || $matches[1] == 11)) {
    100 66        
96 4         5 $matches[1] = '??';
97 4         4 $matches[2] = '??';
98             }
99             elsif ($matches[1] == 2) {
100 4 100 100     25 if (($matches[2] == 29 && $matches[0] % 4 == 0 && $matches[0] % 100 > 0) || $matches[2] < 29) {}
      100        
      66        
101             else {
102 3         3 $matches[1] = '??';
103 3         4 $matches[2] = '??';
104             }
105             }
106             }
107             }
108             }
109             }
110            
111             # If incomplete data should be preserved, we must create a DateTime::Incomplete object instead.
112 42 100       85 if ( $self->{ use_incomplete } ) {
113            
114 25 100       30 grep { $_ = undef if index($_,'?') > -1 } @matches;
  75         186  
115            
116 25         99 return DateTime::Incomplete->new(
117             year => $matches[0],
118             month => $matches[1],
119             day => $matches[2],
120             formatter => $self,
121             );
122             }
123             # The usual DateTime object.
124             else {
125            
126 17 100       19 grep { $_ = 1 if index($_,'?') > -1 } @matches;
  51         139  
127            
128 17         78 return DateTime->new(
129             year => $matches[0],
130             month => $matches[1],
131             day => $matches[2],
132             formatter => $self,
133             );
134             }
135             }
136              
137              
138             sub format_datetime {
139 42     42 1 3538 my ( $self, $dt ) = @_;
140            
141 42 100       87 my $year = (defined $dt->year()) ? $dt->year() : '????';
142 42 100       313 my $month = (defined $dt->month()) ? $dt->month() : '??';
143 42 100       243 my $day = (defined $dt->day()) ? $dt->day() : '??';
144            
145 42         398 return sprintf '%04s.%02s.%02s', $year, $month, $day;
146             }
147              
148             1;
149              
150             __END__