Time-Format-1.16000755000000000000 013623263424 14121 5ustar00unknownunknown000000000000Time-Format-1.16/Build.PL000444000000000000 275013516643477 15571 0ustar00unknownunknown000000000000use 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', configure_requires => { 'Module::Build' => '0.4', }, requires => { 'Time::Local' => '1.07', 'perl' => '5.6.1', }, build_requires => { 'Test::Simple' => '0.40', }, test_requires => { 'Symbol' => 0, 'FindBin' => 0, }, recommends => { 'I18N::Langinfo' => 0, 'POSIX' => 0, 'Time::HiRes' => 0, 'DateTime' => 0, 'Date::Manip' => 0, 'Module::Signature' => 0, 'Socket' => 0, }, sign => 1, add_to_cleanup => [ 'Time-Format-*' ], ); $builder->create_build_script(); Time-Format-1.16/Changes000444000000000000 1524013623262636 15577 0ustar00unknownunknown000000000000>Revision history for Perl extension Time::Format. 1.16 2020 February 19 - Fix a bug in the interface to Time::Format_XS. Using the time_format function with only a format argument (i.e., to use the current time) would fail (fatally) because the XS interface code for time_format requires two arguments. 1.15 2019 July 26 - Fix a bug in the test suite due to floating-point rounding. Thanks to Slaven Rezic (see CPAN RT bug 130150: https://rt.cpan.org/Ticket/Display.html?id=130150) - Also improved __DATA__ handling, so as not to hold a lock on the library. 1.14 2019 July 22 - Fix CPAN RT bug 87484 (https://rt.cpan.org/Ticket/Display.html?id=87484), concerning very small floating-point values (e.g. "2.1458e-06"). - Fix CPAN RT Bug 95447, concerning floating-point numerical time values. - Fix CPAN RT Bug 121367, concerning loading perl-only routines after forking. This might (?) also fix bug 74880, but I can't reproduce that. - Skip locale tests on openbsd platform. - Fix accented strings in locale.t 1.13 2019 July 18 - Fix CPAN RT bug 85001. This was a problem in the test suite only; no code changes were made in the main module lib/Time/Format.pm. The problem existed in how the test suite checked for whether certain CPAN modules were installed, and especially in how it attempted to unload them from memory afterward. Thanks to Sendu Bala for reporting this -- and to Jim Keenan for pushing me to fix this. 1.12 2012 September 27 - Fix CPAN RT bug 44167/54990: Negative milliseconds/microseconds. This was a boneheaded mistake I should have fixed years ago. Many thanks to Karl Moens for reporting the error, and for a patch. - Fix CPAN RT bug 47229: Build.PL dependencies. Unfortunately, I cannot fix Makefile.PL, since ExtUtils::MakeMaker has no concept of "recommended" or "optional" modules. Thanks to Jens Rehsack for the suggestion. - Fix CPAN RT bug 55630: ISO-8601 Z (Zulu, UTC) marker not supported. Thanks to Will Coleda for pointing this out. - Fix CPAN RT bug 76705/76707 (maybe): month out of range. I can't reproduce this bug, but I made a change to the time parsing that might fix it. Thanks to Todd Bezenek for reporting the problem. 1.11 2009 June 18 - Fix error in the new test (past.t) for v1.10! - Rearrange eval's throughout test code to rely on $@ less. 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.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.08 2008 May 27 - Reset $@ at certain places, so as to work with older (broken) perls. Again, thanks to Slaven Rezic. 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.06 2008 March 28 - Fix a broken test case in time.t; failed for non-English locales. 1.05 2008 March 27 - Fix a typo bug in Makefile.PL 1.04 2008 March 26 - Worked around a POSIX bug which would cause hangs under cygwin. - Fixed a couple test cases. 1.03 2008 March 24 - Fixed a broken test case. - Added Module::Build support. 1.02 2005 December 1 - No changes. Had to increment the number because of a PAUSE upload problem. 1.01 2005 December 1 - Support for DateTime, Date::Manip, and ISO 8601 strings. 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. 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. 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.11 2003 July 7 - Some changes for ActiveState Perl. Thanks again to Will Coleda. 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.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.08 2003 June 22 - Distribute correct SIGNATURE file; a bad one was distributed with v0.07. (Thanks to Jeroen Latour again). 0.07 2003 June 21 - Fix some bugs in the test suite -- NO changes to Format.pm (Thanks to CPAN tester Jeroen Latour!) 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.05 2003 June 17 - Add "tz" timezone format code to %time. - Change unambiguous month/minute format codes. - Some minor speed improvements. 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.03 2003 June 11 - Fix the tests to work in other time zones than my own! 0.02 2003 June 10 - Change the %time formatting codes. - Speed up the code somewhat. - Add many tests 0.01 2003 June 8 - First version Time-Format-1.16/MANIFEST000444000000000000 107513623263411 15406 0ustar00unknownunknown000000000000Build.PL Changes lib/Time/Format.pm Makefile.PL MANIFEST MANIFEST.SKIP META.json META.yml quickref.ps quickref.txt README SIGNATURE 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/msec.t t/past.t t/quot.t t/strftime.t t/string.t t/tf_modcheck.pl t/time.t t/TimeFormat_MC.pm t/TimeFormat_Minute.pm t/verysmall.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 SIGNATURE Added here by Module::Build Time-Format-1.16/MANIFEST.SKIP000444000000000000 213713623262636 16163 0ustar00unknownunknown000000000000# Files and directories that are NOT part of the module distribution # (i.e., are not to be added to the distribution tarball) # Patterns here are Perl regexes, applied to full file paths # (relative to the module root directory, of course). # See https://metacpan.org/pod/ExtUtils::Manifest#MANIFEST.SKIP \.tar\.gz$ # Distributions # Version control directories \bCVS\b ^\.cvsignore$ ^\.git ^\.gitignore$ # Temporary build files/dirs ^Build$ ^Build.bat$ ^Makefile$ ^Makefile.old$ ^_build/ ^blib/ ^blibdirs ^MYMETA ^MANIFEST.bak$ ^Time-Format-[\d.]+/ # Temporary files/dirs from profiling tools ^nytprof ^cover_db/ # Documentation temporary files/dirs ^pm_to_blib ^pod.*\.tmp$ # Editor temp files ~$ ^#.*#$ ^\.# # Developer notes and tools ^project-readme ^DEV-NOTES\.org ^TAGS$ build_tags\.cmd TAGS_expr\.txt # Windows image index files Thumbs\.db # -------------------------------- # The following is for Emacs: # Local Variables: # mode: text # comment-start: "# " # comment-start-skip: "#+ *" # comment-use-syntax: nil # End: Time-Format-1.16/META.json000444000000000000 257413623263411 15703 0ustar00unknownunknown000000000000{ "abstract" : "Easy-to-use date/time formatting.", "author" : [ "Eric J. Roode " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4224", "license" : [ "unrestricted" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Time-Format", "prereqs" : { "build" : { "requires" : { "Test::Simple" : "0.40" } }, "configure" : { "requires" : { "Module::Build" : "0.4" } }, "runtime" : { "recommends" : { "Date::Manip" : "0", "DateTime" : "0", "I18N::Langinfo" : "0", "Module::Signature" : "0", "POSIX" : "0", "Socket" : "0", "Time::HiRes" : "0" }, "requires" : { "Time::Local" : "1.07", "perl" : "v5.6.1" } }, "test" : { "requires" : { "FindBin" : "0", "Symbol" : "0" } } }, "provides" : { "Time::Format" : { "file" : "lib/Time/Format.pm", "version" : "1.16" } }, "release_status" : "stable", "version" : "1.16", "x_serialization_backend" : "JSON::PP version 2.97001" } Time-Format-1.16/META.yml000444000000000000 145213623263411 15525 0ustar00unknownunknown000000000000--- abstract: 'Easy-to-use date/time formatting.' author: - 'Eric J. Roode ' build_requires: FindBin: '0' Symbol: '0' Test::Simple: '0.40' configure_requires: Module::Build: '0.4' dynamic_config: 1 generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010' license: unrestricted meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Time-Format provides: Time::Format: file: lib/Time/Format.pm version: '1.16' recommends: Date::Manip: '0' DateTime: '0' I18N::Langinfo: '0' Module::Signature: '0' POSIX: '0' Socket: '0' Time::HiRes: '0' requires: Time::Local: '1.07' perl: v5.6.1 version: '1.16' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Time-Format-1.16/Makefile.PL000444000000000000 321613515405271 16230 0ustar00unknownunknown000000000000use ExtUtils::MakeMaker; my $MMV = $ExtUtils::MakeMaker::VERSION; $MMV =~ s/_.*$//; $MMV += 0.0; my @wm_args = ( NAME => 'Time::Format', VERSION_FROM => 'lib/Time/Format.pm', # finds $VERSION PREREQ_PM => { 'Test::Simple' => '0.40', 'Time::Local' => '1.07', }, PL_FILES => {}, ); if ($] >= 5.005) { push @wm_args, ( ABSTRACT_FROM => 'lib/Time/Format.pm', # retrieve abstract from module AUTHOR => 'Eric Roode ', ); } if ($WWV >= 6.18 && MM->can('signature_target')) { push @wm_args, ( SIGN => 1, ); } if ($WWV >= 6.31) { push @wm_args, ( LICENSE => 'unrestricted', ); } if ($WWV >= 6.48) { push @wm_args, ( MIN_PERL_VERSION => '5.6.1', ); } if ($WWV > 6.55) { push @wm_args, ( BUILD_REQUIRES => { 'Test::Simple' => '0.40', }, ); } if ($WWV >= 6.64) { push @wm_args, ( TEST_REQUIRES => { 'FindBin' => 0, }, ); } WriteMakefile (@wm_args); Time-Format-1.16/README000444000000000000 621013623262636 15141 0ustar00unknownunknown000000000000Time::Format version 1.16 ========================= 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're using Strawberry Perl, you may need to use 'gmake' instead of 'make' (or 'dmake' for older Strawberry versions). If you're using ActiveState Perl, you may need to use 'nmake'. 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) FindBin (used by the test suite only) Test::More (used by the test suite only) Module::Signature (optional) (used by the test suite only) COPYRIGHT AND LICENSE Eric J. Roode, roode @ cpan . org Copyright (c) 2003-2020 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.16/SIGNATURE000644000000000000 1006713623263424 15570 0ustar00unknownunknown000000000000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.83. 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 SHA256 d08ec140d677bbfeb5fc42ea56d022955476d485fbd29390181b5618f6d574b0 Build.PL SHA256 2023b078004a154b79e07cb0a4e90b5811b2d18ae9b6aebf94c5cc8f44ac2310 Changes SHA256 9cabd1c82e7381609d201179858462e5a86829ef3504205d4980d58e1444b1c7 MANIFEST SHA256 b7720530149bbbff7d4c130d6e06f0223f572f1c15efe1565fffabac2b635862 MANIFEST.SKIP SHA256 611e772240a641da1a43f3ba39edda06c1ad0dd1af691fac84984b59cb2d9689 META.json SHA256 6241a7d487a3d1097e77319a6ef558bcf46d75f2688cb0fdae5f4479ac396fdf META.yml SHA256 87e10c22a9bef8423af9bdf21578957f50bbdcc3fd50f4b7b21b6a9d78d7e50f Makefile.PL SHA256 5f1bf77fc5616f3bd6f4c17c75a9a5f0b735314a3051dc303026ed69b08b2f63 README SHA256 d9b328aa2d4bb14a74e7c2102173848fa440ecf002f3188328a3133a5de5fe87 lib/Time/Format.pm SHA256 21c92102b5809d1f05efe08c7ed5daa51d068617c6d95c32ac4e152dfc6ba901 quickref.ps SHA256 0cc94771682b4abfa13d4125fcb2841c3ad0b16c84d1c606716d61472eac44af quickref.txt SHA256 86d31b7cab8ca951d55ec0908b6df0b31c1cd8a763a470791df466af405fbc97 t/0-signature.t SHA256 ea198d83955394c44ddf8f56086976aeda6799dbd8f2fec72f79327157883cc6 t/1-load.t SHA256 0089b07ac00caca0be2d7a09ad20afb15a8ffd9c81d3d9677bc9fb425ab8cbda t/DateManip.t SHA256 4bb8313c8adaf0208034904dd4279f6b06a17f9e51bfff836a5956e76a762da1 t/DateTime.t SHA256 7de4321043798ba437df86fed909ab0b38e09791d601ee0ada07e90791229baf t/TimeFormat_MC.pm SHA256 c2094c5950a9b794f49da7b74350b03de4288d42ad9731a22e2c5745ef532b23 t/TimeFormat_Minute.pm SHA256 bd808a9619a73c21d5f632fb3cd6f91786369b8148230c87374361caa65b2992 t/die.t SHA256 3e6ba075b4de603349d902f213e1b369bb82bf7dd7602782b4f6dac4f9e5fbe8 t/doc.t SHA256 3d89413067ffa2593fc3f60039b6f0e352a1010b2515385cbee7aaaa6d39d4db t/epoch.t SHA256 63abbac99c2757013b735df372484f9d382de5d0d5f52496e043a3caea8dd168 t/export1.t SHA256 92761be885f0fd5b22e0158b9c086d68c015df4e25137805da86184fa9974e08 t/export2.t SHA256 efbe620f0229e5cb97ba2c23e93c79b64081a6d86b9cba842244ef21cd0d7c5e t/export3.t SHA256 1b2df62a59bff9de7437e64b51f50bc3e2897c8f34e3924a9997225d27605b5d t/funcs.t SHA256 4658cc03d168c89e82ee4ecf9bb7dce7990655170e38482a111b8ed5cb6bf8d5 t/locale.t SHA256 d4f4ecdb160c655573baefe2c9d0fd54e2b57bb54f2094185affae9e58fb2027 t/manip.t SHA256 edd34f30c834c475e749e3a5bbf05b88716fc7c8bed4649510802747d5ac4c66 t/msec.t SHA256 1957c6a8490bc85d799ae6e91cc8d332f7491ec507a2b1d160567b4ecb5c45cc t/past.t SHA256 1a165c454fb446a3d69212ee52f494afba9b1a7c93442c56ff2568c64088724c t/quot.t SHA256 5459f175ae77dda99bd3e5e7fd08a4ce51a3273e57ad6881cdcb869b6ddaa945 t/strftime.t SHA256 432f011f091d559dab6772f7d520c656d6a1aa9d1a0799789a4ce175dc8adc8d t/string.t SHA256 4147b04fa39425a1f94a2ecbfbe3e21df749b6f8d7eb4b3c8b9f825edc949e4a t/tf_modcheck.pl SHA256 be1519b912a3b611ebbe25754d94bc2d3b92b45d0f352e9497cf92852d9a77f9 t/time.t SHA256 599a7efd83f4e2fa60317a543e1ada4a1a95422ead202b7485690bc52357cd96 t/verysmall.t SHA256 25f6c64886a88f9f4625c2eb40094f1dbcdae6ec60e7d2a18cc596e2aeaf08ae t/xs_DateTime.t SHA256 c6d0cc7cd1604bd328cc1653bbc498d96084e038c45db02a93103822d0003943 t/xs_doc.t SHA256 5f367073876af3e50c9c228e677d707afb5f76a650319c68842e7f096deee0f8 t/xs_funcs.t SHA256 4b030a90cf8bd0790ad5456a1bf4a16645e4f9f2e9d1968897cf6f7b2ed00256 t/xs_locale.t SHA256 3f721715cb9240946d91f81621ea066a7e3165de2374006cc70948201952ed57 t/xs_quot.t SHA256 e5e4cf34846570bd2c851e4719b811c4f6947d878a99f959163c51f2b4aa1205 t/xs_time.t -----BEGIN PGP SIGNATURE----- iF0EARECAB0WIQTSmjxiQX/QfjsCVJLChJhzmpBWqgUCXk1nCQAKCRDChJhzmpBW qtu+AKCtjGiphuaro0cgPbSAABm/BeG3NACeKZ2t9Wn9LEqpJY8s3fM5qEMHHZE= =9eFk -----END PGP SIGNATURE----- Time-Format-1.16/quickref.ps000444000000000000 2010713623262636 16457 0ustar00unknownunknown000000000000%!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\2612020 by Eric J. Roode. All rights reserved.) dup stringwidth pop neg 0 rmoveto show showpage Time-Format-1.16/quickref.txt000444000000000000 422513163512565 16635 0ustar00unknownunknown000000000000Quick 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.16/lib000755000000000000 013623263411 14663 5ustar00unknownunknown000000000000Time-Format-1.16/lib/Time000755000000000000 013623263411 15561 5ustar00unknownunknown000000000000Time-Format-1.16/lib/Time/Format.pm000444000000000000 12404413623262636 17561 0ustar00unknownunknown000000000000=for gpg -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 =encoding utf8 =head1 NAME Time::Format - Easy-to-use date/time formatting. =head1 VERSION This is version 1.16 of Time::Format, February 19, 2020. =cut use strict; package Time::Format; $Time::Format::VERSION = '1.16'; # This module claims to be compatible with the following versions # of Time::Format_XS. %Time::Format::XSCOMPAT = map {$_ => 1} qw(1.01 1.02 1.03); sub _croak { require Carp; goto &Carp::croak; } # Store the file offset of the __DATA__ region. my $data_pos = tell DATA; close DATA; # so we don't hold a lock on this file. # 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 = sub { my ($fmt, $t) = @_; $t = 'time' if not defined $t; @_ = ($fmt, $t); goto &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 let's defer this until someone actually calls time_format(). *time_format = sub { if (not defined &time_format_perlonly) { open DATA, '<', __FILE__ or die "Can't access code in " . __FILE__ . ": $!\n";; flock DATA, 1; # LOCK_SH seek DATA, $data_pos, 0; local $^W = 0; # disable warning about subroutines redefined local $/ = undef; # slurp my $code = ; flock DATA, 8; # LOCK_UN close DATA; eval $code; die if $@; } *time_format = \&time_format_perlonly; goto &time_format_perlonly; }; 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', \&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. #line 248 "Time/Format.pm" 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; } # Numeric time? # 1 to 11 digits-- Epoch time should be <= 10 digits, and 12 digits might be YYYYMMDDHHMM. elsif ($timeval =~ /^\s* ( (\d{1,11}) (?:[.,](\d+))? ) $/x) { $timeval = $1; $cache_value = $2; $frac = $3? '0.' . $3 : 0; $time_type = $NUMERIC_TIME; } # 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. (?: # year-month-day \d{4} # year [-/.]? (?:0[1-9]|1[0-2]) # month [-/.]? (?:0[1-9]|[12]\d|3[01]) # 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 ( (?:[01]\d|2[0-4]) # hour [:.]? (?:[0-5]\d) # minute [:.]? (?:[0-5]\d|6[0-1])? # second ) # End of $2: HMS (?: [,.] (\d+))? # optional fraction (Z?) # optional "zulu" (UTC) designator )? # end of optional (HMS.fraction) \z }x) { $cache_value = ($1 || q{}) . ($2 || q{}) . ($4 || q{}); $frac = $3? '0.' . $3 : 0; $time_type = $DATETIME_STRING; } # 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 = $timeval - $cache_value; $time_type = $NUMERIC_TIME; } # *Tiny* numeric time (very close to zero; exponential notation)? # (See bug 87484, https://rt.cpan.org/Ticket/Display.html?id=87484) elsif ($timeval =~ /^\s* -? \d\.\d+ e-\d+ \s*$/x) { $timeval = sprintf '%8.6f', abs($timeval); $cache_value = int $timeval; $frac = $timeval - $cache_value; $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[-3] = 0 if $t[-3] == 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?) # optional "zulu" (UTC) indicator )? \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,$tz) = ($1,$2,$3,$4,$5,$6,$7); my ($d_only, $t_only); my ($h12, $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; if ($tz && $tz eq 'Z') { $tz = 'UTC'; } elsif (_have('POSIX')) { $tz = POSIX::strftime('%Z', @t, $dow, -1, $is_dst); } 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. 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 LIMITATIONS 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-2020 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----- iF0EARECAB0WIQTSmjxiQX/QfjsCVJLChJhzmpBWqgUCXk1aEwAKCRDChJhzmpBW qu/jAKCil0ppbfA+FbEEub5E41qEWajl7wCfclrwa5dGIHb1+jL9sAVmACjvKlg= =pSH2 -----END PGP SIGNATURE----- =end gpg Time-Format-1.16/t000755000000000000 013623263411 14360 5ustar00unknownunknown000000000000Time-Format-1.16/t/0-signature.t000444000000000000 142513514402573 17045 0ustar00unknownunknown000000000000#!/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.16/t/1-load.t000444000000000000 10113163512565 15735 0ustar00unknownunknown000000000000 use Test::More tests => 1; BEGIN { use_ok('Time::Format') }; Time-Format-1.16/t/DateManip.t000444000000000000 463213515405271 16553 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 12; use FindBin; use lib $FindBin::Bin; use TimeFormat_MC; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my ($dm_ok, $dmtz_ok) = tf_module_check('Date::Manip'); ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Date::Manip is not available', 11 unless $dm_ok; skip 'Date::Manip cannot determine time zone', 11 unless $dmtz_ok; require Date::Manip; 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.16/t/DateTime.t000444000000000000 464313515405271 16407 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 12; use FindBin; use lib $FindBin::Bin; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $dt_ok; BEGIN { $dt_ok = eval('use DateTime; 1') }; ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'DateTime not available', 11 unless $dt_ok; # 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.16/t/TimeFormat_MC.pm000444000000000000 274213514402573 17511 0ustar00unknownunknown000000000000 =head1 NAME TimeFormat_MC - Module check for Time::Format test suite. =head1 DESCRIPTION This module provides one function, tf_module_check, which tests for the existence (and loadability) of a Perl module without loading it in the current perl process space. See the script tf_modcheck.pl for a little more info. =cut use strict; package TimeFormat_MC; use parent 'Exporter'; our @EXPORT = qw(tf_module_check); # $FindBin::Bin should be the test (t/) directory. use FindBin; my $mod_name_chunk = qr/[_[:alpha:]]+[_[:alnum:]]*/; my $mod_name_re = qr/\A $mod_name_chunk (?: :: $mod_name_chunk )* \z/x; # Returns true if the module exists and can be loaded -- but loads it in a separate # process, so it won't pollute this process. sub tf_module_check { my (@modules) = @_; foreach my $mod (@modules) { next if $mod =~ $mod_name_re; die qq{Invalid module name "$mod"}; } my $script_dir = $FindBin::Bin; my $test_script = 'tf_modcheck.pl'; my $perl = $^X; my $cmd = "$perl $script_dir/$test_script " . join ' ' => @modules; my $ret = `$cmd`; $ret =~ tr/\r\n//d; # For certain special cases (Date::Manip), the script can return multiple values. my @rv = split /\s+/, $ret; $_ = ($_ eq 'yes'? 1 : 0) for @rv; return $rv[0] if @rv == 1; die "Multiple values returned, but tf_modcheck called in scalar context" unless wantarray; return @rv; } Time-Format-1.16/t/TimeFormat_Minute.pm000444000000000000 333413623262636 20456 0ustar00unknownunknown000000000000 =head1 NAME TimeFormat_Minute - Get current time to the nearest minute. =head1 DESCRIPTION This module is used for testing the current-time featues of Time::Format; that is, the use of the function C and the tied hash C<%time> without a time argument. These are difficult to test because of a race condition. Consider the following test: my ($sec, $min, $hr) = localtime; my $now = sprintf '%02d:%02d:%02d', $hr, $min, $sec; is time_Format('hh:mm:ss'), $now => 'Test formatting of current time'; If the first statement occurs just before a second boundary (e.g. C<08:34:09.995>), and the third statement occurs just after that boundary (C<08:34:10.014), the test will fail even if nothing is wrong. The (imperfect) solution in this module is to ignore seconds and focus only on chunks of time that are minute-sized or larger. First call c. That will sleep for three seconds if the current time is within two seconds of a minute boundary. Then do your test-- but don't test any seconds values, because the race condition still applies. This module also supplies a function, tf_cur_minute to return the current time (as determined by C) as a string of the form "YYYY-MM-DD HH:MM". =cut use strict; package TimeFormat_Minute; use parent 'Exporter'; our @EXPORT = qw(tf_minute_sync tf_cur_minute); # The following are arbitrary my $sec_threshold = 58; my $sleep_duration = 3; sub tf_minute_sync { my ($sec) = localtime; sleep $sleep_duration if $sec >= $sec_threshold; } sub tf_cur_minute { my ($s, $min, $h, $d, $mon, $y) = localtime; return sprintf '%04d-%02d-%02d %02d:%02d', $y+1900, $mon+1, $d, $h, $min; } Time-Format-1.16/t/die.t000444000000000000 56713515405271 15435 0ustar00unknownunknown000000000000#!/perl # 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.16/t/doc.t000444000000000000 1141213516321672 15473 0ustar00unknownunknown000000000000#!/perl # Test examples in the docs, so we know we're not misleading anyone. use strict; use Test::More tests => 26; use FindBin; use lib $FindBin::Bin; use TimeFormat_MC; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN { $tl_ok = eval('use Time::Local; 1') } my ($dm_ok, $dmtz_ok) = tf_module_check('Date::Manip'); my $posix_ok = tf_module_check('POSIX'); ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(:all) } ## ---------------------------------------------------------------------------------- ## Begin tests. # 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 = 0; if ($tl_ok) { $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; } SKIP: { skip 'Time::Local not available', 18 unless $tl_ok; # 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'; SKIP: { skip 'Date::Manip is not available', 1 unless $dm_ok; skip 'Date::Manip cannot determine time zone', 1 unless $dmtz_ok; is qq[$time{'yyyymmdd',$manip{'%s',"epoch $t"}}], '20030605' => 'Example 15'; } # 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'; } # POSIX synopsis tests (2) if ($posix_ok) { SKIP: { skip 'Time::Local not available', 2 unless $tl_ok; 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'; } } else { is "POSIXish: $strftime{'%A, %B %d, %Y', 0,0,0,12,11,95,2}", "POSIXish: NO_POSIX" => 'POSIX 1 (dummy)'; is "POSIXish: $strftime{'%A, %B %d, %Y', int $t}", "POSIXish: NO_POSIX" => 'POSIX 2 (dummy)'; } # manip tests (3) if ($dm_ok && $dmtz_ok) { SKIP: { skip 'Time::Local not available', 2 unless $tl_ok; 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'; } } else { is $manip{'%m/%d/%Y',"epoch $t"}, 'NO_DATEMANIP' => 'Example 13 (dummy)'; is $manip{'%m/%d/%Y','first monday in November 2000'}, 'NO_DATEMANIP' => 'Example 14 (dummy)'; } Time-Format-1.16/t/epoch.t000444000000000000 123613515405271 16004 0ustar00unknownunknown000000000000#!/perl # 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.16/t/export1.t000444000000000000 136613515405271 16314 0ustar00unknownunknown000000000000#!/perl 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.16/t/export2.t000444000000000000 114413515405271 16307 0ustar00unknownunknown000000000000#!/perl 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.16/t/export3.t000444000000000000 154013515405271 16310 0ustar00unknownunknown000000000000#!/perl 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 exported 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.16/t/funcs.t000444000000000000 1120313623262636 16045 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 20; use FindBin; use lib $FindBin::Bin; use TimeFormat_MC; use TimeFormat_Minute; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN { $tl_ok = eval ('use Time::Local; 1') } my $posix_ok = tf_module_check('POSIX'); my ($dm_ok, $dmtz_ok) = tf_module_check('Date::Manip'); ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%time time_format time_strftime time_manip) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. my $t = 0; if ($tl_ok) { $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; } SKIP: { skip 'Time::Local not available', 7 unless $tl_ok; # time_format tests (7) 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'; tf_minute_sync; # avoid race condition my $from_func = time_format('yyyy-mm-dd hh:mm'); is time_format('yyyymmdd'), $time{yyyymmdd} => 'time_format equals %time (ymd)'; is time_format('hh:mm'), $time{'hh:mm'} => 'time_format equals %time (hm)'; is time_format('yyyy-mm-dd hh:mm'), tf_cur_minute() => 'ymd+hm'; } # time_strftime tests (6) if ($posix_ok) { SKIP: { skip 'Time::Local not available', 6 unless $tl_ok; # 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'; tf_minute_sync; # avoid race condition is time_strftime('%M'), $time{'mm{in}'} => 'time_strftime equals %time (m)'; } } else { is time_strftime('%d',$t), 'NO_POSIX' => 'day of month (dummy)'; is time_strftime('%m',$t), 'NO_POSIX' => 'Month number (dummy)'; is time_strftime('%M',$t), 'NO_POSIX' => 'minute (dummy)'; is time_strftime('%H',$t), 'NO_POSIX' => 'hour (dummy)'; is time_strftime('%Y',$t), 'NO_POSIX' => 'year (dummy)'; is time_strftime('%M'), 'NO_POSIX' => 'time_strftime equals %time (dummy)'; } # time_manip tests (6) my $m = 'first thursday in june 2003'; if ($dm_ok && $dmtz_ok) { SKIP: { skip 'Time::Local not available', 6 unless $tl_ok; 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'; tf_minute_sync; # avoid race condition is time_manip('%H'), $time{'hh'} => 'time_manip equals %time (h)'; } } else { is time_manip('%Y',$m), 'NO_DATEMANIP' => 'year (dummy)'; is time_manip('%d',$m), 'NO_DATEMANIP' => 'day of month (dummy)'; is time_manip('%D',$m), 'NO_DATEMANIP' => '%D (dummy)'; is time_manip('%e',$m), 'NO_DATEMANIP' => 'spaced day (dummy)'; is time_manip('%H',$m), 'NO_DATEMANIP' => 'hour (dummy)'; is time_manip('%H'), 'NO_DATEMANIP' => 'time_manip equals %time (dummy)'; } Time-Format-1.16/t/locale.t000444000000000000 464613515405271 16155 0ustar00unknownunknown000000000000#!/perl # -*- coding: utf-8; -*- (for Emacs) # Test locale changing use 5.006; use strict; use utf8; use Test::More tests => 9; use FindBin; use lib $FindBin::Bin; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN { $tl_ok = eval ('use Time::Local; 1') } my $posix_ok; my $lc_time; BEGIN { $posix_ok = eval ('require POSIX; 1'); if ($posix_ok) { $lc_time = POSIX::LC_TIME(); *setlocale = \&POSIX::setlocale; } } ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', '%time' } ## ---------------------------------------------------------------------------------- ## Locale setting is not supported under openbsd my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'POSIX not available', 8 unless $posix_ok; skip 'Time::Local not available', 8 unless $tl_ok; skip 'Locale not supported', 8 unless $lc_supported; 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.16/t/manip.t000444000000000000 207013515405271 16007 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 6; use FindBin; use lib $FindBin::Bin; use TimeFormat_MC; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my ($dm_ok, $dmtz_ok) = tf_module_check('Date::Manip'); ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%manip) } ## ---------------------------------------------------------------------------------- ## Begin tests. my $t = 'first thursday in june 2003'; SKIP: { skip 'Date::Manip is not available', 5 unless $dm_ok; skip 'Date::Manip cannot determine time zone', 5 unless $dmtz_ok; 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.16/t/msec.t000444000000000000 151313515405271 15633 0ustar00unknownunknown000000000000#!/perl # Replicate the bug where microseconds and milliseconds show up as negative numbers. use strict; use Test::More tests => 41; BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(:all) } my $hr_ok; BEGIN { $hr_ok = eval('use Time::HiRes qw(usleep); 1') } SKIP: { skip 'Time::HiRes not available', 40 unless $hr_ok; my @vals; for (1..20) { push @vals, "$_: $time{'yyyy/mm/dd hh:mm:ss.mmm'} -- milli"; push @vals, "$_: $time{'yyyy/mm/dd hh:mm:ss.uuuuuu'} -- micro"; if ($hr_ok) { usleep(180_000); # 180 ms } else { sleep 2; } } my $count = 0; foreach my $str (@vals) { ++$count; ok $str !~ /\d\.-\d/, "Bug test $count ($str)"; } } Time-Format-1.16/t/past.t000444000000000000 203613623262636 15662 0ustar00unknownunknown000000000000 # 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.16/t/quot.t000444000000000000 750313515405271 15701 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 23; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format' } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } my $june = lc $June; my $JUNE = uc $June; ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Time::Local not available', 22 unless $tl_ok; 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.16/t/strftime.t000444000000000000 370313623262636 16552 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 7; use FindBin; use lib $FindBin::Bin; use TimeFormat_MC; use TimeFormat_Minute; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $posix_ok = tf_module_check('POSIX'); my $tl_ok; BEGIN { $tl_ok = eval ('use Time::Local; 1') } ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%strftime) } ## ---------------------------------------------------------------------------------- ## Begin tests. my $t = 0; if ($tl_ok) { $t = timelocal(9, 58, 13, 5, 5, 103); # June 5, 2003 at 1:58:09 pm $t .= '.987654321'; } if ($posix_ok) { SKIP: { skip 'Time::Local is not available', 6 unless $tl_ok; # 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'; tf_minute_sync; # avoid race condition is $strftime{'%Y-%m-%d %H:%M'}, tf_cur_minute() => 'ymd+hm'; } } else { is $strftime{'%d',$t}, 'NO_POSIX' => 'day of month (dummy)'; is $strftime{'%m',$t}, 'NO_POSIX' => 'Month number (dummy)'; is $strftime{'%M',$t}, 'NO_POSIX' => 'minute (dummy)'; is $strftime{'%H',$t}, 'NO_POSIX' => 'hour (dummy)'; is $strftime{'%Y',$t}, 'NO_POSIX' => 'year (dummy)'; is $strftime{'%Y-%m-%d %H:%M'}, 'NO_POSIX' => 'ymd+hm (dummy)'; } Time-Format-1.16/t/string.t000444000000000000 1356313515405271 16242 0ustar00unknownunknown000000000000#!/perl # time-as-string tests use strict; use Test::More tests => 61; use lib 'blib/lib', 'blib/arch'; ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(time_format %time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. # June 5, 2003 at 1:58:09 pm my $d = '2003-06-05'; my $t = '13:58:09'; my $d_t = "$d $t"; my $dTt = "${d}T$t"; my $dt = "$d$t"; my $dtx; ($dtx = $dt) =~ tr/-://d; # no separators at all # Date/time strings with Z (UTC indicator) appended. Per CPAN RT bug 55630. my ($tz, $d_tz, $dTtz, $dtz, $dtxz); ($tz, $d_tz, $dTtz, $dtz, $dtxz) = map {$_ . 'Z'} ($t, $d_t, $dTt, $dt, $dtx); my $out; my $err; # time_format tests (22 * 2) is time_format('yyyymmdd', $d), '20030605' => 'ymd f() d only'; is time_format('yyyymmdd', $t), '19691231' => 'ymd f() t only'; is time_format('yyyymmdd', $d_t), '20030605' => 'ymd f() d&t'; is time_format('yyyymmdd', $dTt), '20030605' => 'ymd f() d T t'; is time_format('yyyymmdd', $dt), '20030605' => 'ymd f() dt'; is time_format('yyyymmdd', $dtx), '20030605' => 'ymd f() dt-nosep'; is time_format('yyyymmdd', $tz), '19691231' => 'ymd f() t only (z)'; is time_format('yyyymmdd', $d_tz), '20030605' => 'ymd f() d&t (z)'; is time_format('yyyymmdd', $dTtz), '20030605' => 'ymd f() d T t (z)'; is time_format('yyyymmdd', $dtz), '20030605' => 'ymd f() dt (z)'; is time_format('yyyymmdd', $dtxz), '20030605' => 'ymd f() dt-nosep (z)'; is time_format('hhmmss', $d), '000000' => 'hms f() d only'; is time_format('hhmmss', $t), '135809' => 'hms f() t only'; is time_format('hhmmss', $d_t), '135809' => 'hms f() d&t'; is time_format('hhmmss', $dTt), '135809' => 'hms f() d T t'; is time_format('hhmmss', $dt), '135809' => 'hms f() dt'; is time_format('hhmmss', $dtx), '135809' => 'hms f() dt-nosep'; is time_format('hhmmss', $tz), '135809' => 'hms f() t only (zz)'; is time_format('hhmmss', $d_tz), '135809' => 'hms f() d&t (zz)'; is time_format('hhmmss', $dTtz), '135809' => 'hms f() d T t (zz)'; is time_format('hhmmss', $dtz), '135809' => 'hms f() dt (zz)'; is time_format('hhmmss', $dtxz), '135809' => 'hms f() dt-nosep (zz)'; 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', $dTt}, '20030605' => 'ymd %{} d T t'; is $time{'yyyymmdd', $dt}, '20030605' => 'ymd %{} dt'; is $time{'yyyymmdd', $dtx}, '20030605' => 'ymd %{} dt-nosep'; is $time{'yyyymmdd', $tz}, '19691231' => 'ymd %{} t only (z)'; is $time{'yyyymmdd', $d_tz}, '20030605' => 'ymd %{} d&t (z)'; is $time{'yyyymmdd', $dTtz}, '20030605' => 'ymd %{} d T t (z)'; is $time{'yyyymmdd', $dtz}, '20030605' => 'ymd %{} dt (z)'; is $time{'yyyymmdd', $dtxz}, '20030605' => 'ymd %{} dt-nosep (z)'; 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', $dTt}, '135809' => 'hms %{} d T t'; is $time{'hhmmss', $dt}, '135809' => 'hms %{} dt'; is $time{'hhmmss', $dtx}, '135809' => 'hms %{} dt-nosep'; is $time{'hhmmss', $tz}, '135809' => 'hms %{} t only (z)'; is $time{'hhmmss', $d_tz}, '135809' => 'hms %{} d&t (z)'; is $time{'hhmmss', $dTtz}, '135809' => 'hms %{} d T t (z)'; is $time{'hhmmss', $dtz}, '135809' => 'hms %{} dt (z)'; is $time{'hhmmss', $dtxz}, '135809' => 'hms %{} dt-nosep (z)'; # Whatever the local time zone, 'Z' times should be reported as UTC. (5 * 2) is time_format('tz', $tz), 'UTC' => 'tzone f() t only (z)'; is time_format('tz', $d_tz), 'UTC' => 'tzone f() d&t (z)'; is time_format('tz', $dTtz), 'UTC' => 'tzone f() d T t (z)'; is time_format('tz', $dtz), 'UTC' => 'tzone f() dt (z)'; is time_format('tz', $dtxz), 'UTC' => 'tzone f() dt-nosep (z)'; is $time{'tz', $tz}, 'UTC' => 'tzone %{} t only (z)'; is $time{'tz', $d_tz}, 'UTC' => 'tzone %{} d&t (z)'; is $time{'tz', $dTtz}, 'UTC' => 'tzone %{} d T t (z)'; is $time{'tz', $dtz}, 'UTC' => 'tzone %{} dt (z)'; is $time{'tz', $dtxz}, 'UTC' => 'tzone %{} dt-nosep (z)'; # 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.16/t/tf_modcheck.pl000444000000000000 420713515405271 17325 0ustar00unknownunknown000000000000 =head1 NAME tf_modcheck.pl - Script to check module availability. =head1 DESCRIPTION This is a hacky little script for unit tests to use in order to determine whether a given module exists -- without the unit test having to load the module itself. Instead the module is loaded here, in a separate perl process. Why? Because some tests should only be run if certain modules have been installed, but Time::Format is supposed to detect and load those modules itself. If the unit test loaded them, it would affect Time::Format's operation. This script should be run via the tf_module_check function of the special-purpose TimeFormat_MC module, which invokes the script and interprets its results. =cut use strict; my $GOOD = 'yes'; # Module was loaded successfully my $BAD = 'no'; # Module was not found my $ERR = 'err'; # An error occurred my %RV = ( # Program return values (exit status) $GOOD => 0, $BAD => 1, $ERR => 2, ); sub output { my ($code) = @_; print "$code\n"; my $rv = exists $RV{$code}? $RV{$code} : $RV{$ERR}; exit($rv); } sub output2 { my ($code1, $code2) = @_; print "$code1 $code2\n"; my $rv; $rv = $RV{$GOOD} if $code1 eq $GOOD || $code2 eq $GOOD; $rv = $RV{$ERR} if $code1 eq $ERR || $code2 eq $ERR; $rv = $RV{$BAD} if !defined $rv; exit($rv); } output $ERR unless @ARGV; my $mod = shift @ARGV; my $chunkpat = qr/ [_[:alpha:]]+ [_[:alnum:]]* /x; output $ERR unless $mod =~ /\A $chunkpat (?: :: $chunkpat)* \z/x; output $BAD unless eval "require $mod; 1"; # Annoying special case for Date::Manip. # If we can load Date::Manip, we can do some of the tests. # Other tests require that Date::Manip can also determine the current time zone. # So we have to return two values here. if ($mod eq 'Date::Manip') { # Get the local time zone if (eval ('Date::Manip::Date_TimeZone (); 1')) { output2 $GOOD, $GOOD; } else { output2 $GOOD, $BAD; } } output $GOOD; Time-Format-1.16/t/time.t000444000000000000 2057713623262636 15703 0ustar00unknownunknown000000000000#!/perl # Test the %time tied hash use strict; use Test::More tests => 102; use FindBin; use lib $FindBin::Bin; use TimeFormat_Minute; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Weekday, $Day, $Month, $Mon); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Weekday, $Day, $Month, $Mon) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Time::Local not available', 77 unless $tl_ok; 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 tests (%time with no second argument). tf_minute_sync; my ($sec, $min, $hr, $day, $mon, $yr) = localtime; $yr += 1900; ++$mon; my $h12 = ($hr % 12) || '12'; my $y2 = $yr % 100; # Individual components (10) is $time{'yyyy'}, sprintf('%04d', $yr) => '4-digit year (cur)'; is $time{'yy'}, sprintf('%02d', $y2) => '2-digit year (cur)'; is $time{'mm{on}'}, sprintf('%02d', $mon) => 'month: mm (cur)'; is $time{'m{on}'}, sprintf('%1d', $mon) => 'month: mm (cur)'; is $time{'dd'}, sprintf('%02d', $day) => '2-digit day (cur)'; is $time{'d'}, sprintf('%1d', $day) => '1/2-digit day (cur)'; is $time{'hh'}, sprintf('%02d', $hr) => '2-digit 24-hour (cur)'; is $time{'h'}, sprintf('%1d', $hr) => '1/2-digit 24-hour (cur)'; is $time{'mm{in}'}, sprintf('%02d', $min) => 'minute: mm (cur)'; is $time{'m{in}'}, sprintf('%1d', $min) => 'minute: m (cur)'; # Month disambiguation tests (10) is $time{'yyyymm'}, sprintf('%04d%02d', $yr, $mon) => 'm test: year (cur)'; is $time{'yymm'}, sprintf('%02d%02d', $y2, $mon) => 'm test: year2 (cur)'; is $time{'mmdd'}, sprintf('%02d%02d', $mon, $day) => 'm test: day (cur)'; is $time{'yyyy/m'}, sprintf('%04d/%1d', $yr, $mon) => 'm test: year/ (cur)'; is $time{'yy/m'}, sprintf('%02d/%1d', $y2, $mon) => 'm test: year2/ (cur)'; is $time{'m/d'}, sprintf('%1d/%1d', $mon, $day) => 'm test: /day (cur)'; is $time{'m/dd'}, sprintf('%1d/%02d', $mon, $day) => 'm test: /Day (cur)'; is $time{'?d/mm'}, sprintf('%2d/%02d', $day, $mon) => 'm test: d/m (cur)'; is $time{'?m/yyyy'}, sprintf('%2d/%04d', $mon, $yr) => 'm test: m/y (cur)'; is $time{'m/yy'}, sprintf('%1d/%02d', $mon, $y2) => 'm test: m/y2 (cur)'; # Minute disambiguation tests (5) is $time{'hhmm'}, sprintf('%02d%02d', $hr, $min) => 'm test: hour (cur)'; is $time{'hh:mm'}, sprintf('%02d:%02d', $hr, $min) => 'm test: hour: (cur)'; is $time{'H:mm'}, sprintf('%1d:%02d', $h12, $min) => 'm test: Hour: (cur)'; is $time{'HH:mm'}, sprintf('%02d:%02d', $h12, $min) => 'm test: hour12: (cur)'; is $time{'?H:m'}, sprintf('%2d:%1d', $h12, $min) => 'm test: Hour12: (cur)'; Time-Format-1.16/t/verysmall.t000444000000000000 517213516643477 16744 0ustar00unknownunknown000000000000#!/perl # Test for very small time values; i.e., numerically very close to zero. # See bug 87484 in CPAN's RT bug tracker: https://rt.cpan.org/Ticket/Display.html?id=87484 # # When Perl stringifies numbers that are very close to zero, it uses exponential notation # (under the default numeric format); e.g. "2.3e-05". A user encountered this problem # when using a time value that was a result of some computations. use strict; use Test::More tests => 6; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { $Time::Format::NOXS = 1 } BEGIN { use_ok 'Time::Format', qw(%time) } ## ---------------------------------------------------------------------------------- ## Begin tests. # Millisecond and microsecond values are rounded down (truncated toward zero), not # rounded. Two reasons for this: One, so that the same time value displayed with # milliseconds and with microseconds will have the most similarity (overlap). # Thus, 0.48964 seconds will display # as 0.489 milliseconds and NOT as 0.490 milliseconds # or 0.489640 microseconds and 0.489640 microseconds # Two, so that a time value very close to 1 (say, 0.999877 seconds) won't round up # to 1, which would mean more calculations. # # The extra trailing digits below ensure that the floating-point input time value # will be slightly higher than the value we want. If for example, on the "Input # minimal float for %time" test, we used '0.001' exactly, on some architectures that # would be represented internally as 0.000999999974blahblahblah or something. # Truncating that would yield 000 for the millisecond result, which would erroneously # fail the test. See bug 130150 (https://rt.cpan.org/Ticket/Display.html?id=130150) my $inp; my $out; $inp = '0'; $out = eval{ $time{'mm:ss.mmm',$inp} } || $@; is $out, '00:00.000' => 'Input 0 for %time'; $inp = '0.00100001'; $out = eval{ $time{'mm:ss.mmm',$inp} } || $@; is $out, '00:00.001' => 'Input minimal float for %time'; $inp = '0.0008'; $out = eval{ $time{'mm:ss.mmm',$inp} } || $@; is $out, '00:00.000' => 'Input too-small float for %time'; $inp = 0.000023; $out = eval{ $time{'mm:ss.mmm',$inp} } || $@; is $out, '00:00.000' => 'Input small exp for %time (msec)'; $inp = 0.000023001; $out = eval{ $time{'mm:ss.uuuuuu',$inp} } || $@; is $out, '00:00.000023' => 'Input small exp for %time (usec)'; Time-Format-1.16/t/xs_DateTime.t000444000000000000 507213623262636 17124 0ustar00unknownunknown000000000000#!/perl # Test the use of DateTime objects as input for the XS time_format function and %time tied hash. use strict; use Test::More tests => 12; use FindBin; use lib $FindBin::Bin; ## ---------------------------------------------------------------------------------- ## Test for availability of DateTime. my $dt_ok; BEGIN { eval { require DateTime; $dt_ok = 1} } ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format', qw(time_format %time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'DateTime not available', 11 unless $dt_ok; skip 'XS version not available', 11 unless 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.16/t/xs_doc.t000444000000000000 647413623262636 16204 0ustar00unknownunknown000000000000#!/perl # Test examples in the docs, so we know we're not misleading anyone. # XS TEST: Only need to test the %time and time_format parts. use strict; use Test::More tests => 18; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format', qw(:all) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Tuesday, $December, $Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Tuesday, $December, $Thursday, $Thu, $June, $Jun) = qw(Tuesday December Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. # Were all variables imported? (1) is ref tied %time, 'Time::Format' => '%time imported'; my $t; if ($tl_ok) { $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 unless $tl_ok; skip 'XS version not available', 16 unless 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.16/t/xs_funcs.t000444000000000000 511713623262636 16546 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 8; use FindBin; use lib $FindBin::Bin; use TimeFormat_Minute; # XS TEST: Only need to test the %time and time_format parts. ## ---------------------------------------------------------------------------------- ## Test for availability of Time::Local my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} sub isx (&@) { my ($got_block, $expected, $test_name) = @_; my $got; if (eval {$got = $got_block->(); 1}) { is $got, $expected, $test_name; } else { my $ex = $@; my ($pkg, $fname, $line) = caller; diag "Failed test '$test_name"; diag "at $fname line $line"; diag "Exception: $ex"; fail $test_name; } } ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format', qw(%time time_format) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Time::Local not available', 7 unless $tl_ok; skip 'XS version not available', 7 unless 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 (7) 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'; tf_minute_sync; # avoid race condition isx { time_format('yyyymmdd') } $time{yyyymmdd} => 'time_format equals %time (ymd)'; isx { time_format('hh:mm') } $time{'hh:mm'} => 'time_format equals %time (hm)'; isx { time_format('yyyy-mm-dd hh:mm') } tf_cur_minute() => 'ymd+hm'; } Time-Format-1.16/t/xs_locale.t000444000000000000 472713515405271 16667 0ustar00unknownunknown000000000000#!/perl # -*- coding: utf-8; -*- (for Emacs) # Test locale changing use 5.006; use strict; use utf8; use Test::More tests => 9; use FindBin; use lib $FindBin::Bin; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN { $tl_ok = eval ('use Time::Local; 1') } my $posix_ok; my $lc_time; BEGIN { $posix_ok = eval ('require POSIX; 1'); if ($posix_ok) { $lc_time = POSIX::LC_TIME(); *setlocale = \&POSIX::setlocale; } } ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format', '%time' } ## ---------------------------------------------------------------------------------- ## Locale setting is not supported under openbsd my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'POSIX not available', 8 unless $posix_ok; skip 'Time::Local not available', 8 unless $tl_ok; skip 'Locale not supported', 8 unless $lc_supported; skip 'XS version not available', 8 unless 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.16/t/xs_quot.t000444000000000000 756513515405271 16423 0ustar00unknownunknown000000000000#!/perl use strict; use Test::More tests => 23; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format' } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Thursday, $Thu, $June, $Jun); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Thursday, $Thu, $June, $Jun) = qw(Thursday Thu June Jun); } my $june = lc $June; my $JUNE = uc $June; ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Time::Local not available', 22 unless $tl_ok; skip 'XS version not available', 22 unless 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.16/t/xs_time.t000444000000000000 2051113623262636 16401 0ustar00unknownunknown000000000000#!/perl # Test the %time tied hash (C version) use strict; use Test::More tests => 102; use FindBin; use lib $FindBin::Bin; use TimeFormat_Minute; ## ---------------------------------------------------------------------------------- ## Test for availability of certain modules. my $tl_ok; BEGIN {$tl_ok = eval ('use Time::Local; 1')} ## ---------------------------------------------------------------------------------- ## Load our module. BEGIN { use_ok 'Time::Format', qw(%time) } ## ---------------------------------------------------------------------------------- ## Get day/month names in current locale; fallback to English (sorry!). my ($Weekday, $Day, $Month, $Mon); my $lc_supported = 1; $lc_supported = 0 if $^O eq 'openbsd'; if (!$lc_supported || !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; }) { diag 'Cannot determine locale; falling back to English.'; ($Weekday, $Day, $Month, $Mon) = qw(Thursday Thu June Jun); } ## ---------------------------------------------------------------------------------- ## Begin tests. SKIP: { skip 'Time::Local not available', 76 unless $tl_ok; skip 'XS version not available', 76 unless 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 tests (%time with no second argument). tf_minute_sync; my ($sec, $min, $hr, $day, $mon, $yr) = localtime; $yr += 1900; ++$mon; my $h12 = ($hr % 12) || '12'; my $y2 = $yr % 100; # Individual components (10) is $time{'yyyy'}, sprintf('%04d', $yr) => '4-digit year (cur)'; is $time{'yy'}, sprintf('%02d', $y2) => '2-digit year (cur)'; is $time{'mm{on}'}, sprintf('%02d', $mon) => 'month: mm (cur)'; is $time{'m{on}'}, sprintf('%1d', $mon) => 'month: mm (cur)'; is $time{'dd'}, sprintf('%02d', $day) => '2-digit day (cur)'; is $time{'d'}, sprintf('%1d', $day) => '1/2-digit day (cur)'; is $time{'hh'}, sprintf('%02d', $hr) => '2-digit 24-hour (cur)'; is $time{'h'}, sprintf('%1d', $hr) => '1/2-digit 24-hour (cur)'; is $time{'mm{in}'}, sprintf('%02d', $min) => 'minute: mm (cur)'; is $time{'m{in}'}, sprintf('%1d', $min) => 'minute: m (cur)'; # Month disambiguation tests (10) is $time{'yyyymm'}, sprintf('%04d%02d', $yr, $mon) => 'm test: year (cur)'; is $time{'yymm'}, sprintf('%02d%02d', $y2, $mon) => 'm test: year2 (cur)'; is $time{'mmdd'}, sprintf('%02d%02d', $mon, $day) => 'm test: day (cur)'; is $time{'yyyy/m'}, sprintf('%04d/%1d', $yr, $mon) => 'm test: year/ (cur)'; is $time{'yy/m'}, sprintf('%02d/%1d', $y2, $mon) => 'm test: year2/ (cur)'; is $time{'m/d'}, sprintf('%1d/%1d', $mon, $day) => 'm test: /day (cur)'; is $time{'m/dd'}, sprintf('%1d/%02d', $mon, $day) => 'm test: /Day (cur)'; is $time{'?d/mm'}, sprintf('%2d/%02d', $day, $mon) => 'm test: d/m (cur)'; is $time{'?m/yyyy'}, sprintf('%2d/%04d', $mon, $yr) => 'm test: m/y (cur)'; is $time{'m/yy'}, sprintf('%1d/%02d', $mon, $y2) => 'm test: m/y2 (cur)'; # Minute disambiguation tests (5) is $time{'hhmm'}, sprintf('%02d%02d', $hr, $min) => 'm test: hour (cur)'; is $time{'hh:mm'}, sprintf('%02d:%02d', $hr, $min) => 'm test: hour: (cur)'; is $time{'H:mm'}, sprintf('%1d:%02d', $h12, $min) => 'm test: Hour: (cur)'; is $time{'HH:mm'}, sprintf('%02d:%02d', $h12, $min) => 'm test: hour12: (cur)'; is $time{'?H:m'}, sprintf('%2d:%1d', $h12, $min) => 'm test: Hour12: (cur)';