File Coverage

blib/lib/Date/Language.pm
Criterion Covered Total %
statement 47 48 97.9
branch 8 18 44.4
condition 8 12 66.6
subroutine 9 10 90.0
pod 1 2 50.0
total 73 90 81.1


line stmt bran cond sub pod time code
1              
2             package Date::Language;
3              
4 3     3   1565 use strict;
  3         11  
  3         89  
5 3     3   508 use Time::Local;
  3         2495  
  3         224  
6 3     3   20 use Carp;
  3         6  
  3         206  
7 3     3   19 use vars qw($VERSION @ISA);
  3         4  
  3         1004  
8             require Date::Format;
9              
10             $VERSION = "1.10";
11             @ISA = qw(Date::Format::Generic);
12              
13             sub new
14             {
15 8     8 0 1963 my $self = shift;
16 8   33     29 my $type = shift || $self;
17              
18 8         81 $type =~ s/^(\w+)$/Date::Language::$1/;
19              
20 8 50       42 croak "Bad language"
21             unless $type =~ /^[\w:]+$/;
22              
23 8 50       491 eval "require $type"
24             or croak $@;
25              
26 8         66 bless [], $type;
27             }
28              
29             # Stop AUTOLOAD being called ;-)
30       0     sub DESTROY {}
31              
32             sub AUTOLOAD
33             {
34 3     3   23 use vars qw($AUTOLOAD);
  3         5  
  3         276  
35              
36 5 50   5   41 if($AUTOLOAD =~ /::strptime\Z/o)
37             {
38 5         12 my $self = $_[0];
39 5   33     16 my $type = ref($self) || $self;
40 5         480 require Date::Parse;
41              
42 3     3   20 no strict 'refs';
  3         6  
  3         969  
43 5         28 *{"${type}::strptime"} = Date::Parse::gen_parser(
44 5         27 \%{"${type}::DoW"},
45 5         14 \%{"${type}::MoY"},
46 5         8 \@{"${type}::Dsuf"},
  5         21  
47             1);
48              
49 5         10 goto &{"${type}::strptime"};
  5         127  
50             }
51              
52 0         0 croak "Undefined method &$AUTOLOAD called";
53             }
54              
55             sub str2time
56             {
57 5     5 1 17 my $me = shift;
58 5         40 my @t = $me->strptime(@_);
59              
60             return undef
61 5 50       19 unless @t;
62              
63 5         21 my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
64 5         130 my @lt = localtime(time);
65              
66 5   100     21 $hh ||= 0;
67 5   100     19 $mm ||= 0;
68 5   100     12 $ss ||= 0;
69              
70 5 50       11 $month = $lt[4]
71             unless(defined $month);
72              
73 5 50       14 $day = $lt[3]
74             unless(defined $day);
75              
76 5 0       13 $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
    50          
77             unless(defined $year);
78              
79 5 50       24 return defined $zone ? timegm($ss,$mm,$hh,$day,$month,$year) - $zone
80             : timelocal($ss,$mm,$hh,$day,$month,$year);
81             }
82              
83             1;
84              
85             __END__