File Coverage

blib/lib/DTL/Fast/Utils.pm
Criterion Covered Total %
statement 39 117 33.3
branch 51 124 41.1
condition 2 55 3.6
subroutine 7 7 100.0
pod 0 3 0.0
total 99 306 32.3


line stmt bran cond sub pod time code
1             package DTL::Fast::Utils;
2 98     98   490 use strict; use utf8; use warnings FATAL => 'all';
  98     98   165  
  98     98   2473  
  98         460  
  98         153  
  98         468  
  98         2360  
  98         165  
  98         3284  
3 98     98   471 use parent 'Exporter';
  98         141  
  98         485  
4              
5             require Date::Format;
6             require URI::Escape::XS;
7              
8             our $VERSION = '1.00';
9              
10             our @EXPORT_OK;
11              
12             # @todo what with timezones?
13             push @EXPORT_OK, 'time2str';
14             sub time2str
15             {
16 8     8 0 13 my $format = shift;
17 8         13 my $time = shift;
18              
19             # TIME_FORMAT, DATE_FORMAT, DATETIME_FORMAT, SHORT_DATE_FORMAT or SHORT_DATETIME_FORMAT
20              
21 8         25 return Date::Format::time2str($format, $time );
22             }
23              
24             push @EXPORT_OK, 'time2str_php';
25             # the code below has been taken from Dotiac::DTL and should be re-written on C
26             # would be nice to implement module with this functionality (take from PHP source)
27             #locale stuff
28             our @datemonths=qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
29             our @datemonthl=qw( January February March April May Juni Juli August September October November December );
30             our @datemontha=qw( Jan. Feb. March April May Juni Juli Aug. Sep. Oct. Nov. Dec. );
31             our @weekdays=qw/Sun Mon Tue Wed Thu Fri Sat/;
32             our @weekdayl=qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
33             our @timeampm=qw/a.m. p.m. AM PM/;
34             our @timespotnames=qw/midnight noon/;
35             our @datesuffixes=qw/th st nd rd/; #qw/Default day1 day2 day3 day4 day5...
36             sub time2str_php
37             {
38 6   50 6 0 18 my $format = shift // "";
39 6   50     15 my $time = shift // 0;
40              
41 6         150 my @t = localtime($time);
42 6         26 my @s = split //, $format;
43              
44 6         8 my $res;
45              
46 6         21 while(my $s = shift @s )
47             {
48 54 100       1087 if ($s eq '\\') {
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    100          
    100          
    100          
    100          
    50          
    50          
    50          
    50          
    50          
49 3         10 $res.=shift(@s);
50             }
51             elsif ($s eq "a") {
52 0 0 0     0 if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
      0        
53 0         0 $res.=$timeampm[0];
54             }
55             else {
56 0         0 $res.=$timeampm[1];
57             }
58             }
59             elsif ($s eq "A") {
60 0 0 0     0 if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
      0        
61 0         0 $res.=$timeampm[2];
62             }
63             else {
64 0         0 $res.=$timeampm[3];
65             }
66             }
67             elsif ($s eq "b") {
68 0         0 $res.=lc($datemonths[$t[4]]);
69             }
70             elsif ($s eq "d") {
71 0         0 $res.=sprintf("%02d",$t[3]);
72             }
73             elsif ($s eq "D") {
74 0         0 $res.=$weekdays[$t[6]];
75             }
76             elsif ($s eq "f") {
77 0         0 my $h=$t[2];
78 0         0 $h=$h%12;
79 0 0       0 $h=12 unless $h;
80 0         0 $res.=$h;
81 0 0       0 $res.=sprintf(":%02d",$t[1]) if ($t[1]);
82             }
83             elsif ($s eq "F") {
84 0         0 $res.=$datemonthl[$t[4]];
85             }
86             elsif ($s eq "g") {
87 0         0 my $h=$t[2];
88 0         0 $h=$h%12;
89 0 0       0 $h=12 unless $h;
90 0         0 $res.=$h;
91             }
92             elsif ($s eq "G") {
93 0         0 $res.=$t[2];
94             }
95             elsif ($s eq "h") {
96 0         0 my $h=$t[2];
97 0         0 $h=$h%12;
98 0 0       0 $h=12 unless $h;
99 0         0 $res.=sprintf("%02d",$h);
100             }
101             elsif ($s eq "H") {
102 0         0 $res.=sprintf("%02d",$t[2]);
103             }
104             elsif ($s eq "i") {
105 0         0 $res.=sprintf("%02d",$t[1]);
106             }
107             elsif ($s eq "j") {
108 0         0 $res.=$t[3];
109             }
110             elsif ($s eq "l") {
111 0         0 $res.=$weekdayl[$t[6]];
112             }
113             elsif ($s eq "L") {
114 0         0 my $d=$t[5]+1900;
115 0 0 0     0 $res.=(((not $d%4 and $d%100) or not $d%400)?"1":"0");
116             }
117             elsif ($s eq "m") {
118 0         0 $res.=sprintf("%02d",$t[4]+1);
119             }
120             elsif ($s eq "M") {
121 0         0 $res.=$datemonths[$t[4]];
122             }
123             elsif ($s eq "n") {
124 0         0 $res.=$t[4]+1;
125             }
126             elsif ($s eq "N") {
127 0         0 $res.=$datemontha[$t[4]];
128             }
129             elsif ($s eq "O") {
130 0         0 my @tt=localtime(0);
131 0 0       0 $tt[2]+=1 if $t[8];
132 0         0 $res.=sprintf("%+05d",$tt[2]*100+$tt[1]);
133             }
134             elsif ($s eq "P") {
135 0 0 0     0 if ($t[2] == 12 and $t[1] == 0) {
    0 0        
136 0         0 $res.=$timespotnames[1];
137             }
138             elsif ($t[2] == 0 and $t[1] == 0) {
139 0         0 $res.=$timespotnames[0];
140             }
141             else {
142 0         0 my $h=$t[2];
143 0         0 $h=$h%12;
144 0 0       0 $h=12 unless $h;
145 0         0 $res.=$h;
146 0 0       0 $res.=sprintf(":%02d",$t[1]) if ($t[1]);
147 0 0 0     0 if ($t[2] > 12 or ($t[2] == 12 and $t[1] > 0)) {
      0        
148 0         0 $res.=" ".$timeampm[0];
149             }
150             else {
151 0         0 $res.=" ".$timeampm[1];
152             }
153             }
154              
155             }
156             elsif ($s eq "r") {
157 0         0 $res.=$weekdays[$t[6]];
158 0         0 $res.=", ";
159 0         0 $res.=$t[4]+1;
160 0         0 $res.=" ".$datemonths[$t[4]]." ".($t[5]+1900);
161 0         0 $res.=sprintf(" %02d:%02d:%02d",$t[2],$t[1],$t[0]);
162 0         0 my @tt=localtime(0);
163 0 0       0 $tt[2]+=1 if $t[8];
164 0         0 $res.=sprintf(" %+05d",$tt[2]*100+$tt[1]);
165             }
166             elsif ($s eq "s") {
167 0         0 $res.=sprintf("%02d",$t[0]);
168             }
169             elsif ($s eq "S") {
170 0 0       0 if ($datesuffixes[$t[3]]) {
171 0         0 $res.=$datesuffixes[$t[3]];
172             }
173             else {
174 0         0 $res.=$datesuffixes[0]
175             }
176             }
177             elsif ($s eq "t") {
178 0 0 0     0 if ($t[4] == 1 or $t[4]==3 or $t[4] == 5 or $t[4] == 7 or $t[4] == 8 or $t[4] == 10 or $t[4] == 12) {
    0 0        
      0        
      0        
      0        
      0        
179 0         0 $res.="31";
180             }
181             elsif ($t[4] == 2) {
182 0         0 my $d=$t[5]+1900;
183 0 0 0     0 if ((not $d%4 and $d%100) or not $d%400) {
      0        
184 0         0 $res.="29";
185             }
186             else {
187 0         0 $res.="28";
188             }
189             }
190             else {
191 0         0 $res.="30";
192             }
193             }
194             elsif ($s eq "T") {
195 0         0 require POSIX;
196 0         0 $res.=POSIX::strftime("%Z", @t);
197             }
198             elsif ($s eq "t") {
199 0         0 $res.=$t[6];
200             }
201             elsif ($s eq "W") {
202 0         0 require POSIX;
203 0         0 $res.=POSIX::strftime("%W", @t);
204             }
205             elsif ($s eq "y") {
206 6         37 $res.=sprintf("%02d",($t[5]%100));
207             }
208             elsif ($s eq "Y") {
209 6         28 $res.=sprintf("%04d",$t[5]+1900);
210             }
211             elsif ($s eq "z") {
212 6         19 $res.=$t[7];
213             }
214             elsif ($s eq "Z") {
215 6         97 my @tt=localtime(0);
216 6 50       16 $tt[2]+=1 if $t[8];
217 6         34 $res.=$tt[2]*3600+$t[1]*60+$t[0];
218             }
219             elsif ($s eq "\n") {
220 0         0 $res.="n";
221             }
222             elsif ($s eq "\t") {
223 0         0 $res.="t";
224             }
225             elsif ($s eq "\f") {
226 0         0 $res.="f";
227             }
228             elsif ($s eq "\b") {
229 0         0 $res.="b";
230             }
231             elsif ($s eq "\r") {
232 0         0 $res.="r";
233             }
234             else {
235 27         85 $res.=$s;
236             }
237             }
238 6         23 return $res;
239             }
240             ### end of Dotiac::DTL code
241              
242             #Shortcuts below not working on mswin and perl =< 18.2
243             push @EXPORT_OK, 'uri_escape';
244             *DTL::Fast::Utils::uri_escape = \&URI::Escape::XS::uri_escape;
245              
246             push @EXPORT_OK, 'uri_unescape';
247             *DTL::Fast::Utils::uri_unescape = \&URI::Escape::XS::uri_unescape;
248              
249             push @EXPORT_OK, 'escape';
250             *DTL::Fast::Utils::escape = \&URI::Escape::XS::encodeURIComponent;
251              
252             push @EXPORT_OK, 'unescape';
253             *DTL::Fast::Utils::unescape = \&URI::Escape::XS::decodeURIComponent;
254              
255             push @EXPORT_OK, 'as_bool';
256             sub as_bool
257             {
258 5923     5923 0 8840 my $value = shift;
259 5923         8346 my $value_type = ref $value;
260              
261 5923 100       11618 if( $value_type )
262             {
263 984 100       2556 if ( $value_type eq 'SCALAR' )
    100          
    50          
    0          
264             {
265 328         529 $value = $$value;
266             }
267             elsif( $value_type eq 'HASH' )
268             {
269 328         572 $value = scalar keys(%$value);
270             }
271             elsif( $value_type eq 'ARRAY' )
272             {
273 328         570 $value = scalar @$value;
274             }
275             elsif( UNIVERSAL::can( $value, 'as_bool' ) )
276             {
277 0         0 $value = $value->as_bool();
278             }
279             }
280              
281 5923         23312 return $value;
282             }
283              
284              
285             1;