File Coverage

blib/lib/Time/Duration/Locale.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	2	2	100.0
condition	5	6	83.3
subroutine	11	11	100.0
pod	0	1	0.0
total	52	54	96.3

# Copyright 2009, 2010, 2011, 2013 Kevin Ryde

# This file is part of Time-Duration-Locale.
#
# Time-Duration-Locale is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Time-Duration-Locale is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with Time-Duration-Locale.  If not, see .

package Time::Duration::Locale;
use 5.004;
use strict;
use Carp;
use Time::Duration::LocaleObject;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);

$VERSION = 10;

use Exporter;
@ISA = ('Exporter');

# same exports as Time::Duration
@EXPORT = qw(later later_exact earlier earlier_exact
             ago ago_exact from_now from_now_exact
             duration duration_exact
             concise);
@EXPORT_OK = ('interval', @EXPORT);
%EXPORT_TAGS = (all => \@EXPORT_OK);

# uncomment this to run the ### lines
#use Smart::Comments;

# SUPER::can() here is UNIVERSAL::can().  When an autoloaded function like
# duration() is exported, UNIVERSAL::can() returns the stub coderef which
# calls to AUTOLOAD.  This means AUTOLOAD() can't rely on can() to get the
# dispatcher func, it has to make its own.  Or unless can() oughtn't use
# SUPER::can this way ...
#
# If $name exists as a method in Time::Duration::LocaleObject, meaning a
# function in Time::Duration or langugage-specifc module, then create *$name
# so as to have just one copy of which can() will return each time and so as
# not to go through AUTOLOAD() every time.
#
# If $name is unknown then don't create a dispatcher, firstly of course so
# can() is false, and secondly to avoid junking up the package if a caller
# gets a name wrong.
#
sub can {
  my ($class, $name) = @_;
  ### TDL can(): $name
  return $class->SUPER::can($name) || _make_dispatcher($name);
}
sub AUTOLOAD {
  my $name = $AUTOLOAD;
  ### TDL AUTOLOAD(): $name
  $name =~ s/.*://;
  my $code = _make_dispatcher($name) || croak "No such function $name()";
  goto $code;
}

# The method call to Time::Duration::LocaleObject here is "by name".  Could
# instead go to the coderef returned by can(), like
#
#   sub { unshift @_, 'Time::Duration::LocaleObject'; goto $can; };
#
# Dunno if there's more merit in the name or the coderef.  The name would
# support redefinitions (though the base TDLObj->can() returns the same subr
# every time).  The coderef might save a couple of cycles.
#
sub _make_dispatcher {
  my ($name) = @_;
  Time::Duration::LocaleObject->can($name) or return undef;
  my $subr = sub {
    #### TDL dispatch to TDLObj method: $name
    return Time::Duration::LocaleObject->$name (@_);
  };
  { no strict 'refs'; *$name = $subr }
  return $subr;
}

1;
__END__