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   626771 use strict;
  9         18  
  9         392  
5 9     9   2760 use Time::Local;
  9         14482  
  9         681  
6 9     9   53 use Carp;
  9         14  
  9         775  
7              
8             require Date::Format;
9              
10             our $VERSION = '2.35'; # VERSION: generated
11             # ABSTRACT: Language specific date formatting and parsing
12              
13 9     9   54 use base qw(Date::Format::Generic);
  9         17  
  9         4030  
14              
15             sub _build_lookups
16             {
17 99     99   308 my $pkg = caller;
18 9     9   67 no strict 'refs';
  9         14  
  9         5887  
19 99         241 @{"${pkg}::MoY"}{@{"${pkg}::MoY"}} = (0 .. scalar(@{"${pkg}::MoY"}));
  99         1296  
  99         303  
  99         682  
20 99         285 @{"${pkg}::MoY"}{@{"${pkg}::MoYs"}} = (0 .. scalar(@{"${pkg}::MoYs"}));
  99         1074  
  99         264  
  99         356  
21 99         231 @{"${pkg}::DoW"}{@{"${pkg}::DoW"}} = (0 .. scalar(@{"${pkg}::DoW"}));
  99         865  
  99         306  
  99         358  
22 99         216 @{"${pkg}::DoW"}{@{"${pkg}::DoWs"}} = (0 .. scalar(@{"${pkg}::DoWs"}));
  99         872  
  99         245  
  99         376  
23             }
24              
25             sub new
26             {
27 103     103 0 2034233 my $self = shift;
28 103   33     408 my $type = shift || $self;
29              
30 103         1279 $type =~ s/^(\w+)$/Date::Language::$1/;
31              
32 103 50       626 croak "Bad language"
33             unless $type =~ /^[\w:]+$/;
34              
35 103 100       9102 eval "require $type"
36             or croak $@;
37              
38 102         730 bless [], $type;
39             }
40              
41             # Stop AUTOLOAD being called ;-)
42       0     sub DESTROY {}
43              
44             sub AUTOLOAD
45             {
46 21     21   29 our $AUTOLOAD;
47 21 50       105 if($AUTOLOAD =~ /::strptime\Z/o)
48             {
49 21         37 my $self = $_[0];
50 21   33     60 my $type = ref($self) || $self;
51 21         1174 require Date::Parse;
52              
53 9     9   68 no strict 'refs';
  9         19  
  9         1655  
54 21         134 *{"${type}::strptime"} = Date::Parse::gen_parser(
55 21         87 \%{"${type}::DoW"},
56 21         57 \%{"${type}::MoY"},
57 21         131 \@{"${type}::Dsuf"},
  21         105  
58             1);
59              
60 21         30 goto &{"${type}::strptime"};
  21         538  
61             }
62              
63 0         0 croak "Undefined method &$AUTOLOAD called";
64             }
65              
66             sub format_Z {
67 20     20 0 118 my $tz = Date::Format::Generic::format_Z(@_);
68 20   50     76 my $pkg = ref($_[0]) || 'Date::Language';
69 9     9   55 no strict 'refs';
  9         27  
  9         2328  
70 20         30 my $tz_map = \%{"${pkg}::TZ"};
  20         149  
71 20 100       132 return exists $tz_map->{$tz} ? $tz_map->{$tz} : $tz;
72             }
73              
74             sub str2time
75             {
76 26     26 1 4128 my $me = shift;
77 26         339 my @t = $me->strptime(@_);
78              
79             return undef
80 26 50       82 unless @t;
81              
82 26         84 my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
83 26         657 my @lt = localtime(time);
84              
85 26   100     99 $hh ||= 0;
86 26   100     69 $mm ||= 0;
87 26   100     90 $ss ||= 0;
88              
89 26 50       51 $month = $lt[4]
90             unless(defined $month);
91              
92 26 50       95 $day = $lt[3]
93             unless(defined $day);
94              
95 26 0       81 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
    50          
96             unless(defined $year);
97              
98 26 50       185 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__