File Coverage

blib/lib/Time/Duration/Locale.pm
Criterion Covered Total %
statement 33 33 100.0
branch 2 2 100.0
condition 5 6 83.3
subroutine 11 11 100.0
pod 0 1 0.0
total 51 53 96.2


line stmt bran cond sub pod time code
1             # Copyright 2009, 2010, 2011, 2013, 2016 Kevin Ryde
2              
3             # This file is part of Time-Duration-Locale.
4             #
5             # Time-Duration-Locale is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # Time-Duration-Locale is distributed in the hope that it will be useful,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with Time-Duration-Locale. If not, see .
17              
18             package Time::Duration::Locale;
19 3     3   3110 use 5.004;
  3         13  
20 3     3   17 use strict;
  3         5  
  3         97  
21 3     3   16 use Carp;
  3         4  
  3         311  
22 3     3   1161 use Time::Duration::LocaleObject;
  3         8  
  3         140  
23 3     3   19 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
  3         6  
  3         354  
24              
25             $VERSION = 11;
26              
27 3     3   23 use Exporter;
  3         5  
  3         1144  
28             @ISA = ('Exporter');
29              
30             # same exports as Time::Duration
31             @EXPORT = qw(later later_exact earlier earlier_exact
32             ago ago_exact from_now from_now_exact
33             duration duration_exact
34             concise);
35             @EXPORT_OK = ('interval', @EXPORT);
36             %EXPORT_TAGS = (all => \@EXPORT_OK);
37              
38             # uncomment this to run the ### lines
39             #use Smart::Comments;
40              
41             # SUPER::can() here is UNIVERSAL::can(). When an autoloaded function like
42             # duration() is exported, UNIVERSAL::can() returns the stub coderef which
43             # calls to AUTOLOAD. This means AUTOLOAD() can't rely on can() to get the
44             # dispatcher func, it has to make its own. Or unless can() oughtn't use
45             # SUPER::can this way ...
46             #
47             # If $name exists as a method in Time::Duration::LocaleObject, meaning a
48             # function in Time::Duration or langugage-specifc module, then create *$name
49             # so as to have just one copy of which can() will return each time and so as
50             # not to go through AUTOLOAD() every time.
51             #
52             # If $name is unknown then don't create a dispatcher, firstly of course so
53             # can() is false, and secondly to avoid junking up the package if a caller
54             # gets a name wrong.
55             #
56             sub can {
57 3     3 0 3220 my ($class, $name) = @_;
58             ### TDL can(): $name
59 3   100     39 return $class->SUPER::can($name) || _make_dispatcher($name);
60             }
61             sub AUTOLOAD {
62 24     24   14665 my $name = $AUTOLOAD;
63             ### TDL AUTOLOAD(): $name
64 24         131 $name =~ s/.*://;
65 24   66     48 my $code = _make_dispatcher($name) || croak "No such function $name()";
66 23         44 goto $code;
67             }
68              
69             # The method call to Time::Duration::LocaleObject here is "by name". Could
70             # instead go to the coderef returned by can(), like
71             #
72             # sub { unshift @_, 'Time::Duration::LocaleObject'; goto $can; };
73             #
74             # Dunno if there's more merit in the name or the coderef. The name would
75             # support redefinitions (though the base TDLObj->can() returns the same subr
76             # every time). The coderef might save a couple of cycles.
77             #
78             sub _make_dispatcher {
79 26     26   43 my ($name) = @_;
80 26 100       106 Time::Duration::LocaleObject->can($name) or return undef;
81             my $subr = sub {
82             #### TDL dispatch to TDLObj method: $name
83 38     38   9536 return Time::Duration::LocaleObject->$name (@_);
84 24         57 };
85 3     3   20 { no strict 'refs'; *$name = $subr }
  3         4  
  3         251  
  24         26  
  24         45  
86 24         56 return $subr;
87             }
88              
89             1;
90             __END__