diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/Date/Format.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/Date/Format.pm | 403 |
1 files changed, 0 insertions, 403 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/Date/Format.pm b/Master/tlpkg/tlperl/site/lib/Date/Format.pm deleted file mode 100644 index 3a1ea90ef1f..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Date/Format.pm +++ /dev/null @@ -1,403 +0,0 @@ -# Copyright (c) 1995-2009 Graham Barr. This program is free -# software; you can redistribute it and/or modify it under the same terms -# as Perl itself. - -package Date::Format; - -use strict; -use vars qw(@EXPORT @ISA $VERSION); -require Exporter; - -$VERSION = "2.24"; -@ISA = qw(Exporter); -@EXPORT = qw(time2str strftime ctime asctime); - -sub time2str ($;$$) -{ - Date::Format::Generic->time2str(@_); -} - -sub strftime ($\@;$) -{ - Date::Format::Generic->strftime(@_); -} - -sub ctime ($;$) -{ - my($t,$tz) = @_; - Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz); -} - -sub asctime (\@;$) -{ - my($t,$tz) = @_; - Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz); -} - -## -## -## - -package Date::Format::Generic; - -use vars qw($epoch $tzname); -use Time::Zone; -use Time::Local; - -sub ctime -{ - my($me,$t,$tz) = @_; - $me->time2str("%a %b %e %T %Y\n", $t, $tz); -} - -sub asctime -{ - my($me,$t,$tz) = @_; - $me->strftime("%a %b %e %T %Y\n", $t, $tz); -} - -sub _subs -{ - my $fn; - $_[1] =~ s/ - %(O?[%a-zA-Z]) - / - ($_[0]->can("format_$1") || sub { $1 })->($_[0]); - /sgeox; - - $_[1]; -} - -sub strftime -{ - my($pkg,$fmt,$time); - - ($pkg,$fmt,$time,$tzname) = @_; - - my $me = ref($pkg) ? $pkg : bless []; - - if(defined $tzname) - { - $tzname = uc $tzname; - - $tzname = sprintf("%+05d",$tzname) - unless($tzname =~ /\D/); - - $epoch = timegm(@{$time}[0..5]); - - @$me = gmtime($epoch + tz_offset($tzname) - tz_offset()); - } - else - { - @$me = @$time; - undef $epoch; - } - - _subs($me,$fmt); -} - -sub time2str -{ - my($pkg,$fmt,$time); - - ($pkg,$fmt,$time,$tzname) = @_; - - my $me = ref($pkg) ? $pkg : bless [], $pkg; - - $epoch = $time; - - if(defined $tzname) - { - $tzname = uc $tzname; - - $tzname = sprintf("%+05d",$tzname) - unless($tzname =~ /\D/); - - $time += tz_offset($tzname); - @$me = gmtime($time); - } - else - { - @$me = localtime($time); - } - $me->[9] = $time; - _subs($me,$fmt); -} - -my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf); - -@DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); - -@MoY = qw(January February March April May June - July August September October November December); - -@DoWs = map { substr($_,0,3) } @DoW; -@MoYs = map { substr($_,0,3) } @MoY; - -@AMPM = qw(AM PM); - -@Dsuf = (qw(th st nd rd th th th th th th)) x 3; -@Dsuf[11,12,13] = qw(th th th); -@Dsuf[30,31] = qw(th st); - -%format = ('x' => "%m/%d/%y", - 'C' => "%a %b %e %T %Z %Y", - 'X' => "%H:%M:%S", - ); - -my @locale; -my $locale = "/usr/share/lib/locale/LC_TIME/default"; -local *LOCALE; - -if(open(LOCALE,"$locale")) - { - chop(@locale = <LOCALE>); - close(LOCALE); - - @MoYs = @locale[0 .. 11]; - @MoY = @locale[12 .. 23]; - @DoWs = @locale[24 .. 30]; - @DoW = @locale[31 .. 37]; - @format{"X","x","C"} = @locale[38 .. 40]; - @AMPM = @locale[41 .. 42]; - } - -sub wkyr { - my($wstart, $wday, $yday) = @_; - $wday = ($wday + 7 - $wstart) % 7; - return int(($yday - $wday + 13) / 7 - 1); -} - -## -## these 6 formatting routins need to be *copied* into the language -## specific packages -## - -my @roman = ('',qw(I II III IV V VI VII VIII IX)); -sub roman { - my $n = shift; - - $n =~ s/(\d)$//; - my $r = $roman[ $1 ]; - - if($n =~ s/(\d)$//) { - (my $t = $roman[$1]) =~ tr/IVX/XLC/; - $r = $t . $r; - } - if($n =~ s/(\d)$//) { - (my $t = $roman[$1]) =~ tr/IVX/CDM/; - $r = $t . $r; - } - if($n =~ s/(\d)$//) { - (my $t = $roman[$1]) =~ tr/IVX/M../; - $r = $t . $r; - } - $r; -} - -sub format_a { $DoWs[$_[0]->[6]] } -sub format_A { $DoW[$_[0]->[6]] } -sub format_b { $MoYs[$_[0]->[4]] } -sub format_B { $MoY[$_[0]->[4]] } -sub format_h { $MoYs[$_[0]->[4]] } -sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] } -sub format_P { lc($_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0]) } - -sub format_d { sprintf("%02d",$_[0]->[3]) } -sub format_e { sprintf("%2d",$_[0]->[3]) } -sub format_H { sprintf("%02d",$_[0]->[2]) } -sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)} -sub format_j { sprintf("%03d",$_[0]->[7] + 1) } -sub format_k { sprintf("%2d",$_[0]->[2]) } -sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)} -sub format_L { $_[0]->[4] + 1 } -sub format_m { sprintf("%02d",$_[0]->[4] + 1) } -sub format_M { sprintf("%02d",$_[0]->[1]) } -sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) } -sub format_s { - $epoch = timelocal(@{$_[0]}[0..5]) - unless defined $epoch; - sprintf("%d",$epoch) -} -sub format_S { sprintf("%02d",$_[0]->[0]) } -sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) } -sub format_w { $_[0]->[6] } -sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) } -sub format_y { sprintf("%02d",$_[0]->[5] % 100) } -sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) } - -sub format_Z { - my $o = tz_local_offset(timelocal(@{$_[0]}[0..5])); - defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]); -} - -sub format_z { - my $t = timelocal(@{$_[0]}[0..5]); - my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t); - sprintf("%+03d%02d", int($o / 3600), int(abs($o) % 3600) / 60); -} - -sub format_c { &format_x . " " . &format_X } -sub format_D { &format_m . "/" . &format_d . "/" . &format_y } -sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p } -sub format_R { &format_H . ":" . &format_M } -sub format_T { &format_H . ":" . &format_M . ":" . &format_S } -sub format_t { "\t" } -sub format_n { "\n" } -sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) } -sub format_x { my $f = $format{'x'}; _subs($_[0],$f); } -sub format_X { my $f = $format{'X'}; _subs($_[0],$f); } -sub format_C { my $f = $format{'C'}; _subs($_[0],$f); } - -sub format_Od { roman(format_d(@_)) } -sub format_Oe { roman(format_e(@_)) } -sub format_OH { roman(format_H(@_)) } -sub format_OI { roman(format_I(@_)) } -sub format_Oj { roman(format_j(@_)) } -sub format_Ok { roman(format_k(@_)) } -sub format_Ol { roman(format_l(@_)) } -sub format_Om { roman(format_m(@_)) } -sub format_OM { roman(format_M(@_)) } -sub format_Oq { roman(format_q(@_)) } -sub format_Oy { roman(format_y(@_)) } -sub format_OY { roman(format_Y(@_)) } - -sub format_G { int(($_[0]->[9] - 315993600) / 604800) } - -1; -__END__ - -=head1 NAME - -Date::Format - Date formating subroutines - -=head1 SYNOPSIS - - use Date::Format; - - @lt = localtime(time); - - print time2str($template, time); - print strftime($template, @lt); - - print time2str($template, time, $zone); - print strftime($template, @lt, $zone); - - print ctime(time); - print asctime(@lt); - - print ctime(time, $zone); - print asctime(@lt, $zone); - -=head1 DESCRIPTION - -This module provides routines to format dates into ASCII strings. They -correspond to the C library routines C<strftime> and C<ctime>. - -=over 4 - -=item time2str(TEMPLATE, TIME [, ZONE]) - -C<time2str> converts C<TIME> into an ASCII string using the conversion -specification given in C<TEMPLATE>. C<ZONE> if given specifies the zone -which the output is required to be in, C<ZONE> defaults to your current zone. - - -=item strftime(TEMPLATE, TIME [, ZONE]) - -C<strftime> is similar to C<time2str> with the exception that the time is -passed as an array, such as the array returned by C<localtime>. - -=item ctime(TIME [, ZONE]) - -C<ctime> calls C<time2str> with the given arguments using the -conversion specification C<"%a %b %e %T %Y\n"> - -=item asctime(TIME [, ZONE]) - -C<asctime> calls C<time2str> with the given arguments using the -conversion specification C<"%a %b %e %T %Y\n"> - -=back - -=head1 MULTI-LANGUAGE SUPPORT - -Date::Format is capable of formating into several languages by creating -a language specific object and calling methods, see L<Date::Language> - - my $lang = Date::Language->new('German'); - $lang->time2str("%a %b %e %T %Y\n", time); - -I am open to suggestions on this. - -=head1 CONVERSION SPECIFICATION - -Each conversion specification is replaced by appropriate -characters as described in the following list. The -appropriate characters are determined by the LC_TIME -category of the program's locale. - - %% PERCENT - %a day of the week abbr - %A day of the week - %b month abbr - %B month - %c MM/DD/YY HH:MM:SS - %C ctime format: Sat Nov 19 21:05:57 1994 - %d numeric day of the month, with leading zeros (eg 01..31) - %e like %d, but a leading zero is replaced by a space (eg 1..32) - %D MM/DD/YY - %G GPS week number (weeks since January 6, 1980) - %h month abbr - %H hour, 24 hour clock, leading 0's) - %I hour, 12 hour clock, leading 0's) - %j day of the year - %k hour - %l hour, 12 hour clock - %L month number, starting with 1 - %m month number, starting with 01 - %M minute, leading 0's - %n NEWLINE - %o ornate day of month -- "1st", "2nd", "25th", etc. - %p AM or PM - %P am or pm (Yes %p and %P are backwards :) - %q Quarter number, starting with 1 - %r time format: 09:05:57 PM - %R time format: 21:05 - %s seconds since the Epoch, UCT - %S seconds, leading 0's - %t TAB - %T time format: 21:05:57 - %U week number, Sunday as first day of week - %w day of the week, numerically, Sunday == 0 - %W week number, Monday as first day of week - %x date format: 11/19/94 - %X time format: 21:05:57 - %y year (2 digits) - %Y year (4 digits) - %Z timezone in ascii. eg: PST - %z timezone in format -/+0000 - -C<%d>, C<%e>, C<%H>, C<%I>, C<%j>, C<%k>, C<%l>, C<%m>, C<%M>, C<%q>, -C<%y> and C<%Y> can be output in Roman numerals by prefixing the letter -with C<O>, e.g. C<%OY> will output the year as roman numerals. - -=head1 LIMITATION - -The functions in this module are limited to the time range that can be -represented by the time_t data type, i.e. 1901-12-13 20:45:53 GMT to -2038-01-19 03:14:07 GMT. - -=head1 AUTHOR - -Graham Barr <gbarr@pobox.com> - -=head1 COPYRIGHT - -Copyright (c) 1995-2009 Graham Barr. This program is free -software; you can redistribute it and/or modify it under the same terms -as Perl itself. - -=cut - - |