# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
package Mdc::FormatTime;
our $VERSION = '2.06'; # 2/25/2008 6:15PM
=head1 Name
Mdc::FormatTime
Version 2.06
=head1 Synopsis
use Mdc::FormatTime; # use this module
my $T = new Mdc::FormatTime; # create a new datetime object
print $OBJ->Format; # default format (2003/11/01 13:09:22)
print $OBJ->Format('longdate'); # predefined long date format (Saturday, November 1, 2003)
print $OBJ->Format('time date'); # combined formats (13:09:22 2003/11/01)
print $OBJ->Format('YYMMMDD'); # custom format (03Nov01)
=head1 Description
The FormatTime module provides a method for creating a date/time object which
will produce a formatted time and date string.
A predefined format or a customized date/time format may be chosen during object
creation or as a parameter of the Format method.
=head3 Predefined formats:
%default Default format (2003/11/01 13:09:22)
%date ISO date format (2003/11/01)
%usdate US date format (1/11/03)
%longdate Long date format (Saturday, November 1, 2003)
%shortdate Short date format (Nov 1, '03)
%http RFC xxxx date string (Sat, 01 Nov 2003 21:09:22 GMT)
%time 24 hour time format (13:09:22)
%time12 12 hour time format (1:09PM)
%timestamp Non-delimited date and local time (200311011309220000).
%utimestamp Unix timestamp in GMT (20031101T2109220000Z).
=head3 Custom formatting
%YY two digit year
%YYYY four digit year
%M month
%MM two digit month with zero padding
%MMM three character month (Jan)
%MMMM complete month (January)
%D day of the month
%DD two digit day of the month with zero padding
%W numeric day of the week (0=Sunday)
%WW two character day of the week (Su)
%WWW three character day of the week (Sun)
%WWWW complete day of the week (Sunday)
%h hour
%hh two digit hour with zero padding
%m minute
%mm two digit minute with zero padding
%s second
%ss two digit second with zero padding
%u tenths of a second
%uu hundredths of a second
%uuu milliseconds
%uuuu tenths of a millisecond
=head3 Directives
The following directives in the format string will affect the output. Using an
ampersand (&) instead of a percent sign (%) with GMT, UTC, and AM/PM will suppress
the output of the designator.
[+-]nt Add or subtract time segment (t) by amount (n). The number (n) must
be an integer and (t) must be one of s, m, h, D, M or Y.
Example: "+5h" will add 5 hours to the output.
%GMT Set offset to Greenwich Mean Time designated with "GMT" in output.
%UTC Same offset as Greenwich Mean Time but with "UTC" in output.
%AM|%PM 12 hour time mode designated with "AM" or "PM" in output.
%ST Append suffix to date. 1st, 2nd, etc.
=cut
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
use strict;
require 5.008;
use Carp;
use Time::HiRes( 'time' ); # comment out this line if the HiRes module is not installed
require Exporter;
our @ISA = qw/Exporter/;
our @EXPORT_OK = qw/$VERSION DayOfWeek/;
my @desc;
@{$desc[5]} = qw/x January February March April May June July August September October November December/;
@{$desc[7]} = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
my %timeMultiplier = (
s => 1,
m => 60,
h => 3600,
D => 86400
);
# carefull, the predefined order is important
my @predefined=('default' ,'%YYYY/%MM/%DD %hh:%mm:%ss',
'date' ,'%YYYY/%MM/%DD',
'usdate' ,'%M/%D/%YY',
'longdate' ,'%WWWW, %MMMM %D, %YYYY',
'shortdate' ,"%MMM %D, '%YY",
'http' ,'%WWW, %DD %MMM %YYYY %hh:%mm:%ss %GMT',
'timestamp' ,'%YYYY%MM%DD%hh%mm%ss%uuuu',
'time12' ,'%h:%mm%PM',
'time' ,'%hh:%mm:%ss',
'utimestamp' ,'%YYYY%MM%DDT%hh%mm%ss%uuuuZ&GMT' );
=head1 Methods
=head2 new
$OBJ = new Mdc::FormatTime( [$format_string [, seconds]] )
Create a new date/time object. Optional parameters are format string and seconds.
If a format string is supplied here, then subsquent uses of the "Format" method
will return this default format. The second optional parameter is seconds. This
is the number typically returned by "time", the Perl built-in function or the
high-res function. It represents the number of seconds since midnight 1/1/1980.
=cut
sub new {
bless my $self = {}, shift;
$self->{format} = (@_)? shift : '%default' ;
return $self;
}
=head2 Now
$OBJ->Now( [$format_string [,$seconds]] )
Return the formatted date/time string. The format that was chosen at object
creation may be temporarily overridden by supplying a format string here.
$OBJ->Now('h:mmPM') # 1:09PM
You may optionally format a static time by supplying the seconds as is returned
by the time function.
=cut
sub Now {
my $self = shift;
my($fmt,$tm) = @_;
$fmt = $self->{format} if !defined $fmt;
for( my $i=0; $i<@predefined; $i+=2 ){
$fmt =~ s/\%$predefined[$i]/$predefined[$i+1]/g;
}
my $sfx = ($fmt =~ s/%ST/%T/gi);
my $h12 = ($fmt =~ s/%[AP]M{0,1}/%P/g || $fmt =~ s/\&[AP]M{0,1}//g);
my $gmt = ($fmt =~ s/%GMT/GMT/g || $fmt =~ s/\&GMT//g);
my $utc = ($fmt =~ s/%UTC/UTC/g || $fmt =~ s/\&UTC//g);
my @offsetTime = ($1,$2,$3) if $fmt =~ s/(\+|\-)(\d+)(D|h|m|s)//g;
my @offsetMY = ($1,$2,$3) if $fmt =~ s/(\+|\-)(\d+)(M|Y)//g;
my $x=0;
foreach ( qw/u s m h D M Y W/ ) {
for ( my $i=4; $i; $i-- ) {
my $r = $_ x $i;
$fmt =~ s/%$r/\%$x$i/g;
}
$x++;
}
my ($s,$u) = split('\.', sprintf('%.6f', defined $tm? $tm: time) );
$s += _offsetTime(@offsetTime);
my @lt = ($u, $gmt?gmtime($s):localtime($s) );
($lt[7],$lt[6],$lt[5],$lt[4]) = _offsetMY($lt[6],$lt[5],$lt[4],@offsetMY);
my $p = ($lt[3]>12)?'PM':'AM';
$lt[3] -= 12 if $lt[3]>12 && $h12;
foreach my $i (3,4) {
my $l = ($i==4)?9: $i;
($fmt =~ s/\%$_$i/substr($desc[$_][$lt[$_]],0,$l)/ge) foreach (5,7);
}
$fmt =~ s/\%72/substr($desc[7][$lt[7]],0,2)/ge;
foreach my $i (0...5,7) {
foreach my $l (1...4) {
my $v = ($i==0)? substr(_pad($lt[$i],5),0,$l) : _pad($lt[$i],(($l==1)?1:2));
$fmt =~ s/\%$i$l/$v/ge;
}
}
$fmt =~ s/%6(\d)/substr($lt[6],-$1,$1)/ge;
$fmt =~ s/(\d*\d)%T/_suffix($1)/ge;
$fmt =~ s/%P/$p/g;
$fmt =~ s/%U/UTC/g;
$fmt =~ s/%G/GMT/g;
$fmt =~ s/^\s+//;
$fmt =~ s/\s+$//;
return $fmt;
}
=head2 DayOfWeek
In scalar context, will return the numeric day of the week, where 0 is Sunday,
given the year, month, and day of the month. In list context, will return the
numeric day of the week and the string day of the week. May be imported and
used as a function.
# will return 2
DayOfWeek(2007,6,19)
# will return (2,Tuesday)
DayOfWeek(2007,6,19)
=cut
sub DayOfWeek {
shift if ref $_[0];
my($y,$m,$d) = @_;
$y = $m<3? $y-1: $y;
my $n = (int(23*$m/9)+$d+4+$y+int($y/4)-int($y/100)+int($y/400)-2*($m>=3))%7;
if(wantarray){ return($n,$desc[7][$n]) }
return $n;
}
=head2 Format
Same as Now.
=cut
sub Format {
my $self = shift;
return $self->Now(@_);
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# Private methods
sub _offsetTime {
my ($op,$amt,$t) = @_;
return 0 if !defined $amt;
$amt *= $timeMultiplier{$t} * (($op eq '-')?-1:1);
return $amt;
}
sub _offsetMY {
my ($Y,$M,$D,$op,$amt,$t) = @_;
$Y += 1900;
if( defined $op ){
$M += $amt * (($op eq '-')?-1:1) if 'M' eq $t;
if($M<0||$M>11){
($M,$Y) = ( ($M%12), $Y+(($M<0)? -1+int($M/12): int($M/12)) );
}
}
$M++;
my $W = DayOfWeek($Y,$M,$D);
return ($W,$Y,$M,$D);
}
sub _pad {
my ($v,$n) = @_;
return ($n>length $v)?(0 x ($n-length $v)).$v:$v;
}
sub _suffix {
my $n = shift;
my @suffix = (qw(th st nd rd th th th th th th));
if( ($n > 10) and ($n < 14) ){
return $n . 'th';
}
$n =~ /(\d)$/;
return $n . $suffix[$1];
}
=head1 Author and Copyright
Mdc::FormatTime - Copyright(c) 2003-2008, Mark K Mueller, All Rights Reserved.
www.markmueller.com
=for html
MkM 2/27/2008 7:36AM
=cut
1;
__END__