File Coverage

blib/lib/Time/CTime.pm

Criterion	Covered	Total	%
statement	37	39	94.8
branch	4	6	66.6
condition			n/a
subroutine	11	12	91.6
pod	1	7	14.2
total	53	64	82.8

package Time::CTime;


require 5.000;

use Time::Timezone;
use Time::CTime;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(ctime asctime strftime);
@EXPORT_OK = qw(asctime_n ctime_n @DoW @MoY @DayOfWeek @MonthOfYear);

use strict;

# constants
use vars qw(@DoW @DayOfWeek @MoY @MonthOfYear %strftime_conversion $VERSION);
use vars qw($template $sec $min $hour $mday $mon $year $wday $yday $isdst);

$VERSION = 2011.0505;

CONFIG: {
    @DoW = 	   qw(Sun Mon Tue Wed Thu Fri Sat);
    @DayOfWeek =   qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
    @MoY = 	   qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    @MonthOfYear = qw(January February March April May June
		      July August September October November December);

    %strftime_conversion = (
	'%',	sub { '%' },
	'a',	sub { $DoW[$wday] },
	'A',	sub { $DayOfWeek[$wday] },
	'b',	sub { $MoY[$mon] },
	'B',	sub { $MonthOfYear[$mon] },
	'c',	sub { asctime_n($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, "") },
	'd',	sub { sprintf("%02d", $mday); },
	'D',	sub { sprintf("%02d/%02d/%02d", $mon+1, $mday, $year%100) },
	'e',	sub { sprintf("%2d", $mday); },
	'f',	sub { fracprintf ("%3.3f", $sec); },
	'F',	sub { fracprintf ("%6.6f", $sec); },
	'h',	sub { $MoY[$mon] },
	'H',	sub { sprintf("%02d", $hour) },
	'I',	sub { sprintf("%02d", $hour % 12 || 12) },
	'j',	sub { sprintf("%03d", $yday + 1) },
	'k',	sub { sprintf("%2d", $hour); },
	'l',	sub { sprintf("%2d", $hour % 12 || 12) },
	'm',	sub { sprintf("%02d", $mon+1); },
	'M',	sub { sprintf("%02d", $min) },
	'n',	sub { "\n" },
	'o',	sub { sprintf("%d%s", $mday, (($mday < 20 && $mday > 3) ? 'th' : ($mday%10 == 1 ? "st" : ($mday%10 == 2 ? "nd" : ($mday%10 == 3 ? "rd" : "th"))))) },
	'p',	sub { $hour > 11 ? "PM" : "AM" },
	'r',	sub { sprintf("%02d:%02d:%02d %s", $hour % 12 || 12, $min, $sec, $hour > 11 ? 'PM' : 'AM') },
	'R',	sub { sprintf("%02d:%02d", $hour, $min) },
	'S',	sub { sprintf("%02d", $sec) },
	't',	sub { "\t" },
	'T',	sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) },
	'U',	sub { wkyr(0, $wday, $yday) },
	'v',	sub { sprintf("%2d-%s-%4d", $mday, $MoY[$mon], $year+1900) },
	'w',	sub { $wday },
	'W',	sub { wkyr(1, $wday, $yday) },
	'y',	sub { sprintf("%02d",$year%100) },
	'Y',	sub { $year + 1900 },
	'x',	sub { sprintf("%02d/%02d/%02d", $mon + 1, $mday, $year%100) },
	'X',	sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) },
	'Z',	sub { &tz2zone(undef,undef,$isdst) }
	# z sprintf("%+03d%02d", $offset / 3600, ($offset % 3600)/60);
    );


}

sub fracprintf {
    my($t,$s) = @_;
    my($p) = sprintf($t, $s-int($s));
    $p=~s/^0+//;
    $p;
}

sub asctime_n {
    my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = @_;
    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = localtime($sec) unless defined $min;
    $year += 1900;
    $TZname .= ' '
	if $TZname;
    sprintf("%s %s %2d %2d:%02d:%02d %s%4d",
	  $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZname, $year);
}

sub asctime
{
    return asctime_n(@_)."\n";
}

# is this formula right?
sub wkyr {
    my($wstart, $wday, $yday) = @_;
    $wday = ($wday + 7 - $wstart) % 7;
    return int(($yday - $wday + 13) / 7 - 1);
}

# ctime($time)

sub ctime {
    my($time) = @_;
    asctime(localtime($time), &tz2zone(undef,$time));
}

sub ctime_n {
    my($time) = @_;
    asctime_n(localtime($time), &tz2zone(undef,$time));
}

# strftime($template, @time_struct)
#
# Does not support locales

sub strftime {
    local ($template, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;

    undef $@;
    $template =~ s/%([%aAbBcdDefFhHIjklmMnopQrRStTUvwWxXyYZ])/&{$Time::CTime::strftime_conversion{$1}}()/egs;
    die $@ if $@;
    return $template;
}

1;

__END__