File Coverage

blib/lib/Date/Calc/XS.pm
Criterion Covered Total %
statement 117 122 95.9
branch 71 78 91.0
condition 18 24 75.0
subroutine 7 7 100.0
pod 0 3 0.0
total 213 234 91.0


line stmt bran cond sub pod time code
1              
2             ###############################################################################
3             ## ##
4             ## Copyright (c) 1995 - 2015 by Steffen Beyer. ##
5             ## All rights reserved. ##
6             ## ##
7             ## This package is free software; you can redistribute it ##
8             ## and/or modify it under the same terms as Perl itself. ##
9             ## ##
10             ###############################################################################
11              
12             package Date::Calc::XS;
13              
14 50     50   147938 BEGIN { eval { require bytes; }; }
  50         1258  
15 50     50   161 use strict;
  50         58  
  50         1295  
16 50     50   170 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  50         57  
  50         2645  
17              
18 50     50   16290 use Carp::Clan qw(^Date::);
  50         114598  
  50         258  
19              
20             require Exporter;
21             require DynaLoader;
22              
23             @ISA = qw(Exporter DynaLoader);
24              
25             @EXPORT = qw();
26              
27             @EXPORT_OK = qw(
28             Days_in_Year
29             Days_in_Month
30             Weeks_in_Year
31             leap_year
32             check_date
33             check_time
34             check_business_date
35             Day_of_Year
36             Date_to_Days
37             Day_of_Week
38             Week_Number
39             Week_of_Year
40             Monday_of_Week
41             Nth_Weekday_of_Month_Year
42             Standard_to_Business
43             Business_to_Standard
44             Delta_Days
45             Delta_DHMS
46             Delta_YMD
47             Delta_YMDHMS
48             N_Delta_YMD
49             N_Delta_YMDHMS
50             Normalize_DHMS
51             Add_Delta_Days
52             Add_Delta_DHMS
53             Add_Delta_YM
54             Add_Delta_YMD
55             Add_Delta_YMDHMS
56             Add_N_Delta_YMD
57             Add_N_Delta_YMDHMS
58             System_Clock
59             Today
60             Now
61             Today_and_Now
62             This_Year
63             Gmtime
64             Localtime
65             Mktime
66             Timezone
67             Date_to_Time
68             Time_to_Date
69             Easter_Sunday
70             Decode_Month
71             Decode_Day_of_Week
72             Decode_Language
73             Decode_Date_EU
74             Decode_Date_US
75             Fixed_Window
76             Moving_Window
77             Compress
78             Uncompress
79             check_compressed
80             Compressed_to_Text
81             Date_to_Text
82             Date_to_Text_Long
83             English_Ordinal
84             Calendar
85             Month_to_Text
86             Day_of_Week_to_Text
87             Day_of_Week_Abbreviation
88             Language_to_Text
89             Language
90             Languages
91             Decode_Date_EU2
92             Decode_Date_US2
93             Parse_Date
94             ISO_LC
95             ISO_UC
96             );
97              
98             %EXPORT_TAGS = (all => [@EXPORT_OK]);
99              
100             ##################################################
101             ## ##
102             ## "Version()" is available but not exported ##
103             ## in order to avoid possible name clashes. ##
104             ## Call "Date::Calc::XS::Version()" instead! ##
105             ## ##
106             ##################################################
107              
108             $VERSION = '6.4';
109              
110             bootstrap Date::Calc::XS $VERSION;
111              
112             sub Decode_Date_EU2
113             {
114 46 50 66 46 0 450 croak "Usage: (\$year,\$month,\$day) = Decode_Date_EU2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));
115              
116 46         48 my($buffer) = shift;
117 46   100     109 my($lang) = shift || 0;
118 46         30 my($year,$month,$day,$length);
119              
120 46 100 66     114 $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
121 46 100       177 if ($buffer =~ /^\D* (\d+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D*$/x)
    100          
    100          
122             {
123 22         27 ($day,$month,$year) = ($1,$2,$3);
124 22         56 $month = Decode_Month($month,$lang);
125 22 100       37 unless ($month > 0)
126             {
127 1         3 return(); # can't decode month!
128             }
129             }
130             elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x)
131             {
132 19         23 $buffer = $1;
133 19         12 $length = length($buffer);
134 19 100       49 if ($length == 3)
    100          
    100          
    100          
    100          
    100          
135             {
136 3         4 $day = substr($buffer,0,1);
137 3         4 $month = substr($buffer,1,1);
138 3         2 $year = substr($buffer,2,1);
139             }
140             elsif ($length == 4)
141             {
142 3         5 $day = substr($buffer,0,1);
143 3         3 $month = substr($buffer,1,1);
144 3         3 $year = substr($buffer,2,2);
145             }
146             elsif ($length == 5)
147             {
148 3         4 $day = substr($buffer,0,1);
149 3         3 $month = substr($buffer,1,2);
150 3         2 $year = substr($buffer,3,2);
151             }
152             elsif ($length == 6)
153             {
154 3         8 $day = substr($buffer,0,2);
155 3         1 $month = substr($buffer,2,2);
156 3         4 $year = substr($buffer,4,2);
157             }
158             elsif ($length == 7)
159             {
160 3         4 $day = substr($buffer,0,1);
161 3         3 $month = substr($buffer,1,2);
162 3         3 $year = substr($buffer,3,4);
163             }
164             elsif ($length == 8)
165             {
166 3         3 $day = substr($buffer,0,2);
167 3         4 $month = substr($buffer,2,2);
168 3         3 $year = substr($buffer,4,4);
169             }
170 1         3 else { return(); } # wrong number of digits!
171             }
172             elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
173             {
174 3         7 ($day,$month,$year) = ($1,$2,$3);
175             }
176 2         7 else { return(); } # no match at all!
177 42         165 $year = Moving_Window($year);
178 42 100       70 if (check_date($year,$month,$day))
179             {
180 40         114 return($year,$month,$day);
181             }
182 2         5 else { return(); } # not a valid date!
183             }
184              
185             sub Decode_Date_US2
186             {
187 46 50 66 46 0 451 croak "Usage: (\$year,\$month,\$day) = Decode_Date_US2(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));
188              
189 46         51 my($buffer) = shift;
190 46   100     104 my($lang) = shift || 0;
191 46         34 my($year,$month,$day,$length);
192              
193 46 100 66     116 $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
194 46 100       215 if ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* 0*(\d+) \D*$/x)
    100          
    100          
    100          
