package TimeStamp;
#use strict;
use Carp;

my @a = qw(Sun Mon Tue Wed Thu Fri Sat);
my @A = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
my @b = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my @B = qw(January February March April May June July August September October November December);
my @meridian = qw( AM PM );

# KEY TO FORMAT TOKEN CODES
# %a:short day of week, %A:long day of week, 
# %b:short month, %B:long month, %d:day of month,
# %D: date, %X:time (24 hour), %x: time (12 hour), 
# %y:short year, %Y:long year

sub a { $a[$_[6]] }
sub A { $A[$_[6]] }
sub b { $b[$_[4]] }
sub B { $B[$_[4]] }
sub d { &pad($_[3]) }
sub D { &pad(1 + $_[4]) . "/" . &pad($_[3]) . "/" . &pad($_[5] - 100) }
sub X { my ($ss,$mm,$hh) = map { &pad($_) } @_; "$hh:$mm:$ss" }
sub x { my ($ss,$mm,$hh) = map { &pad($_) } @_;
        ($hh>12) ? $hh-12 . ":$mm:$ss $meridian[1]" : "$hh:$mm:$ss $meridian[0]"; }
sub y { &pad($_[5] - 100) }
sub Y { $_[5] + 1900 }

# &pad() will add a leading zero to single digits. 

sub pad {
	my @result = map {($_ < 10) ? "0$_" : $_} @_;
	return wantarray ? (@result) : $result[0];
}

sub TIESCALAR {
	return (bless { fmt => \"%a %D %X" }, shift);
}

sub FETCH {
	my $obj = shift;
	my @time = localtime;
	my $fmtString = ${$obj->{fmt}};
	my @tokens = split /(%\w)/, $fmtString;
	my $result = "";
	for ( @tokens ) {
		if ( /\%./ ) {
			s/\%//;
			eval {
				$result .= &{$_}(@time);
			};
			next if ($@);
		} else {
				$result .= $_;
		}
	}
	return $result;
}

sub STORE {
	my ($obj, $fmt) = @_;
	$obj->{fmt} = \$fmt;
}

1;

##</code><code>##

#!/usr/bin/perl
use strict;
use warnings;

use TimeStamp;
my $ts;
tie $ts, 'TimeStamp';

print $ts, "\n";

$ts = "%A, %B %d, %Y";
print $ts, "\n";

$ts = "Day %d in the month of %B, the year %YAD";
print $ts, "\n";

my $ts2;
tie $ts2, 'TimeStamp';

$ts = "%D %x";
$ts3 = "%D";

print $ts2, "\n";
print $ts, "\n";

##</code><code>##

C:\>perl -w ts_test.pl 
Tue 10/29/02 20:07:48
Tuesday, October 29, 2002
Day 29 in the month of October, the year 2002AD
10/29/02
10/29/02 8:07:48 PM

##</code><code>##

C:\>perl -w ts_test.pl 
  
,  , 
Day  in the month of , the year AD