Time::Piece::Adaptive - subclass of Time::Piece which allows the default

Time-Piece-Adaptive documentation Contained in the Time-Piece-Adaptive distribution.

Index

Code Index:

VERSION

Top

Version 0.03

NAME

Top

Time::Piece::Adaptive - subclass of Time::Piece which allows the default stringification function to be set.

REQUIRES

Top

Subclasses Time::Piece.

SYNOPSIS

Top

See Time::Piece

I actually think this subclass encapsulates the behavior I would expect from Time::Piece, but I haven't been able to elicit a response from the authors of Time::Piece.

EXPORT

Top

* gmtime
* localtime
* :override:

See Time::Piece for more.

METHODS

Top

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);

localtime

gmtime

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

set_stringify

  $t->set_stringify ($format, $arg);
  print "The date is $t.";

If $format is a reference to a function, set the stringify function to $format, which should return a string when passed a reference to an instantiated Time::Piece and $arg.

If $format is a string, use it to format an output string using strftime (any $arg is ignored).

When called without specifying $format, restore the default stringifier (&Time::Piece::cdate).

add

subtract

Like the Time::Piece functions of the same name, except stringify and stringify_arg arguments are accepted.

Also, when a Time::Piece::Adaptive object is subtracted from an arbitrary object, it is converted to a string according to its stringify function and passed to perl for handling.

strptime

  my $t = Time::Piece::Adaptive::strptime ($mysqltime, "%Y%m%d%H%M%S");
  print "The MySql timestamp was $t.";

  my $t = Time::Piece::Adaptive::strptime ($mysqltime, "%Y%m%d%H%M%S",
                                           stringify =>
                                           \&Time::Piece::Adaptive::cdate);
  print "The MySql timestamp was $t.";

Like the Time::Piece::strptime, except a stringify function may be set as per Time::Piece::Adaptive::new and, if the stringify function is not explicitly specified, then it is set by calling set_stringify ($format) on the new object with the same $format string passed to strptime.

SEE ALSO

Top

Time::Piece

AUTHOR

Top

Derek Price, <derek at ximbiot.com>

BUGS

Top

Please report any bugs or feature requests to time-piece-adaptive at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Piece-Adaptive. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Time::Piece::Adaptive

You can also look for information at:

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Time-Piece-Adaptive

* CPAN Ratings

http://cpanratings.perl.org/d/Time-Piece-Adaptive

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Piece-Adaptive

* Search CPAN

http://search.cpan.org/dist/Time-Piece-Adaptive

COPYRIGHT & LICENSE

Top

Copyright 2006 Derek Price, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Time-Piece-Adaptive documentation Contained in the Time-Piece-Adaptive distribution. 
package Time::Piece::Adaptive;

use warnings;
use strict;

no warnings 'redefine';


our $VERSION = 0.03;


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);
    }
}




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;
}




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");
    $time = time unless defined $time;
    return $class->_mktime ($time, 1, @_);
}

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

sub _mktime
{
    my ($class, $time, $islocal, %args) = @_;
    return $class->SUPER::_mktime ($time) if wantarray;

    my $self = $class->SUPER::_mktime ($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;
}


use overload '""' => \&_stringify;

use constant 'c_stringify_func' => 11;
use constant 'c_stringify_arg' => 12;

sub _stringify
{
    my ($self) = @_;
    my $func = $self->[c_stringify_func];
    my $arg = $self->[c_stringify_arg];
    my $string = &{$func}($self, $arg);
    return $string;
}



sub set_stringify
{
    my ($self, $format, $arg) = @_;
    if (ref $format) {
	$self->[c_stringify_func] = $format;
	if (defined $arg) {
	    $self->[c_stringify_arg] = $arg if defined $arg;
	} else {
	    delete $self->[c_stringify_arg];
	}
    } elsif (defined $format) {
	$self->[c_stringify_func] = \&Time::Piece::strftime;
	$self->[c_stringify_arg] = $format;
    } else {
	$self->[c_stringify_func] = \&Time::Piece::cdate;
	delete $self->[c_stringify_arg];
    }
}




use overload
        '-' => \&subtract,
        '+' => \&add;

sub subtract
{
    my $time = shift;

    if ($_[1])
    {
	# SWAPED is set and our parent doesn't know how to handle
	# NOTDATE - DATE.  For backwards compatibility reasons, return
	# the result as if the string $time resolves to was subtracted
	# from NOTDATE.
	return $_[0] - "$time";
    }

    my $new = $time->SUPER::subtract (@_);
    $new->set_stringify ($time->[c_stringify_func],
			 $time->[c_stringify_arg])
	if $new->isa ('Time::Piece');
    return $new;
}

sub add
{
    my ($time) = shift;
    my $new = $time->SUPER::add (@_);
    $new->set_stringify ($time->[c_stringify_func],
			 $time->[c_stringify_arg]);
    return $new;
}




sub strptime
{
    my ($time, $string, $format, %args) = @_;
    my $self = $time->SUPER::strptime ($string, $format);
    my $stringify = exists $args{stringify} ? $args{stringify} : $format;
    my $stringify_args = $args{stringify_args} if exists $args{stringify_args};
    $self->set_stringify ($stringify, $stringify_args);
    return $self;
}


1;