Time-Format-1.11/0000755000175600010010000000000011216576120012512 5ustar eroodeNoneTime-Format-1.11/t/0000755000175600010010000000000011216346144012756 5ustar eroodeNoneTime-Format-1.11/t/xs_time.t0000755000175600010010000001403111216346144014615 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 78; BEGIN { use_ok 'Time::Format', qw(%time) } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Get day/month names in current locale my ($Weekday, $Day, $Month, $Mon); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Weekday, $Day, $Month, $Mon) = map langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Weekday, $Day, $Month, $Mon) = qw(Thursday Thu June Jun); } SKIP: { skip 'Time::Local not available', 77 if $tl_notok; skip 'XS version not available', 77 if !defined $Time::Format_XS::VERSION; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # Basic tests (34) is $time{'yyyy',$t}, '2003' => '4-digit year'; is $time{'yy',$t}, '03' => '2-digit year'; is $time{'mm{on}',$t}, '06' => 'month: mm'; is $time{'m{on}',$t}, '6' => 'month: m'; is $time{'?m{on}',$t}, ' 6' => 'month: ?m'; is $time{'Month',$t}, $Month => 'month name'; is $time{'MONTH',$t}, uc $Month => 'uc month name'; is $time{'month',$t}, lc $Month => 'lc month name'; is $time{'Mon',$t}, $Mon => 'abbr month name'; is $time{'MON',$t}, uc $Mon => 'uc abbr month name'; is $time{'mon',$t}, lc $Mon => 'lc abbr month name'; is $time{'dd',$t}, '05' => '2-digit day'; is $time{'d',$t}, '5' => '1-digit day'; is $time{'?d',$t}, ' 5' => 'spaced day'; is $time{'Weekday',$t}, $Weekday => 'weekday'; is $time{'WEEKDAY',$t}, uc $Weekday => 'uc weekday'; is $time{'weekday',$t}, lc $Weekday => 'lc weekday'; is $time{'Day',$t}, $Day => 'weekday abbr'; is $time{'DAY',$t}, uc $Day => 'uc weekday abbr'; is $time{'day',$t}, lc $Day => 'lc weekday abbr'; is $time{'hh',$t}, '13' => '2-digit 24-hour'; is $time{'h',$t}, '13' => '1-digit 24-hour'; is $time{'?h',$t}, '13' => 'spaced 24-hour'; is $time{'HH',$t}, '01' => '2-digit 12-hour'; is $time{'H',$t}, '1' => '1-digit 12-hour'; is $time{'?H',$t}, ' 1' => 'spaced 12-hour'; is $time{'mm{in}',$t}, '58' => 'minute: mm'; is $time{'m{in}',$t}, '58' => 'minute: m'; is $time{'?m{in}',$t}, '58' => 'minute: ?m'; is $time{'ss',$t}, '09' => '2-digit second'; is $time{'s',$t}, '9' => '1-digit second'; is $time{'?s',$t}, ' 9' => 'spaced second'; is $time{'mmm',$t}, '987' => 'millisecond'; is $time{'uuuuuu',$t}, '987654' => 'microsecond'; # am/pm tests (16) is $time{'am',$t}, 'pm' => 'am'; is $time{'AM',$t}, 'PM' => 'AM'; is $time{'pm',$t}, 'pm' => 'pm'; is $time{'PM',$t}, 'PM' => 'PM'; is $time{'a.m.',$t}, 'p.m.' => 'a.m.'; is $time{'A.M.',$t}, 'P.M.' => 'A.M.'; is $time{'p.m.',$t}, 'p.m.' => 'p.m.'; is $time{'P.M.',$t}, 'P.M.' => 'P.M.'; is $time{'am',$t-9999}, 'am' => 'am 2'; is $time{'AM',$t-9999}, 'AM' => 'AM 2'; is $time{'pm',$t-9999}, 'am' => 'pm 2'; is $time{'PM',$t-9999}, 'AM' => 'PM 2'; is $time{'a.m.',$t-9999}, 'a.m.' => 'a.m. 2'; is $time{'A.M.',$t-9999}, 'A.M.' => 'A.M. 2'; is $time{'p.m.',$t-9999}, 'a.m.' => 'p.m. 2'; is $time{'P.M.',$t-9999}, 'A.M.' => 'P.M. 2'; # ordinal suffix tests (8) is $time{'dth',$t}, '5th' => '5th'; is $time{'dTH',$t}, '5TH' => '5TH'; is $time{'dth',$t-4*86400},'1st' => '1st'; is $time{'dth',$t-3*86400},'2nd' => '2nd'; is $time{'dth',$t-2*86400},'3rd' => '3rd'; is $time{'dTH',$t-2*86400},'3RD' => '3RD'; is $time{'dth',$t+6*86400},'11th' => '11th'; is $time{'dth',$t+16*86400},'21st' => '21st'; # Make sure 'm' guessing works reasonably well (18) is $time{'yyyymm',$t}, '200306' => 'm test: year'; is $time{'yymm',$t}, '0306' => 'm test: year2'; is $time{'mmdd',$t}, '0605' => 'm test: day'; is $time{'yyyy/m',$t}, '2003/6' => 'm test: year/'; is $time{'yy/m',$t}, '03/6' => 'm test: year2/'; is $time{'m/d',$t}, '6/5' => 'm test: /day'; is $time{'m/dd',$t}, '6/05' => 'm test: /Day'; is $time{'?d/mm',$t}, ' 5/06' => 'm test: d/m'; is $time{'?m/yyyy',$t}, ' 6/2003' => 'm test: m/y'; is $time{'m/yy',$t}, '6/03' => 'm test: m/y2'; is $time{'yyyy mon',$t}, '2003 jun' => 'm test: year mon'; is $time{'hhmm',$t}, '1358' => 'm test: hour'; is $time{'mmss',$t}, '5809' => 'm test: sec'; is $time{'hh:mm',$t}, '13:58' => 'm test: hour:'; is $time{'?m:ss',$t}, '58:09' => 'm test: :sec'; is $time{'H:mm',$t}, '1:58' => 'm test: Hour:'; is $time{'HH:mm',$t}, '01:58' => 'm test: hour12:'; is $time{'?H:m',$t}, ' 1:58' => 'm test: Hour12:'; # Current time value (1) # localtime seems always to return English day/month my ($m,$d) = (localtime)[4,6]; my $mon = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$m]; my $day = (qw(Sun Mon Tue Wed Thu Fri Sat))[$d]; is "$day $mon $time{'?d hh:mm:ss yyyy'}", scalar(localtime) => 'current time'; # # Note that there are two race conditions in the last section, above. # 1: The day or month could change between the first localtime() # call and the second. # 2: The time (especially the seconds) could change between the # %time call and the second localtime(). # The first is extremely rare; the second more frequent. # Re-run the test suite if there is any doubt. } Time-Format-1.11/t/xs_funcs.t0000755000175600010010000000227411216346144015003 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 5; # XS TEST: Only need to test the %time and time_format bits. BEGIN { use_ok 'Time::Format', qw(time_format time_strftime time_manip) } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } SKIP: { skip 'Time::Local not available', 4 if $tl_notok; skip 'XS version not available', 4 if !defined $Time::Format_XS::VERSION; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # time_format tests (4) is time_format('yyyymmdd',$t), '20030605' => 'month: mm'; is time_format('hhmmss',$t), '135809' => 'm minute: 1'; is time_format('MONTH',$t), uc $June => 'uc month name'; is time_format('weekday',$t), lc $Thursday => 'lc weekday'; } Time-Format-1.11/t/die.t0000755000175600010010000000055211216346144013711 0ustar eroodeNone#!/perl -I.. # Test some error cases use strict; use Test::More tests => 3; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(:all) } my $err = 'Invalid call to Time::Format internal function'; my $len = length $err; eval '$time{foo} = 1'; is substr($@,0,$len), $err, 'Store'; eval '%strftime = ()'; is substr($@,0,$len), $err, 'Clear'; Time-Format-1.11/t/DateManip.t0000755000175600010010000000357411216346144015021 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 12; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } my $manip_bad; BEGIN { if (eval 'use Date::Manip (); 1') { # If Date::Manip can't determine the time zone, it'll bomb out of the tests. $manip_bad = 'Date::Manip cannot determine time zone' unless eval 'Date::Manip::Date_TimeZone(); 1'; } else { $manip_bad = 'Date::Manip is not available'; } } # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } SKIP: { skip $manip_bad, 11 if $manip_bad; my $t = Date::Manip::ParseDate('June 5, 2003 at 1:58:09 pm'); # time_format tests (5) is time_format('yyyymmdd', $t), '20030605' => 'mm month'; is time_format('hhmmss', $t), '135809' => 'mm minute'; is time_format('MONTH', $t), uc $June => 'uc month name'; is time_format('weekday', $t), lc $Thursday => 'lc weekday'; is time_format('\QToday is\E yyyy/mm/dd hh:mm:ss', $t), 'Today is 2003/06/05 13:58:09' => 'Full timestamp'; is $time{'yyyymmdd', $t}, '20030605' => 'month: mm'; is $time{'hhmmss', $t}, '135809' => 'mm minute'; is $time{'MONTH', $t}, uc $June => 'uc month name'; is $time{'weekday', $t}, lc $Thursday => 'lc weekday'; is $time{'\QToday is\E yyyy/mm/dd hh:mm:ss', $t}, 'Today is 2003/06/05 13:58:09' => 'Full timestamp'; is "$time{'\QToday is\E yyyy/mm/dd hh:mm:ss', $t}", 'Today is 2003/06/05 13:58:09' => 'Full timestamp'; } Time-Format-1.11/t/locale.t0000755000175600010010000000333111216346144014405 0ustar eroodeNone#!/perl -I.. # Test locale changing use strict; use Test::More tests => 9; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', '%time' } my $posix_bad; my $lc_time; BEGIN { $posix_bad = eval ('require POSIX; 1')? 0 : 1; unless ($posix_bad) { $lc_time = POSIX::LC_TIME(); *setlocale = \&POSIX::setlocale; } delete $INC{'POSIX.pm'}; %POSIX:: = (); } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} SKIP: { skip 'POSIX not available', 8 if $posix_bad; skip 'Time::Local not available', 8 if $tl_notok; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm my $en_ok = setlocale($lc_time, 'en_US'); $en_ok ||= setlocale($lc_time, 'C'); SKIP: { skip 'No English locale', 2 unless $en_ok; is $time{'Mon',$t}, 'Jun' => 'English month'; is $time{'Day',$t}, 'Thu' => 'English day'; } my $fr_ok = setlocale($lc_time, 'fr_FR'); SKIP: { skip 'No French locale', 2 unless $fr_ok; is $time{'month',$t}, 'juin' => 'Mois français'; is $time{'weekday',$t}, 'jeudi' => 'Jour de la semaine français'; } my $de_ok = setlocale($lc_time, 'de_DE'); SKIP: { skip 'No German locale', 2 unless $de_ok; is $time{'month',$t}, 'juni' => 'Deutscher Monat'; is $time{'weekday',$t}, 'donnerstag' => 'Deutscher Wochentag'; } my $es_ok = setlocale($lc_time, 'es_ES'); SKIP: { skip 'No Spanish locale', 2 unless $es_ok; is $time{'month',$t}, 'junio' => 'Mes español'; is $time{'weekday',$t}, 'jueves' => 'Día español de la semana'; } } Time-Format-1.11/t/export1.t0000755000175600010010000000134011216346144014546 0ustar eroodeNone#!/perl -I.. use Test::More tests => 7; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format' } # hashes exported properly? is ref tied %time, Time::Format => '%time exported by default'; is ref tied %strftime, '' => '%strftime not exported by default'; is ref tied %manip, '' => '%manip not exported by default'; eval {%strftime = ()}; # suppress "used only once" warning eval {%manip = ()}; # suppress "used only once" warning # functions exported properly? ok defined &time_format => 'time_format exported by default'; ok !defined &time_strftime => 'time_strftime not exported by default'; ok !defined &time_manip => 'time_manip not exported by default'; Time-Format-1.11/t/funcs.t0000755000175600010010000000564611216346144014277 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 18; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%time time_format time_strftime time_manip) } my $tl_notok; BEGIN { $tl_notok = eval ('use Time::Local; 1')? 0 : 1 } my $posix_bad; BEGIN { $posix_bad = eval ('use POSIX (); 1')? 0 : 1; delete $INC{'POSIX.pm'}; %POSIX:: = (); } my $manip_bad; my $manip_notz; BEGIN { $manip_bad = eval('use Date::Manip (); 1')? 0 : 1; unless ($manip_bad) { # If Date::Manip can't determine the time zone, it'll bomb out of the tests. $manip_notz = eval ('Date::Manip::Date_TimeZone (); 1')? 0 : 1; } delete $INC{'Date/Manip.pm'}; %Date::Manip:: = (); } # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } SKIP: { skip 'Time::Local not available', 17 if $tl_notok; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # time_format tests (5) is time_format('yyyymmdd',$t), '20030605' => 'month: mm'; is time_format('hhmmss',$t), '135809' => 'm minute: 1'; is time_format('MONTH',$t), uc $June => 'uc month name'; is time_format('weekday',$t), lc $Thursday => 'lc weekday'; is time_format('yyyymmdd'), $time{yyyymmdd} => 'time_format equals %time'; # time_strftime tests (6) SKIP: { skip 'POSIX not available', 6 if $posix_bad; # Be sure to use ONLY ansi standard strftime codes here, # otherwise the tests will fail on somebody's system somewhere. is time_strftime('%d',$t), '05' => 'day of month'; is time_strftime('%m',$t), '06' => 'Month number'; is time_strftime('%M',$t), '58' => 'minute'; is time_strftime('%H',$t), '13' => 'hour'; is time_strftime('%Y',$t), '2003' => 'year'; is time_strftime('%M'), $time{'mm{in}'} => 'time_strftime equals %time'; } # time_manip tests (6) SKIP: { skip 'Date::Manip not available', 6 if $manip_bad; skip 'Date::Manip cannot determine timezone', 6 if $manip_notz; my $m = 'first thursday in june 2003'; is time_manip('%Y',$m), '2003' => 'year'; is time_manip('%d',$m), '05' => 'day of month'; is time_manip('%D',$m), '06/05/03' => '%D'; is time_manip('%e',$m), ' 5' => 'spaced day'; is time_manip('%H',$m), '00' => 'hour'; is time_manip('%H'), $time{'hh'} => 'time_manip equals %time'; } } Time-Format-1.11/t/xs_doc.t0000755000175600010010000000524711216346144014435 0ustar eroodeNone#!/perl -I.. # Test examples in the docs, so we know we're not misleading anyone. # XS TEST: Only need to test the %time and time_format bits. use strict; use Test::More tests => 18; BEGIN { use_ok 'Time::Format', qw(:all) } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Were all variables imported? (1) is ref tied %time, 'Time::Format' => '%time imported'; # Get day/month names in current locale my ($Tuesday, $December, $Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Tuesday, $December, $Thursday, $Thu, $June, $Jun) = map langinfo($_), (DAY_3(), MON_12(), DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Tuesday, $December, $Thursday, $Thu, $June, $Jun) = qw(Tuesday December Thursday Thu June Jun); } my $t; unless ($tl_notok) { $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; } SKIP: { skip 'Time::Local not available', 16 if $tl_notok; skip 'XS version not available', 16 if !defined $Time::Format_XS::VERSION; # Synopsis tests (5) is "Today is $time{'yyyy/mm/dd',$t}", 'Today is 2003/06/05' => 'Today'; is "Yesterday was $time{'yyyy/mm/dd', $t-24*60*60}", 'Yesterday was 2003/06/04' => 'Yesterday'; is "The time is $time{'hh:mm:ss',$t}", 'The time is 13:58:09' => 'time'; is "Another time is $time{'H:mm am', $t}", 'Another time is 1:58 pm' => 'Another time'; is "Timestamp: $time{'yyyymmdd.hhmmss.mmm',$t}", 'Timestamp: 20030605.135809.987' => 'Timestamp'; # Examples section (11) is $time{'Weekday Month d, yyyy',$t}, "$Thursday $June 5, 2003" => 'Example 1'; is $time{'Day Mon d, yyyy',$t}, "$Thu $Jun 5, 2003" => 'Example 2'; is $time{'dd/mm/yyyy',$t}, "05/06/2003" => 'Example 3'; is $time{'yymmdd',$t}, "030605" => 'Example 4'; is $time{'dth of Month',$t}, "5th of $June" => 'Example 5'; is $time{'H:mm:ss am',$t}, "1:58:09 pm" => 'Example 6'; is $time{'hh:mm:ss.uuuuuu',$t}, "13:58:09.987654" => 'Example 7'; is $time{'yyyy/mm{on}/dd hh:mm{in}:ss.mmm',$t}, '2003/06/05 13:58:09.987' => 'Example 8'; is $time{'yyyy/mm/dd hh:mm:ss.mmm',$t}, '2003/06/05 13:58:09.987' => 'Example 9'; is $time{"It's H:mm.",$t}, "It'9 1:58." => 'Example 10'; is $time{"It'\\s H:mm.",$t}, "It's 1:58." => 'Example 11'; } Time-Format-1.11/t/string.t0000755000175600010010000000466711216346144014471 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 27; use lib 'blib/lib', 'blib/arch'; # time-as-string tests BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } # June 5, 2003 at 1:58:09 pm my $d = '2003-06-05'; my $t = '13:58:09'; my $d_t = "$d $t"; my $dt = "$d$t"; my $dtx; ($dtx = $dt) =~ tr/-://d; # no separators at all my $out; my $err; # time_format tests (10 * 2) is time_format('yyyymmdd', $d), '20030605' => 'ymd d only'; is time_format('yyyymmdd', $t), '19691231' => 'ymd t only'; is time_format('yyyymmdd', $d_t),'20030605' => 'ymd d&t'; is time_format('yyyymmdd', $dt), '20030605' => 'ymd dt'; is time_format('yyyymmdd', $dtx),'20030605' => 'ymd dt-nosep'; is time_format('hhmmss', $d), '000000' => 'hms d only'; is time_format('hhmmss', $t), '135809' => 'hms t only'; is time_format('hhmmss', $d_t),'135809' => 'hms d&t'; is time_format('hhmmss', $dt), '135809' => 'hms dt'; is time_format('hhmmss', $dtx),'135809' => 'hms dt-nosep'; is $time{'yyyymmdd', $d}, '20030605' => 'ymd d only'; is $time{'yyyymmdd', $t}, '19691231' => 'ymd t only'; is $time{'yyyymmdd', $d_t},'20030605' => 'ymd d&t'; is $time{'yyyymmdd', $dt}, '20030605' => 'ymd dt'; is $time{'yyyymmdd', $dtx},'20030605' => 'ymd dt-nosep'; is $time{'hhmmss', $d}, '000000' => 'hms d only'; is $time{'hhmmss', $t}, '135809' => 'hms t only'; is $time{'hhmmss', $d_t},'135809' => 'hms d&t'; is $time{'hhmmss', $dt}, '135809' => 'hms dt'; is $time{'hhmmss', $dtx},'135809' => 'hms dt-nosep'; # Reported bug case: eval { $out = time_format('yyyy.mm.dd', '2007.12.31'); }; is $@, '', 'December bug I: no error'; is $out, '2007.12.31' => 'December bug I'; eval { $out = time_format('yyyy.mm.dd', '2000.01.01'); }; is $@, '', 'December bug II: no error'; is $out, '2000.01.01' => 'December bug II'; eval { $out = time_format('yyyy.mm.dd', '1968.01.01'); }; is $@, '', 'December bug III: no error'; is $out, '1968.01.01' => 'December bug III'; Time-Format-1.11/t/export3.t0000755000175600010010000000152511216346144014555 0ustar eroodeNone#!/perl -I.. use Test::More tests => 7; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%manip time_format time_manip) } # hashes exported properly? is ref tied %time, '' => '%time not xported when it should not be'; is ref tied %strftime, '' => '%strftime not exported when it should not be'; is ref tied %manip, Time::Format => '%manip exported when explicitly requested'; eval {%time = ()}; # suppress "used only once" warning eval {%strftime = ()}; # suppress "used only once" warning # functions exported properly? ok defined &time_format => 'time_format exported when explicitly requested'; ok !defined &time_strftime => 'time_strftime not exported when not requested'; ok defined &time_manip => 'time_manip exported when explicitly requested'; Time-Format-1.11/t/0-signature.t0000755000175600010010000000142011216346144015301 0ustar eroodeNone#!/usr/bin/perl use strict; print "1..1\n"; if (!$ENV{TEST_SIGNATURE}) { print "ok 1 # skip Set the environment variable", " TEST_SIGNATURE to enable this test\n"; } elsif (!-s 'SIGNATURE') { print "ok 1 # skip No signature file found\n"; } elsif (!eval { require Module::Signature; 1 }) { print "ok 1 # skip ", "Next time around, consider install Module::Signature, ", "so you can verify the integrity of this distribution.\n"; } elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) { print "ok 1 # skip ", "Cannot connect to the keyserver\n"; } else { (Module::Signature::verify() == Module::Signature::SIGNATURE_OK()) or print "not "; print "ok 1 # Valid signature\n"; } Time-Format-1.11/t/xs_quot.t0000755000175600010010000000633011216346144014652 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 23; BEGIN { use_ok 'Time::Format' } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } my $june = lc $June; my $JUNE = uc $June; SKIP: { skip 'Time::Local not available', 22 if $tl_notok; skip 'XS version not available', 22 if !defined $Time::Format_XS::VERSION; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # (3) \Q \E tests is $time{q[\QThis is a test string that should not be changed.\E],$t}, 'This is a test string that should not be changed.', '\Q...\E'; is $time{q[\QThis is a test string that should not be changed.],$t}, 'This is a test string that should not be changed.', '\Q...'; is $time{q[This is a test string that should not be changed.],$t}, 'T13i9 i9 a te9t 9tring that 913oul5 not be c13ange5.', 'unquoted'; # (8) Static upper/lower tests is $time{q[aaabbbccc\Ueeefff\Eggg],$t}, 'aaabbbcccEEEFFFggg', 'upper1'; is $time{q[aaabbbccc\Ueeefffggg],$t}, 'aaabbbcccEEEFFFGGG', 'upper2'; is $time{q[AAABBBCCC\LEEEFFF\EGGG],$t}, 'AAABBBCCCeeefffGGG', 'lower1'; is $time{q[AAABBBCCC\LEEEFFFGGG],$t}, 'AAABBBCCCeeefffggg', 'lower2'; is $time{q[aaabbbccc\ueeefffggg],$t}, 'aaabbbcccEeefffggg', 'upperfirst1'; is $time{q[AAABBBCCC\uEEEFFFGGG],$t}, 'AAABBBCCCEEEFFFGGG', 'upperfirst2'; is $time{q[aaabbbccc\leeefffggg],$t}, 'aaabbbccceeefffggg', 'lowerfirst1'; is $time{q[AAABBBCCC\lEEEFFFGGG],$t}, 'AAABBBCCCeEEFFFGGG', 'lowerfirst2'; # (3) Backslash tests is $time{q[a\aab\bbc\cce\eef\ffg\gg],$t}, 'aaabbbccceeefffggg', 'extraneous backslashes'; is $time{q[aaa\Qbbbccc\Ueeefff\Eggg],$t}, 'aaabbbccc\Ueeefffggg', '\Q trumps \U'; is $time{q[a\aab\bbc\cc\Qe\eef\ffg\gg],$t},'aaabbbccce\eef\ffg\gg', '\Q trumps \ '; # (8) Variable upper/lower tests is $time{q[xxx \UMonth\E zzz],$t}, "xxx \U$June\E zzz", 'upper month'; is $time{q[xxx \LMonth\E zzz],$t}, "xxx \L$June\E zzz", 'lower month'; is $time{q[xxx \umonth zzz],$t}, "xxx \u$june zzz", 'ucfirst month'; is $time{q[xxx \lMONTH zzz],$t}, "xxx \l$JUNE zzz", 'lcfirst month'; is $time{q[xxx \l\UMonth\E zzz],$t}, "xxx \l\U$June\E zzz", 'lcfirst upper month'; is $time{q[xxx \u\LMonth\E zzz],$t}, "xxx \u\L$June\E zzz", 'ucfirst lower month'; is $time{q[xxx \U\lMonth\E zzz],$t}, "xxx \U\l$June\E zzz", 'upper lcfirst month'; is $time{q[xxx \L\uMonth\E zzz],$t}, "xxx \L\u$June\E zzz", 'lower ucfirst month'; } Time-Format-1.11/t/strftime.t0000755000175600010010000000172311216346144015006 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 6; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%strftime) } my $posix_bad; BEGIN { $posix_bad = eval ('use POSIX (); 1')? 0 : 1; delete $INC{'POSIX.pm'}; %POSIX:: = (); } my $tl_bad; BEGIN { $tl_bad = eval ('use Time::Local; 1')? 0 : 1 } SKIP: { skip 'POSIX is not available', 5 if $posix_bad; skip 'Time::Local is not available', 5 if $tl_bad; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # Be sure to use ONLY ansi standard strftime codes here, # otherwise the tests will fail on somebody's system somewhere. is $strftime{'%d',$t}, '05' => 'day of month'; is $strftime{'%m',$t}, '06' => 'Month number'; is $strftime{'%M',$t}, '58' => 'minute'; is $strftime{'%H',$t}, '13' => 'hour'; is $strftime{'%Y',$t}, '2003' => 'year'; } Time-Format-1.11/t/doc.t0000755000175600010010000000746711216346144013731 0ustar eroodeNone#!/perl -I.. # Test examples in the docs, so we know we're not misleading anyone. use strict; use Test::More tests => 26; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(:all) } my $tl_notok; BEGIN { $tl_notok = eval('use Time::Local; 1')? 0 : 1 } my $dm_notok; my $dm_notz; BEGIN { $dm_notok = eval('use Date::Manip (); 1')? 0 : 1; unless ($dm_notok) { # If Date::Manip can't determine the time zone, it'll bomb out of the tests. $dm_notz = eval('Date::Manip::Date_TimeZone (); 1')? 0 : 1; } delete $INC{'Date/Manip.pm'}; %Date::Manip:: = (); } # Were all variables imported? (3) is ref tied %time, 'Time::Format' => '%time imported'; is ref tied %strftime, 'Time::Format' => '%strftime imported'; is ref tied %manip, 'Time::Format' => '%manip imported'; # Get day/month names in current locale my ($Tuesday, $December, $Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Tuesday, $December, $Thursday, $Thu, $June, $Jun) = map langinfo($_), (DAY_3(), MON_12(), DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Tuesday, $December, $Thursday, $Thu, $June, $Jun) = qw(Tuesday December Thursday Thu June Jun); } my $t; unless ($tl_notok) { $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; } SKIP: { skip 'Time::Local not available', 22 if $tl_notok; # Synopsis tests (7) is "Today is $time{'yyyy/mm/dd',$t}", 'Today is 2003/06/05' => 'Today'; is "Yesterday was $time{'yyyy/mm/dd', $t-24*60*60}", 'Yesterday was 2003/06/04' => 'Yesterday'; is "The time is $time{'hh:mm:ss',$t}", 'The time is 13:58:09' => 'time'; is "Another time is $time{'H:mm am', $t}", 'Another time is 1:58 pm' => 'Another time'; is "Timestamp: $time{'yyyymmdd.hhmmss.mmm',$t}", 'Timestamp: 20030605.135809.987' => 'Timestamp'; is "POSIXish: $strftime{'%A, %B %d, %Y', 0,0,0,12,11,95,2}", "POSIXish: $Tuesday, $December 12, 1995" => 'POSIX 1'; is "POSIXish: $strftime{'%A, %B %d, %Y', int $t}", "POSIXish: $Thursday, $June 05, 2003" => 'POSIX 2'; # Examples section (12) is $time{'Weekday Month d, yyyy',$t}, "$Thursday $June 5, 2003" => 'Example 1'; is $time{'Day Mon d, yyyy',$t}, "$Thu $Jun 5, 2003" => 'Example 2'; is $time{'dd/mm/yyyy',$t}, "05/06/2003" => 'Example 3'; is $time{'yymmdd',$t}, "030605" => 'Example 4'; is $time{'dth of Month',$t}, "5th of $June" => 'Example 5'; is $time{'H:mm:ss am',$t}, "1:58:09 pm" => 'Example 6'; is $time{'hh:mm:ss.uuuuuu',$t}, "13:58:09.987654" => 'Example 7'; is $time{'yyyy/mm{on}/dd hh:mm{in}:ss.mmm',$t}, '2003/06/05 13:58:09.987' => 'Example 8'; is $time{'yyyy/mm/dd hh:mm:ss.mmm',$t}, '2003/06/05 13:58:09.987' => 'Example 9'; is $time{"It's H:mm.",$t}, "It'9 1:58." => 'Example 10'; is $time{"It'\\s H:mm.",$t}, "It's 1:58." => 'Example 11'; is $strftime{'%A %B %d, %Y',$t}, "$Thursday $June 05, 2003" => 'Example 12'; # manip tests (3) SKIP: { skip 'Date::Manip not available', 3 if $dm_notok; skip 'Date::Manip cannot determine timezone', 3 if $dm_notz; is $manip{'%m/%d/%Y',"epoch $t"}, '06/05/2003' => 'Example 13'; is $manip{'%m/%d/%Y','first monday in November 2000'}, '11/06/2000' => 'Example 14'; is qq[$time{'yyyymmdd',$manip{'%s',"epoch $t"}}], '20030605' => 'Example 15'; } } Time-Format-1.11/t/past.t0000644000175600010010000000177111216346144014120 0ustar eroodeNone # Test cases for bug reported by Will "Coke" Coleda use strict; use Test::More; use Time::Format; my $have_module = eval { require 'DateTime::Format::ISO8601'; 1; }; # Input string, output string my @tuples = ( ['2009-04-15T01:58:17.010760Z', 'April 15, 2009 @ 1:58'], ['2009-04-15T13:58:17.010760Z', 'April 15, 2009 @ 1:58'], ); # The above array contains all of the tests this unit will run. my $num_tests = 2 * scalar(@tuples); plan tests => $num_tests; SKIP: { skip 'DateTime::Format::ISO8601 required for this test', $num_tests unless $have_module; my $time_format = 'Month d, yyyy @ H:mm'; my $index = 0; foreach my $pair (@tuples) { my ($input, $expected) = @$pair; my $dt = DateTime::Format::ISO8601->parse_datetime($input); is $time{$time_format, $dt}, $expected, "Test case $index (hash)"; is time_format($time_format, $dt), $expected, "Test case $index (func)"; ++$index; } } Time-Format-1.11/t/time.t0000755000175600010010000001413511216346144014110 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 78; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%time) } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Get day/month names in current locale my ($Weekday, $Day, $Month, $Mon); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Weekday, $Day, $Month, $Mon) = map langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Weekday, $Day, $Month, $Mon) = qw(Thursday Thu June Jun); } SKIP: { skip 'Time::Local not available', 77 if $tl_notok; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # Basic tests (34) is $time{'yyyy',$t}, '2003' => '4-digit year'; is $time{'yy',$t}, '03' => '2-digit year'; is $time{'mm{on}',$t}, '06' => 'month: mm'; is $time{'m{on}',$t}, '6' => 'month: m'; is $time{'?m{on}',$t}, ' 6' => 'month: ?m'; is $time{'Month',$t}, $Month => 'month name'; is $time{'MONTH',$t}, uc $Month => 'uc month name'; is $time{'month',$t}, lc $Month => 'lc month name'; is $time{'Mon',$t}, $Mon => 'abbr month name'; is $time{'MON',$t}, uc $Mon => 'uc abbr month name'; is $time{'mon',$t}, lc $Mon => 'lc abbr month name'; is $time{'dd',$t}, '05' => '2-digit day'; is $time{'d',$t}, '5' => '1-digit day'; is $time{'?d',$t}, ' 5' => 'spaced day'; is $time{'Weekday',$t}, $Weekday => 'weekday'; is $time{'WEEKDAY',$t}, uc $Weekday => 'uc weekday'; is $time{'weekday',$t}, lc $Weekday => 'lc weekday'; is $time{'Day',$t}, $Day => 'weekday abbr'; is $time{'DAY',$t}, uc $Day => 'uc weekday abbr'; is $time{'day',$t}, lc $Day => 'lc weekday abbr'; is $time{'hh',$t}, '13' => '2-digit 24-hour'; is $time{'h',$t}, '13' => '1-digit 24-hour'; is $time{'?h',$t}, '13' => 'spaced 24-hour'; is $time{'HH',$t}, '01' => '2-digit 12-hour'; is $time{'H',$t}, '1' => '1-digit 12-hour'; is $time{'?H',$t}, ' 1' => 'spaced 12-hour'; is $time{'mm{in}',$t}, '58' => 'minute: mm'; is $time{'m{in}',$t}, '58' => 'minute: m'; is $time{'?m{in}',$t}, '58' => 'minute: ?m'; is $time{'ss',$t}, '09' => '2-digit second'; is $time{'s',$t}, '9' => '1-digit second'; is $time{'?s',$t}, ' 9' => 'spaced second'; is $time{'mmm',$t}, '987' => 'millisecond'; is $time{'uuuuuu',$t}, '987654' => 'microsecond'; # am/pm tests (16) is $time{'am',$t}, 'pm' => 'am'; is $time{'AM',$t}, 'PM' => 'AM'; is $time{'pm',$t}, 'pm' => 'pm'; is $time{'PM',$t}, 'PM' => 'PM'; is $time{'a.m.',$t}, 'p.m.' => 'a.m.'; is $time{'A.M.',$t}, 'P.M.' => 'A.M.'; is $time{'p.m.',$t}, 'p.m.' => 'p.m.'; is $time{'P.M.',$t}, 'P.M.' => 'P.M.'; is $time{'am',$t-9999}, 'am' => 'am 2'; is $time{'AM',$t-9999}, 'AM' => 'AM 2'; is $time{'pm',$t-9999}, 'am' => 'pm 2'; is $time{'PM',$t-9999}, 'AM' => 'PM 2'; is $time{'a.m.',$t-9999}, 'a.m.' => 'a.m. 2'; is $time{'A.M.',$t-9999}, 'A.M.' => 'A.M. 2'; is $time{'p.m.',$t-9999}, 'a.m.' => 'p.m. 2'; is $time{'P.M.',$t-9999}, 'A.M.' => 'P.M. 2'; # ordinal suffix tests (8) is $time{'dth',$t}, '5th' => '5th'; is $time{'dTH',$t}, '5TH' => '5TH'; is $time{'dth',$t-4*86400},'1st' => '1st'; is $time{'dth',$t-3*86400},'2nd' => '2nd'; is $time{'dth',$t-2*86400},'3rd' => '3rd'; is $time{'dTH',$t-2*86400},'3RD' => '3RD'; is $time{'dth',$t+6*86400},'11th' => '11th'; is $time{'dth',$t+16*86400},'21st' => '21st'; # Make sure 'm' guessing works reasonably well (18) is $time{'yyyymm',$t}, '200306' => 'm test: year'; is $time{'yymm',$t}, '0306' => 'm test: year2'; is $time{'mmdd',$t}, '0605' => 'm test: day'; is $time{'yyyy/m',$t}, '2003/6' => 'm test: year/'; is $time{'yy/m',$t}, '03/6' => 'm test: year2/'; is $time{'m/d',$t}, '6/5' => 'm test: /day'; is $time{'m/dd',$t}, '6/05' => 'm test: /Day'; is $time{'?d/mm',$t}, ' 5/06' => 'm test: d/m'; is $time{'?m/yyyy',$t}, ' 6/2003' => 'm test: m/y'; is $time{'m/yy',$t}, '6/03' => 'm test: m/y2'; # This test was broken until v1.06 (2008/03/28): was hardcoded to "jun". is $time{'yyyy mon',$t}, "2003 \L$Mon" => 'm test: year mon'; is $time{'hhmm',$t}, '1358' => 'm test: hour'; is $time{'mmss',$t}, '5809' => 'm test: sec'; is $time{'hh:mm',$t}, '13:58' => 'm test: hour:'; is $time{'?m:ss',$t}, '58:09' => 'm test: :sec'; is $time{'H:mm',$t}, '1:58' => 'm test: Hour:'; is $time{'HH:mm',$t}, '01:58' => 'm test: hour12:'; is $time{'?H:m',$t}, ' 1:58' => 'm test: Hour12:'; # Current time value (1) # localtime seems always to return English day/month my ($m,$d) = (localtime)[4,6]; my $mon = (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$m]; my $day = (qw(Sun Mon Tue Wed Thu Fri Sat))[$d]; is "$day $mon $time{'?d hh:mm:ss yyyy'}", scalar(localtime) => 'current time'; # # Note that there are two race conditions in the last section, above. # 1: The day or month could change between the first localtime() # call and the second. # 2: The time (especially the seconds) could change between the # %time call and the second localtime(). # The first is extremely rare; the second more frequent. # Re-run the test suite if there is any doubt. } Time-Format-1.11/t/xs_DateTime.t0000755000175600010010000000347711216346144015367 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 12; BEGIN { use_ok 'Time::Format', qw(time_format %time) } my $datetime_notok; BEGIN { $datetime_notok = eval ('use DateTime; 1')? 0 : 1; } # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } SKIP: { skip 'DateTime not available', 11 if $datetime_notok; skip 'XS version not available', 11 if !defined $Time::Format_XS::VERSION; # June 5, 2003 at 1:58:09 pm my $t = DateTime->new (year => 2003, month => 6, day => 5, hour => 13, minute => 58, second => 9, nanosecond => 987_654_321); # time_format tests (5) is time_format('yyyymmdd', $t), '20030605' => 'mm month'; is time_format('hhmmss', $t), '135809' => 'mm minute'; is time_format('MONTH', $t), uc $June => 'uc month name'; is time_format('weekday', $t), lc $Thursday => 'lc weekday'; is time_format('\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t), 'Today is 2003/06/05 13:58:09.987654' => 'Full timestamp'; is $time{'yyyymmdd', $t}, '20030605' => 'month: mm'; is $time{'hhmmss', $t}, '135809' => 'mm minute'; is $time{'MONTH', $t}, uc $June => 'uc month name'; is $time{'weekday', $t}, lc $Thursday => 'lc weekday'; is $time{'\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t}, 'Today is 2003/06/05 13:58:09.000000' => 'Full timestamp'; is "$time{'\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t}", 'Today is 2003/06/05 13:58:09.000000' => 'Full timestamp'; } Time-Format-1.11/t/1-load.t0000644000175600010010000000007611216346144014223 0ustar eroodeNone use Test::More tests => 1; BEGIN { use_ok('Time::Format') }; Time-Format-1.11/t/export2.t0000755000175600010010000000113011216346144014544 0ustar eroodeNone#!/perl -I.. use Test::More tests => 7; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', ':all' } # hashes exported properly? is ref tied %time, Time::Format => '%time exported by :all'; is ref tied %strftime, Time::Format => '%strftime exported by :all'; is ref tied %manip, Time::Format => '%manip exported by :all'; # functions exported properly? ok defined &time_format => 'time_format exported by :all'; ok defined &time_strftime => 'time_strftime exported by :all'; ok defined &time_manip => 'time_manip exported by :all'; Time-Format-1.11/t/manip.t0000755000175600010010000000161711216346144014257 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 6; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%manip) } my $manip_bad; BEGIN { unless (eval 'use Date::Manip (); 1') { $manip_bad = 'Date::Manip is not available'; } else { # If Date::Manip can't determine the time zone, it'll bomb out of the tests. $manip_bad = 'Date::Manip cannot determine time zone' unless eval 'Date::Manip::Date_TimeZone(); 1'; } delete $INC{'Date/Manip.pm'}; %Date::Manip:: = (); } my $t = 'first thursday in june 2003'; SKIP: { skip $manip_bad, 5 if $manip_bad; is $manip{'%Y',$t}, '2003' => 'year'; is $manip{'%d',$t}, '05' => 'day of month'; is $manip{'%D',$t}, '06/05/03' => '%D'; is $manip{'%e',$t}, ' 5' => 'spaced day'; is $manip{'%H',$t}, '00' => 'hour'; } Time-Format-1.11/t/quot.t0000755000175600010010000000625111216346144014142 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 23; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format' } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } my $june = lc $June; my $JUNE = uc $June; SKIP: { skip 'Time::Local not available', 22 if $tl_notok; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; # (3) \Q \E tests is $time{q[\QThis is a test string that should not be changed.\E],$t}, 'This is a test string that should not be changed.', '\Q...\E'; is $time{q[\QThis is a test string that should not be changed.],$t}, 'This is a test string that should not be changed.', '\Q...'; is $time{q[This is a test string that should not be changed.],$t}, 'T13i9 i9 a te9t 9tring that 913oul5 not be c13ange5.', 'unquoted'; # (8) Static upper/lower tests is $time{q[aaabbbccc\Ueeefff\Eggg],$t}, 'aaabbbcccEEEFFFggg', 'upper1'; is $time{q[aaabbbccc\Ueeefffggg],$t}, 'aaabbbcccEEEFFFGGG', 'upper2'; is $time{q[AAABBBCCC\LEEEFFF\EGGG],$t}, 'AAABBBCCCeeefffGGG', 'lower1'; is $time{q[AAABBBCCC\LEEEFFFGGG],$t}, 'AAABBBCCCeeefffggg', 'lower2'; is $time{q[aaabbbccc\ueeefffggg],$t}, 'aaabbbcccEeefffggg', 'upperfirst1'; is $time{q[AAABBBCCC\uEEEFFFGGG],$t}, 'AAABBBCCCEEEFFFGGG', 'upperfirst2'; is $time{q[aaabbbccc\leeefffggg],$t}, 'aaabbbccceeefffggg', 'lowerfirst1'; is $time{q[AAABBBCCC\lEEEFFFGGG],$t}, 'AAABBBCCCeEEFFFGGG', 'lowerfirst2'; # (3) Backslash tests is $time{q[a\aab\bbc\cce\eef\ffg\gg],$t}, 'aaabbbccceeefffggg', 'extraneous backslashes'; is $time{q[aaa\Qbbbccc\Ueeefff\Eggg],$t}, 'aaabbbccc\Ueeefffggg', '\Q trumps \U'; is $time{q[a\aab\bbc\cc\Qe\eef\ffg\gg],$t},'aaabbbccce\eef\ffg\gg', '\Q trumps \ '; # (8) Variable upper/lower tests is $time{q[xxx \UMonth\E zzz],$t}, "xxx \U$June\E zzz", 'upper month'; is $time{q[xxx \LMonth\E zzz],$t}, "xxx \L$June\E zzz", 'lower month'; is $time{q[xxx \umonth zzz],$t}, "xxx \u$june zzz", 'ucfirst month'; is $time{q[xxx \lMONTH zzz],$t}, "xxx \l$JUNE zzz", 'lcfirst month'; is $time{q[xxx \l\UMonth\E zzz],$t}, "xxx \l\U$June\E zzz", 'lcfirst upper month'; is $time{q[xxx \u\LMonth\E zzz],$t}, "xxx \u\L$June\E zzz", 'ucfirst lower month'; is $time{q[xxx \U\lMonth\E zzz],$t}, "xxx \U\l$June\E zzz", 'upper lcfirst month'; is $time{q[xxx \L\uMonth\E zzz],$t}, "xxx \L\u$June\E zzz", 'lower ucfirst month'; } Time-Format-1.11/t/DateTime.t0000755000175600010010000000341211216346144014642 0ustar eroodeNone#!/perl -I.. use strict; use Test::More tests => 12; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } my $datetime_notok; BEGIN {$datetime_notok = eval('use DateTime; 1;')? 0 : 1;} # Get day/month names in current locale my ($Thursday, $Thu, $June, $Jun); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo DAY_3 MON_12 DAY_5 ABDAY_5 MON_6 ABMON_6)); ($Thursday, $Thu, $June, $Jun) = map ucfirst lc langinfo($_), (DAY_5(), ABDAY_5(), MON_6(), ABMON_6()); 1; }) { ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } SKIP: { skip 'DateTime not available', 11 if $datetime_notok; # June 5, 2003 at 1:58:09 pm my $t = DateTime->new (year => 2003, month => 6, day => 5, hour => 13, minute => 58, second => 9, nanosecond => 987_654_321); # time_format tests (5) is time_format('yyyymmdd', $t), '20030605' => 'mm month'; is time_format('hhmmss', $t), '135809' => 'mm minute'; is time_format('MONTH', $t), uc $June => 'uc month name'; is time_format('weekday', $t), lc $Thursday => 'lc weekday'; is time_format('\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t), 'Today is 2003/06/05 13:58:09.987654' => 'Full timestamp'; is $time{'yyyymmdd', $t}, '20030605' => 'month: mm'; is $time{'hhmmss', $t}, '135809' => 'mm minute'; is $time{'MONTH', $t}, uc $June => 'uc month name'; is $time{'weekday', $t}, lc $Thursday => 'lc weekday'; is $time{'\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t}, 'Today is 2003/06/05 13:58:09.000000' => 'Full timestamp'; is "$time{'\QToday is\E yyyy/mm/dd hh:mm:ss.uuuuuu', $t}", 'Today is 2003/06/05 13:58:09.000000' => 'Full timestamp'; } Time-Format-1.11/t/epoch.t0000755000175600010010000000124311216346144014244 0ustar eroodeNone#!/perl -I.. # Test epoch-time formatting. # Based on a bug report by Adam Schneider, 11 June 2009 use strict; use Test::More; BEGIN { $Time::Format::NOXS = 1 } use Time::Format; my @test_inputs = ( 100000000, 99999999, 10000000, 9999999, 1000000, 999999, ); plan tests => scalar @test_inputs; my $tnum = 0; foreach my $epoch (@test_inputs) { my @t = localtime $epoch; $t[4]++; $t[5] += 1900; my $expected = sprintf '%04d/%02d/%02d %02d:%02d:%02d', @t[5,4,3, 2,1,0]; eval {is time_format('yyyy/mm/dd hh:mm:ss', $epoch), $expected, "Test case $tnum"} ; ++$tnum; } Time-Format-1.11/t/xs_locale.t0000755000175600010010000000340711216346144015123 0ustar eroodeNone#!/perl -I.. # Test locale changing use strict; use Test::More tests => 9; BEGIN { use_ok 'Time::Format', '%time' } my $posix_bad; my $lc_time; BEGIN { $posix_bad = eval ('require POSIX; 1')? 0 : 1; unless ($posix_bad) { $lc_time = POSIX::LC_TIME(); *setlocale = \&POSIX::setlocale; } delete $INC{'POSIX.pm'}; %POSIX:: = (); } my $tl_notok; BEGIN {$tl_notok = eval ('use Time::Local; 1')? 0 : 1} SKIP: { skip 'POSIX not available', 8 if $posix_bad; skip 'Time::Local not available', 8 if $tl_notok; skip 'XS version not available', 8 if !defined $Time::Format_XS::VERSION; my $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm my $en_ok = setlocale($lc_time, 'en_US'); $en_ok ||= setlocale($lc_time, 'C'); SKIP: { skip 'No English locale', 2 unless $en_ok; is $time{'Mon',$t}, 'Jun' => 'English month'; is $time{'Day',$t}, 'Thu' => 'English day'; } my $fr_ok = setlocale($lc_time, 'fr_FR'); SKIP: { skip 'No French locale', 2 unless $fr_ok; is $time{'month',$t}, 'juin' => 'Mois français'; is $time{'weekday',$t}, 'jeudi' => 'Jour de la semaine français'; } my $de_ok = setlocale($lc_time, 'de_DE'); SKIP: { skip 'No German locale', 2 unless $de_ok; is $time{'month',$t}, 'juni' => 'Deutscher Monat'; is $time{'weekday',$t}, 'donnerstag' => 'Deutscher Wochentag'; } my $es_ok = setlocale($lc_time, 'es_ES'); SKIP: { skip 'No Spanish locale', 2 unless $es_ok; is $time{'month',$t}, 'junio' => 'Mes español'; is $time{'weekday',$t}, 'jueves' => 'Día español de la semana'; } } Time-Format-1.11/Changes0000644000175600010010000001022311216346144014004 0ustar eroodeNone>Revision history for Perl extension Time::Format. 0.01 2003 June 8 - First version 0.02 2003 June 10 - Change the %time formatting codes. - Speed up the code somewhat. - Add many tests 0.03 2003 June 11 - Fix the tests to work in other time zones than my own! 0.04 2003 June 13 - Add internationalization support (Month/weekday names). - Expose underlying function interface to all hashes. - Export %time and time_format by default. 0.05 2003 June 17 - Add "tz" timezone format code to %time. - Change unambiguous month/minute format codes. - Some minor speed improvements. 0.06 2003 June 20 - Fix handling of "yyyy/mon". - Minor documentation fixes (Thanks to Will Coleda!). - Add th/TH formatting codes. - Allow backslash escaping in format strings. 0.07 2003 June 21 - Fix some bugs in the test suite -- NO changes to Format.pm (Thanks to CPAN tester Jeroen Latour!) 0.08 2003 June 22 - Distribute correct SIGNATURE file; a bad one was distributed with v0.07. (Thanks to Jeroen Latour again). 0.09 2003 June 23 - Add more checking on the Date::Manip module, which dies messily if it gets upset about not finding things like Time Zone. This affects the test suite only -- No changes to Time::Format. 0.10 2003 July 5 - Some speed improvements. Removed need for Exporter, Carp. - Add support for optional Time::Format_XS module. - More test suite changes, due to strftime not being nearly as standard as you'd think it would be. - Removed support for deprecated month/minute codes. 0.11 2003 July 7 - Some changes for ActiveState Perl. Thanks again to Will Coleda. 0.12 2003 July 20 - Add \Q, \U, \L, \u, \l, \E handling in format strings. - Change "Month" (etc) to be defined as "locale-preferred capitalization" rather than "always ucfirst". Thanks to Mark Jason Dominus for his thoughts on this topic. - Don't bother compiling the Perl routines until we know that the XS routines (in Time::Format_XS) are not available. 0.13 2003 August 1 - Check that the version of Time::Format_XS matches our version. - Test suite now tests perl-only routines separately from XS-enabled routines. - Further delay compilation of time_format until needed. 1.00 2004 September 24 - Increase version to 1.00. - More flexible version-compatibility checking with Time::Format_XS - Fix some warning messages (and some typos) in tests. 1.01 2005 December 1 - Support for DateTime, Date::Manip, and ISO 8601 strings. 1.02 2005 December 1 - No changes. Had to increment the number because of a PAUSE upload problem. 1.03 2008 March 24 - Fixed a broken test case. - Added Module::Build support. 1.04 2008 March 26 - Worked around a POSIX bug which would cause hangs under cygwin. - Fixed a couple test cases. 1.05 2008 March 27 - Fix a typo bug in Makefile.PL 1.06 2008 March 28 - Fix a broken test case in time.t; failed for non-English locales. 1.07 2008 March 31 - More test-case changes, to work with older perls. Many thanks to Slaven Rezic and the rest of the tireless CPAN testers! 1.08 2008 May 27 - Reset $@ at certain places, so as to work with older (broken) perls. Again, thanks to Slaven Rezic. 1.09 2008 May 27 - Bug fix: generated error if second argument to time_format was a string and was in December. Thanks to Bokor Béla for spotting this one. 1.10 2009 June 17 - Bug fix: Did not trim leading zero off the am/pm hour (H code) if the argument was a DateTime. Thanks to Coke Coleda for spotting this. 1.10 2009 June 18 - Fix error in the new test (past.t) for v1.10! - Rearrange eval's throughout test code to rely on $@ less. Time-Format-1.11/MANIFEST0000644000175600010010000000066111216346144013647 0ustar eroodeNoneBuild.PL Changes MANIFEST MANIFEST.SKIP META.yml Makefile.PL README SIGNATURE lib/Time/Format.pm quickref.ps quickref.txt t/0-signature.t t/1-load.t t/DateManip.t t/DateTime.t t/die.t t/doc.t t/epoch.t t/export1.t t/export2.t t/export3.t t/funcs.t t/locale.t t/manip.t t/past.t t/quot.t t/strftime.t t/string.t t/time.t t/xs_DateTime.t t/xs_doc.t t/xs_funcs.t t/xs_locale.t t/xs_quot.t t/xs_time.t Time-Format-1.11/quickref.txt0000644000175600010010000000411311216346144015064 0ustar eroodeNoneQuick reference for Time::Format formatting codes. $time{$format} $time{$format, $time_value} Numbers: yyyy 4-digit year yy 2-digit year, 00-99 m 1- or 2-digit month, 1-12 mm 2-digit month, 01-12 ?m month with leading space if < 10 m{on} Unambiguous month, 1-12 mm(on} Unambiguous month, 01-12 ?m(on} Unambiguous month with leading space if < 10 d day number, 1-31 dd day number, 01-31 ?d day with leading space if < 10 h hour, 0-23 hh hour, 00-23 ?h hour, 0-23 with leading space if < 10 H hour, 1-12 HH hour, 01-12 ?H hour, 1-12 with leading space if < 10 m minute, 0-59 mm minute, 00-59 ?m minute, 0-59 with leading space if < 10 m{in} Unambiguous minute, 1-12 mm(in} Unambiguous minute, 01-12 ?m(in} Unambiguous minute with leading space if < 10 s second, 0-59 ss second, 00-59 ?s second, 0-59 with leading space if < 10 mmm millisecond, 000-999 uuuuuu microsecond, 000000-999999 Names and other strings: Month full month name, mixed-case (locale-specific capitalization) MONTH full month name, all-uppercase month full month name, all-lowercase Mon 3-letter month abbreviation MON ditto, all-uppercase mon ditto, all-lowercase Weekday weekday name WEEKDAY weekday name, all-uppercase weekday weekday name, all-lowercase Day 3-letter weekday name abbreviation DAY ditto, all-uppercase day ditto, all-lowercase th day suffix (st, nd, rd, or th) TH uppercase suffix am The string "am" or "pm" pm ditto AM The string "AM" or "PM" PM ditto a.m. The string "a.m." or "p.m." p.m. ditto A.M. The string "A.M." or "P.M." P.M. ditto tz time zone abbreviation Time-Format-1.11/quickref.ps0000644000175600010010000001756211216346144014703 0ustar eroodeNone%!PS /fs 10 def /ti-font /Helvetica findfont fs 1.4 mul scalefont def /code-font /Courier findfont fs scalefont def /ital-font /Times-Italic findfont fs scalefont def /desc-font /Times-Roman findfont fs scalefont def /copy-font /Times-Italic findfont 7 scalefont def /left-x 72 def /right-x 540 def /top-y 792 54 sub def /col1-x left-x 24 add def /col2-x col1-x 72 add def /copy-y 54 def /y top-y 16 sub def /downby { /y exch y exch sub def } def /bigspace fs 1.5 mul def left-x top-y moveto ti-font setfont (Quick reference for Time::Format formatting codes.) show 16 downby code-font setfont left-x y moveto ($time{$format}) show fs downby left-x y moveto ($time{$format, $time_value}) show fs downby fs downby ital-font setfont left-x y moveto (Numbers:) show fs 1.2 mul downby code-font setfont col1-x y moveto (yyyy) show desc-font setfont col2-x y moveto (4-digit year) show fs downby code-font setfont col1-x y moveto (yy) show desc-font setfont col2-x y moveto (2-digit year, 00\26199) show bigspace downby code-font setfont col1-x y moveto (m) show desc-font setfont col2-x y moveto (1- or 2-digit month, 1\26112) show fs downby code-font setfont col1-x y moveto (mm) show desc-font setfont col2-x y moveto (2-digit month, 01\26112) show fs downby code-font setfont col1-x y moveto (?m) show desc-font setfont col2-x y moveto (month with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (m{on}) show desc-font setfont col2-x y moveto (Unambiguous month, 1\26112) show fs downby code-font setfont col1-x y moveto (mm{on}) show desc-font setfont col2-x y moveto (Unambiguous month, 01\26112) show fs downby code-font setfont col1-x y moveto (?m{on}) show desc-font setfont col2-x y moveto (Unambiguous month with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (d) show desc-font setfont col2-x y moveto (day number, 1\26131) show fs downby code-font setfont col1-x y moveto (dd) show desc-font setfont col2-x y moveto (day number, 01\26131) show fs downby code-font setfont col1-x y moveto (?d) show desc-font setfont col2-x y moveto (day with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (h) show desc-font setfont col2-x y moveto (hour, 0\26123) show fs downby code-font setfont col1-x y moveto (hh) show desc-font setfont col2-x y moveto (hour, 00\26123) show fs downby code-font setfont col1-x y moveto (?h) show desc-font setfont col2-x y moveto (hour, 0\26123 with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (H) show desc-font setfont col2-x y moveto (hour, 1\26112) show fs downby code-font setfont col1-x y moveto (HH) show desc-font setfont col2-x y moveto (hour, 01\26112) show fs downby code-font setfont col1-x y moveto (?H) show desc-font setfont col2-x y moveto (hour, 1\26112 with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (m) show desc-font setfont col2-x y moveto (minute, 0\26159) show fs downby code-font setfont col1-x y moveto (mm) show desc-font setfont col2-x y moveto (minute, 00\26159) show fs downby code-font setfont col1-x y moveto (?m) show desc-font setfont col2-x y moveto (minute, 0\26159 with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (m{in}) show desc-font setfont col2-x y moveto (Unambiguous minute, 1\26112) show fs downby code-font setfont col1-x y moveto (mm{in}) show desc-font setfont col2-x y moveto (Unambiguous minute, 01\26112) show fs downby code-font setfont col1-x y moveto (?m{in}) show desc-font setfont col2-x y moveto (Unambiguous minute with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (s) show desc-font setfont col2-x y moveto (second, 0\26159) show fs downby code-font setfont col1-x y moveto (ss) show desc-font setfont col2-x y moveto (second, 00\26159) show fs downby code-font setfont col1-x y moveto (?s) show desc-font setfont col2-x y moveto (second, 0\26159 with leading space if < 10) show bigspace downby code-font setfont col1-x y moveto (mmm) show desc-font setfont col2-x y moveto (millisecond, 000\261999) show fs downby code-font setfont col1-x y moveto (uuuuuu) show desc-font setfont col2-x y moveto (microsecond, 000000\261999999) show 16 downby ital-font setfont left-x y moveto (Names and other strings:) show fs 1.2 mul downby code-font setfont col1-x y moveto (Month) show desc-font setfont col2-x y moveto (full month name, mixed-case (locale-speci\256c capitalization)) show fs downby code-font setfont col1-x y moveto (MONTH) show desc-font setfont col2-x y moveto (full month name, all-uppercase) show fs downby code-font setfont col1-x y moveto (month) show desc-font setfont col2-x y moveto (full month name, all-lowercase) show bigspace downby code-font setfont col1-x y moveto (Mon) show desc-font setfont col2-x y moveto (3-letter month abbreviation) show fs downby code-font setfont col1-x y moveto (MON) show desc-font setfont col2-x y moveto (ditto, all-uppercase) show fs downby code-font setfont col1-x y moveto (mon) show desc-font setfont col2-x y moveto (ditto, all-lowercase) show bigspace downby code-font setfont col1-x y moveto (Weekday) show desc-font setfont col2-x y moveto (weekday name) show fs downby code-font setfont col1-x y moveto (WEEKDAY) show desc-font setfont col2-x y moveto (weekday name, all-uppercase) show fs downby code-font setfont col1-x y moveto (weekday) show desc-font setfont col2-x y moveto (weekday name, all-lowercase) show bigspace downby code-font setfont col1-x y moveto (Day) show desc-font setfont col2-x y moveto (3-letter weekday name abbreviation) show fs downby code-font setfont col1-x y moveto (DAY) show desc-font setfont col2-x y moveto (ditto, all-uppercase) show fs downby code-font setfont col1-x y moveto (day) show desc-font setfont col2-x y moveto (ditto, all-lowercase) show bigspace downby code-font setfont col1-x y moveto (th) show desc-font setfont col2-x y moveto (day suf\256x (st, nd, rd, or th)) show fs downby code-font setfont col1-x y moveto (TH) show desc-font setfont col2-x y moveto (uppercase suf\256x) show bigspace downby code-font setfont col1-x y moveto (am) show desc-font setfont col2-x y moveto (The string \252am\272 or \252pm\272) show fs downby code-font setfont col1-x y moveto (pm) show desc-font setfont col2-x y moveto (ditto) show fs downby code-font setfont col1-x y moveto (AM) show desc-font setfont col2-x y moveto (The string \252AM\272 or \252PM\272) show fs downby code-font setfont col1-x y moveto (PM) show desc-font setfont col2-x y moveto (ditto) show fs downby code-font setfont col1-x y moveto (a.m.) show desc-font setfont col2-x y moveto (The string \252a.m.\272 or \252p.m.\272) show fs downby code-font setfont col1-x y moveto (p.m.) show desc-font setfont col2-x y moveto (ditto) show fs downby code-font setfont col1-x y moveto (A.M.) show desc-font setfont col2-x y moveto (The string \252A.M.\272 or \252P.M.\272) show fs downby code-font setfont col1-x y moveto (P.M.) show desc-font setfont col2-x y moveto (ditto) show bigspace downby code-font setfont col1-x y moveto (tz) show desc-font setfont col2-x y moveto (time zone abbreviation) show right-x copy-y moveto copy-font setfont (Copyright (c) 2003\2612008 by Eric J. Roode. All rights reserved.) dup stringwidth pop neg 0 rmoveto show showpage Time-Format-1.11/lib/0000755000175600010010000000000011216346144013261 5ustar eroodeNoneTime-Format-1.11/lib/Time/0000755000175600010010000000000011216576126014164 5ustar eroodeNoneTime-Format-1.11/lib/Time/Format.pm0000644000175600010010000011623711216575756015774 0ustar eroodeNone=for gpg -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 =head1 NAME Time::Format - Easy-to-use date/time formatting. =head1 VERSION This documentation describes version 1.11 of Time::Format.pm, June 18, 2009. =cut use strict; package Time::Format; $Time::Format::VERSION = '1.11'; # This module claims to be compatible with the following versions # of Time::Format_XS. %Time::Format::XSCOMPAT = map {$_ => 1} qw(1.01 1.02); sub _croak { require Carp; goto &Carp::croak; } # Here we go through a bunch of tests to decide whether we can use the # XS module, or if we need to load and compile the perl-only # subroutines (which are stored in __DATA__). my $load_perlonly = 0; $load_perlonly = 1 if defined $Time::Format::NOXS && $Time::Format::NOXS; if (!$load_perlonly) { # Check whether the optional XS module is installed. eval { require Time::Format_XS }; if ($@ || !defined $Time::Format_XS::VERSION) { $load_perlonly = 1; } else { # Check that we're compatible with them (backwards compatibility) # or they're compatible with us (forwards compatibility). unless ($Time::Format::XSCOMPAT{$Time::Format_XS::VERSION} || $Time::Format_XS::PLCOMPAT{$Time::Format::VERSION}) { warn "Your Time::Format_XS version ($Time::Format_XS::VERSION) " . "is not compatible with Time::Format version ($Time::Format::VERSION).\n" . "Using Perl-only functions.\n"; $load_perlonly = 1; } } # Okay to use the XS version? Great. Wrap it. if (!$load_perlonly) { *time_format = \&Time::Format_XS::time_format; } } if ($load_perlonly) { # Time::Format_XS not installed, or version mismatch, or NOXS was set. # The perl routines will need to be loaded. # But defer this until someone actually calls time_format(). *time_format = sub { local $^W = 0; # disable warning about subroutine redefined local $/ = undef; eval ; die if $@; *time_format = \&time_format_perlonly; goto &time_format; }; undef $Time::Format_XS::VERSION; # Indicate that XS version is not available. } my @EXPORT = qw(%time time_format); my @EXPORT_OK = qw(%time %strftime %manip time_format time_strftime time_manip); # We don't need any of Exporter's fancy features, so it's quicker to # do the import ourselves. sub import { my $pkg = shift; my ($cpkg,$file,$line) = caller; my @symbols; if (@_) { if (grep $_ eq ':all', @_) { @symbols = (@EXPORT, @EXPORT_OK, grep $_ ne ':all', @_); } else { @symbols = @_; } my %seen; @symbols = grep !$seen{$_}++, @symbols; } else { @symbols = @EXPORT; } my %ok; @ok{@EXPORT_OK,@EXPORT} = (); my @badsym = grep !exists $ok{$_}, @symbols; if (@badsym) { my $s = @badsym>1? 's' : ''; my $v = @badsym>1? 'are' : 'is'; _croak ("The symbol$s ", join(', ', @badsym), " $v not exported by Time::Format at $file line $line.\n"); } no strict 'refs'; foreach my $sym (@symbols) { $sym =~ s/^([\$\&\@\%])?//; my $pfx = $1 || '&'; my $calsym = $cpkg . '::' . $sym; my $mysym = $pkg . '::' . $sym; if ($pfx eq '%') { *$calsym = \%$mysym; } elsif ($pfx eq '@') { *$calsym = \@$mysym; } elsif ($pfx eq '$') { *$calsym = \$$mysym; } else { *$calsym = \&$mysym; } } } # Simple tied-hash implementation. # Each hash is simply tied to a subroutine reference. "Fetching" a # value from the hash invokes the subroutine. If a hash (tied or # otherwise) has multiple comma-separated values but the leading # character is a $, then Perl joins the values with $;. This makes it # easy to simulate function calls with tied hashes -- we just split on # $; to recreate the argument list. # # 2005/12/01: We must ensure that time_format gets two arguments, since # the XS version cannot handle variable argument lists. use vars qw(%time %strftime %manip); tie %time, 'Time::Format', sub { push @_, 'time' if @_ == 1; goto &time_format}; tie %strftime, 'Time::Format', \&time_strftime; tie %manip, 'Time::Format', \&time_manip; sub TIEHASH { my $class = shift; my $func = shift || die "Bad call to $class\::TIEHASH"; bless $func, $class; } sub FETCH { my $self = shift; my $key = shift; my @args = split $;, $key, -1; $self->(@args); } use subs qw( STORE EXISTS CLEAR FIRSTKEY NEXTKEY ); *STORE = *EXISTS = *CLEAR = *FIRSTKEY = *NEXTKEY = sub { my ($pkg,$file,$line) = caller; _croak "Invalid call to Time::Format internal function at $file line $line."; }; # Module finder -- do we have the specified module available? { my %have; sub _have { my $module = shift || return; return $have{$module} if exists $have{$module}; my $incmod = $module; $incmod =~ s!::!/!g; return $have{$module} = 1 if exists $INC{"$incmod.pm"}; $@ = ''; eval "require $module"; return $have{$module} = $@? 0 : 1; } } # POSIX strftime, for people who like those weird % formats. sub time_strftime { # Check if POSIX is available (why wouldn't it be?) return 'NO_POSIX' unless _have('POSIX'); my $fmt = shift; my @time; # If more than one arg, assume they're doing the whole arg list if (@_ > 1) { @time = @_; } else # use unix time (current or passed) { my $time = @_? shift : time; @time = localtime $time; } return POSIX::strftime($fmt, @time); } # Date::Manip interface sub time_manip { return "NO_DATEMANIP" unless _have('Date::Manip'); my $fmt = shift; my $time = @_? shift : 'now'; $time = $1 if $time =~ /^\s* (epoch \s+ \d+)/x; return Date::Manip::UnixDate($time, $fmt); } 1; __DATA__ # The following is only compiled if Time::Format_XS is not available. use Time::Local; # Default names for months, days my %english_names = ( Month => [qw[January February March April May June July August September October November December]], Weekday => [qw[Sunday Monday Tuesday Wednesday Thursday Friday Saturday]], th => [qw[/th st nd rd th th th th th th th th th th th th th th th th th st nd rd th th th th th th th st]], ); my %names; my $locale; my %loc_cache; # Cache for remembering times that have already been parsed out. my $cache_size=0; # Number of keys in %loc_cache my $cache_size_limit = 1024; # Max number of times to cache # Internal function to initialize locale info. # Returns true if the locale changed. sub setup_locale { # Do nothing if locale has not changed since %names was set up. my $locale_in_use; $locale_in_use = POSIX::setlocale(POSIX::LC_TIME()) if _have('POSIX'); $locale_in_use = '' if !defined $locale_in_use; return if defined $locale && $locale eq $locale_in_use; my (@Month, @Mon, @Weekday, @Day); unless (eval { require I18N::Langinfo; I18N::Langinfo->import(qw(langinfo)); @Month = map langinfo($_), I18N::Langinfo::MON_1(), I18N::Langinfo::MON_2(), I18N::Langinfo::MON_3(), I18N::Langinfo::MON_4(), I18N::Langinfo::MON_5(), I18N::Langinfo::MON_6(), I18N::Langinfo::MON_7(), I18N::Langinfo::MON_8(), I18N::Langinfo::MON_9(), I18N::Langinfo::MON_10(), I18N::Langinfo::MON_11(), I18N::Langinfo::MON_12(); @Mon = map langinfo($_), I18N::Langinfo::ABMON_1(), I18N::Langinfo::ABMON_2(), I18N::Langinfo::ABMON_3(), I18N::Langinfo::ABMON_4(), I18N::Langinfo::ABMON_5(), I18N::Langinfo::ABMON_6(), I18N::Langinfo::ABMON_7(), I18N::Langinfo::ABMON_8(), I18N::Langinfo::ABMON_9(), I18N::Langinfo::ABMON_10(), I18N::Langinfo::ABMON_11(), I18N::Langinfo::ABMON_12(); @Weekday = map langinfo($_), I18N::Langinfo::DAY_1(), I18N::Langinfo::DAY_2(), I18N::Langinfo::DAY_3(), I18N::Langinfo::DAY_4(), I18N::Langinfo::DAY_5(), I18N::Langinfo::DAY_6(), I18N::Langinfo::DAY_7(); @Day = map langinfo($_), I18N::Langinfo::ABDAY_1(), I18N::Langinfo::ABDAY_2(), I18N::Langinfo::ABDAY_3(), I18N::Langinfo::ABDAY_4(), I18N::Langinfo::ABDAY_5(), I18N::Langinfo::ABDAY_6(), I18N::Langinfo::ABDAY_7(); 1; } ) { # Internationalization didn't work for some reason; go with English. @Month = @{ $english_names{Month} }; @Weekday = @{ $english_names{Weekday} }; @Mon = map substr($_,0,3), @Month; @Day = map substr($_,0,3), @Weekday; $@ = ''; } # Store in %names, setting proper case $names{Month} = \@Month; $names{Weekday} = \@Weekday; $names{Mon} = \@Mon; $names{Day} = \@Day; $names{th} = $english_names{th}; $names{TH} = [map uc, @{$names{th}}]; foreach my $name (keys %names) { my $aref = $names{$name}; # locale-native case $names{uc $name} = [map uc, @$aref]; # upper=case $names{lc $name} = [map lc, @$aref]; # lower-case } %loc_cache = (); # locale changes are rare. Clear out cache. $cache_size = 0; $locale = $locale_in_use; return 1; } # Types of time values we can handle: my $NUMERIC_TIME = \&decode_epoch; my $DATETIME_OBJECT = \&decode_DateTime_object; my $DATETIME_STRING = \&decode_DateTime_string; # my $DATEMANIP_STRING = \&decode_DateManip_string; # What kind of argument was passed to time_format? # Returns (type, time, cache_time_key, milliseconds, microseconds) sub _classify_time { my $timeval = shift; $timeval = 'time' if !defined $timeval; my $frac; # Fractional seconds, if any my $cache_value; # 1/20 of 1 cent my $time_type; # DateTime object? if (UNIVERSAL::isa($timeval, 'DateTime')) { $cache_value = "$timeval"; # stringify $frac = $timeval->nanosecond() / 1e9; $time_type = $DATETIME_OBJECT; } # Stringified DateTime object # Except we make it more flexible by allowing the date OR the time to be specfied # This will also match Date::Manip strings, and many ISO-8601 strings. elsif ($timeval =~ m{\A( (?!\d{6,8}\z) # string must not consist of only 6 or 8 digits. (?: \d{4} [-/.]? \d{2} [-/.]? \d{2} # year-month-day )? # ymd is optional (?: (?<=\d) [T_ ] (?=\d) )? # separator: T or _ or space, but only if ymd and hms both present ) # End of $1: YMD and separator (?: # hms is optional ( \d{2} [:.]? \d{2} [:.]? \d{2} # hour:minute:second ) # End of $2: HMS (?: [,.] (\d+))? # optional fraction )? # end of optional (HMS.fraction) \z }x) { $cache_value = ($1 || q{}) . ($2 || q{}); $frac = $3? '0.' . $3 : 0; $time_type = $DATETIME_STRING; } # Numeric time? elsif ($timeval =~ /^\s* ( (\d+) (?:[.,](\d+))? ) $/x) { $timeval = $1; $cache_value = $2; $frac = $3? '0.' . $3 : 0; $time_type = $NUMERIC_TIME; } # Not set, or set to 'time' string elsif ($timeval eq 'time' || $timeval eq q{}) { # Get numeric time $timeval = _have('Time::HiRes')? Time::HiRes::time() : time; $cache_value = int $timeval; $frac = $cache_value - $timeval; $time_type = $NUMERIC_TIME; } else { # User passed us something we don't know how to handle. _croak qq{Unrecognized time value: "$timeval"}; } # We messed up. die qq{Illegal time type "$time_type"; programming error in Time::Format. Contact author.} if !defined &$time_type; # Calculate millisecond, microsecond from fraction # msec and usec are TRUNCATED, not ROUNDED, because rounding up # to the next higher second would be a nightmare. my $msec = sprintf '%03d', int ( 1_000 * $frac); my $usec = sprintf '%06d', int (1_000_000 * $frac); return ($time_type, $timeval, $cache_value, $msec, $usec); } # Helper function -- returns localtime() hashref sub _loctime { my ($decode, $time, $cachekey, $msec, $usec) = _classify_time(@_); my $locale_changed = setup_locale; # Cached, because I expect this'll be called on the same time values frequently. die "Programming error: undefined cache value. Contact Time::Format author." if !defined $cachekey; # If locale has changed, can't use the cached value. if (!$locale_changed && exists $loc_cache{$cachekey}) { my $h = $loc_cache{$cachekey}; ($h->{mmm}, $h->{uuuuuu}) = ($msec, $usec); return $h; } # Hour-12, time zone, localtime parts, decoded from input my ($h12, $tz, @time_parts) = $decode->($time); # Populate a whole mess o' data elements my %th; my $m0 = $time_parts[4] - 1; # zero-based month # NOTE: When adding new codes, be wary of adding any that interfere # with the user's ability to use the words "at", "on", or "of" literally. # year, hour(12), month, day, hour, minute, second, millisecond, microsecond, time zone @th{qw[yyyy H m{on} d h m{in} s mmm uuuuuu tz]} = ( $time_parts[5], $h12, @time_parts[4,3,2,1,0], $msec, $usec, $tz); @th{qw[yy HH mm{on} dd hh mm{in} ss]} = map $_<10?"0$_":$_, $time_parts[5]%100, $h12, @time_parts[4,3,2,1,0]; @th{qw[ ?H ?m{on} ?d ?h ?m{in} ?s]} = map $_<10?" $_":$_, $h12, @time_parts[4,3,2,1,0]; # AM/PM my ($h,$d,$wx) = @time_parts[2,3,6]; # Day, weekday index my $a = $h<12? 'a' : 'p'; $th{am} = $th{pm} = $a . 'm'; $th{'a.m.'} = $th{'p.m.'} = $a . '.m.'; @th{qw/AM PM A.M. P.M./} = map uc, @th{qw/am pm a.m. p.m./}; $th{$_} = $names{$_}[$wx] for qw/Weekday WEEKDAY weekday Day DAY day/; $th{$_} = $names{$_}[$m0] for qw/Month MONTH month Mon MON mon/; $th{$_} = $names{$_}[$d] for qw/th TH/; # Don't let the time cache grow boundlessly. if (++$cache_size == $cache_size_limit) { $cache_size = 0; %loc_cache = (); } return $loc_cache{$cachekey} = \%th; } sub decode_DateTime_object { my $dt = shift; my @t = ($dt->hour_12, $dt->time_zone_short_name, $dt->second, $dt->minute, $dt->hour, $dt->day, $dt->month, $dt->year, $dt->dow, $dt->doy, $dt->is_dst); $t[-1] = 0 if $t[-1] == 7; # Convert 1-7 (Mon-Sun) to 0-6 (Sun-Sat). return @t; } # 2005-10-31T15:14:39 sub decode_DateTime_string { my $dts = shift; unless ($dts =~ m{\A (?!>\d{6,8}\z) # string must not consist of only 6 or 8 digits. (?: (\d{4}) [-/.]? (\d{2}) [-/.]? (\d{2}) # year-month-day )? # ymd is optional, but next must not be digit (?: (?<=\d) [T_ ] (?=\d) )? # separator: T or _ or space, but only if ymd and hms both present (?: # hms is optional (\d{2}) [:.]? (\d{2}) [:.]? (\d{2}) # hour:minute:second (?: [,.] \d+)? # optional fraction (ignored in this sub) )? \z }x) { # This "should" never happen, since we checked the format of # the string already. die qq{Unrecognized DateTime string "$dts": probable Time::Format bug}; } my ($y,$mon,$d,$h,$min,$s) = ($1,$2,$3,$4,$5,$6); my ($d_only, $t_only); my ($h12, $tz, $is_dst, $dow); if (!defined $y) { # Time only. Set date to 1969-12-31. $y = 1969; $mon = 12; $d = 31; $h12 = $h == 0? 12 : $h > 12? $h - 12 : $h; $is_dst = 0; # (it's the dead of winter!) $dow = 3; # 12/31/1969 is Wednesday. $t_only = 1; } if (!defined $h) { $h = 0; $min = 0; $s = 0; $d_only = 1; } if (!$t_only) { $h12 = $h == 0? 12 : $h > 12? $h - 12 : $h; # DST? # If year is before 1970, use current year. my $tmp_year = $y > 1969? $y : (localtime)[5]+1900; my $ttime = timelocal(0, 0, 0, $d, $mon-1, $tmp_year); my @t = localtime $ttime; $is_dst = $t[8]; $dow = _dow($y, $mon, $d); } # +0 is to force numeric (remove leading zeroes) my @t = map {$_+0} ($s,$min,$h,$d,$mon,$y); $h12 += 0; $tz = POSIX::strftime('%Z', @t, $dow, -1, $is_dst) if _have('POSIX'); return ($h12, $tz, @t, $dow, -1, $is_dst); } sub decode_epoch { my $time = shift; # Assumed to be an epoch time integer my @t = localtime $time; my $tz = _have('POSIX')? POSIX::strftime('%Z', @t) : ''; my $h = $t[2]; # Hour (24), Month index $t[4]++; $t[5] += 1900; my $h12 = $h>12? $h-12 : ($h || 12); return ($h12, $tz, @t); } # $int = dow ($year, $month, $day); # # Returns the day of the week (0=Sunday .. 6=Saturday). Uses Zeller's # congruence, so it isn't subject to the unix 2038 limitation. # #---> $int = dow ($year, $month, $day); sub _dow { my ($Y, $M, $D) = @_; $M -= 2; if ($M < 1) { $M += 12; $Y--; } my $C = int($Y/100); $Y %= 100; return (int((26*$M - 2)/10) + $D + $Y + int($Y/4) + int($C/4) - 2*$C) % 7; } # The heart of the module. Didja ever see so many wicked regexes in a row? my %disam; # Disambiguator for 'm' format. $disam{$_} = "{on}" foreach qw/yy d dd ?d/; # If year or day is nearby, it's 'month' $disam{$_} = "{in}" foreach qw/h hh ?h H HH ?H s ss ?s/; # If hour or second is nearby, it's 'minute' sub time_format_perlonly { my $fmt = shift; my $time = _loctime(@_); # Remove \Q...\E sequences my $rc; if (index($fmt, '\Q') >= 0) { $rc = init_store($fmt); $fmt =~ s/\\Q(.*?)(?:\\E|$)/remember($1)/seg; } # "Guess" how to interpret ambiguous 'm' $fmt =~ s/ (?{$1}/gx; # Simulate \U \L \u \l $fmt =~ s/((?:\\[UL])+)((?:\\[ul])+)/$2$1/g; $fmt =~ s/\\U(.*?)(?=\\[EULul]|$)/\U$1/gs; $fmt =~ s/\\L(.*?)(?=\\[EULul]|$)/\L$1/gs; $fmt =~ s/\\l(.)/\l$1/gs; $fmt =~ s/\\u(.)/\u$1/gs; $fmt =~ s/\\E//g; $fmt =~ tr/\\//d; # Remove extraneous backslashes. if (defined $rc) # Fixup \Q \E regions. { $fmt =~ s/$rc(..)/recall($1)/seg; } return $fmt; } # Code for remembering/restoring \Q...\E regions. # init_store finds a sigil character that's not used within the format string. # remember stores a string in the next slot in @store, and returns a coded replacement. # recall looks up and returns a string from @store. { my $rcode; my @store; my $stx; sub init_store { my $str = shift; $stx = 0; return $rcode = "\x01" unless index($str,"\x01") >= 0; for ($rcode="\x02"; $rcode<"\xFF"; $rcode=chr(1+ord $rcode)) { return $rcode unless index($str, $rcode) >= 0; } _croak "Time::Format cannot process string: no unique characters left."; } sub remember { my $enc; do # Must not return a code that contains a backslash { $enc = pack 'S', $stx++; } while index($enc, '\\') >= 0; $store[$stx-1] = shift; return join '', map "\\$_", split //, "$rcode$enc"; # backslash-escape it! } sub recall { return $store[unpack 'S', shift]; } } __END__ =head1 SYNOPSIS use Time::Format qw(%time %strftime %manip); $time{$format} $time{$format, $unixtime} print "Today is $time{'yyyy/mm/dd'}\n"; print "Yesterday was $time{'yyyy/mm/dd', time-24*60*60}\n"; print "The time is $time{'hh:mm:ss'}\n"; print "Another time is $time{'H:mm am tz', $another_time}\n"; print "Timestamp: $time{'yyyymmdd.hhmmss.mmm'}\n"; C<%time> also accepts Date::Manip strings and DateTime objects: $dm = Date::Manip::ParseDate('last monday'); print "Last monday was $time{'Month d, yyyy', $dm}"; $dt = DateTime->new (....); print "Here's another date: $time{'m/d/yy', $dt}"; It also accepts most ISO-8601 date/time strings: $t = '2005/10/31T17:11:09'; # date separator: / or - or . $t = '2005-10-31 17.11.09'; # in-between separator: T or _ or space $t = '20051031_171109'; # time separator: : or . $t = '20051031171109'; # separators may be omitted $t = '2005/10/31'; # date-only is okay $t = '17:11:09'; # time-only is okay # But not: $t = '20051031'; # date-only without separators $t = '171109'; # time-only without separators # ...because those look like epoch time numbers. C<%strftime> works like POSIX's C, if you like those C<%>-formats. $strftime{$format} $strftime{$format, $unixtime} $strftime{$format, $sec,$min,$hour, $mday,$mon,$year, $wday,$yday,$isdst} print "POSIXish: $strftime{'%A, %B %d, %Y', 0,0,0,12,11,95,2}\n"; print "POSIXish: $strftime{'%A, %B %d, %Y', 1054866251}\n"; print "POSIXish: $strftime{'%A, %B %d, %Y'}\n"; # current time C<%manip> works like Date::Manip's C function. $manip{$format}; $manip{$format, $when}; print "Date::Manip: $manip{'%m/%d/%Y'}\n"; # current time print "Date::Manip: $manip{'%m/%d/%Y','last Tuesday'}\n"; These can also be used as standalone functions: use Time::Format qw(time_format time_strftime time_manip); print "Today is ", time_format('yyyy/mm/dd', $some_time), "\n"; print "POSIXish: ", time_strftime('%A %B %d, %Y',$some_time), "\n"; print "Date::Manip: ", time_manip('%m/%d/%Y',$some_time), "\n"; =head1 DESCRIPTION This module creates global pseudovariables which format dates and times, according to formatting codes you pass to them in strings. The C<%time> formatting codes are designed to be easy to remember and use, and to take up just as many characters as the output time value whenever possible. For example, the four-digit year code is "C", the three-letter month abbreviation is "C". The nice thing about having a variable-like interface instead of function calls is that the values can be used inside of strings (as well as outside of strings in ordinary expressions). Dates are frequently used within strings (log messages, output, data records, etc.), so having the ability to interpolate them directly is handy. Perl allows arbitrary expressions within curly braces of a hash, even when that hash is being interpolated into a string. This allows you to do computations on the fly while formatting times and inserting them into strings. See the "yesterday" example above. The format strings are designed with programmers in mind. What do you need most frequently? 4-digit year, month, day, 24-based hour, minute, second -- usually with leading zeroes. These six are the easiest formats to use and remember in Time::Format: C, C, C
, C, C, C. Variants on these formats follow a simple and consistent formula. This module is for everyone who is weary of trying to remember I's arcane codes, or of endlessly writing C<$t[4]++; $t[5]+=1900> as you manually format times or dates. Note that C (and related codes) are used both for months and minutes. This is a feature. C<%time> resolves the ambiguity by examining other nearby formatting codes. If it's in the context of a year or a day, "month" is assumed. If in the context of an hour or a second, "minute" is assumed. The format strings are not meant to encompass every date/time need ever conceived. But how often do you need the day of the year (strftime's C<%j>) or the week number (strftime's C<%W>)? For capabilities that C<%time> does not provide, C<%strftime> provides an interface to POSIX's C, and C<%manip> provides an interface to the Date::Manip module's C function. If the companion module L is also installed, Time::Format will detect and use it. This will result in a significant speed increase for C<%time> and C. =head1 VARIABLES =over 4 =item time $time{$format} $time{$format,$time_value}; Formats a unix time number (seconds since the epoch), DateTime object, stringified DateTime, Date::Manip string, or ISO-8601 string, according to the specified format. If the time expression is omitted, the current time is used. The format string may contain any of the following: yyyy 4-digit year yy 2-digit year m 1- or 2-digit month, 1-12 mm 2-digit month, 01-12 ?m month with leading space if < 10 Month full month name, mixed-case MONTH full month name, uppercase month full month name, lowercase Mon 3-letter month abbreviation, mixed-case MON mon ditto, uppercase and lowercase versions d day number, 1-31 dd day number, 01-31 ?d day with leading space if < 10 th day suffix (st, nd, rd, or th) TH uppercase suffix Weekday weekday name, mixed-case WEEKDAY weekday name, uppercase weekday weekday name, lowercase Day 3-letter weekday name, mixed-case DAY day ditto, uppercase and lowercase versions h hour, 0-23 hh hour, 00-23 ?h hour, 0-23 with leading space if < 10 H hour, 1-12 HH hour, 01-12 ?H hour, 1-12 with leading space if < 10 m minute, 0-59 mm minute, 00-59 ?m minute, 0-59 with leading space if < 10 s second, 0-59 ss second, 00-59 ?s second, 0-59 with leading space if < 10 mmm millisecond, 000-999 uuuuuu microsecond, 000000-999999 am a.m. The string "am" or "pm" (second form with periods) pm p.m. same as "am" or "a.m." AM A.M. same as "am" or "a.m." but uppercase PM P.M. same as "AM" or "A.M." tz time zone abbreviation Millisecond and microsecond require Time::HiRes, otherwise they'll always be zero. Timezone requires POSIX, otherwise it'll be the empty string. The second codes (C, C, C) can be 60 or 61 in rare circumstances (leap seconds, if your system supports such). Anything in the format string other than the above patterns is left intact. Any character preceded by a backslash is left alone and not used for any part of a format code. See the L section for more details. For the most part, each of the above formatting codes takes up as much space as the output string it generates. The exceptions are the codes whose output is variable length: C, C, time zone, and the single-character codes. The mixed-case "Month", "Mon", "Weekday", and "Day" codes return the name of the month or weekday in the preferred case representation for the locale currently in effect. Thus in an English-speaking locale, the seventh month would be "July" (uppercase first letter, lowercase rest); while in a French-speaking locale, it would be "juillet" (all lowercase). See the L section for ways to control the case of month/weekday names. Note that the "C", "C", and "C" formats are ambiguous. C<%time> tries to guess whether you meant "month" or "minute" based on nearby characters in the format string. Thus, a format of "C" is correctly parsed as "year month day, hour minute second". If C<%time> cannot determine whether you meant "month" or "minute", it leaves the C, C, or C untranslated. To remove the ambiguity, you can use the following codes: m{on} month, 1-12 mm{on} month, 01-12 ?m{on} month, 1-12 with leading space if < 10 m{in} minute, 0-59 mm{in} minute, 00-59 ?m{in} minute, 0-59 with leading space if < 10 In other words, append "C<{on}>" or "C<{in}>" to make "C", "C", or "C" unambiguous. =item strftime $strftime{$format, $sec,$min,$hour, $mday,$mon,$year, $wday,$yday,$isdst} $strftime{$format, $unixtime} $strftime{$format} For those who prefer L's weird % formats, or who need POSIX compliance, or who need week numbers or other features C<%time> does not provide. =item manip $manip{$format}; $manip{$format,$when}; Provides an interface to the Date::Manip module's C function. This function is rather slow, but can parse a very wide variety of date input. See the L module for details about the inputs accepted. If you want to use the C<%time> codes, but need the input flexibility of C<%manip>, you can use Date::Manip's C function: print "$time{'yyyymmdd', ParseDate('last sunday')}"; =back =head1 FUNCTIONS =over 4 =item time_format time_format($format); time_format($format, $unix_time); This is a function interface to C<%time>. It accepts the same formatting codes and everything. This is provided for people who want their function calls to I like function calls, not hashes. :-) The following two are equivalent: $x = $time{'yyyy/mm/dd'}; $x = time_format('yyyy/mm/dd'); =item time_strftime time_strftime($format, $sec,$min,$hour, $mday,$mon,$year, $wday,$yday,$isdst); time_strftime($format, $unixtime); time_strftime($format); This is a function interface to C<%strftime>. It simply calls POSIX::C, but it does provide a bit of an advantage over calling C directly, in that you can pass the time as a unix time (seconds since the epoch), or omit it in order to get the current time. =item time_manip manip($format); manip($format,$when); This is a function interface to C<%manip>. It calls Date::Manip::C under the hood. It does not provide much of an advantage over calling C directly, except that you can omit the C<$when> parameter in order to get the current time. =back =head1 QUOTING This section applies to the format strings used by C<%time> and C only. Sometimes it is necessary to suppress expansion of some format characters in a format string. For example: $time{'Hour: hh; Minute: mm{in}; Second: ss'}; In the above expression, the "H" in "Hour" would be expanded, as would the "d" in "Second". The result would be something like: 8our: 08; Minute: 10; Secon17: 30 It would not be a good solution to break the above statement out into three calls to %time: "Hour: $time{hh}; Minute: $time{'mm{in}'}; Second: $time{ss}" because the time could change from one call to the next, which would be a problem when the numbers roll over (for example, a split second after 7:59:59). For this reason, you can escape individual format codes with a backslash: $time{'\Hour: hh; Minute: mm{in}; Secon\d: ss'}; Note that with double-quoted (and qq//) strings, the backslash must be doubled, because Perl first interpolates the string: $time{"\\Hour: hh; Minute: mm{in}; Secon\\d: ss"}; For added convenience, Time::Format simulates Perl's built-in \Q and \E inline quoting operators. Anything in a string between a \Q and \E will not be interpolated as any part of any formatting code: $time{'\QHour:\E hh; \QMinute:\E mm{in}; \QSecond:\E ss'}; Again, within interpolated strings, the backslash must be doubled, or else Perl will interpret and remove the \Q...\E sequence before Time::Format gets it: $time{"\\QHour:\\E hh; \\QMinute:\\E mm{in}; \\QSecond\\E: ss"}; Time::Format also recognizes and simulates the \U, \L, \u, and \l sequences. This is really only useful for finer control of the Month, Mon, Weekday, and Day formats. For example, in some locales, the month names are all-lowercase by convention. At the start of a sentence, you may want to ensure that the first character is uppercase: $time{'\uMonth \Qis the finest month of all.'}; Again, be sure to use \Q, and be sure to double the backslashes in interpolated strings, otherwise you'll get something ugly like: July i37 ste fine37t july of all. =head1 EXAMPLES $time{'Weekday Month d, yyyy'} Thursday June 5, 2003 $time{'Day Mon d, yyyy'} Thu Jun 5, 2003 $time{'dd/mm/yyyy'} 05/06/2003 $time{yymmdd} 030605 $time{'yymmdd',time-86400} 030604 $time{'dth of Month'} 5th of June $time{'H:mm:ss am'} 1:02:14 pm $time{'hh:mm:ss.uuuuuu'} 13:02:14.171447 $time{'yyyy/mm{on}/dd hh:mm{in}:ss.mmm'} 2003/06/05 13:02:14.171 $time{'yyyy/mm/dd hh:mm:ss.mmm'} 2003/06/05 13:02:14.171 $time{"It's H:mm."} It'14 1:02. # OOPS! $time{"It'\\s H:mm."} It's 1:02. # Backslash fixes it. . . # Rename a file based on today's date: rename $file, "$file_$time{yyyymmdd}"; # Rename a file based on its last-modify date: rename $file, "$file_$time{'yyyymmdd',(stat $file)[9]}"; # stftime examples $strftime{'%A %B %d, %Y'} Thursday June 05, 2003 $strftime{'%A %B %d, %Y',time+86400} Friday June 06, 2003 # manip examples $manip{'%m/%d/%Y'} 06/05/2003 $manip{'%m/%d/%Y','yesterday'} 06/04/2003 $manip{'%m/%d/%Y','first monday in November 2000'} 11/06/2000 =head1 INTERNATIONALIZATION If the I18N::Langinfo module is available, Time::Format will return weekday and month names in the language appropriate for the current locale. If not, English names will be used. Programmers in non-English locales may want to provide an alias to C<%time> in their own preferred language. This can be done by assigning C<\%time> to a typeglob: # French use Time::Format; use vars '%temps'; *temps = \%time; print "C'est aujourd'hui le $temps{'d Month'}\n"; # German use Time::Format; use vars '%zeit'; *zeit = \%time; print "Heutiger Tag ist $zeit{'d.m.yyyy'}\n"; =head1 EXPORTS The following symbols are exported into your namespace by default: %time time_format The following symbols are available for import into your namespace: %strftime %manip time_strftime time_manip The C<:all> tag will import all of these into your namespace. Example: use Time::Format ':all'; =head1 BUGS The format string used by C<%time> must not have $; as a substring anywhere. $; (by default, ASCII character 28, or 1C hex) is used to separate values passed to the tied hash, and thus Time::Format will interpret your format string to be two or more arguments if it contains $;. The C function does not have this limitation. =head1 REQUIREMENTS Time::Local I18N::Langinfo, if you want non-English locales to work. POSIX, if you choose to use %strftime or want the C format to work. Time::HiRes, if you want the C and C time formats to work. Date::Manip, if you choose to use %manip. Time::Format_XS is optional but will make C<%time> and C much faster. The version of Time::Format_XS installed must match the version of Time::Format installed; otherwise Time::Format will not use it (and will issue a warning). =head1 AUTHOR / COPYRIGHT Copyright (c) 2003-2009 by Eric J. Roode, ROODE I<-at-> cpan I<-dot-> org All rights reserved. To avoid my spam filter, please include "Perl", "module", or this module's name in the message's subject line, and/or GPG-sign your message. This module is copyrighted only to ensure proper attribution of authorship and to ensure that it remains available to all. This module is free, open-source software. This module may be freely used for any purpose, commercial, public, or private, provided that proper credit is given, and that no more-restrictive license is applied to derivative (not dependent) works. Substantial efforts have been made to ensure that this software meets high quality standards; however, no guarantee can be made that there are no undiscovered bugs, and no warranty is made as to suitability to any given use, including merchantability. Should this module cause your house to burn down, your dog to collapse, your heart-lung machine to fail, your spouse to desert you, or George Bush to be re-elected, I can offer only my sincere sympathy and apologies, and promise to endeavor to improve the software. =begin gpg -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (Cygwin) iEYEARECAAYFAko6+8sACgkQwoSYc5qQVqpHSgCggtDbvzExQFNs4b1QoF/t9TaU BNYAn0C5LsPiJqCk4lzf8Jfn/4t+Zw7+ =C+Tp -----END PGP SIGNATURE----- =end gpg Time-Format-1.11/MANIFEST.SKIP0000644000175600010010000000026411216346144014413 0ustar eroodeNone^Makefile$ ^Makefile.old$ ^blib/ ^pm_to_blib ^blibdirs ^Build$ ^Build.bat$ ^_build/ ^Time-Format-[\d.]+/ ^Time-Format\.ppd \bCVS\b ~$ \.tar\.gz$ ^pod.*tmp$ ^\.cvsignore$ ^cover_db Time-Format-1.11/Build.PL0000644000175600010010000000122111216346144014003 0ustar eroodeNoneuse strict; use warnings; eval {require Module::Build}; if ($@) { warn "Module::Build is required for Build.PL\n"; exit 0; } my $builder = Module::Build->new( module_name => 'Time::Format', license => 'unrestricted', dist_author => 'Eric J. Roode ', dist_version_from => 'lib/Time/Format.pm', build_requires => { 'Test::Simple' => '0.40', }, requires => { 'Time::Local' => '1.07', }, sign => 1, add_to_cleanup => [ 'Time-Format-*' ], ); $builder->create_build_script(); Time-Format-1.11/Makefile.PL0000644000175600010010000000106311216346144014465 0ustar eroodeNoneuse ExtUtils::MakeMaker; WriteMakefile ( NAME => 'Time::Format', VERSION_FROM => 'lib/Time/Format.pm', # finds $VERSION PREREQ_PM => { 'Test::Simple' => '0.40', 'Time::Local' => '1.07', }, PL_FILES => {}, ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Time/Format.pm', # retrieve abstract from module AUTHOR => 'Eric Roode ') : ()), (MM->can('signature_target')? (SIGN => 1) : ()), ); Time-Format-1.11/README0000644000175600010010000000570311216346144013400 0ustar eroodeNoneTime::Format version 1.11 ========================= Time::Format provides a very easy way to format dates and times. The formatting functions are tied to hash variables, so they can be used inside strings as well as in ordinary expressions. The formatting codes used are meant to be easy to remember, use, and read. They follow a simple, consistent pattern. If I've done my job right, once you learn the codes, you should never have to refer to the documentation again. A quick-reference page is included, just in case. ;-) Time::Format can also format DateTime objects, and strings created with Date::Manip. Also provided is a tied-hash interface to POSIX::strftime and Date::Manip::UnixDate. If the I18N::Langinfo module is available, Time::Format provides weekday and month names in a language appropriate for your locale. A companion module, Time::Format_XS, is also available; if it is installed, Time::Format will detect and use it, which will result in a significant speed improvement. EXAMPLES $time{'Weekday Month d, yyyy'} Thursday June 5, 2003 $time{'Day Mon d, yyyy'} Thu Jun 5, 2003 $time{'DAY MON d, yyyy'} THU JUN 5, 2003 $time{'dd/mm/yyyy'} 05/06/2003 $time{yymmdd} 030605 $time{'yymmdd',time-86400} 030604 $time{'H:mm:ss am'} 1:02:14 pm $time{'hh:mm:ss.uuuuuu'} 13:02:14.171447 $time{'yyyy/mm/dd hh:mm:ss.mmm'} 2003/06/05 13:02:14.171 $strftime{'%A %B %d, %Y'} Thursday June 05, 2003 $strftime{'%A %B %d, %Y',time+86400} Friday June 06, 2003 $manip{'%m/%d/%Y'} 06/05/2003 $manip{'%m/%d/%Y','yesterday'} 06/04/2003 $manip{'%m/%d/%Y','first monday in November 2000'} 11/06/2000 There are also corresponding functions for each of these hashes, which you can use if you prefer (or need) a function-based interface. INSTALLATION To install this module, issue the following commands: perl Build.PL perl Build perl Build test perl Build install If you do not have Module::Build, use the old-style commands: perl Makefile.PL make make test make install If you are running under Windows, you will need to use 'nmake' instead of 'make'. DEPENDENCIES This module can use these other modules and libraries: Time::Local I18N::Langinfo (optional) POSIX (optional) Time::HiRes (optional) Date::Manip (optional) Time::Format_XS (optional) Test::More (used by the test suite only) Module::Signature (optional) (used by test suite only) COPYRIGHT AND LICENSE Eric J. Roode, roode @ cpan . org Copyright (c) 2003-2009 by Eric J. Roode. All Rights Reserved. This module is free software; See the copyright notice in the module source code for full details. To avoid my spam filter, please include "Perl", "module", or this module's name in the message's subject line, and/or GPG-sign your message. Time-Format-1.11/SIGNATURE0000644000175600010010000000517011216346144014002 0ustar eroodeNoneThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.55. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 788642c04d87fd08ab37c47becafaa017e8ae45a Build.PL SHA1 18ea5e04f2672abf000988c24975f8b263749ea1 Changes SHA1 5778d42ec82cb9ff5b3e711008c16a06ff340d11 MANIFEST SHA1 aa9b2f3cbd5f90ccb7260734593e4de1a7972b90 MANIFEST.SKIP SHA1 1360b3a426806f179e895b45be824cd6829455bf META.yml SHA1 9c459381eef73dade1e6d38530846b50f0901731 Makefile.PL SHA1 483535639f76e3e1e417e1d0edf0996590569ef7 README SHA1 8239155b1a7328890c7a5e41dfc8ae074f87d6e6 lib/Time/Format.pm SHA1 829b98264e37c56117646eed075e039f03ae6892 quickref.ps SHA1 2d3df18b888ce54592232c9fa4fe59480340c212 quickref.txt SHA1 85bda61499a37e0128b67166d7b0ace7e631676e t/0-signature.t SHA1 6485dd41e255a38c57986fe86dca56a1ca6dac97 t/1-load.t SHA1 bae14ef08a158a5b46b37f8c1daf836547f2cc4e t/DateManip.t SHA1 80cda162244702a8091706abd2f94dffda9a0b55 t/DateTime.t SHA1 e54c03886f4466bbe803cfbea88226a430f4511d t/die.t SHA1 5f54aa49bfbaa71d52468d42468afce1c0acc585 t/doc.t SHA1 e1a6f2be6db2551661299ff12bb32fd0fade73e6 t/epoch.t SHA1 56c91f05df9f93155b918a98f004b3239c57ac57 t/export1.t SHA1 96054241cdd6d43799569b5dd7efb7ada9964fc2 t/export2.t SHA1 c3792783e7a73a9ae93d6f8f9575421b32ef47d9 t/export3.t SHA1 6bd4e629990832908abfea314a1733e3e150153c t/funcs.t SHA1 0e31be1cf28677e8189cade1a903071760fd3df4 t/locale.t SHA1 29783572625af2246d980bd7a16fb1efd6fd27c5 t/manip.t SHA1 0ae99d8d225c57d306b3a6198bb0a5be64e72d47 t/past.t SHA1 509cabd441d7e47117ee46be9c5832be55caa720 t/quot.t SHA1 26fe4e61a13d2d6e19a3812ba7c8013175aa4338 t/strftime.t SHA1 8c8d6e4b4978505924f137c4dd492055ff18b630 t/string.t SHA1 fb636b39acc23e773db7406d3f1b84b6059240fa t/time.t SHA1 c9d0b6166805d4477e3387ccb2cd0bfa6056246a t/xs_DateTime.t SHA1 3448367c017f771673bf30f4603fb11400a888f4 t/xs_doc.t SHA1 bde375233e922e7fd7fc6bc203128cef6f96fd01 t/xs_funcs.t SHA1 f03d06a73b1b6dbb6ea8c9171e776e06c4111a34 t/xs_locale.t SHA1 0aa9f17e9e3a283a7f1aa26587091a3f0c6248b3 t/xs_quot.t SHA1 1d67a33bfbd58d3f17bb6d63f5838bd47b8a90f8 t/xs_time.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (Cygwin) iEYEARECAAYFAko6/H8ACgkQwoSYc5qQVqpE+ACfQSfNHu0aaCUPQOqlioqdyh+m IUIAn3axpp32TWUHzoc9WW9qKO/wLfiv =TcEi -----END PGP SIGNATURE----- Time-Format-1.11/META.yml0000644000175600010010000000074111216346144013766 0ustar eroodeNone--- #YAML:1.0 name: Time-Format version: 1.11 abstract: Easy-to-use date/time formatting. license: ~ author: - Eric Roode generated_by: ExtUtils::MakeMaker version 6.44 distribution_type: module requires: Test::Simple: 0.40 Time::Local: 1.07 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3