| Subject: | Time::Piece::strptime should preserve stringify format. |
This is actually broken in 1.09, but this choice of versions was not in
the tracker.
I wanted to use Time::Piece parse a timestamps coming out of a MySQL
server (but stored as a varchar) in a backwards-compatible manner, in
the same sense that Time::Piece::localtime returns a backwards
compatible object since it stringifies the same way the scalar output of
localtime would.
Thus, since the timestamp field was normally formatted as
"YYYYmmddHHMMSS", I wanted a Time::Piece object that stringified the
same way.
To this end, I subclassed Time::Piece with an object that allows the
default stringify function to be set via a set_stringify method, via
arguments to new(), or via arguments to strptime(). In addition,
strptime($string, $format) method calls set_stringify
(\&Time::Piece::strftime, $format) on the object it creates before
returning it, regardless.
This seems like good default behavior to me and would be trivial to add
it to Time::Piece in a backwards compatible manner (except for the
non-&cdate default stringify for objects created by strptime, but I
think this would be a Good Thing (tm)).
I've attached the subclass I created. Moving the new functionality into
Time::Piece should be trivial, but please let me know if you have any
questions. Also, please let me know what you decide to do with it,
whatever that is.
| Subject: | Adaptive.pm |
package Time::Piece::Adaptive;
use warnings;
use strict;
=head1 VERSION
Version 0.01
=cut
our $VERSION = 0.01;
=head1 NAME
Time::Piece::Adaptive - subclass of Time::Piece which allows the default
stringification function to be set.
=head1 REQUIRES
Subclasses Time::Piece.
=head1 SYNOPSIS
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.
=head1 EXPORT
=over 4
=item * gmtime
=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',
);
=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, $time, %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;
$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;
$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;
}
=head2 set_stringify
$t->set_stringify ($format, $arg);
print "The date is $t.";
If C<$format> is a reference to a function, set the stringify function to
C<$format>, which should return a string when passed a reference to an
instantiated Time::Piece and C<$arg>.
If C<$format> is a string, use it to format an output string using
C<strftime> (any C<$arg> is ignored).
When called without specifying C<$format>, restore the default stringifier
(&Time::Piece::cdate).
=cut
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];
}
}
=head2 add
=head2 subtract
Like the Time::Piece functions of the same name, except C<stringify_func> and
C<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.
=cut
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;
}
=head2 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 C<Time::Piece::strptime>, except a stringify function may be set as
per C<Time::Piece::Adaptive::new> and, if the stringify function is not
explicitly specified, then it is set by calling C<set_stringify ($format)> on
the new object with the same C<$format> string passed to C<strptime>.
=cut
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;
}
=head1 AUTHOR
Derek Price, C<< <derek at ximbiot.com> >>
=head1 BUGS
Please report any bugs or feature requests to
C<bug-cgi-wiki-store-mediawiki at rt.cpan.org>, or through the web interface at
L<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.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Time::Piece::Adaptive
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/Time-Piece-Adaptive>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/Time-Piece-Adaptive>
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Piece-Adaptive>
=item * Search CPAN
L<http://search.cpan.org/dist/Time-Piece-Adaptive>
=back
=head1 COPYRIGHT & LICENSE
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.
=cut
1;