195             {
196 14         23 ($month,$buffer) = ($1,$2);
197 14         46 $month = Decode_Month($month,$lang);
198 14 50       20 unless ($month > 0)
199             {
200 0         0 return(); # can't decode month!
201             }
202 14         13 $length = length($buffer);
203 14 50       36 if ($length == 2)
    100          
    100          
    100          
    50          
204             {
205 0         0 $day = substr($buffer,0,1);
206 0         0 $year = substr($buffer,1,1);
207             }
208             elsif ($length == 3)
209             {
210 3         5 $day = substr($buffer,0,1);
211 3         4 $year = substr($buffer,1,2);
212             }
213             elsif ($length == 4)
214             {
215 4         5 $day = substr($buffer,0,2);
216 4         4 $year = substr($buffer,2,2);
217             }
218             elsif ($length == 5)
219             {
220 3         9 $day = substr($buffer,0,1);
221 3         4 $year = substr($buffer,1,4);
222             }
223             elsif ($length == 6)
224             {
225 4         6 $day = substr($buffer,0,2);
226 4         6 $year = substr($buffer,2,4);
227             }
228 0         0 else { return(); } # wrong number of digits!
229             }
230             elsif ($buffer =~ /^[^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* ([A-Za-z\xC0-\xD6\xD8-\xF6\xF8-\xFF]+) [^A-Za-z0-9\xC0-\xD6\xD8-\xF6\xF8-\xFF]* (\d+) \D+ (\d+) \D*$/x)
231             {
232 8         14 ($month,$day,$year) = ($1,$2,$3);
233 8         32 $month = Decode_Month($month,$lang);
234 8 100       13 unless ($month > 0)
235             {
236 1         3 return(); # can't decode month!
237             }
238             }
239             elsif ($buffer =~ /^\D* 0*(\d+) \D*$/x)
240             {
241 19         25 $buffer = $1;
242 19         17 $length = length($buffer);
243 19 100       45 if ($length == 3)
    100          
    100          
    100          
    100          
    100          
244             {
245 3         5 $month = substr($buffer,0,1);
246 3         5 $day = substr($buffer,1,1);
247 3         5 $year = substr($buffer,2,1);
248             }
249             elsif ($length == 4)
250             {
251 3         4 $month = substr($buffer,0,1);
252 3         3 $day = substr($buffer,1,1);
253 3         3 $year = substr($buffer,2,2);
254             }
255             elsif ($length == 5)
256             {
257 3         8 $month = substr($buffer,0,1);
258 3         4 $day = substr($buffer,1,2);
259 3         4 $year = substr($buffer,3,2);
260             }
261             elsif ($length == 6)
262             {
263 3         5 $month = substr($buffer,0,2);
264 3         3 $day = substr($buffer,2,2);
265 3         3 $year = substr($buffer,4,2);
266             }
267             elsif ($length == 7)
268             {
269 3         3 $month = substr($buffer,0,1);
270 3         4 $day = substr($buffer,1,2);
271 3         5 $year = substr($buffer,3,4);
272             }
273             elsif ($length == 8)
274             {
275 3         5 $month = substr($buffer,0,2);
276 3         3 $day = substr($buffer,2,2);
277 3         4 $year = substr($buffer,4,4);
278             }
279 1         4 else { return(); } # wrong number of digits!
280             }
281             elsif ($buffer =~ /^\D* (\d+) \D+ (\d+) \D+ (\d+) \D*$/x)
282             {
283 3         8 ($month,$day,$year) = ($1,$2,$3);
284             }
285 2         5 else { return(); } # no match at all!
286 42         200 $year = Moving_Window($year);
287 42 100       77 if (check_date($year,$month,$day))
288             {
289 40         118 return($year,$month,$day);
290             }
291 2         7 else { return(); } # not a valid date!
292             }
293              
294             sub Parse_Date
295             {
296 15 50 66 15 0 135 croak "Usage: (\$year,\$month,\$day) = Parse_Date(\$date[,\$lang]);\n" unless ((@_ == 1) or (@_ == 2));
297              
298 15         16 my($date) = shift;
299 15   100     32 my($lang) = shift || 0;
300 15         11 my($year,$month,$day);
301              
302 15 100 66     48 $lang = Language() unless (($lang >= 1) and ($lang <= Languages()));
303 15 100       49 unless ($date =~ /\b([\x41-\x5A\x61-\x7A\xC0-\xD6\xD8-\xF6\xF8-\xFF]{3})\s+([0123]??\d)\b/)
304             {
305 1         4 return();
306             }
307 14         15 $month = $1;
308 14         11 $day = $2;
309 14 100       36 unless ($date =~ /\b(19\d\d|20\d\d)\b/)
310             {
311 1         3 return();
312             }
313 13         10 $year = $1;
314 13         43 $month = Decode_Month($month,$lang);
315 13 50       19 unless ($month > 0)
316             {
317 0         0 return();
318             }
319 13 100       31 unless (check_date($year,$month,$day))
320             {
321 1         2 return();
322             }
323 12         32 return($year,$month,$day);
324             }
325              
326             1;
327              
328             __END__