File Coverage

blib/lib/DateTime/Format/Natural/Compat.pm
Criterion Covered Total %
statement 71 72 98.6
branch 17 18 94.4
condition n/a
subroutine 13 13 100.0
pod n/a
total 101 103 98.0


line stmt bran cond sub pod time code
1             package DateTime::Format::Natural::Compat;
2              
3 26     26   212 use strict;
  26         51  
  26         747  
4 26     26   130 use warnings;
  26         78  
  26         836  
5 26     26   6194 use boolean qw(true false);
  26         48127  
  26         182  
6              
7 26     26   25156 use DateTime ();
  26         13195130  
  26         3166  
8              
9             our ($VERSION, $Pure);
10              
11             $VERSION = '0.07';
12              
13             BEGIN
14             {
15 26 50   26   1695 if (eval "require Date::Calc") {
16 26         177424 Date::Calc->import(qw(
17             Add_Delta_Days
18             Day_of_Week
19             Days_in_Month
20             Decode_Day_of_Week
21             Decode_Month
22             Nth_Weekday_of_Month_Year
23             check_date
24             check_time
25             ));
26 26         245 $Pure = false;
27             }
28             else {
29 0         0 $Pure = true;
30             }
31             }
32              
33             sub _Add_Delta_Days
34             {
35 132     132   1115 my $self = shift;
36              
37 132 100       383 if ($Pure) {
38 60         538 my ($year, $day) = @_;
39 60         279 my $dt = DateTime->from_day_of_year(year => $year, day_of_year => $day);
40 60         21403 return ($dt->year, $dt->month, $dt->mday);
41             }
42             else {
43 72         623 my ($year, $day) = @_;
44 72         540 return Add_Delta_Days($year, 1, 1, $day - 1);
45             }
46             }
47              
48             sub _Day_of_Week
49             {
50 1530     1530   23513 my $self = shift;
51              
52 1530 100       3567 if ($Pure) {
53 765         6733 return $self->{datetime}->wday;
54             }
55             else {
56 765         8950 return Day_of_Week(@_);
57             }
58             }
59              
60             sub _Days_in_Month
61             {
62 105     105   605 my $self = shift;
63              
64 105 100       310 if ($Pure) {
65 45         370 my ($year, $month) = @_;
66 45         180 my $dt = DateTime->last_day_of_month(year => $year, month => $month);
67 45         15216 return $dt->day;
68             }
69             else {
70 60         716 return Days_in_Month(@_);
71             }
72             }
73              
74             sub _Decode_Day_of_Week
75             {
76 3645     3645   6633 my $self = shift;
77              
78 3645 100       8111 if ($Pure) {
79 1767         13621 my ($day) = @_;
80 1767         8866 return $self->{data}->{weekdays}->{$day};
81             }
82             else {
83 1878         22735 return Decode_Day_of_Week(@_);
84             }
85             }
86              
87             sub _Decode_Month
88             {
89 3030     3030   5645 my $self = shift;
90              
91 3030 100       6966 if ($Pure) {
92 1452         11127 my ($month) = @_;
93 1452         7372 return $self->{data}->{months}->{$month};
94             }
95             else {
96 1578         18776 return Decode_Month(@_);
97             }
98             }
99              
100             sub _Nth_Weekday_of_Month_Year
101             {
102 228     228   2432 my $self = shift;
103              
104 228 100       658 if ($Pure) {
105 114         1370 my ($year, $month, $weekday, $count) = @_;
106 114         397 my $dt = $self->{datetime}->clone;
107 114         1729 $dt->set_year($year);
108 114         58295 $dt->set_month($month);
109 114         53290 $dt->set_day(1);
110 114         52811 $dt->set_day($dt->day + 1)
111             while ($weekday ne $dt->dow);
112 114         195747 $dt->set_day($dt->day + 7 * ($count - 1));
113 114         52025 return ($dt->year, $dt->month, $dt->day);
114             }
115             else {
116 114         1459 return Nth_Weekday_of_Month_Year(@_);
117             }
118             }
119              
120             sub _check_date
121             {
122 4029     4029   9168 my $self = shift;
123              
124 4029 100       11876 if ($Pure) {
125 1941         16362 my ($year, $month, $day) = @_;
126 1941         3573 local $@;
127 1941         4010 eval {
128 1941         6124 my $dt = $self->{datetime}->clone;
129 1941         28234 $dt->set(year => $year, month => $month, day => $day);
130             };
131 1941         999070 return !$@;
132             }
133             else {
134 2088         23214 return check_date(@_);
135             }
136             }
137              
138             sub _check_time
139             {
140 9058     9058   18726 my $self = shift;
141              
142 9058 100       28914 if ($Pure) {
143 4467         38984 my ($hour, $minute, $second) = @_;
144 4467         8403 local $@;
145 4467         10010 eval {
146 4467         15209 my $dt = $self->{datetime}->clone;
147 4467         60893 $dt->set(hour => $hour, minute => $minute, second => $second);
148             };
149 4467         2370939 return !$@;
150             }
151             else {
152 4591         54055 return check_time(@_);
153             }
154             }
155              
156             1;
157             __END__
158              
159             =head1 NAME
160              
161             DateTime::Format::Natural::Compat - Methods with more than one implementation
162              
163             =head1 SYNOPSIS
164              
165             Please see the DateTime::Format::Natural documentation.
166              
167             =head1 DESCRIPTION
168              
169             The C<DateTime::Format::Natural::Compat> class defines methods which must retain
170             more than one possible implementation due to compatibility issues on certain
171             platforms.
172              
173             =head1 SEE ALSO
174              
175             L<DateTime::Format::Natural>
176              
177             =head1 AUTHOR
178              
179             Steven Schubiger <schubiger@cpan.org>
180              
181             =head1 LICENSE
182              
183             This program is free software; you may redistribute it and/or
184             modify it under the same terms as Perl itself.
185              
186             See L<http://dev.perl.org/licenses/>
187              
188             =cut