File Coverage

blib/lib/Date/Language.pm
Criterion Covered Total %
statement 65 66 98.4
branch 9 18 50.0
condition 8 12 66.6
subroutine 10 11 90.9
pod 1 2 50.0
total 93 109 85.3


line stmt bran cond sub pod time code
1              
2             package Date::Language;
3              
4 5     5   233300 use strict;
  5         8  
  5         184  
5 5     5   969 use Time::Local;
  5         4977  
  5         282  
6 5     5   25 use Carp;
  5         7  
  5         349  
7              
8             require Date::Format;
9              
10             our $VERSION = '2.34'; # VERSION: generated
11             # ABSTRACT: Language specific date formatting and parsing
12              
13 5     5   25 use base qw(Date::Format::Generic);
  5         10  
  5         1884  
14              
15             sub _build_lookups
16             {
17 58     58   168 my $pkg = caller;
18 5     5   28 no strict 'refs';
  5         8  
  5         3040  
19 58         111 @{"${pkg}::MoY"}{@{"${pkg}::MoY"}} = (0 .. scalar(@{"${pkg}::MoY"}));
  58         635  
  58         129  
  58         317  
20 58         123 @{"${pkg}::MoY"}{@{"${pkg}::MoYs"}} = (0 .. scalar(@{"${pkg}::MoYs"}));
  58         476  
  58         136  
  58         163  
21 58         133 @{"${pkg}::DoW"}{@{"${pkg}::DoW"}} = (0 .. scalar(@{"${pkg}::DoW"}));
  58         392  
  58         125  
  58         183  
22 58         99 @{"${pkg}::DoW"}{@{"${pkg}::DoWs"}} = (0 .. scalar(@{"${pkg}::DoWs"}));
  58         412  
  58         159  
  58         175  
23             }
24              
25             sub new
26             {
27 59     59 0 768520 my $self = shift;
28 59   33     185 my $type = shift || $self;
29              
30 59         654 $type =~ s/^(\w+)$/Date::Language::$1/;
31              
32 59 50       288 croak "Bad language"
33             unless $type =~ /^[\w:]+$/;
34              
35 59 100       4089 eval "require $type"
36             or croak $@;
37              
38 58         341 bless [], $type;
39             }
40              
41             # Stop AUTOLOAD being called ;-)
42       0     sub DESTROY {}
43              
44             sub AUTOLOAD
45             {
46 19     19   28 our $AUTOLOAD;
47 19 50       91 if($AUTOLOAD =~ /::strptime\Z/o)
48             {
49 19         57 my $self = $_[0];
50 19   33     50 my $type = ref($self) || $self;
51 19         510 require Date::Parse;
52              
53 5     5   33 no strict 'refs';
  5         9  
  5         1439  
54 19         100 *{"${type}::strptime"} = Date::Parse::gen_parser(
55 19         69 \%{"${type}::DoW"},
56 19         68 \%{"${type}::MoY"},
57 19         28 \@{"${type}::Dsuf"},
  19         84  
58             1);
59              
60 19         32 goto &{"${type}::strptime"};
  19         565  
61             }
62              
63 0         0 croak "Undefined method &$AUTOLOAD called";
64             }
65              
66             sub str2time
67             {
68 24     24 1 4539 my $me = shift;
69 24         345 my @t = $me->strptime(@_);
70              
71             return undef
72 24 50       73 unless @t;
73              
74 24         77 my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
75 24         569 my @lt = localtime(time);
76              
77 24   100     79 $hh ||= 0;
78 24   100     95 $mm ||= 0;
79 24   100     56 $ss ||= 0;
80              
81 24 50       70 $month = $lt[4]
82             unless(defined $month);
83              
84 24 50       45 $day = $lt[3]
85             unless(defined $day);
86              
87 24 0       48 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
    50          
88             unless(defined $year);
89              
90 24 50       98 return defined $zone ? timegm($ss,$mm,$hh,$day,$month,$year) - $zone
91             : timelocal($ss,$mm,$hh,$day,$month,$year);
92             }
93              
94             1;
95              
96             __END__