view release on metacpan or  search on metacpan

lib/Time/Piece/Adaptive.pm  view on Meta::CPAN

=item * localtime

=item * :override:

=back

See Time::Piece for more.

=cut

use vars qw(@ISA @EXPORT %EXPORT_TAGS);

require Exporter;
require DynaLoader;
use Time::Piece;

@ISA = qw(Time::Piece);

@EXPORT = qw(
    localtime
    gmtime
);

%EXPORT_TAGS = (
    ':override' => 'internal',
    );

my %_special_exports = (
  localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } },
  gmtime    => sub { my $c = $_[0]; sub { $c->gmtime(@_)    } },
); 

sub _export
{ 
    my ($class, $to, @methods) = @_;
    for my $method (@methods)
    {
	if (exists $_special_exports{$method})
	{
	    no strict 'refs';
	    no warnings 'redefine';
	    *{$to . "::$method"} = $_special_exports{$method}->($class);
	} else { 
	    $class->SUPER::export ($to, $method);
	}
    } 
}

sub import
{
    # replace CORE::GLOBAL localtime and gmtime if required
    my $class = shift;
    my %params;
    map $params{$_}++, @_, @EXPORT;
    if (delete $params{':override'})
    {
	$class->_export ('CORE::GLOBAL', keys %params);
    }
    else
    {
	$class->_export((caller)[0], keys %params);
    }
}



=head1 METHODS

=head2 new

  my $t1 = new Time::Piece::Adaptive (time, stringify => "%Y%m%d%H%M%S");
  print "The MySql timestamp was $t1.";

  my $t2 = new Time::Piece::Adaptive (time,
                                      stringify => \&my_func,
                                      stringify_args => $my_data);

Like the constructor for Time::Piece, except it may set the default
stringify function.

The above examples are semanticly equivalent to:

  my $t1 = new Time::Piece::Adaptive (time);
  $t1->set_stringify ("%Y%m%d%H%M%S");
  print "The MySql timestamp was $t1.";

  my $t2 = new Time::Piece::Adaptive (time);
  $t2->set_stringify (\&my_func, $my_data);

=cut

sub new
{
    my $class = shift;
    my $time = shift
	unless $_[0] && ($_[0] eq "stringify" || $_[0] eq "stringify_arg");
    my %args = @_;

    my $self = $class->SUPER::new ($time);
    my $stringify = $args{stringify} if exists $args{stringify};
    my $stringify_args = $args{stringify_args} if exists $args{stringify_args};
    $self->set_stringify ($stringify, $stringify_args);
    return $self;
}



=head2 localtime

=head2 gmtime

C<localtime> and C<gmtime> work like Time::Piece's versions, except they accept
stringify arguments, as C<new>.

=cut

sub localtime {
    unshift @_, __PACKAGE__ unless eval {$_[0]->isa ('Time::Piece')};
    my $class = shift;
    my $time  = shift
	unless $_[0] && ($_[0] eq "stringify" || $_[0] eq "stringify_arg");