File Coverage

blib/lib/Date/Language.pm
Criterion Covered Total %
statement 73 74 98.6
branch 11 20 55.0
condition 9 14 64.2
subroutine 12 13 92.3
pod 1 3 33.3
total 106 124 85.4


line stmt bran cond sub pod time code
1              
2             package Date::Language;
3              
4 9     9   557581 use strict;
  9         18  
  9         380  
5 9     9   2436 use Time::Local;
  9         13320  
  9         615  
6 9     9   57 use Carp;
  9         14  
  9         726  
7              
8             require Date::Format;
9              
10             our $VERSION = '2.34_03'; # TRIAL VERSION: generated
11             # ABSTRACT: Language specific date formatting and parsing
12              
13 9     9   47 use base qw(Date::Format::Generic);
  9         18  
  9         3830  
14              
15             sub _build_lookups
16             {
17 99     99   346 my $pkg = caller;
18 9     9   58 no strict 'refs';
  9         13  
  9         5607  
19 99         259 @{"${pkg}::MoY"}{@{"${pkg}::MoY"}} = (0 .. scalar(@{"${pkg}::MoY"}));
  99         1397  
  99         305  
  99         647  
20 99         285 @{"${pkg}::MoY"}{@{"${pkg}::MoYs"}} = (0 .. scalar(@{"${pkg}::MoYs"}));
  99         982  
  99         247  
  99         397  
21 99         250 @{"${pkg}::DoW"}{@{"${pkg}::DoW"}} = (0 .. scalar(@{"${pkg}::DoW"}));
  99         795  
  99         306  
  99         372  
22 99         230 @{"${pkg}::DoW"}{@{"${pkg}::DoWs"}} = (0 .. scalar(@{"${pkg}::DoWs"}));
  99         924  
  99         248  
  99         364  
23             }
24              
25             sub new
26             {
27 103     103 0 2186281 my $self = shift;
28 103   33     405 my $type = shift || $self;
29              
30 103         1165 $type =~ s/^(\w+)$/Date::Language::$1/;
31              
32 103 50       570 croak "Bad language"
33             unless $type =~ /^[\w:]+$/;
34              
35 103 100       8423 eval "require $type"
36             or croak $@;
37              
38 102         721 bless [], $type;
39             }
40              
41             # Stop AUTOLOAD being called ;-)
42       0     sub DESTROY {}
43              
44             sub AUTOLOAD
45             {
46 21     21   44 our $AUTOLOAD;
47 21 50       140 if($AUTOLOAD =~ /::strptime\Z/o)
48             {
49 21         41 my $self = $_[0];
50 21   33     81 my $type = ref($self) || $self;
51 21         1375 require Date::Parse;
52              
53 9     9   76 no strict 'refs';
  9         15  
  9         1796  
54 21         170 *{"${type}::strptime"} = Date::Parse::gen_parser(
55 21         109 \%{"${type}::DoW"},
56 21         110 \%{"${type}::MoY"},
57 21         49 \@{"${type}::Dsuf"},
  21         130  
58             1);
59              
60 21         57 goto &{"${type}::strptime"};
  21         807  
61             }
62              
63 0         0 croak "Undefined method &$AUTOLOAD called";
64             }
65              
66             sub format_Z {
67 20     20 0 71 my $tz = Date::Format::Generic::format_Z(@_);
68 20   50     100 my $pkg = ref($_[0]) || 'Date::Language';
69 9     9   59 no strict 'refs';
  9         15  
  9         2301  
70 20         41 my $tz_map = \%{"${pkg}::TZ"};
  20         137  
71 20 100       142 return exists $tz_map->{$tz} ? $tz_map->{$tz} : $tz;
72             }
73              
74             sub str2time
75             {
76 26     26 1 3465 my $me = shift;
77 26         395 my @t = $me->strptime(@_);
78              
79             return undef
80 26 50       109 unless @t;
81              
82 26         135 my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
83 26         786 my @lt = localtime(time);
84              
85 26   100     154 $hh ||= 0;
86 26   100     87 $mm ||= 0;
87 26   100     108 $ss ||= 0;
88              
89 26 50       69 $month = $lt[4]
90             unless(defined $month);
91              
92 26 50       76 $day = $lt[3]
93             unless(defined $day);
94              
95 26 0       70 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
    50          
96             unless(defined $year);
97              
98 26 50       176 return defined $zone ? timegm($ss,$mm,$hh,$day,$month,$year) - $zone
99             : timelocal($ss,$mm,$hh,$day,$month,$year);
100             }
101              
102             1;
103              
104             __END__