From 53121f1f5aac6cd6aa756064af15e3deb39ce2d3 Mon Sep 17 00:00:00 2001 From: Thomas Sibley Date: Wed, 24 Feb 2016 22:05:06 -0800 Subject: [PATCH 1/4] Test::OperationHelper: Allow a test name passed through do_match Naming tests is often very helpful in debugging to ensure you're looking at the right thing and to more quickly get a sense of what's broken. --- lib/App/RecordStream/Test/OperationHelper.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/App/RecordStream/Test/OperationHelper.pm b/lib/App/RecordStream/Test/OperationHelper.pm index 5f39acb..4885146 100644 --- a/lib/App/RecordStream/Test/OperationHelper.pm +++ b/lib/App/RecordStream/Test/OperationHelper.pm @@ -155,6 +155,7 @@ sub do_match { my $args = shift; my $input = shift; my $output = shift; + my $test_name = shift; my $operation_class = "App::RecordStream::Operation::$operation_name"; my $keeper = App::RecordStream::Test::OperationHelper::Keeper->new(); @@ -178,7 +179,7 @@ sub do_match { output => $output, ); - $helper->matches(); + $helper->matches($test_name); return $helper; } From b741f19ce182813cd5cb4fed082af97705a24c2d Mon Sep 17 00:00:00 2001 From: Thomas Sibley Date: Wed, 7 Oct 2015 23:56:26 -0700 Subject: [PATCH 2/4] parsedate: Parse and reformat dates and times Basically a front-end to Time::ParseDate, which offers more control than Date::Manip::DM5's ParseDate(). The fatpack recs, already 7.4MB, is increased only 28KB by Time::ParseDate, so there's no huge loss to avoid it. POSIX, luckily, is part of core. --- cpanfile | 2 + lib/App/RecordStream/Operation/parsedate.pm | 192 ++++++++++++++++++ tests/RecordStream/Operation/parsedate.t | 206 ++++++++++++++++++++ 3 files changed, 400 insertions(+) create mode 100644 lib/App/RecordStream/Operation/parsedate.pm create mode 100644 tests/RecordStream/Operation/parsedate.t diff --git a/cpanfile b/cpanfile index ab19370..e29578b 100644 --- a/cpanfile +++ b/cpanfile @@ -13,11 +13,13 @@ requires 'IO::String'; requires 'JSON::MaybeXS', '1.002005'; requires 'Module::Pluggable::Object', '5.1'; requires 'Pod::Perldoc'; +requires 'POSIX'; requires 'Scalar::Util'; requires 'Text::Autoformat'; requires 'Text::CSV'; requires 'Tie::Array'; requires 'Tie::Hash'; # includes Tie::ExtraHash +requires 'Time::ParseDate', '2013.1113'; # XS deps recommends 'Cpanel::JSON::XS', diff --git a/lib/App/RecordStream/Operation/parsedate.pm b/lib/App/RecordStream/Operation/parsedate.pm new file mode 100644 index 0000000..65ab2d9 --- /dev/null +++ b/lib/App/RecordStream/Operation/parsedate.pm @@ -0,0 +1,192 @@ +use strict; +use warnings; + +package App::RecordStream::Operation::parsedate; +use base qw(App::RecordStream::Operation); +use App::RecordStream::KeyGroups; + +use Time::ParseDate qw< parsedate >; +use POSIX qw< strftime tzset >; + +sub init { + my $this = shift; + my $args = shift; + + $this->{'KEYS'} = App::RecordStream::KeyGroups->new; + $this->{'INPUT_TIMEZONE'} = $ENV{TZ}; + $this->{'OUTPUT_TIMEZONE'} = $ENV{TZ}; + + # Using a single "now" is important if we're processing a lot of relative + # dates so that "now" doesn't drift during processing. time() is the + # default, anyway. + $this->{'NOW'} = time; + + my $options = { + 'key|k=s' => sub { $this->{'KEYS'}->add_groups($_[1]) }, + 'format|f=s' => \($this->{'FORMAT'}), + 'iso|iso8601' => sub { $this->{'FORMAT'} = '%FT%T%z' }, + 'epoch' => sub { $this->{'FORMAT'} = '%s' }, + 'pretty' => sub { $this->{'FORMAT'} = '%c' }, + 'dmy' => \($this->{'UK'}), + 'past' => \($this->{'PAST'}), + 'future' => \($this->{'FUTURE'}), + 'relative!' => \($this->{'RELATIVE'}), + 'now=i' => \($this->{'NOW'}), + 'from-tz=s' => \($this->{'INPUT_TIMEZONE'}), + 'to-tz=s' => \($this->{'OUTPUT_TIMEZONE'}), + 'tz=s' => sub { $this->{'OUTPUT_TIMEZONE'} = $this->{'INPUT_TIMEZONE'} = $_[1] }, + }; + $this->parse_options($args, $options); + + die "--key is required\n" + unless $this->{'KEYS'}->has_any_group; + + die "--format (or one of --iso, --epoch, or --pretty) is required\n" + unless defined $this->{'FORMAT'}; +} + +sub accept_record { + my $this = shift; + my $record = shift; + + my @values = map { $record->guess_key_from_spec($_) } + @{ $this->{'KEYS'}->get_keyspecs_for_record($record) }; + + for my $date (@values) { + my $epoch = $this->parse_date($$date); + $$date = $this->format_epoch($epoch); + } + + $this->push_record($record); + return 1; +} + +sub parse_date { + my ($this, $date) = @_; + + my ($epoch, $status) = $this->with_tz( + $this->{'INPUT_TIMEZONE'}, + sub { + # It might seem that we could pass our timezone to parsedate()'s ZONE + # parameter, but it has very limited capacity for supported timezone + # strings. For example, PST is supported but America/Los_Angeles is not. + # On the other hand, if you let it default to the environmental TZ, it + # can do the right math using standard functions. \o/ + + parsedate( + $date, + WHOLE => 1, + VALIDATE => 1, + PREFER_PAST => $this->{'PAST'}, + PREFER_FUTURE => $this->{'FUTURE'}, + NO_RELATIVE => !$this->{'RELATIVE'}, + UK => $this->{'UK'}, + NOW => $this->{'NOW'}, + ); + } + ); + + warn "Unable to parse '$date': $status\n" + unless defined $epoch; + + return $epoch; +} + +sub format_epoch { + my ($this, $epoch) = @_; + my $formatted; + + return undef + unless defined $epoch; + + return scalar $this->with_tz( + $this->{'OUTPUT_TIMEZONE'}, + sub { + # Since we're operating in our desired output timezone, we use the + # localtime function (instead of gmtime). It's also important that + # localtime and strftime run under the same TZ, so localtime must be in + # this block. + + strftime($this->{'FORMAT'}, localtime $epoch); + } + ); +} + +sub with_tz { + my ($this, $tz, $code) = @_; + my @return; + + # Set TZ locally and restore it when we exit the block to + # avoid side-effects elsewhere. + { + local $ENV{TZ} = $tz; + tzset(); + + @return = $code->(); + } + + # By now $ENV{TZ} is back to what it was, thanks to local(), + # so make sure everything sees the restored value again. + tzset(); + + return wantarray ? @return : $return[0]; +} + +sub add_help_types { + my $this = shift; + $this->use_help_type('keyspecs'); + $this->use_help_type('keygroups'); + $this->use_help_type('keys'); +} + +sub usage { + my $this = shift; + my $options = [ + ['key|-k ', 'Datetime keys to parse and reformat; may be a key spec or key group. Required.'], + ['format|-f ', 'Format string for strftime(3). Required.'], + ['iso|--iso8601', 'Output datetimes as an ISO 8601 timestamp (equivalent to -f %FT%T%z)'], + ['epoch', 'Output datetimes as the number of seconds since the epoch (equivalent to -f %s)'], + ['pretty', 'Output datetimes in the locale-preferred format (equivalent to -f %c)'], + ['dmy', 'Assume dd/mm (UK-style) instead of mm/dd (US-style)'], + ['past', 'Assume ambiguous years and days of the week are in the past'], + ['future', 'Assume ambiguous years and days of the week are in the future'], + ['relative', 'Try to parse relative dates and times (e.g. 1 hour ago)'], + ['now ', 'Set the "current time" for relative datetimes, as seconds since the epoch (rarely needed)'], + ['from-tz ', 'Assume ambiguous datetimes are in the given timezone (defaults to the local TZ)'], + ['to-tz ', 'Convert datetimes to the given timezone for output (defaults to the local TZ)'], + ['tz ', 'Set both --from-tz and --to-tz to the same timezone at once'], + ]; + my $args_string = $this->options_string($options); + + return < -f [] [] + __FORMAT_TEXT__ + Parses the values of the specified keys and reformats them according to the + specified strftime(3) format string. Partial dates and times may be parsed. A + full list of formats parsed is provided in the documentation for + Time::ParseDate [1]. + + Times without a timezone are parsed in the current TZ, unless otherwise + specified by --from-tz. Times are output in the current TZ, unless + otherwise specified by --to-tz. + + Values that cannot be parsed will be set to undef/null. + + If using --relative, you probably also want to specify --past or --future, + otherwise your ambiguous datetimes (e.g. "Friday") won't be parsed. + + [1] https://metacpan.org/pod/Time::ParseDate#DATE-FORMATS-RECOGNIZED + __FORMAT_TEXT__ + +Arguments: +$args_string + +Examples: + Normalize dates from a variety of formats to YYYY-MM-DD in UTC: + ... | recs parsedate -k when -f "%Y-%m-%d" --to-tz UTC + Convert timestamps in UTC to local time in an ISO 8601 format: + ... | recs parsedate -k timestamp --from-tz UTC --iso8601 +USAGE +} + +1; diff --git a/tests/RecordStream/Operation/parsedate.t b/tests/RecordStream/Operation/parsedate.t new file mode 100644 index 0000000..5fece62 --- /dev/null +++ b/tests/RecordStream/Operation/parsedate.t @@ -0,0 +1,206 @@ +use strict; +use warnings; + +use Test::More; +use App::RecordStream::Test::OperationHelper; +use App::RecordStream::Operation::parsedate; + +BEGIN { + # Normalize localtime for testing + $ENV{TZ} = 'US/Pacific'; + + # This may cause warnings if en_US isn't available on a system running these + # tests, but it's the only way to standardize testing for --pretty. + $ENV{LC_TIME} = 'en_US'; +} + +# These tests aim to exercise the interplay of recs-provided options to +# parsedate to ensure they're working correctly, not test Time::ParseDate's +# functionality which is proven elsewhere. + +note 'Formatting presets'; +{ + my @args = qw[ -k when --from-tz UTC ]; + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --iso ]], + '{"when":"2016-02-28 18:45:18"}', + '{"when":"2016-02-28T10:45:18-0800"}', + "--iso: 2016-02-28 18:45:18 is 2016-02-28T10:45:18-0800", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --epoch ]], + '{"when":"2016-02-28 18:45:18"}', + '{"when":"1456685118"}', + "--epoch 2016-02-28 18:45:18 is 1456685118", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --pretty ]], + '{"when":"2016-02-28 18:45:18"}', + '{"when":"Sun 28 Feb 2016 10:45:18 AM PST"}', + "--pretty 2016-02-28 18:45:18 is Sun 28 Feb 2016 10:45:18 AM PST", + ); +} + +note 'Timezones'; +{ + my @args = qw[ -k when --format %T ]; + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args], + '{"when":"Feb 23 21:51:47 2016"}', + '{"when":"21:51:47"}', + "Feb 23 21:51:47 2016 (assuming \$ENV{TZ} = $ENV{TZ}) is 21:51:47 PST", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --to-tz UTC ]], + '{"when":"Feb 23 21:51:47 2016"}', + '{"when":"05:51:47"}', + "Feb 23 21:51:47 2016 (assuming \$ENV{TZ} = $ENV{TZ}) is 05:51:47 UTC", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --from-tz UTC ]], + '{"when":"Feb 23 21:51:47 2016"}', + '{"when":"13:51:47"}', + "Feb 23 21:51:47 2016 (with --from-tz UTC) is 13:51:47 PST", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@args, qw[ --from-tz UTC --to-tz UTC ]], + '{"when":"Feb 23 21:51:47 2016"}', + '{"when":"21:51:47"}', + "Feb 23 21:51:47 2016 (with --from-tz UTC) is 21:51:47 UTC", + ); +} + +note 'MDY vs DMY'; +{ + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --format %F ]], + '{"when":"10/5/2015"}', + '{"when":"2015-10-05"}', + "10/5/2015 is 2015-10-05", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --format %F --dmy ]], + '{"when":"10/5/2015"}', + '{"when":"2015-05-10"}', + "10/5/2015 is 2015-05-10 with --dmy", + ); +}; + +note '--relative: Friday'; +{ + my @relative = qw[ --relative -k when --format %F --now 1456293091 ]; # Tue Feb 23 21:51:47 PST 2016 + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative], + '{"when":"friday"}', + '{"when":null}', + "Friday is undef without --future or --past", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative, "--future"], + '{"when":"friday"}', + '{"when":"2016-02-26"}', + "Friday is 2016-02-26 with --future", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative, "--past"], + '{"when":"friday"}', + '{"when":"2016-02-19"}', + "Friday is 2016-02-19 with --past", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative, "--future", "--to-tz", "UTC"], + '{"when":"friday"}', + '{"when":"2016-02-27"}', + "Friday is 2016-02-27 with --future --to-tz UTC", + ); +} + +note '--relative: +2d'; +{ + my @relative = qw[ --relative -k when --format %F --now 1456293091 ]; # Tue Feb 23 21:51:47 PST 2016 + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative], + '{"when":"+2 days"}', + '{"when":"2016-02-25"}', + "Friday is 2016-02-25 without --future or --past", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative, "--future"], + '{"when":"+2 days"}', + '{"when":"2016-02-25"}', + "Friday is 2016-02-25 with --future", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [@relative, "--past"], + '{"when":"+2 days"}', + '{"when":"2016-02-25"}', + "Friday is 2016-02-25 with --past", + ); +} + +# XXX TODO +note 'Special handling'; +{ + # epochs... unparseable without special casing? + # ISO8601 +}; + +note 'Bug: datetimes on and around the epoch'; +{ + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --tz UTC --epoch ]], + '{"when":"1970-01-01 00:00:00"}', + '{"when":"0"}', + "1970-01-01 00:00:00 is 0s from epoch", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --tz UTC --epoch ]], + '{"when":"1970-01-01 00:00:01"}', + '{"when":"1"}', + "1970-01-01 00:00:01 is 1s from epoch", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --tz UTC --epoch ]], + '{"when":"1969-12-31 23:59:59"}', + '{"when":"-1"}', + "1969-12-31 23:59:59 is -1s from epoch", + ); +} + +done_testing; From 09b8ccd669302ab8d852bcbd431a47be78699a43 Mon Sep 17 00:00:00 2001 From: Thomas Sibley Date: Thu, 25 Feb 2016 20:48:23 -0800 Subject: [PATCH 3/4] Update build metadata and fatpacking artifacts --- LICENSE | 2 +- META.json | 4 +- Makefile.PL | 8 +- fatlib/Time/CTime.pm | 205 ++++++ fatlib/Time/DaysInMonth.pm | 83 +++ fatlib/Time/JulianDay.pm | 224 +++++++ fatlib/Time/ParseDate.pm | 1258 ++++++++++++++++++++++++++++++++++++ fatlib/Time/Timezone.pm | 329 ++++++++++ recs | 282 +++++++- 9 files changed, 2389 insertions(+), 6 deletions(-) create mode 100644 fatlib/Time/CTime.pm create mode 100644 fatlib/Time/DaysInMonth.pm create mode 100644 fatlib/Time/JulianDay.pm create mode 100644 fatlib/Time/ParseDate.pm create mode 100644 fatlib/Time/Timezone.pm diff --git a/LICENSE b/LICENSE index 6319377..7cc0c53 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -This software is Copyright (c) 2010-2017 by the AUTHORS. +This software is Copyright (c) 2010-2018 by the AUTHORS. This is free software, dual licensed under: diff --git a/META.json b/META.json index 9657927..2ea857c 100644 --- a/META.json +++ b/META.json @@ -214,12 +214,14 @@ "IO::String" : "0", "JSON::MaybeXS" : "1.002005", "Module::Pluggable::Object" : "5.1", + "POSIX" : "0", "Pod::Perldoc" : "0", "Scalar::Util" : "0", "Text::Autoformat" : "0", "Text::CSV" : "0", "Tie::Array" : "0", - "Tie::Hash" : "0" + "Tie::Hash" : "0", + "Time::ParseDate" : "2013.1113" } }, "test" : { diff --git a/Makefile.PL b/Makefile.PL index 21c5306..44d8096 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -73,12 +73,14 @@ my %WriteMakefileArgs = ( "IO::String" => 0, "JSON::MaybeXS" => "1.002005", "Module::Pluggable::Object" => "5.1", + "POSIX" => 0, "Pod::Perldoc" => 0, "Scalar::Util" => 0, "Text::Autoformat" => 0, "Text::CSV" => 0, "Tie::Array" => 0, - "Tie::Hash" => 0 + "Tie::Hash" => 0, + "Time::ParseDate" => "2013.1113" }, "TEST_REQUIRES" => { "File::Spec::Functions" => 0, @@ -119,13 +121,15 @@ my %FallbackPrereqs = ( "JSON::MaybeXS" => "1.002005", "Module::Pluggable::Object" => "5.1", "Module::Versions::Report" => "1.06", + "POSIX" => 0, "Pod::Perldoc" => 0, "Scalar::Util" => 0, "Test::More" => "0.88", "Text::Autoformat" => 0, "Text::CSV" => 0, "Tie::Array" => 0, - "Tie::Hash" => 0 + "Tie::Hash" => 0, + "Time::ParseDate" => "2013.1113" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { diff --git a/fatlib/Time/CTime.pm b/fatlib/Time/CTime.pm new file mode 100644 index 0000000..484aa32 --- /dev/null +++ b/fatlib/Time/CTime.pm @@ -0,0 +1,205 @@ +package Time::CTime; + + +require 5.000; + +use Time::Timezone; +use Time::CTime; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(ctime asctime strftime); +@EXPORT_OK = qw(asctime_n ctime_n @DoW @MoY @DayOfWeek @MonthOfYear); + +use strict; + +# constants +use vars qw(@DoW @DayOfWeek @MoY @MonthOfYear %strftime_conversion $VERSION); +use vars qw($template $sec $min $hour $mday $mon $year $wday $yday $isdst); + +$VERSION = 2011.0505; + +CONFIG: { + @DoW = qw(Sun Mon Tue Wed Thu Fri Sat); + @DayOfWeek = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday); + @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + @MonthOfYear = qw(January February March April May June + July August September October November December); + + %strftime_conversion = ( + '%', sub { '%' }, + 'a', sub { $DoW[$wday] }, + 'A', sub { $DayOfWeek[$wday] }, + 'b', sub { $MoY[$mon] }, + 'B', sub { $MonthOfYear[$mon] }, + 'c', sub { asctime_n($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, "") }, + 'd', sub { sprintf("%02d", $mday); }, + 'D', sub { sprintf("%02d/%02d/%02d", $mon+1, $mday, $year%100) }, + 'e', sub { sprintf("%2d", $mday); }, + 'f', sub { fracprintf ("%3.3f", $sec); }, + 'F', sub { fracprintf ("%6.6f", $sec); }, + 'h', sub { $MoY[$mon] }, + 'H', sub { sprintf("%02d", $hour) }, + 'I', sub { sprintf("%02d", $hour % 12 || 12) }, + 'j', sub { sprintf("%03d", $yday + 1) }, + 'k', sub { sprintf("%2d", $hour); }, + 'l', sub { sprintf("%2d", $hour % 12 || 12) }, + 'm', sub { sprintf("%02d", $mon+1); }, + 'M', sub { sprintf("%02d", $min) }, + 'n', sub { "\n" }, + 'o', sub { sprintf("%d%s", $mday, (($mday < 20 && $mday > 3) ? 'th' : ($mday%10 == 1 ? "st" : ($mday%10 == 2 ? "nd" : ($mday%10 == 3 ? "rd" : "th"))))) }, + 'p', sub { $hour > 11 ? "PM" : "AM" }, + 'r', sub { sprintf("%02d:%02d:%02d %s", $hour % 12 || 12, $min, $sec, $hour > 11 ? 'PM' : 'AM') }, + 'R', sub { sprintf("%02d:%02d", $hour, $min) }, + 'S', sub { sprintf("%02d", $sec) }, + 't', sub { "\t" }, + 'T', sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) }, + 'U', sub { wkyr(0, $wday, $yday) }, + 'v', sub { sprintf("%2d-%s-%4d", $mday, $MoY[$mon], $year+1900) }, + 'w', sub { $wday }, + 'W', sub { wkyr(1, $wday, $yday) }, + 'y', sub { sprintf("%02d",$year%100) }, + 'Y', sub { $year + 1900 }, + 'x', sub { sprintf("%02d/%02d/%02d", $mon + 1, $mday, $year%100) }, + 'X', sub { sprintf("%02d:%02d:%02d", $hour, $min, $sec) }, + 'Z', sub { &tz2zone(undef,undef,$isdst) } + # z sprintf("%+03d%02d", $offset / 3600, ($offset % 3600)/60); + ); + + +} + +sub fracprintf { + my($t,$s) = @_; + my($p) = sprintf($t, $s-int($s)); + $p=~s/^0+//; + $p; +} + +sub asctime_n { + my($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = @_; + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = localtime($sec) unless defined $min; + $year += 1900; + $TZname .= ' ' + if $TZname; + sprintf("%s %s %2d %2d:%02d:%02d %s%4d", + $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZname, $year); +} + +sub asctime +{ + return asctime_n(@_)."\n"; +} + +# is this formula right? +sub wkyr { + my($wstart, $wday, $yday) = @_; + $wday = ($wday + 7 - $wstart) % 7; + return int(($yday - $wday + 13) / 7 - 1); +} + +# ctime($time) + +sub ctime { + my($time) = @_; + asctime(localtime($time), &tz2zone(undef,$time)); +} + +sub ctime_n { + my($time) = @_; + asctime_n(localtime($time), &tz2zone(undef,$time)); +} + +# strftime($template, @time_struct) +# +# Does not support locales + +sub strftime { + local ($template, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_; + + undef $@; + $template =~ s/%([%aAbBcdDefFhHIjklmMnopQrRStTUvwWxXyYZ])/&{$Time::CTime::strftime_conversion{$1}}()/egs; + die $@ if $@; + return $template; +} + +1; + +__END__ + +=head1 NAME + +Time::CTime -- format times ala POSIX asctime + +=head1 SYNOPSIS + + use Time::CTime + print ctime(time); + print asctime(localtime(time)); + print strftime(template, localtime(time)); + +=head2 strftime conversions + + %% PERCENT + %a day of the week abbr + %A day of the week + %b month abbr + %B month + %c ctime format: Sat Nov 19 21:05:57 1994 + %d DD + %D MM/DD/YY + %e numeric day of the month + %f floating point seconds (milliseconds): .314 + %F floating point seconds (microseconds): .314159 + %h month abbr + %H hour, 24 hour clock, leading 0's) + %I hour, 12 hour clock, leading 0's) + %j day of the year + %k hour + %l hour, 12 hour clock + %m month number, starting with 1, leading 0's + %M minute, leading 0's + %n NEWLINE + %o ornate day of month -- "1st", "2nd", "25th", etc. + %p AM or PM + %r time format: 09:05:57 PM + %R time format: 21:05 + %S seconds, leading 0's + %t TAB + %T time format: 21:05:57 + %U week number, Sunday as first day of week + %v DD-Mon-Year + %w day of the week, numerically, Sunday == 0 + %W week number, Monday as first day of week + %x date format: 11/19/94 + %X time format: 21:05:57 + %y year (2 digits) + %Y year (4 digits) + %Z timezone in ascii. eg: PST + +=head1 DESCRIPTION + +This module provides routines to format dates. They correspond +to the libc routines. &strftime() supports a pretty good set of +conversions -- more than most C libraries. + +strftime supports a pretty good set of conversions. + +The POSIX module has very similar functionality. You should consider +using it instead if you do not have allergic reactions to system +libraries. + +=head1 GENESIS + +Written by David Muir Sharnoff . + +The starting point for this package was a posting by +Paul Foley + +=head1 LICENSE + +Copyright (C) 1996-2010 David Muir Sharnoff. +Copyright (C) 2011 Google, Inc. +License hereby +granted for anyone to use, modify or redistribute this module at +their own risk. Please feed useful changes back to cpan@dave.sharnoff.org. + diff --git a/fatlib/Time/DaysInMonth.pm b/fatlib/Time/DaysInMonth.pm new file mode 100644 index 0000000..60a7508 --- /dev/null +++ b/fatlib/Time/DaysInMonth.pm @@ -0,0 +1,83 @@ +package Time::DaysInMonth; + +use Carp; + +require 5.000; + +@ISA = qw(Exporter); +@EXPORT = qw(days_in is_leap); +@EXPORT_OK = qw(%mltable); + +use strict; + +use vars qw($VERSION %mltable); + +$VERSION = 99.1117; + +CONFIG: { + %mltable = qw( + 1 31 + 3 31 + 4 30 + 5 31 + 6 30 + 7 31 + 8 31 + 9 30 + 10 31 + 11 30 + 12 31); +} + +sub days_in +{ + # Month is 1..12 + my ($year, $month) = @_; + return $mltable{$month+0} unless $month == 2; + return 28 unless &is_leap($year); + return 29; +} + +sub is_leap +{ + my ($year) = @_; + return 0 unless $year % 4 == 0; + return 1 unless $year % 100 == 0; + return 0 unless $year % 400 == 0; + return 1; +} + +1; + +__END__ + +=head1 NAME + +Time::DaysInMonth -- simply report the number of days in a month + +=head1 SYNOPSIS + + use Time::DaysInMonth; + $days = days_in($year, $month_1_to_12); + $leapyear = is_leap($year); + +=head1 DESCRIPTION + +DaysInMonth is simply a package to report the number of days in +a month. That's all it does. Really! + +=head1 AUTHOR + +David Muir Sharnoff + +=head1 BUGS + +This only deals with the "modern" calendar. Look elsewhere for +historical time and date support. + +=head1 LICENSE + +Copyright (C) 1996-1999 David Muir Sharnoff. License hereby +granted for anyone to use, modify or redistribute this module at +their own risk. Please feed useful changes back to muir@idiom.org. + diff --git a/fatlib/Time/JulianDay.pm b/fatlib/Time/JulianDay.pm new file mode 100644 index 0000000..a749c79 --- /dev/null +++ b/fatlib/Time/JulianDay.pm @@ -0,0 +1,224 @@ +package Time::JulianDay; + +require 5.000; + +use Carp; +use Time::Timezone; + +@ISA = qw(Exporter); +@EXPORT = qw(julian_day inverse_julian_day day_of_week + jd_secondsgm jd_secondslocal + jd_timegm jd_timelocal + gm_julian_day local_julian_day + ); +@EXPORT_OK = qw($brit_jd); + +use strict; +use integer; + +# constants +use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION); + +$VERSION = 2011.0505; + +# calculate the julian day, given $year, $month and $day +sub julian_day +{ + my($year, $month, $day) = @_; + my($tmp); + + use Carp; +# confess() unless defined $day; + + $tmp = $day - 32075 + + 1461 * ( $year + 4800 - ( 14 - $month ) / 12 )/4 + + 367 * ( $month - 2 + ( ( 14 - $month ) / 12 ) * 12 ) / 12 + - 3 * ( ( $year + 4900 - ( 14 - $month ) / 12 ) / 100 ) / 4 + ; + + return($tmp); + +} + +sub gm_julian_day +{ + my($secs) = @_; + my($sec, $min, $hour, $mon, $year, $day, $month); + ($sec, $min, $hour, $day, $mon, $year) = gmtime($secs); + $month = $mon + 1; + $year += 1900; + return julian_day($year, $month, $day) +} + +sub local_julian_day +{ + my($secs) = @_; + my($sec, $min, $hour, $mon, $year, $day, $month); + ($sec, $min, $hour, $day, $mon, $year) = localtime($secs); + $month = $mon + 1; + $year += 1900; + return julian_day($year, $month, $day) +} + +sub day_of_week +{ + my ($jd) = @_; + return (($jd + 1) % 7); # calculate weekday (0=Sun,6=Sat) +} + + +# The following defines the first day that the Gregorian calendar was used +# in the British Empire (Sep 14, 1752). The previous day was Sep 2, 1752 +# by the Julian Calendar. The year began at March 25th before this date. + +$brit_jd = 2361222; + +# Usage: ($year,$month,$day) = &inverse_julian_day($julian_day) +sub inverse_julian_day +{ + my($jd) = @_; + my($jdate_tmp); + my($m,$d,$y); + + carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n") + if ($jd < $brit_jd); + + $jdate_tmp = $jd - 1721119; + $y = (4 * $jdate_tmp - 1)/146097; + $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y; + $d = $jdate_tmp/4; + $jdate_tmp = (4 * $d + 3)/1461; + $d = 4 * $d + 3 - 1461 * $jdate_tmp; + $d = ($d + 4)/4; + $m = (5 * $d - 3)/153; + $d = 5 * $d - 3 - 153 * $m; + $d = ($d + 5) / 5; + $y = 100 * $y + $jdate_tmp; + if($m < 10) { + $m += 3; + } else { + $m -= 9; + ++$y; + } + return ($y, $m, $d); +} + +{ + my($sec, $min, $hour, $day, $mon, $year) = gmtime(0); + $year += 1900; + if ($year == 1970 && $mon == 0 && $day == 1) { + # standard unix time format + $jd_epoch = 2440588; + } else { + $jd_epoch = julian_day($year, $mon+1, $day); + } + $jd_epoch_remainder = $hour*3600 + $min*60 + $sec; +} + +sub jd_secondsgm +{ + my($jd, $hr, $min, $sec) = @_; + + my($r) = (($jd - $jd_epoch) * 86400 + + $hr * 3600 + $min * 60 + - $jd_epoch_remainder); + + no integer; + return ($r + $sec); + use integer; +} + +sub jd_secondslocal +{ + my($jd, $hr, $min, $sec) = @_; + my $jds = jd_secondsgm($jd, $hr, $min, $sec); + return $jds - tz_local_offset($jds); +} + +# this uses a 0-11 month to correctly reverse localtime() +sub jd_timelocal +{ + my ($sec,$min,$hours,$mday,$mon,$year) = @_; + $year += 1900 unless $year > 1000; + my $jd = julian_day($year, $mon+1, $mday); + my $jds = jd_secondsgm($jd, $hours, $min, $sec); + return $jds - tz_local_offset($jds); +} + +# this uses a 0-11 month to correctly reverse gmtime() +sub jd_timegm +{ + my ($sec,$min,$hours,$mday,$mon,$year) = @_; + $year += 1900 unless $year > 1000; + my $jd = julian_day($year, $mon+1, $mday); + return jd_secondsgm($jd, $hours, $min, $sec); +} + +1; + +__END__ + +=head1 NAME + +Time::JulianDay -- Julian calendar manipulations + +=head1 SYNOPSIS + + use Time::JulianDay + + $jd = julian_day($year, $month_1_to_12, $day) + $jd = local_julian_day($seconds_since_1970); + $jd = gm_julian_day($seconds_since_1970); + ($year, $month_1_to_12, $day) = inverse_julian_day($jd) + $dow = day_of_week($jd) + + print (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$dow]; + + $seconds_since_jan_1_1970 = jd_secondslocal($jd, $hour, $min, $sec) + $seconds_since_jan_1_1970 = jd_secondsgm($jd, $hour, $min, $sec) + $seconds_since_jan_1_1970 = jd_timelocal($sec,$min,$hours,$mday,$month_0_to_11,$year) + $seconds_since_jan_1_1970 = jd_timegm($sec,$min,$hours,$mday,$month_0_to_11,$year) + +=head1 DESCRIPTION + +JulianDay is a package that manipulates dates as number of days since +some time a long time ago. It's easy to add and subtract time +using julian days... + +The day_of_week returned by day_of_week() is 0 for Sunday, and 6 for +Saturday and everything else is in between. + +=head1 ERRATA + +Time::JulianDay is not a correct implementation. There are two +problems. The first problem is that Time::JulianDay only works +with integers. Julian Day can be fractional to represent time +within a day. If you call inverse_julian_day() with a non-integer +time, it will often give you an incorrect result. + +The second problem is that Julian Days start at noon rather than +midnight. The julian_day() function returns results that are too +large by 0.5. + +What to do about these problems is currently open for debate. I'm +tempted to leave the current functions alone and add a second set +with more accurate behavior. + +There is another implementation in Astro::Time that may be more accurate. + +=head1 GENESIS + +Written by David Muir Sharnoff with help from +previous work by +Kurt Jaeger aka PI + based on postings from: Ian Miller ; +Gary Puckering + based on Collected Algorithms of the ACM ?; +and the unknown-to-me author of Time::Local. + +=head1 LICENSE + +Copyright (C) 1996-1999 David Muir Sharnoff. License hereby +granted for anyone to use, modify or redistribute this module at +their own risk. Please feed useful changes back to cpan@dave.sharnoff.org. + diff --git a/fatlib/Time/ParseDate.pm b/fatlib/Time/ParseDate.pm new file mode 100644 index 0000000..a4a27f4 --- /dev/null +++ b/fatlib/Time/ParseDate.pm @@ -0,0 +1,1258 @@ +package Time::ParseDate; + +require 5.000; + +use Carp; +use Time::Timezone; +use Time::JulianDay; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(parsedate); +@EXPORT_OK = qw(pd_raw %mtable %umult %wdays); + +use strict; +#use diagnostics; + +# constants +use vars qw(%mtable %umult %wdays $VERSION); + +$VERSION = 2013.1113; + +# globals +use vars qw($debug); + +# dynamically-scoped +use vars qw($parse); + +my %mtable; +my %umult; +my %wdays; +my $y2k; + +CONFIG: { + + %mtable = qw( + Jan 1 Jan. 1 January 1 + Feb 2 Feb. 2 February 2 + Mar 3 Mar. 3 March 3 + Apr 4 Apr. 4 April 4 + May 5 + Jun 6 Jun. 6 June 6 + Jul 7 Jul. 7 July 7 + Aug 8 Aug. 8 August 8 + Sep 9 Sep. 9 September 9 Sept 9 + Oct 10 Oct. 10 October 10 + Nov 11 Nov. 11 November 11 + Dec 12 Dec. 12 December 12 ); + %umult = qw( + sec 1 second 1 + min 60 minute 60 + hour 3600 + day 86400 + week 604800 + fortnight 1209600); + %wdays = qw( + sun 0 sunday 0 + mon 1 monday 1 + tue 2 tuesday 2 + wed 3 wednesday 3 + thu 4 thursday 4 + fri 5 friday 5 + sat 6 saturday 6 + ); + + $y2k = 946684800; # turn of the century +} + +my $break = qr{(?:\s+|\Z|\b(?![-:.,/]\d))}; + +sub parsedate +{ + my ($t, %options) = @_; + + my ($y, $m, $d); # year, month - 1..12, day + my ($H, $M, $S); # hour, minute, second + my $tz; # timezone + my $tzo; # timezone offset + my ($rd, $rs); # relative days, relative seconds + + my $rel; # time&|date is relative + + my $isspec; + my $now = defined($options{NOW}) ? $options{NOW} : time; + my $passes = 0; + my $uk = defined($options{UK}) ? $options{UK} : 0; + + local $parse = ''; # will be dynamically scoped. + + if ($t =~ s#^ ([ \d]\d) + / (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) + / (\d\d\d\d) + : (\d\d) + : (\d\d) + : (\d\d) + (?: + [ ] + ([-+] \d\d\d\d) + (?: \("?(?:(?:[A-Z]{1,4}[TCW56])|IDLE)\))? + )? + $break + ##xi) { #"emacs + # [ \d]/Mon/yyyy:hh:mm:ss [-+]\d\d\d\d + # This is the format for www server logging. + + ($d, $m, $y, $H, $M, $S, $tzo) = ($1, $mtable{"\u\L$2"}, $3, $4, $5, $6, $7 ? &mkoff($7) : ($tzo || undef)); + $parse .= " ".__LINE__ if $debug; + } elsif ($t =~ s#^(\d\d)/(\d\d)/(\d\d)\.(\d\d)\:(\d\d)($break)##) { + # yy/mm/dd.hh:mm + # I support this format because it's used by wbak/rbak + # on Apollo Domain OS. Silly, but historical. + + ($y, $m, $d, $H, $M, $S) = ($1, $2, $3, $4, $5, 0); + $parse .= " ".__LINE__ if $debug; + } else { + while(1) { + if (! defined $m and ! defined $rd and ! defined $y + and ! ($passes == 0 and $options{'TIMEFIRST'})) + { + # no month defined. + if (&parse_date_only(\$t, \$y, \$m, \$d, $uk)) { + $parse .= " ".__LINE__ if $debug; + next; + } + } + if (! defined $H and ! defined $rs) { + if (&parse_time_only(\$t, \$H, \$M, \$S, + \$tz, %options)) + { + $parse .= " ".__LINE__ if $debug; + next; + } + } + next if $passes == 0 and $options{'TIMEFIRST'}; + if (! defined $y) { + if (&parse_year_only(\$t, \$y, $now, %options)) { + $parse .= " ".__LINE__ if $debug; + next; + } + } + if (! defined $tz and ! defined $tzo and ! defined $rs + and (defined $m or defined $H)) + { + if (&parse_tz_only(\$t, \$tz, \$tzo)) { + $parse .= " ".__LINE__ if $debug; + next; + } + } + if (! defined $H and ! defined $rs) { + if (&parse_time_offset(\$t, \$rs, %options)) { + $rel = 1; + $parse .= " ".__LINE__ if $debug; + next; + } + } + if (! defined $m and ! defined $rd and ! defined $y) { + if (&parse_date_offset(\$t, $now, \$y, + \$m, \$d, \$rd, \$rs, %options)) + { + $rel = 1; + $parse .= " ".__LINE__ if $debug; + next; + } + } + if (defined $M or defined $rd) { + if ($t =~ s/^\s*(?:at|\@|\+)($break)//x) { + $rel = 1; + $parse .= " ".__LINE__ if $debug; + next; + } + } + last; + } continue { + $passes++; + &debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug; + + } + + if ($passes == 0) { + print "nothing matched\n" if $debug; + return (undef, "no match on time/date") + if wantarray(); + return undef; + } + } + + &debug_display($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) if $debug; + + $t =~ s/^\s+//; + + if ($t ne '') { + # we didn't manage to eat the string + print "NOT WHOLE\n" if $debug; + if ($options{WHOLE}) { + return (undef, "characters left over after parse") + if wantarray(); + return undef + } + } + + # define a date if there isn't one already + + if (! defined $y and ! defined $m and ! defined $rd) { + print "no date defined, trying to find one." if $debug; + if (defined $rs or defined $H) { + # we do have a time. + if ($options{DATE_REQUIRED}) { + return (undef, "no date specified") + if wantarray(); + return undef; + } + if (defined $rs) { + print "simple offset: $rs\n" if $debug; + my $rv = $now + $rs; + return ($rv, $t) if wantarray(); + return $rv; + } + $rd = 0; + } else { + print "no time either!\n" if $debug; + return (undef, "no time specified") + if wantarray(); + return undef; + } + } + + if ($options{TIME_REQUIRED} && ! defined($rs) + && ! defined($H) && ! defined($rd)) + { + return (undef, "no time found") + if wantarray(); + return undef; + } + + my $secs; + my $jd; + + if (defined $rd) { + if (defined $rs || ! (defined($H) || defined($M) || defined($S))) { + print "fully relative\n" if $debug; + my ($j, $in, $it); + my $definedrs = defined($rs) ? $rs : 0; + my ($isdst_now, $isdst_then); + my $r = $now + $rd * 86400 + $definedrs; + # + # It's possible that there was a timezone shift + # during the time specified. If so, keep the + # hours the "same". + # + $isdst_now = (localtime($r))[8]; + $isdst_then = (localtime($now))[8]; + if (($isdst_now == $isdst_then) || $options{GMT}) + { + return ($r, $t) if wantarray(); + return $r + } + + print "localtime changed DST during time period!\n" if $debug; + } + + print "relative date\n" if $debug; + $jd = $options{GMT} + ? gm_julian_day($now) + : local_julian_day($now); + print "jd($now) = $jd\n" if $debug; + $jd += $rd; + } else { + unless (defined $y) { + if ($options{PREFER_PAST}) { + my ($day, $mon011); + ($day, $mon011, $y) = (&righttime($now))[3,4,5]; + + print "calc year -past $day-$d $mon011-$m $y\n" if $debug; + $y -= 1 if ($mon011+1 < $m) || + (($mon011+1 == $m) && ($day < $d)); + } elsif ($options{PREFER_FUTURE}) { + print "calc year -future\n" if $debug; + my ($day, $mon011); + ($day, $mon011, $y) = (&righttime($now))[3,4,5]; + $y += 1 if ($mon011 >= $m) || + (($mon011+1 == $m) && ($day > $d)); + } else { + print "calc year -this\n" if $debug; + $y = (localtime($now))[5]; + } + $y += 1900; + } + + $y = expand_two_digit_year($y, $now, %options) + if $y < 100; + + if ($options{VALIDATE}) { + require Time::DaysInMonth; + my $dim = Time::DaysInMonth::days_in($y, $m); + if ($y < 1000 or $m < 1 or $d < 1 + or $y > 9999 or $m > 12 or $d > $dim) + { + return (undef, "illegal YMD: $y, $m, $d") + if wantarray(); + return undef; + } + } + $jd = julian_day($y, $m, $d); + print "jd($y, $m, $d) = $jd\n" if $debug; + } + + # put time into HMS + + if (! defined($H)) { + if (defined($rd) || defined($rs)) { + ($S, $M, $H) = &righttime($now, %options); + print "HMS set to $H $M $S\n" if $debug; + } + } + + my $carry; + + print "before ", (defined($rs) ? "$rs" : ""), + " $jd $H $M $S\n" + if $debug; + # + # add in relative seconds. Do it this way because we want to + # preserve the localtime across DST changes. + # + + $S = 0 unless $S; # -w + $M = 0 unless $M; # -w + $H = 0 unless $H; # -w + + if ($options{VALIDATE} and + ($S < 0 or $M < 0 or $H < 0 or $S > 59 or $M > 59 or $H > 23)) + { + return (undef, "illegal HMS: $H, $M, $S") if wantarray(); + return undef; + } + + $S += $rs if defined $rs; + $carry = int($S / 60) - ($S < 0 && $S % 60 && 1); + $S -= $carry * 60; + $M += $carry; + $carry = int($M / 60) - ($M < 0 && $M % 60 && 1); + $M %= 60; + $H += $carry; + $carry = int($H / 24) - ($H < 0 && $H % 24 && 1); + $H %= 24; + $jd += $carry; + + print "after rs $jd $H $M $S\n" if $debug; + + $secs = jd_secondsgm($jd, $H, $M, $S); + print "jd_secondsgm($jd, $H, $M, $S) = $secs\n" if $debug; + + # + # If we see something link 3pm CST then and we want to end + # up with a GMT seconds, then we convert the 3pm to GMT and + # subtract in the offset for CST. We subtract because we + # are converting from CST to GMT. + # + my $tzadj; + if ($tz) { + $tzadj = tz_offset($tz, $secs); + if (defined $tzadj) { + print "adjusting secs for $tz: $tzadj\n" if $debug; + $tzadj = tz_offset($tz, $secs-$tzadj); + $secs -= $tzadj; + } else { + print "unknown timezone: $tz\n" if $debug; + undef $secs; + undef $t; + } + } elsif (defined $tzo) { + print "adjusting time for offset: $tzo\n" if $debug; + $secs -= $tzo; + } else { + unless ($options{GMT}) { + if ($options{ZONE}) { + $tzadj = tz_offset($options{ZONE}, $secs) || 0; + $tzadj = tz_offset($options{ZONE}, $secs-$tzadj); + unless (defined($tzadj)) { + return (undef, "could not convert '$options{ZONE}' to time offset") + if wantarray(); + return undef; + } + print "adjusting secs for $options{ZONE}: $tzadj\n" if $debug; + $secs -= $tzadj; + } else { + $tzadj = tz_local_offset($secs); + print "adjusting secs for local offset: $tzadj\n" if $debug; + # + # Just in case we are very close to a time + # change... + # + $tzadj = tz_local_offset($secs-$tzadj); + $secs -= $tzadj; + } + } + } + + print "returning $secs.\n" if $debug; + + return ($secs, $t) if wantarray(); + return $secs; +} + + +sub mkoff +{ + my($offset) = @_; + + if (defined $offset and $offset =~ s#^([-+])(\d\d):?(\d\d)$##) { + return ($1 eq '+' ? + 3600 * $2 + 60 * $3 + : -3600 * $2 + -60 * $3 ); + } + return undef; +} + +sub parse_tz_only +{ + my($tr, $tz, $tzo) = @_; + + $$tr =~ s#^\s+##; + my $o; + + if ($$tr =~ s#^ + ([-+]\d\d:?\d\d) + \s+ + \( + "? + (?: + (?: + [A-Z]{1,4}[TCW56] + ) + | + IDLE + ) + \) + $break + ##x) { #"emacs + $$tzo = &mkoff($1); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})($break)##x) { + $o = $1; + if ($o < 24 and $o !~ /^0/) { + # probably hours. + printf "adjusted at %d. ($o 00)\n", __LINE__ if $debug; + $o = "${o}00"; + } + $o =~ s/\b(\d\d\d)/0$1/; + $$tzo = &mkoff($o); + printf "matched at %d. ($$tzo, $o)\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?:GMT\s*)?([-+]\d\d:?\d\d)($break)##x) { + $o = $1; + $$tzo = &mkoff($o); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^"?((?:[A-Z]{1,4}[TCW56])|IDLE)$break##x) { #" + $$tz = $1; + $$tz .= " DST" + if $$tz eq 'MET' && $$tr =~ s#^DST$break##x; + printf "matched at %d: '$$tz'.\n", __LINE__ if $debug; + return 1; + } + return 0; +} + +sub parse_date_only +{ + my ($tr, $yr, $mr, $dr, $uk) = @_; + + $$tr =~ s#^\s+##; + + if ($$tr =~ s#^(\d\d\d\d)([-./])(\d\d?)\2(\d\d?)(T|$break)##) { + # yyyy/mm/dd + + ($$yr, $$mr, $$dr) = ($1, $3, $4); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(\d\d?)([-./])(\d\d?)\2(\d\d\d\d?)($break)##) { + # mm/dd/yyyy - is this safe? No. + # -- or dd/mm/yyyy! If $1>12, then it's unambiguous. + # Otherwise check option UK for UK style date. + if ($uk || $1>12) { + ($$yr, $$mr, $$dr) = ($4, $3, $1); + } else { + ($$yr, $$mr, $$dr) = ($4, $1, $3); + } + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(\d\d\d\d)/(\d\d?)$break##x) { + # yyyy/mm + + ($$yr, $$mr, $$dr) = ($1, $2, 1); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (?: + (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday| + Thu|Thursday|Fri|Friday| + Sat|Saturday|Sun|Sunday),? + \s+ + )? + (\d\d?) + (\s+ | - | \. | /) + (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.? + (?: + \2 + (\d\d (?:\d\d)? ) + )? + $break + ##) { + # [Dow,] dd Mon [yy[yy]] + ($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1); + + printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $3 if $debug; + print "y undef\n" if ($debug && ! defined($$yr)); + return 1; + } elsif ($$tr =~ s#^(?xi) + (?: + (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday| + Thu|Thursday|Fri|Friday| + Sat|Saturday|Sun|Sunday),? + \s+ + )? + (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.? + ((\s)+ | - | \. | /) + + (\d\d?) + ,? + (?: + (?: \2|\3+) + (\d\d (?: \d\d)?) + )? + $break + ##) { + # [Dow,] Mon dd [yyyy] + # [Dow,] Mon d, [yy] + ($$yr, $$mr, $$dr) = ($5, $mtable{"\u\L$1"}, $4); + printf "%d: %s - %s - %s\n", __LINE__, $1, $2, $4 if $debug; + print "y undef\n" if ($debug && ! defined($$yr)); + return 1; + } elsif ($$tr =~ s#^(?xi) + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + \s+ + (\d+) + (?:st|nd|rd|th)? + \,? + (?: + \s+ + (?: + (\d\d\d\d) + |(?:\' (\d\d)) + ) + )? + $break + ##) { + # Month day{st,nd,rd,th}, 'yy + # Month day{st,nd,rd,th}, year + # Month day, year + # Mon. day, year + ($$yr, $$mr, $$dr) = ($3 || $4, $mtable{"\u\L$1"}, $2); + printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug; + print "y undef\n" if ($debug && ! defined($$yr)); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(\d\d?)([-/.])(\d\d?)\2(\d\d?)($break)##x) { + if ($1 > 31 || (!$uk && $1 > 12 && $4 < 32)) { + # yy/mm/dd + ($$yr, $$mr, $$dr) = ($1, $3, $4); + } elsif ($1 > 12 || $uk) { + # dd/mm/yy + ($$yr, $$mr, $$dr) = ($4, $3, $1); + } else { + # mm/dd/yy + ($$yr, $$mr, $$dr) = ($4, $1, $3); + } + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(\d\d?)/(\d\d?)($break)##x) { + if ($1 > 31 || (!$uk && $1 > 12)) { + # yy/mm + ($$yr, $$mr, $$dr) = ($1, $2, 1); + } elsif ($2 > 31 || ($uk && $2 > 12)) { + # mm/yy + ($$yr, $$mr, $$dr) = ($2, $1, 1); + } elsif ($1 > 12 || $uk) { + # dd/mm + ($$mr, $$dr) = ($2, $1); + } else { + # mm/dd + ($$mr, $$dr) = ($1, $2); + } + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(\d\d)(\d\d)(\d\d)($break)##x) { + if ($1 > 31 || (!$uk && $1 > 12)) { + # YYMMDD + ($$yr, $$mr, $$dr) = ($1, $2, $3); + } elsif ($1 > 12 || $uk) { + # DDMMYY + ($$yr, $$mr, $$dr) = ($3, $2, $1); + } else { + # MMDDYY + ($$yr, $$mr, $$dr) = ($3, $1, $2); + } + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (\d{1,2}) + (\s+ | - | \. | /) + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + (?: + \2 + ( + \d\d + (?:\d\d)? + ) + ) + $break + ##) { + # dd Month [yr] + ($$yr, $$mr, $$dr) = ($4, $mtable{"\u\L$3"}, $1); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (\d+) + (?:st|nd|rd|th)? + \s+ + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + (?: + \,? + \s+ + (\d\d\d\d) + )? + $break + ##) { + # day{st,nd,rd,th}, Month year + ($$yr, $$mr, $$dr) = ($3, $mtable{"\u\L$2"}, $1); + printf "%d: %s - %s - %s - %s\n", __LINE__, $1, $2, $3, $4 if $debug; + print "y undef\n" if ($debug && ! defined($$yr)); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } + return 0; +} + +sub parse_time_only +{ + my ($tr, $hr, $mr, $sr, $tzr, %options) = @_; + + $$tr =~ s#^\s+##; + + if ($$tr =~ s!^(?x) + (?: + (?: + ([012]\d) (?# $1) + (?: + ([0-5]\d) (?# $2) + (?: + ([0-5]\d) (?# $3) + )? + ) + \s* + ([apAP][mM])? (?# $4) + ) | (?: + (\d{1,2}) (?# $5) + (?: + \: + (\d\d) (?# $6) + (?: + \: + (\d\d) (?# $7) + ( + (?# don't barf on database sub-second timings) + [:.,] + \d+ + )? (?# $8) + )? + ) + \s* + ([apAP][mM])? (?# $9) + ) | (?: + (\d{1,2}) (?# $10) + ([apAP][mM]) (?# ${11}) + ) + ) + (?: + \s+ + "? + ( (?# ${12}) + (?: [A-Z]{1,4}[TCW56] ) + | + IDLE + ) + )? + $break + !!) { #"emacs + # HH[[:]MM[:SS]]meridian [zone] + my $ampm; + $$hr = $1 || $5 || $10 || 0; # 10 is undef, but 5 is defined.. + $$mr = $2 || $6 || 0; + $$sr = $3 || $7 || 0; + if (defined($8) && exists($options{SUBSECOND}) && $options{SUBSECOND}) { + my($frac) = $8; + substr($frac,0,1) = '.'; + $$sr += $frac; + } + print "S = $$sr\n" if $debug; + $ampm = $4 || $9 || $11 || ''; + $$tzr = $12; + $$hr += 12 if $ampm and "\U$ampm" eq "PM" && $$hr != 12; + $$hr = 0 if $$hr == 12 && "\U$ampm" eq "AM"; + printf "matched at %d, rem = %s.\n", __LINE__, $$tr if $debug; + return 1; + } elsif ($$tr =~ s#^noon$break##ix) { + # noon + ($$hr, $$mr, $$sr) = (12, 0, 0); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^midnight$break##ix) { + # midnight + ($$hr, $$mr, $$sr) = (0, 0, 0); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } + return 0; +} + +sub parse_time_offset +{ + my ($tr, $rsr, %options) = @_; + + $$tr =~ s/^\s+//; + + return 0 if $options{NO_RELATIVE}; + + if ($$tr =~ s{^(?xi) + (?: + (-) (?# 1) + | + [+] + )? + \s* + (?: + (\d+(?:\.\d+)?) (?# 2) + | + (?:(\d+)\s+(\d+)/(\d+)) (?# 3 4/5) + ) + \s* + (sec|second|min|minute|hour)s? (?# 6) + ( + \s+ + ago (?# 7) + )? + $break + }{}) { + # count units + $$rsr = 0 unless defined $$rsr; + return 0 if defined($5) && $5 == 0; + my $num = defined($2) + ? $2 + : $3 + $4/$5; + $num = -$num if $1; + $$rsr += $umult{"\L$6"} * $num; + + $$rsr = -$$rsr if $7 || + $$tr =~ /\b(day|mon|month|year)s?\s*ago\b/; + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } + return 0; +} + +# +# What to you do with a date that has a two-digit year? +# There's not much that can be done except make a guess. +# +# Some example situations to handle: +# +# now year +# +# 1999 01 +# 1999 71 +# 2010 71 +# 2110 09 +# + +sub expand_two_digit_year +{ + my ($yr, $now, %options) = @_; + + return $yr if $yr > 100; + + my ($y) = (&righttime($now, %options))[5]; + $y += 1900; + my $century = int($y / 100) * 100; + my $within = $y % 100; + + my $r = $yr + $century; + + if ($options{PREFER_PAST}) { + if ($yr > $within) { + $r = $yr + $century - 100; + } + } elsif ($options{PREFER_FUTURE}) { + # being strict here would be silly + if ($yr < $within-20) { + # it's 2019 and the date is '08' + $r = $yr + $century + 100; + } + } elsif ($options{UNAMBIGUOUS}) { + # we really shouldn't guess + return undef; + } else { + # prefer the current century in most cases + + if ($within > 80 && $within - $yr > 60) { + $r = $yr + $century + 100; + } + + if ($within < 30 && $yr - $within > 59) { + $r = $yr + $century - 100; + } + } + print "two digit year '$yr' expanded into $r\n" if $debug; + return $r; +} + + +sub calc +{ + my ($rsr, $yr, $mr, $dr, $rdr, $now, $units, $count, %options) = @_; + + confess unless $units; + $units = "\L$units"; + print "calc based on $units\n" if $debug; + + if ($units eq 'day') { + $$rdr = $count; + } elsif ($units eq 'week') { + $$rdr = $count * 7; + } elsif ($umult{$units}) { + $$rsr = $count * $umult{$units}; + } elsif ($units eq 'mon' || $units eq 'month') { + ($$yr, $$mr, $$dr) = &monthoff($now, $count, %options); + $$rsr = 0 unless $$rsr; + } elsif ($units eq 'year') { + ($$yr, $$mr, $$dr) = &monthoff($now, $count * 12, %options); + $$rsr = 0 unless $$rsr; + } else { + carp "interal error"; + } + print "calced rsr $$rsr rdr $$rdr, yr $$yr mr $$mr dr $$dr.\n" if $debug; +} + +sub monthoff +{ + my ($now, $months, %options) = @_; + + # months are 0..11 + my ($d, $m11, $y) = (&righttime($now, %options)) [ 3,4,5 ] ; + + $y += 1900; + + print "m11 = $m11 + $months, y = $y\n" if $debug; + + $m11 += $months; + + print "m11 = $m11, y = $y\n" if $debug; + if ($m11 > 11 || $m11 < 0) { + $y -= 1 if $m11 < 0 && ($m11 % 12 != 0); + $y += int($m11/12); + + # this is required to work around a bug in perl 5.003 + no integer; + $m11 %= 12; + } + print "m11 = $m11, y = $y\n" if $debug; + + # + # What is "1 month from January 31st?" + # I think the answer is February 28th most years. + # + # Similarly, what is one year from February 29th, 1980? + # I think it's February 28th, 1981. + # + # If you disagree, change the following code. + # + if ($d > 30 or ($d > 28 && $m11 == 1)) { + require Time::DaysInMonth; + my $dim = Time::DaysInMonth::days_in($y, $m11+1); + print "dim($y,$m11+1)= $dim\n" if $debug; + $d = $dim if $d > $dim; + } + return ($y, $m11+1, $d); +} + +sub righttime +{ + my ($time, %options) = @_; + if ($options{GMT}) { + return gmtime($time); + } else { + return localtime($time); + } +} + +sub parse_year_only +{ + my ($tr, $yr, $now, %options) = @_; + + $$tr =~ s#^\s+##; + + if ($$tr =~ s#^(\d\d\d\d)$break##) { + $$yr = $1; + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#\'(\d\d)$break##) { + $$yr = expand_two_digit_year($1, $now, %options); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } + return 0; +} + +sub parse_date_offset +{ + my ($tr, $now, $yr, $mr, $dr, $rdr, $rsr, %options) = @_; + + return 0 if $options{NO_RELATIVE}; + + # now - current seconds_since_epoch + # yr - year return + # mr - month return + # dr - day return + # rdr - relative day return + # rsr - relative second return + + my $j; + my $wday = (&righttime($now, %options))[6]; + + $$tr =~ s#^\s+##; + + if ($$tr =~ s#^(?xi) + \s* + (\d+) + \s* + (day|week|month|year)s? + ( + \s+ + ago + )? + $break + ##) { + my $amt = $1 + 0; + my $units = $2; + $amt = -$amt if $3 || + $$tr =~ m#\b(sec|second|min|minute|hour)s?\s*ago\b#; + &calc($rsr, $yr, $mr, $dr, $rdr, $now, $units, + $amt, %options); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (?: + (?: + now + \s+ + )? + (\+ | \-) + \s* + )? + (\d+) + \s* + (day|week|month|year)s? + $break + ##) { + my $one = $1 || ''; + my $two = $2 || ''; + my $amt = "$one$two"+0; + &calc($rsr, $yr, $mr, $dr, $rdr, $now, $3, + $amt, %options); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + \s+ + after + \s+ + next + $break + ##) { + # Dow "after next" + $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} > $wday ? 7 : 14); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + \s+ + before + \s+ + last + $break + ##) { + # Dow "before last" + $$rdr = $wdays{"\L$1"} - $wday - ( $wdays{"\L$1"} < $wday ? 7 : 14); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + next\s+ + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break + ##) { + # "next" Dow + $$rdr = $wdays{"\L$1"} - $wday + + ( $wdays{"\L$1"} > $wday ? 0 : 7); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^(?xi) + last\s+ + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break##) { + # "last" Dow + printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug; + $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($options{PREFER_PAST} and $$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break##) { + # Dow + printf "c %d - %d + ( %d < %d ? 0 : -7 \n", $wdays{"\L$1"}, $wday, $wdays{"\L$1"}, $wday if $debug; + $$rdr = $wdays{"\L$1"} - $wday + ( $wdays{"\L$1"} < $wday ? 0 : -7); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($options{PREFER_FUTURE} and $$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break + ##) { + # Dow + $$rdr = $wdays{"\L$1"} - $wday + + ( $wdays{"\L$1"} > $wday ? 0 : 7); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^today$break##xi) { + # today + $$rdr = 0; + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^tomorrow$break##xi) { + $$rdr = 1; + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^yesterday$break##xi) { + $$rdr = -1; + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^last\s+(week|month|year)$break##xi) { + &calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, -1, %options); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^next\s+(week|month|year)$break##xi) { + &calc($rsr, $yr, $mr, $dr, $rdr, $now, $1, 1, %options); + printf "matched at %d.\n", __LINE__ if $debug; + return 1; + } elsif ($$tr =~ s#^now $break##x) { + $$rdr = 0; + return 1; + } + return 0; +} + +sub debug_display +{ + my ($tz, $tzo, $H, $M, $S, $m, $d, $y, $rs, $rd, $rel, $passes, $parse, $t) = @_; + print "---------<<\n"; + print defined($tz) ? "tz: $tz.\n" : "no tz\n"; + print defined($tzo) ? "tzo: $tzo.\n" : "no tzo\n"; + print "HMS: "; + print defined($H) ? "$H, " : "no H, "; + print defined($M) ? "$M, " : "no M, "; + print defined($S) ? "$S\n" : "no S.\n"; + print "mdy: "; + print defined($m) ? "$m, " : "no m, "; + print defined($d) ? "$d, " : "no d, "; + print defined($y) ? "$y\n" : "no y.\n"; + print defined($rs) ? "rs: $rs.\n" : "no rs\n"; + print defined($rd) ? "rd: $rd.\n" : "no rd\n"; + print $rel ? "relative\n" : "not relative\n"; + print "passes: $passes\n"; + print "parse:$parse\n"; + print "t: $t.\n"; + print "--------->>\n"; +} +1; + +__END__ + +=head1 NAME + +Time::ParseDate -- date parsing both relative and absolute + +=head1 SYNOPSIS + + use Time::ParseDate; + $seconds_since_jan1_1970 = parsedate("12/11/94 2pm", NO_RELATIVE => 1) + $seconds_since_jan1_1970 = parsedate("12/11/94 2pm", %options) + +=head1 OPTIONS + +Date parsing can also use options. The options are as follows: + + FUZZY -> it's okay not to parse the entire date string + NOW -> the "current" time for relative times (defaults to time()) + ZONE -> local timezone (defaults to $ENV{TZ}) + WHOLE -> the whole input string must be parsed + GMT -> input time is assumed to be GMT, not localtime + UK -> prefer UK style dates (dd/mm over mm/dd) + DATE_REQUIRED -> do not default the date + TIME_REQUIRED -> do not default the time + NO_RELATIVE -> input time is not relative to NOW + TIMEFIRST -> try parsing time before date [not default] + PREFER_PAST -> when year or day of week is ambigueous, assume past + PREFER_FUTURE -> when year or day of week is ambigueous, assume future + SUBSECOND -> parse fraction seconds + VALIDATE -> only accept normal values for HHMMSS, YYMMDD. Otherwise + days like -1 might give the last day of the previous month. + +=head1 DATE FORMATS RECOGNIZED + +=head2 Absolute date formats + + Dow, dd Mon yy + Dow, dd Mon yyyy + Dow, dd Mon + dd Mon yy + dd Mon yyyy + Month day{st,nd,rd,th}, year + Month day{st,nd,rd,th} + Mon dd yyyy + yyyy/mm/dd + yyyy-mm-dd (usually the best date specification syntax) + yyyy/mm + mm/dd/yy + mm/dd/yyyy + mm/yy + yy/mm (only if year > 12, or > 31 if UK) + yy/mm/dd (only if year > 12 and day < 32, or year > 31 if UK) + dd/mm/yy (only if UK, or an invalid mm/dd/yy or yy/mm/dd) + dd/mm/yyyy (only if UK, or an invalid mm/dd/yyyy) + dd/mm (only if UK, or an invalid mm/dd) + +=head2 Relative date formats: + + count "days" + count "weeks" + count "months" + count "years" + Dow "after next" + Dow "before last" + Dow (requires PREFER_PAST or PREFER_FUTURE) + "next" Dow + "tomorrow" + "today" + "yesterday" + "last" dow + "last week" + "now" + "now" "+" count units + "now" "-" count units + "+" count units + "-" count units + count units "ago" + +=head2 Absolute time formats: + + hh:mm:ss[.ddd] + hh:mm + hh:mm[AP]M + hh[AP]M + hhmmss[[AP]M] + "noon" + "midnight" + +=head2 Relative time formats: + + count "minutes" (count can be franctional "1.5" or "1 1/2") + count "seconds" + count "hours" + "+" count units + "+" count + "-" count units + "-" count + count units "ago" + +=head2 Timezone formats: + + [+-]dddd + GMT[+-]d+ + [+-]dddd (TZN) + TZN + +=head2 Special formats: + + [ d]d/Mon/yyyy:hh:mm:ss [[+-]dddd] + yy/mm/dd.hh:mm + +=head1 DESCRIPTION + +This module recognizes the above date/time formats. Usually a +date and a time are specified. There are numerous options for +controlling what is recognized and what is not. + +The return code is always the time in seconds since January 1st, 1970 +or undef if it was unable to parse the time. + +If a timezone is specified it must be after the time. Year specifications +can be tacked onto the end of absolute times. + +If C is called from array context, then it will return two +elements. On successful parses, it will return the seconds and what +remains of its input string. On unsuccessful parses, it will return +C and an error string. + +=head1 EXAMPLES + + $seconds = parsedate("Mon Jan 2 04:24:27 1995"); + $seconds = parsedate("Tue Apr 4 00:22:12 PDT 1995"); + $seconds = parsedate("04.04.95 00:22", ZONE => PDT); + $seconds = parsedate("Jan 1 1999 11:23:34.578", SUBSECOND => 1); + $seconds = parsedate("122212 950404", ZONE => PDT, TIMEFIRST => 1); + $seconds = parsedate("+3 secs", NOW => 796978800); + $seconds = parsedate("2 months", NOW => 796720932); + $seconds = parsedate("last Tuesday"); + $seconds = parsedate("Sunday before last"); + + ($seconds, $remaining) = parsedate("today is the day"); + ($seconds, $error) = parsedate("today is", WHOLE=>1); + +=head1 LICENSE + +Copyright (C) 1996-2010 David Muir Sharnoff. +Copyright (C) 2011 Google, Inc. +License hereby +granted for anyone to use, modify or redistribute this module at +their own risk. Please feed useful changes back to cpan@dave.sharnoff.org. + diff --git a/fatlib/Time/Timezone.pm b/fatlib/Time/Timezone.pm new file mode 100644 index 0000000..8b55f66 --- /dev/null +++ b/fatlib/Time/Timezone.pm @@ -0,0 +1,329 @@ +package Time::Timezone; + +require 5.002; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name); +@EXPORT_OK = qw(); + +use Carp; +use strict; + +# Parts stolen from code by Paul Foley + +use vars qw($VERSION); + +$VERSION = 2006.0814; + +sub tz2zone +{ + my($TZ, $time, $isdst) = @_; + + use vars qw(%tzn_cache); + + $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '' + unless $TZ; + + # Hack to deal with 'PST8PDT' format of TZ + # Note that this can't deal with all the esoteric forms, but it + # does recognize the most common: [:]STDoff[DST[off][,rule]] + + if (! defined $isdst) { + my $j; + $time = time() unless $time; + ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time); + } + + if (defined $tzn_cache{$TZ}->[$isdst]) { + return $tzn_cache{$TZ}->[$isdst]; + } + + if ($TZ =~ /^ + ( [^:\d+\-,] {3,} ) + ( [+-] ? + \d {1,2} + ( : \d {1,2} ) {0,2} + ) + ( [^\d+\-,] {3,} )? + /x + ) { + $TZ = $isdst ? $4 : $1; + $tzn_cache{$TZ} = [ $1, $4 ]; + } else { + $tzn_cache{$TZ} = [ $TZ, $TZ ]; + } + return $TZ; +} + +sub tz_local_offset +{ + my ($time) = @_; + + $time = time() unless $time; + + return &calc_off($time); +} + +sub calc_off +{ + my ($time) = @_; + + my (@l) = localtime($time); + my (@g) = gmtime($time); + + my $off; + + $off = $l[0] - $g[0] + + ($l[1] - $g[1]) * 60 + + ($l[2] - $g[2]) * 3600; + + # subscript 7 is yday. + + if ($l[7] == $g[7]) { + # done + } elsif ($l[7] == $g[7] + 1) { + $off += 86400; + } elsif ($l[7] == $g[7] - 1) { + $off -= 86400; + } elsif ($l[7] < $g[7]) { + # crossed over a year boundary! + # localtime is beginning of year, gmt is end + # therefore local is ahead + $off += 86400; + } else { + $off -= 86400; + } + + return $off; +} + +# constants +# The rest of the file originally comes from Graham Barr +# +# Some references: +# http://www.weltzeituhr.com/laender/zeitzonen_e.shtml +# http://www.worldtimezone.com/wtz-names/timezonenames.html +# http://www.timegenie.com/timezones.php + +CONFIG: { + use vars qw(%dstZone %zoneOff %dstZoneOff %Zone); + + %dstZone = ( + "brst" => -2*3600, # Brazil Summer Time (East Daylight) + "adt" => -3*3600, # Atlantic Daylight + "edt" => -4*3600, # Eastern Daylight + "cdt" => -5*3600, # Central Daylight + "mdt" => -6*3600, # Mountain Daylight + "pdt" => -7*3600, # Pacific Daylight + "ydt" => -8*3600, # Yukon Daylight + "hdt" => -9*3600, # Hawaii Daylight + "bst" => +1*3600, # British Summer + "mest" => +2*3600, # Middle European Summer + "met dst" => +2*3600, # Middle European Summer + "sst" => +2*3600, # Swedish Summer + "fst" => +2*3600, # French Summer + "eest" => +3*3600, # Eastern European Summer + "cest" => +2*3600, # Central European Daylight + "wadt" => +8*3600, # West Australian Daylight + "kdt" => +10*3600, # Korean Daylight + # "cadt" => +10*3600+1800, # Central Australian Daylight + "eadt" => +11*3600, # Eastern Australian Daylight + "nzdt" => +13*3600, # New Zealand Daylight + ); + + # not included due to ambiguity: + # IST Indian Standard Time +5.5 + # Ireland Standard Time 0 + # Israel Standard Time +2 + # IDT Ireland Daylight Time +1 + # Israel Daylight Time +3 + # AMST Amazon Standard Time / -3 + # Armenia Standard Time +8 + # BST Brazil Standard -3 + + %Zone = ( + "gmt" => 0, # Greenwich Mean + "ut" => 0, # Universal (Coordinated) + "utc" => 0, + "wet" => 0, # Western European + "wat" => -1*3600, # West Africa + "azost" => -1*3600, # Azores Standard Time + "cvt" => -1*3600, # Cape Verde Time + "at" => -2*3600, # Azores + "fnt" => -2*3600, # Brazil Time (Extreme East - Fernando Noronha) + "ndt" => -2*3600-1800,# Newfoundland Daylight + "art" => -3*3600, # Argentina Time + # For completeness. BST is also British Summer, and GST is also Guam Standard. + # "gst" => -3*3600, # Greenland Standard + "nft" => -3*3600-1800,# Newfoundland + # "nst" => -3*3600-1800,# Newfoundland Standard + "mnt" => -4*3600, # Brazil Time (West Standard - Manaus) + "ewt" => -4*3600, # U.S. Eastern War Time + "ast" => -4*3600, # Atlantic Standard + "bot" => -4*3600, # Bolivia Time + "vet" => -4*3600, # Venezuela Time + "est" => -5*3600, # Eastern Standard + "cot" => -5*3600, # Colombia Time + "act" => -5*3600, # Brazil Time (Extreme West - Acre) + "pet" => -5*3600, # Peru Time + "cst" => -6*3600, # Central Standard + "cest" => +2*3600, # Central European Summer + "mst" => -7*3600, # Mountain Standard + "pst" => -8*3600, # Pacific Standard + "yst" => -9*3600, # Yukon Standard + "hst" => -10*3600, # Hawaii Standard + "cat" => -10*3600, # Central Alaska + "ahst" => -10*3600, # Alaska-Hawaii Standard + "taht" => -10*3600, # Tahiti Time + "nt" => -11*3600, # Nome + "idlw" => -12*3600, # International Date Line West + "cet" => +1*3600, # Central European + "mez" => +1*3600, # Central European (German) + "met" => +1*3600, # Middle European + "mewt" => +1*3600, # Middle European Winter + "swt" => +1*3600, # Swedish Winter + "set" => +1*3600, # Seychelles + "fwt" => +1*3600, # French Winter + "west" => +1*3600, # Western Europe Summer Time + "eet" => +2*3600, # Eastern Europe, USSR Zone 1 + "ukr" => +2*3600, # Ukraine + "sast" => +2*3600, # South Africa Standard Time + "bt" => +3*3600, # Baghdad, USSR Zone 2 + "eat" => +3*3600, # East Africa Time + # "it" => +3*3600+1800,# Iran + "irst" => +3*3600+1800,# Iran Standard Time + "zp4" => +4*3600, # USSR Zone 3 + "msd" => +4*3600, # Moscow Daylight Time + "sct" => +4*3600, # Seychelles Time + "zp5" => +5*3600, # USSR Zone 4 + "azst" => +5*3600, # Azerbaijan Summer Time + "mvt" => +5*3600, # Maldives Time + "uzt" => +5*3600, # Uzbekistan Time + "ist" => +5*3600+1800,# Indian Standard + "zp6" => +6*3600, # USSR Zone 5 + "lkt" => +6*3600, # Sri Lanka Time + "pkst" => +6*3600, # Pakistan Summer Time + "yekst" => +6*3600, # Yekaterinburg Summer Time + # For completeness. NST is also Newfoundland Stanard, and SST is also Swedish Summer. + # "nst" => +6*3600+1800,# North Sumatra + # "sst" => +7*3600, # South Sumatra, USSR Zone 6 + "wast" => +7*3600, # West Australian Standard + "ict" => +7*3600, # Indochina Time + "wit" => +7*3600, # Western Indonesia Time + # "jt" => +7*3600+1800,# Java (3pm in Cronusland!) + "cct" => +8*3600, # China Coast, USSR Zone 7 + "wst" => +8*3600, # West Australian Standard + "hkt" => +8*3600, # Hong Kong + "bnt" => +8*3600, # Brunei Darussalam Time + "cit" => +8*3600, # Central Indonesia Time + "myt" => +8*3600, # Malaysia Time + "pht" => +8*3600, # Philippines Time + "sgt" => +8*3600, # Singapore Time + "jst" => +9*3600, # Japan Standard, USSR Zone 8 + "kst" => +9*3600, # Korean Standard + # "cast" => +9*3600+1800,# Central Australian Standard + "east" => +10*3600, # Eastern Australian Standard + "gst" => +10*3600, # Guam Standard, USSR Zone 9 + "nct" => +11*3600, # New Caledonia Time + "nzt" => +12*3600, # New Zealand + "nzst" => +12*3600, # New Zealand Standard + "fjt" => +12*3600, # Fiji Time + "idle" => +12*3600, # International Date Line East + ); + + %zoneOff = reverse(%Zone); + %dstZoneOff = reverse(%dstZone); + + # Preferences + + $zoneOff{0} = 'gmt'; + $dstZoneOff{3600} = 'bst'; + +} + +sub tz_offset +{ + my ($zone, $time) = @_; + + return &tz_local_offset() unless($zone); + + $time = time() unless $time; + my(@l) = localtime($time); + my $dst = $l[8]; + + $zone = lc $zone; + + if ($zone =~ /^([\-\+]\d{3,4})$/) { + my $sign = $1 < 0 ? -1 : 1 ; + my $v = abs(0 + $1); + return $sign * 60 * (int($v / 100) * 60 + ($v % 100)); + } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) { + return $dstZone{$zone}; + } elsif(exists $Zone{$zone}) { + return $Zone{$zone}; + } + undef; +} + +sub tz_name +{ + my ($off, $time) = @_; + + $time = time() unless $time; + my(@l) = localtime($time); + my $dst = $l[8]; + + if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) { + return $dstZoneOff{$off}; + } elsif (exists $zoneOff{$off}) { + return $zoneOff{$off}; + } + sprintf("%+05d", int($off / 60) * 100 + $off % 60); +} + +1; + +__END__ + +=head1 NAME + +Time::Timezone -- miscellaneous timezone manipulations routines + +=head1 SYNOPSIS + + use Time::Timezone; + print tz2zone(); + print tz2zone($ENV{'TZ'}); + print tz2zone($ENV{'TZ'}, time()); + print tz2zone($ENV{'TZ'}, undef, $isdst); + $offset = tz_local_offset(); + $offset = tz_offset($TZ); + +=head1 DESCRIPTION + +This is a collection of miscellaneous timezone manipulation routines. + +C parses the TZ environment variable and returns a timezone +string suitable for inclusion in L-like output. It optionally takes +a timezone string, a time, and a is-dst flag. + +C determines the offset from GMT time in seconds. It +only does the calculation once. + +C determines the offset from GMT in seconds of a specified +timezone. + +C determines the name of the timezone based on its offset + +=head1 AUTHORS + +Graham Barr +David Muir Sharnoff +Paul Foley + +=head1 LICENSE + +David Muir Sharnoff disclaims any copyright and puts his contribution +to this module in the public domain. + diff --git a/recs b/recs index 83798d8..2202099 100755 --- a/recs +++ b/recs @@ -2090,6 +2090,38 @@ $fatpacked{"App/RecordStream/Operation/normalizetime.pm"} = '#line '.(1+__LINE__ USAGE APP_RECORDSTREAM_OPERATION_NORMALIZETIME +$fatpacked{"App/RecordStream/Operation/parsedate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RECORDSTREAM_OPERATION_PARSEDATE'; + use strict;use warnings;package App::RecordStream::Operation::parsedate;use base qw(App::RecordStream::Operation);use App::RecordStream::KeyGroups;use Time::ParseDate qw;use POSIX qw;sub init {my$this=shift;my$args=shift;$this->{'KEYS'}=App::RecordStream::KeyGroups->new;$this->{'INPUT_TIMEZONE'}=$ENV{TZ};$this->{'OUTPUT_TIMEZONE'}=$ENV{TZ};$this->{'NOW'}=time;my$options={'key|k=s'=>sub {$this->{'KEYS'}->add_groups($_[1])},'format|f=s'=>\($this->{'FORMAT'}),'iso|iso8601'=>sub {$this->{'FORMAT'}='%FT%T%z'},'epoch'=>sub {$this->{'FORMAT'}='%s'},'pretty'=>sub {$this->{'FORMAT'}='%c'},'dmy'=>\($this->{'UK'}),'past'=>\($this->{'PAST'}),'future'=>\($this->{'FUTURE'}),'relative!'=>\($this->{'RELATIVE'}),'now=i'=>\($this->{'NOW'}),'from-tz=s'=>\($this->{'INPUT_TIMEZONE'}),'to-tz=s'=>\($this->{'OUTPUT_TIMEZONE'}),'tz=s'=>sub {$this->{'OUTPUT_TIMEZONE'}=$this->{'INPUT_TIMEZONE'}=$_[1]},};$this->parse_options($args,$options);die "--key is required\n" unless$this->{'KEYS'}->has_any_group;die "--format (or one of --iso, --epoch, or --pretty) is required\n" unless defined$this->{'FORMAT'}}sub accept_record {my$this=shift;my$record=shift;my@values=map {$record->guess_key_from_spec($_)}@{$this->{'KEYS'}->get_keyspecs_for_record($record)};for my$date (@values){my$epoch=$this->parse_date($$date);$$date=$this->format_epoch($epoch)}$this->push_record($record);return 1}sub parse_date {my ($this,$date)=@_;my ($epoch,$status)=$this->with_tz($this->{'INPUT_TIMEZONE'},sub {parsedate($date,WHOLE=>1,VALIDATE=>1,PREFER_PAST=>$this->{'PAST'},PREFER_FUTURE=>$this->{'FUTURE'},NO_RELATIVE=>!$this->{'RELATIVE'},UK=>$this->{'UK'},NOW=>$this->{'NOW'},)});warn "Unable to parse '$date': $status\n" unless defined$epoch;return$epoch}sub format_epoch {my ($this,$epoch)=@_;my$formatted;return undef unless defined$epoch;return scalar$this->with_tz($this->{'OUTPUT_TIMEZONE'},sub {strftime($this->{'FORMAT'},localtime$epoch)})}sub with_tz {my ($this,$tz,$code)=@_;my@return;{local$ENV{TZ}=$tz;tzset();@return=$code->()}tzset();return wantarray ? @return : $return[0]}sub add_help_types {my$this=shift;$this->use_help_type('keyspecs');$this->use_help_type('keygroups');$this->use_help_type('keys')}sub usage {my$this=shift;my$options=[['key|-k ','Datetime keys to parse and reformat; may be a key spec or key group. Required.'],['format|-f ','Format string for strftime(3). Required.'],['iso|--iso8601','Output datetimes as an ISO 8601 timestamp (equivalent to -f %FT%T%z)'],['epoch','Output datetimes as the number of seconds since the epoch (equivalent to -f %s)'],['pretty','Output datetimes in the locale-preferred format (equivalent to -f %c)'],['dmy','Assume dd/mm (UK-style) instead of mm/dd (US-style)'],['past','Assume ambiguous years and days of the week are in the past'],['future','Assume ambiguous years and days of the week are in the future'],['relative','Try to parse relative dates and times (e.g. 1 hour ago)'],['now ','Set the "current time" for relative datetimes, as seconds since the epoch (rarely needed)'],['from-tz ','Assume ambiguous datetimes are in the given timezone (defaults to the local TZ)'],['to-tz ','Convert datetimes to the given timezone for output (defaults to the local TZ)'],['tz ','Set both --from-tz and --to-tz to the same timezone at once'],];my$args_string=$this->options_string($options);return < -f [] [] + __FORMAT_TEXT__ + Parses the values of the specified keys and reformats them according to the + specified strftime(3) format string. Partial dates and times may be parsed. A + full list of formats parsed is provided in the documentation for + Time::ParseDate [1]. + + Times without a timezone are parsed in the current TZ, unless otherwise + specified by --from-tz. Times are output in the current TZ, unless + otherwise specified by --to-tz. + + Values that cannot be parsed will be set to undef/null. + + If using --relative, you probably also want to specify --past or --future, + otherwise your ambiguous datetimes (e.g. "Friday") won't be parsed. + + [1] https://metacpan.org/pod/Time::ParseDate#DATE-FORMATS-RECOGNIZED + __FORMAT_TEXT__ + + Arguments: + $args_string + + Examples: + Normalize dates from a variety of formats to YYYY-MM-DD in UTC: + ... | recs parsedate -k when -f "%Y-%m-%d" --to-tz UTC + Convert timestamps in UTC to local time in an ISO 8601 format: + ... | recs parsedate -k timestamp --from-tz UTC --iso8601 + USAGE +APP_RECORDSTREAM_OPERATION_PARSEDATE + $fatpacked{"App/RecordStream/Operation/sort.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RECORDSTREAM_OPERATION_SORT'; package App::RecordStream::Operation::sort;our$VERSION="4.0.24";use strict;use warnings;use base qw(App::RecordStream::Accumulator App::RecordStream::Operation);sub init {my$this=shift;my$args=shift;my@keys;my$reverse;my$spec={"key|k=s"=>sub {push@keys,split(/,/,$_[1])},"reverse|r"=>\$reverse,};$this->parse_options($args,$spec);$this->{'KEYS'}=\@keys;$this->{'REVERSE'}=$reverse}sub stream_done {my$this=shift;my@records=App::RecordStream::Record::sort($this->get_records(),@{$this->{'KEYS'}});if ($this->{'REVERSE'}){@records=reverse@records}for my$record (@records){$this->push_record($record)}}sub add_help_types {my$this=shift;$this->use_help_type('keyspecs')}sub usage {my$this=shift;my$options=[['key ',"May be comma separated, May be specified multiple times. Each keyspec is a name or a name=sortType. The name should be a field name to sort on. The sort type should be either lexical or numeric. Default sort type is lexical (can also use nat, lex, n, and l). Additionallly, the sort type may be prefixed with '-' to indicate a decreasing sort order. Additionally, the sort type may be postfixed with '*' to sort the special value 'ALL' to the end (useful for the output of recs-collate --cube). See perldoc for App::RecordStream::Record for more on sort specs. May be a key spec, see '--help-keyspecs' for more. Cannot be a keygroup."],['reverse','Reverses the sort order'],];my$args_string=$this->options_string($options);return < [] @@ -2663,7 +2695,7 @@ $fatpacked{"App/RecordStream/Test/LastHelper.pm"} = '#line '.(1+__LINE__).' "'._ APP_RECORDSTREAM_TEST_LASTHELPER $fatpacked{"App/RecordStream/Test/OperationHelper.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RECORDSTREAM_TEST_OPERATIONHELPER'; - package App::RecordStream::Test::OperationHelper;our$VERSION="4.0.24";use strict;use warnings;use Test::More;use App::RecordStream::InputStream;use App::RecordStream::OutputStream;use Carp qw(croak);sub import {my$class=shift;require App::RecordStream::OptionalRequire;local$App::RecordStream::OptionalRequire::PRINT_WARNING=0;for my$op (@_){croak "invalid package name: '$op'" unless$op =~ /^[a-z0-9_]+$/;if (not eval "require App::RecordStream::Operation::$op; 1;"){if ($@ =~ /Please install missing modules/){plan skip_all=>"Missing deps for operation $op"}else {die $@}}}}sub new {my$class=shift;my%args=@_;my$this={INPUT=>create_stream($args{'input'}),OUTPUT=>create_stream($args{'output'}),OPERATION=>$args{'operation'},KEEPER=>$args{'keeper'},};bless$this,$class;return$this}sub create_stream {my$input=shift;return undef unless ($input);return$input if (ref($input)eq 'ARRAY');if (UNIVERSAL::isa($input,'App::RecordStream::InputStream')){return$input}if ((not ($input =~ m/\n/m))&& -e $input){return App::RecordStream::InputStream->new(FILE=>$input)}return App::RecordStream::InputStream->new(STRING=>$input)}sub matches {my$this=shift;my$name=shift || 'unnamed';my$op=$this->{'OPERATION'};my$input=$this->{'INPUT'};if ($op->wants_input()&& $input){if (ref($input)eq 'ARRAY'){my ($t,@v)=@$input;if ($t eq 'LINES'){for my$l (@v){if (!$op->accept_line($l)){last}}}elsif ($t eq 'FILES'){local@ARGV=@v;while(my$l=<>){App::RecordStream::Operation::set_current_filename($ARGV);chomp$l;if (!$op->accept_line($l)){last}}}else {die}}else {App::RecordStream::Operation::set_current_filename($input->get_filename());while (my$r=$input->get_record()){if (!$op->accept_record($r)){last}}}}$op->finish();my$output=$this->{'OUTPUT'};my$results=$this->{'KEEPER'}->get_records();my$i=0;my@output_records;if ($output){while (my$record=$output->get_record()){push@output_records,$record}}my ($level_to_testfile,$file)=(0,(caller(0))[1]);while (defined$file and $file !~ /\.t$/){$level_to_testfile++;$file=(caller($level_to_testfile))[1]}local$Test::Builder::Level=$Test::Builder::Level + $level_to_testfile + 1;my$is_ok=1;for my$record (@$results){$is_ok=0 if (!ok(UNIVERSAL::isa($record,'App::RecordStream::Record'),"Record is a App::RecordStream::Record"))}$is_ok=0 if (!is_deeply($results,\@output_records,"Records match: $name"));$is_ok=0 if (!ok($this->{'KEEPER'}->has_called_finish(),"Has called finish: $name"));if (!$is_ok){warn "Expected and output differed!\nExpected:\n";for my$record (@output_records){print STDERR App::RecordStream::OutputStream::hashref_string($record)."\n"}warn "Output from module:\n";for my$record (@$results){print STDERR App::RecordStream::OutputStream::hashref_string($record)."\n"}}return$is_ok}sub do_match {my$class=shift;my$operation_name=shift;my$args=shift;my$input=shift;my$output=shift;my$operation_class="App::RecordStream::Operation::$operation_name";my$keeper=App::RecordStream::Test::OperationHelper::Keeper->new();my$op=$operation_class->new($args,$keeper);if ($op->wants_input()&& @$args){if ($input){fail("Both extra args [" .join(", ",@$args)."] and input provided?")}else {$input=['FILES',@$args]}}ok($op,"Operation initialization");my$helper=$class->new(operation=>$op,keeper=>$keeper,input=>$input,output=>$output,);$helper->matches();return$helper}sub test_output {my$class=shift;my$operation_name=shift;my$args=shift;my$input=shift;my$output=shift;my$operation_class="App::RecordStream::Operation::$operation_name";my$keeper=App::RecordStream::Test::OperationHelper::Keeper->new();my$op=$operation_class->new($args,$keeper);ok($op,"Object initialization");my$helper=__PACKAGE__->new(operation=>$op,keeper=>$keeper,input=>$input,output=>'',);$helper->matches();is(join ('',map {"$_\n"}@{$keeper->get_lines()}),$output,"Output matches expected")}package App::RecordStream::Test::OperationHelper::Keeper;use base qw(App::RecordStream::Stream::Base);sub new {my$class=shift;my$this={RECORDS=>[],LINES=>[]};bless$this,$class;return$this}sub accept_record {my$this=shift;my$record=shift;push @{$this->{'RECORDS'}},$record;return 1}sub get_records {my$this=shift;return$this->{'RECORDS'}}sub accept_line {my$this=shift;my$line=shift;push @{$this->{'LINES'}},$line;return 1}sub get_lines {my$this=shift;return$this->{'LINES'}}sub has_called_finish {my$this=shift;return$this->{'CALLED_FINISH'}}sub finish {my$this=shift;$this->{'CALLED_FINISH'}=1}1; + package App::RecordStream::Test::OperationHelper;our$VERSION="4.0.24";use strict;use warnings;use Test::More;use App::RecordStream::InputStream;use App::RecordStream::OutputStream;use Carp qw(croak);sub import {my$class=shift;require App::RecordStream::OptionalRequire;local$App::RecordStream::OptionalRequire::PRINT_WARNING=0;for my$op (@_){croak "invalid package name: '$op'" unless$op =~ /^[a-z0-9_]+$/;if (not eval "require App::RecordStream::Operation::$op; 1;"){if ($@ =~ /Please install missing modules/){plan skip_all=>"Missing deps for operation $op"}else {die $@}}}}sub new {my$class=shift;my%args=@_;my$this={INPUT=>create_stream($args{'input'}),OUTPUT=>create_stream($args{'output'}),OPERATION=>$args{'operation'},KEEPER=>$args{'keeper'},};bless$this,$class;return$this}sub create_stream {my$input=shift;return undef unless ($input);return$input if (ref($input)eq 'ARRAY');if (UNIVERSAL::isa($input,'App::RecordStream::InputStream')){return$input}if ((not ($input =~ m/\n/m))&& -e $input){return App::RecordStream::InputStream->new(FILE=>$input)}return App::RecordStream::InputStream->new(STRING=>$input)}sub matches {my$this=shift;my$name=shift || 'unnamed';my$op=$this->{'OPERATION'};my$input=$this->{'INPUT'};if ($op->wants_input()&& $input){if (ref($input)eq 'ARRAY'){my ($t,@v)=@$input;if ($t eq 'LINES'){for my$l (@v){if (!$op->accept_line($l)){last}}}elsif ($t eq 'FILES'){local@ARGV=@v;while(my$l=<>){App::RecordStream::Operation::set_current_filename($ARGV);chomp$l;if (!$op->accept_line($l)){last}}}else {die}}else {App::RecordStream::Operation::set_current_filename($input->get_filename());while (my$r=$input->get_record()){if (!$op->accept_record($r)){last}}}}$op->finish();my$output=$this->{'OUTPUT'};my$results=$this->{'KEEPER'}->get_records();my$i=0;my@output_records;if ($output){while (my$record=$output->get_record()){push@output_records,$record}}my ($level_to_testfile,$file)=(0,(caller(0))[1]);while (defined$file and $file !~ /\.t$/){$level_to_testfile++;$file=(caller($level_to_testfile))[1]}local$Test::Builder::Level=$Test::Builder::Level + $level_to_testfile + 1;my$is_ok=1;for my$record (@$results){$is_ok=0 if (!ok(UNIVERSAL::isa($record,'App::RecordStream::Record'),"Record is a App::RecordStream::Record"))}$is_ok=0 if (!is_deeply($results,\@output_records,"Records match: $name"));$is_ok=0 if (!ok($this->{'KEEPER'}->has_called_finish(),"Has called finish: $name"));if (!$is_ok){warn "Expected and output differed!\nExpected:\n";for my$record (@output_records){print STDERR App::RecordStream::OutputStream::hashref_string($record)."\n"}warn "Output from module:\n";for my$record (@$results){print STDERR App::RecordStream::OutputStream::hashref_string($record)."\n"}}return$is_ok}sub do_match {my$class=shift;my$operation_name=shift;my$args=shift;my$input=shift;my$output=shift;my$test_name=shift;my$operation_class="App::RecordStream::Operation::$operation_name";my$keeper=App::RecordStream::Test::OperationHelper::Keeper->new();my$op=$operation_class->new($args,$keeper);if ($op->wants_input()&& @$args){if ($input){fail("Both extra args [" .join(", ",@$args)."] and input provided?")}else {$input=['FILES',@$args]}}ok($op,"Operation initialization");my$helper=$class->new(operation=>$op,keeper=>$keeper,input=>$input,output=>$output,);$helper->matches($test_name);return$helper}sub test_output {my$class=shift;my$operation_name=shift;my$args=shift;my$input=shift;my$output=shift;my$operation_class="App::RecordStream::Operation::$operation_name";my$keeper=App::RecordStream::Test::OperationHelper::Keeper->new();my$op=$operation_class->new($args,$keeper);ok($op,"Object initialization");my$helper=__PACKAGE__->new(operation=>$op,keeper=>$keeper,input=>$input,output=>'',);$helper->matches();is(join ('',map {"$_\n"}@{$keeper->get_lines()}),$output,"Output matches expected")}package App::RecordStream::Test::OperationHelper::Keeper;use base qw(App::RecordStream::Stream::Base);sub new {my$class=shift;my$this={RECORDS=>[],LINES=>[]};bless$this,$class;return$this}sub accept_record {my$this=shift;my$record=shift;push @{$this->{'RECORDS'}},$record;return 1}sub get_records {my$this=shift;return$this->{'RECORDS'}}sub accept_line {my$this=shift;my$line=shift;push @{$this->{'LINES'}},$line;return 1}sub get_lines {my$this=shift;return$this->{'LINES'}}sub has_called_finish {my$this=shift;return$this->{'CALLED_FINISH'}}sub finish {my$this=shift;$this->{'CALLED_FINISH'}=1}1; APP_RECORDSTREAM_TEST_OPERATIONHELPER $fatpacked{"App/RecordStream/Test/Tester.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'APP_RECORDSTREAM_TEST_TESTER'; @@ -6601,6 +6633,252 @@ $fatpacked{"Text/Reform.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TEX package Text::Reform;use strict;use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);use Carp;use 5.005;$VERSION='1.20';require Exporter;@ISA=qw(Exporter);@EXPORT=qw(form);@EXPORT_OK=qw(columns tag break_with break_at break_wrap break_TeX debug);my@bspecials=qw([ | ]);my@lspecials=qw(< ^ >);my$ljustified='[<]{2,}[>]{2,}';my$bjustified='[[]{2,}[]]{2,}';my$bsingle='~+';my@specials=(@bspecials,@lspecials);my$fixed_fieldpat=join('|',($ljustified,$bjustified,$bsingle,map {"\\$_\{2,}"}@specials));my ($lfieldmark,$bfieldmark,$fieldmark,$fieldpat,$decimal);my$emptyref='';sub import {$decimal='.';my$lnumerical='[>]+(?:'.quotemeta($decimal).'[<]{1,})';my$bnumerical='[]]+(?:'.quotemeta($decimal).'[[]{1,})';$fieldpat=join('|',($lnumerical,$bnumerical,$fixed_fieldpat));$lfieldmark=join '|',($lnumerical,$ljustified,map {"\\$_\{2}"}@lspecials);$bfieldmark=join '|',($bnumerical,$bjustified,$bsingle,map {"\\$_\{2}"}@bspecials);$fieldmark=join '|',($lnumerical,$bnumerical,$bsingle,$ljustified,$bjustified,$lfieldmark,$bfieldmark);Text::Reform->export_to_level(1,@_)}sub carpfirst {use vars '%carped';my ($msg)=@_;return if$carped{$msg}++;carp$msg}sub BAD_CONFIG {'Configuration hash not allowed between format and data'}sub break_with {my$hyphen=$_[0];my$hylen=length($hyphen);my@ret;sub {if ($_[2]<=$hylen){@ret=(substr($_[0],0,1),substr($_[0],1))}else {@ret=(substr($_[0],0,$_[1]-$hylen),substr($_[0],$_[1]-$hylen))}if ($ret[0]=~ /\A\s*\Z/){return ("",$_[0])}else {return ($ret[0].$hyphen,$ret[1])}}}sub break_at {my ($hyphen,$opts_ref)=@_;my$hylen=length($hyphen);my$except=$opts_ref->{except};my@ret;sub {my$max=$_[2]-$hylen;if ($max <= 0){@ret=(substr($_[0],0,1),substr($_[0],1))}elsif (defined$except && $_[0]=~ m/\A (.{1,$max}) ($except .*)/xms){@ret=($1,$2)}elsif (defined$except && $_[0]=~ m/\A ($except) (.*)/xms){@ret=($1,$2)}elsif ($_[0]=~ /\A (.{1,$max}$hyphen) (.*)/xms){@ret=($1,$2)}elsif (length($_[0])>$_[2]){@ret=(substr($_[0],0,$_[1]-$hylen).$hyphen,substr($_[0],$_[1]-$hylen))}else {@ret=("",$_[0])}if ($ret[0]=~ /\A\s*\Z/){return ("",$_[0])}else {return@ret}}}sub break_wrap {return \&break_wrap unless @_;my ($text,$reqlen,$fldlen)=@_;if ($reqlen==$fldlen){$text =~ m/\A(\s*\S*)(.*)/s}else {("",$text)}}my%hyp;sub break_TeX {my$file=$_[0]|| "";croak "Can't find TeX::Hyphen module" unless require "TeX/Hyphen.pm";$hyp{$file}=TeX::Hyphen->new($file||undef)|| croak "Can't open hyphenation file $file" unless$hyp{$file};return sub {for (reverse$hyp{$file}->hyphenate($_[0])){if ($_ < $_[1]){return (substr($_[0],0,$_).'-',substr($_[0],$_))}}return ("",$_[0])}}my$debug=0;sub _debug {print STDERR @_,"\n" if$debug}sub debug {$debug=1}sub notempty {my$ne=${$_[0]}=~ /\S/;_debug("\tnotempty('${$_[0]}') = $ne\n");return$ne}sub strtod1 {my$n=shift;my$real_re='((?:[+-]?)(?:(?=[0123456789]|[.])(?:[0123456789]*)(?:(?:[.])(?:[0123456789]{0,}))?)'.'(?:(?:[eE])(?:(?:[+-]?)(?:[0123456789]+))|))';if ($n=~/^\s*$real_re(.*)$/os){return ($1,length($2 || ''))}else {return (undef,length($n))}}sub replace($$$$) {my$ref=$_[2];my$text='';my$rem=$_[1];my$config=$_[3];my$filled=0;if ($config->{fill}){$$ref =~ s/\A\s*//}else {$$ref =~ s/\A[ \t]*//}my$fmtnum=length $_[0];if ($$ref =~ /\S/ && $fmtnum>2){NUMERICAL:{my ($ilen,$dlen)=map {length}$_[0]=~ m/([]>]+)\Q$decimal\E([[<]+)/;my ($num,$unconsumed)=strtod1($$ref);if ($unconsumed==length $$ref){$$ref =~ s/\s*\S*//;redo NUMERICAL if$config->{numeric}=~ m/\bSkipNaN\b/i && $$ref =~ m/\S/;$text='?' x $ilen .$decimal .'?' x $dlen;$rem=0;return$text}my$formatted=sprintf "%$fmtnum.${dlen}f",$num;$text=(length$formatted > $fmtnum)? '#' x $ilen .$decimal .'#' x $dlen : $formatted;$text =~ s/(\Q$decimal\E\d+?)(0+)$/$1 . " " x length $2/e unless$config->{numeric}=~ m/\bAllPlaces\b/i || $num =~ /\Q$decimal\E\d\d{$dlen,}$/;if ($unconsumed){if ($unconsumed==length $$ref){$$ref =~ s/\A.[^0-9.+-]*//}else {substr($$ref,0,-$unconsumed)=""}}else {$$ref=""}$rem=0}}else {while ($$ref =~ /\S/){if (!$config->{fill}&& $$ref=~s/\A[ \t]*\n//){$filled=2;last}last unless $$ref =~ /\A(\s*)(\S+)(.*)\z/s;my ($ws,$word,$extra)=($1,$2,$3);my$nonnl=$ws =~ /[^\n]/;$ws =~ s/\n/$nonnl? "" : " "/ge if$config->{fill};my$lead=($config->{squeeze}? ($ws ? " " : ""): $ws);my$match=$lead .$word;_debug "Extracted [$match]";last if$text && $match =~ /\n/;my$len1=length($match);if ($len1 <= $rem){_debug "Accepted [$match]";$text .= $match;$rem -= $len1;$$ref=$extra}else {_debug "Need to break [$match]";if ($rem-length($lead)>$config->{minbreak}){_debug "Trying to break '$match'";my ($broken,$left)=$config->{break}->($match,$rem,$_[1]);$text .= $broken;_debug "Broke as: [$broken][$left]";$$ref=$left.$extra;$rem -= length$broken}last}}continue {$filled=1}}if (!$filled && $rem>0 && $$ref=~/\S/ && length$text==0){$$ref =~ s/^\s*(.{1,$rem})//;$text=$1;$rem -= length$text}if ($text=~/ / && $_[0]eq 'J' && $$ref=~/\S/ && $filled!=2){$text=reverse$text;$text =~ s/( +)/($rem-->0?" ":"").$1/ge while$rem>0;$text=reverse$text}elsif ($_[0]=~ /\>|\]/){substr($text,0,0)=substr($config->{filler}{left}x $rem,-$rem)if$rem > 0}elsif ($_[0]=~ /\^|\|/){if ($rem>0){my$halfrem=int($rem/2);substr($text,0,0)=substr($config->{filler}{left}x$halfrem,-$halfrem);$halfrem=$rem-$halfrem;$text .= substr($config->{filler}{right}x$halfrem,0,$halfrem)}}else {$text .= substr($config->{filler}{right}x$rem,0,$rem)if$rem > 0}return$text}my%std_config=(header=>sub{""},footer=>sub{""},pagefeed=>sub{""},pagelen=>0,pagenum=>undef,pagewidth=>72,break=>break_with('-'),minbreak=>2,squeeze=>0,filler=>{left=>' ',right=>' '},interleave=>0,numeric=>"",_used=>1,);sub lcr {my ($data,$pagewidth,$header)=@_;$data->{width}||= $pagewidth;$data->{left}||= "";$data->{centre}||= $data->{center}||"";$data->{right}||= "";return sub {my@l=split "\n",(ref$data->{left}eq 'CODE' ? $data->{left}->(@_): $data->{left}),-1;my@c=split "\n",(ref$data->{centre}eq 'CODE' ? $data->{centre}->(@_): $data->{centre}),-1;my@r=split "\n",(ref$data->{right}eq 'CODE' ? $data->{right}->(@_): $data->{right}),-1;my$text="";while (@l||@c||@r){my$l=@l ? shift(@l): "";my$c=@c ? shift(@c): "";my$r=@r ? shift(@r): "";my$gap=int(($data->{width}-length($c))/2-length($l));if ($gap < 0){$gap=0;carpfirst "\nWarning: $header is wider than specified page width ($data->{width} chars)" if $^W}$text .= $l ." " x $gap .$c ." " x ($data->{width}-length($l)-length($c)-$gap-length($r)).$r ."\n"}return$text}}sub fix_config(\%) {my ($config)=@_;if (ref$config->{header}eq 'HASH'){$config->{header}=lcr$config->{header},$config->{pagewidth},'header'}elsif (ref$config->{header}eq 'CODE'){my$tmp=$config->{header};$config->{header}=sub {my$header=&$tmp;return (ref$header eq 'HASH')? lcr($header,$config->{pagewidth},'header')->(): $header}}else {my$tmp=$config->{header};$config->{header}=sub {$tmp}}if (ref$config->{footer}eq 'HASH'){$config->{footer}=lcr$config->{footer},$config->{pagewidth},'footer'}elsif (ref$config->{footer}eq 'CODE'){my$tmp=$config->{footer};$config->{footer}=sub {my$footer=&$tmp;return (ref$footer eq 'HASH')? lcr($footer,$config->{pagewidth},'footer')->(): $footer}}else {my$tmp=$config->{footer};$config->{footer}=sub {$tmp}}unless (ref$config->{pagefeed}eq 'CODE'){my$tmp=$config->{pagefeed};$config->{pagefeed}=sub {$tmp}}unless (ref$config->{break}eq 'CODE'){$config->{break}=break_at($config->{break})}if (defined$config->{pagenum}&& ref$config->{pagenum}ne 'SCALAR'){my$tmp=$config->{pagenum}+0;$config->{pagenum}=\$tmp}unless (ref$config->{filler}eq 'HASH'){$config->{filler}={left=>"$config->{filler}",right=>"$config->{filler}" }}}sub FormOpt::DESTROY {print STDERR "\nWarning: lexical &form configuration at $std_config{_line} was never used.\n" if $^W &&!$std_config{_used};%std_config=%{$std_config{_prev}}}sub form {use vars '%carped';local%carped;my$config={%std_config};my$startidx=0;if (@_ && ref($_[0])eq 'HASH'){if (@_ > 1){$config={%$config,%{$_[$startidx++]}};fix_config(%$config);$startidx=1}elsif (defined wantarray){$_[0]->{_prev}={%std_config };$_[0]->{_used}=0;$_[0]->{_line}=join " line ",(caller)[1..2];;%{$_[0]}=%std_config=(%std_config,%{$_[0]});fix_config(%std_config);return bless $_[0],'FormOpt'}else {$_[0]->{_used}=1;$_[0]->{_line}=join " line ",(caller)[1..2];;%std_config=(%std_config,%{$_[0]});fix_config(%std_config);return}}$config->{pagenum}=do{\(my$tmp=1)}unless defined$config->{pagenum};$std_config{_used}++;my@ref=map {ref}@_;my@orig=@_;my$caller=caller;no strict;for (my$nextarg=0;$nextarg<@_;$nextarg++){my$next=$_[$nextarg];if (!defined$next){my$tmp="";splice @_,$nextarg,1,\$tmp}elsif ($ref[$nextarg]eq 'ARRAY'){splice @_,$nextarg,1,\join("\n",@$next)}elsif ($ref[$nextarg]eq 'HASH' && $next->{cols}){croak "Missing 'from' data for 'cols' option" unless$next->{from};croak "Can't mix other options with 'cols' option" if keys %$next > 2;my ($cols,$data)=@{$next}{'cols','from'};croak "Invalid 'cols' option.\nExpected reference to array of column specifiers but found " .(ref($cols)||"'$cols'")unless ref$cols eq 'ARRAY';croak "Invalid 'from' data for 'cols' option.\nExpected reference to array of hashes or arrays but found " .(ref($data)||"'$data'")unless ref$data eq 'ARRAY';splice @_,$nextarg,2,columns(@$cols,@$data);splice@ref,$nextarg,2,('ARRAY')x@$cols;$nextarg--}elsif (!defined eval {local$SIG{__DIE__};$_[$nextarg]=$next;_debug "writeable: [$_[$nextarg]]";1}){_debug "unwriteable: [$_[$nextarg]]";my$arg=$_[$nextarg];splice @_,$nextarg,1,\$arg}elsif (!$ref[$nextarg]){splice @_,$nextarg,1,\$_[$nextarg]}elsif ($ref[$nextarg]ne 'HASH' and $ref[$nextarg]ne 'SCALAR'){splice @_,$nextarg,1,\"$next"}}my$header=$config->{header}->(${$config->{pagenum}});$header.="\n" if$header && substr($header,-1,1)ne "\n";my$footer=$config->{footer}->(${$config->{pagenum}});$footer.="\n" if$footer && substr($footer,-1,1)ne "\n";my$prevfooter=$footer;my$linecount=$header=~tr/\n/\n/ + $footer=~tr/\n/\n/;my$hfcount=$linecount;my$text=$header;my@format_stack;LINE: while ($startidx < @_ || @format_stack){if (($ref[$startidx]||'')eq 'HASH'){$config={%$config,%{$_[$startidx++]}};fix_config(%$config);next}unless (@format_stack){@format_stack=$config->{interleave}? map "$_\n",split /\n/,${$_[$startidx++]}||"" : ${$_[$startidx++]}||""}my$format=shift@format_stack;_debug("format: [$format]");my@parts=split /(\n|(?:\\.)+|$fieldpat)/,$format;push@parts,"\n" unless@parts && $parts[-1]eq "\n";my$fieldcount=0;my$filled=0;my$firstline=1;while (!$filled){my$nextarg=$startidx;my@data;for my$part (@parts){if ($part =~ /\A(?:\\.)+/){_debug("esc literal: [$part]");my$tmp=$part;$tmp =~ s/\\(.)/$1/g;$text .= $tmp}elsif ($part =~ /($lfieldmark)/){if ($firstline){$fieldcount++;if ($nextarg > $#_){push @_,\$emptyref;push@ref,''}my$type=$1;$type='J' if$part =~ /$ljustified/;croak BAD_CONFIG if ($ref[$startidx]eq 'HASH');_debug("once field: [$part]");_debug("data was: [${$_[$nextarg]}]");$text .= replace($type,length($part),$_[$nextarg],$config);_debug("data now: [${$_[$nextarg]}]")}else {$text .= substr($config->{filler}{left}x length($part),-length($part));_debug("missing once field: [$part]")}$nextarg++}elsif ($part =~ /($fieldmark)/ and substr($part,0,2)ne '~~'){$fieldcount++ if$firstline;if ($nextarg > $#_){push @_,\$emptyref;push@ref,''}my$type=$1;$type='J' if$part =~ /$bjustified/;croak BAD_CONFIG if ($ref[$startidx]eq 'HASH');_debug("multi field: [$part]");_debug("data was: [${$_[$nextarg]}]");$text .= replace($type,length($part),$_[$nextarg],$config);_debug("data now: [${$_[$nextarg]}]");push@data,$_[$nextarg];$nextarg++}else {_debug("literal: [$part]");my$tmp=$part;$tmp =~ s/\0(\0*)/$1/g;$text .= $tmp;if ($part eq "\n"){$linecount++;if ($config->{pagelen}&& $linecount>=$config->{pagelen}){_debug("\tejecting page: $config->{pagenum}");carpfirst "\nWarning: could not format page ${$config->{pagenum}} within specified page length" if $^W && $config->{pagelen}&& $linecount > $config->{pagelen};${$config->{pagenum}}++;my$pagefeed=$config->{pagefeed}->(${$config->{pagenum}});$header=$config->{header}->(${$config->{pagenum}});$header.="\n" if$header && substr($header,-1,1)ne "\n";$text .= $footer .$pagefeed .$header;$prevfooter=$footer;$footer=$config->{footer}->(${$config->{pagenum}});$footer.="\n" if$footer && substr($footer,-1,1)ne "\n";$linecount=$hfcount=$header=~tr/\n/\n/ + $footer=~tr/\n/\n/;$header=$pagefeed .$header}}}_debug("\tnextarg now: $nextarg");_debug("\tstartidx now: $startidx")}$firstline=0;$filled=!grep {notempty $_}@data}$startidx += $fieldcount}if ($hfcount && $linecount==$hfcount){$text =~ s/\Q$header\E\Z//}elsif ($linecount && $config->{pagelen}){$text .= "\n" x ($config->{pagelen}-$linecount).$footer;$prevfooter=$footer}if ($prevfooter){my$lastfooter=$config->{footer}->(${$config->{pagenum}},1);$lastfooter.="\n" if$lastfooter && substr($lastfooter,-1,1)ne "\n";my$footerdiff=($lastfooter =~ tr/\n/\n/)- ($prevfooter =~ tr/\n/\n/);my$tail='^[^\S\n]*\n' x $footerdiff;if ($footerdiff > 0 && $text =~ /($tail\Q$prevfooter\E)\Z/m){$prevfooter=$1;$footerdiff=0}if ($footerdiff > 0){${$config->{pagenum}}++;my$lastheader=$config->{header}->(${$config->{pagenum}});$lastheader.="\n" if$lastheader && substr($lastheader,-1,1)ne "\n";$lastfooter=$config->{footer}->(${$config->{pagenum}},1);$lastfooter.="\n" if$lastfooter && substr($lastfooter,-1,1)ne "\n";$text .= $lastheader .("\n" x ($config->{pagelen}- ($lastheader =~ tr/\n/\n/)- ($lastfooter =~ tr/\n/\n/))).$lastfooter}else {$lastfooter=("\n"x-$footerdiff).$lastfooter;substr($text,-length($prevfooter))=$lastfooter}}for my$i (0..$#orig){if ($ref[$i]eq 'ARRAY'){eval {@{$orig[$i]}=map "$_\n",split /\n/,${$_[$i]}}}elsif (!$ref[$i]){eval {_debug("restoring $i (".$_[$i].") to " .defined($orig[$i])? $orig[$i]: "");${$_[$i]}=$orig[$i]}}}${$config->{pagenum}}++;$text =~ s/[ ]+$//gm if$config->{trim};return$text unless wantarray;return map "$_\n",split /\n/,$text}sub columns {my@cols;my (@fullres,@res);while (@_){my$arg=shift @_;my$type=ref$arg;if ($type eq 'HASH'){push @{$res[$_]},$arg->{$cols[$_]}for 0..$#cols}elsif ($type eq 'ARRAY'){push @{$res[$_]},$arg->[$cols[$_]]for 0..$#cols}else {if (@res){push@fullres,@res;@res=@cols=()}push@cols,$arg}}return@fullres,@res}sub invert($) {my$inversion=reverse $_[0];$inversion =~ tr/{[<(/}]>)/;return$inversion}sub tag {my ($tagleader,$tagindent,$ldelim,$tag,$tagargs,$tagtrailer)=($_[0]=~ /\A((?:[ \t]*\n)*)([ \t]*)(\W*)(\w+)(.*?)(\s*)\Z/);$ldelim='<' unless$ldelim;$tagtrailer =~ s/([ \t]*)\Z//;my$textindent=$1||"";my$rdelim=invert$ldelim;my$i;for ($i=-1;-1-$i < length$rdelim && -1-$i < length$tagargs;$i--){last unless substr($tagargs,$i,1)eq substr($rdelim,$i,1)}if ($i < -1){$i++;$tagargs=substr($tagargs,0,$i);$rdelim=substr($rdelim,$i)}my$endtag=$_[2]|| "$ldelim/$tag$rdelim";return "$tagleader$tagindent$ldelim$tag$tagargs$rdelim$tagtrailer".join("\n",map {"$tagindent$textindent$_"}split /\n/,$_[1])."$tagtrailer$tagindent$endtag$tagleader"}1; TEXT_REFORM +$fatpacked{"Time/CTime.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_CTIME'; + package Time::CTime;require 5.000;use Time::Timezone;use Time::CTime;require Exporter;@ISA=qw(Exporter);@EXPORT=qw(ctime asctime strftime);@EXPORT_OK=qw(asctime_n ctime_n @DoW @MoY @DayOfWeek @MonthOfYear);use strict;use vars qw(@DoW @DayOfWeek @MoY @MonthOfYear %strftime_conversion $VERSION);use vars qw($template $sec $min $hour $mday $mon $year $wday $yday $isdst);$VERSION=2011.0505;CONFIG: {@DoW=qw(Sun Mon Tue Wed Thu Fri Sat);@DayOfWeek=qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);@MoY=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);@MonthOfYear=qw(January February March April May June July August September October November December);%strftime_conversion=('%',sub {'%'},'a',sub {$DoW[$wday]},'A',sub {$DayOfWeek[$wday]},'b',sub {$MoY[$mon]},'B',sub {$MonthOfYear[$mon]},'c',sub {asctime_n($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,"")},'d',sub {sprintf("%02d",$mday)},'D',sub {sprintf("%02d/%02d/%02d",$mon+1,$mday,$year%100)},'e',sub {sprintf("%2d",$mday)},'f',sub {fracprintf ("%3.3f",$sec)},'F',sub {fracprintf ("%6.6f",$sec)},'h',sub {$MoY[$mon]},'H',sub {sprintf("%02d",$hour)},'I',sub {sprintf("%02d",$hour % 12 || 12)},'j',sub {sprintf("%03d",$yday + 1)},'k',sub {sprintf("%2d",$hour)},'l',sub {sprintf("%2d",$hour % 12 || 12)},'m',sub {sprintf("%02d",$mon+1)},'M',sub {sprintf("%02d",$min)},'n',sub {"\n"},'o',sub {sprintf("%d%s",$mday,(($mday < 20 && $mday > 3)? 'th' : ($mday%10==1 ? "st" : ($mday%10==2 ? "nd" : ($mday%10==3 ? "rd" : "th")))))},'p',sub {$hour > 11 ? "PM" : "AM"},'r',sub {sprintf("%02d:%02d:%02d %s",$hour % 12 || 12,$min,$sec,$hour > 11 ? 'PM' : 'AM')},'R',sub {sprintf("%02d:%02d",$hour,$min)},'S',sub {sprintf("%02d",$sec)},'t',sub {"\t"},'T',sub {sprintf("%02d:%02d:%02d",$hour,$min,$sec)},'U',sub {wkyr(0,$wday,$yday)},'v',sub {sprintf("%2d-%s-%4d",$mday,$MoY[$mon],$year+1900)},'w',sub {$wday},'W',sub {wkyr(1,$wday,$yday)},'y',sub {sprintf("%02d",$year%100)},'Y',sub {$year + 1900},'x',sub {sprintf("%02d/%02d/%02d",$mon + 1,$mday,$year%100)},'X',sub {sprintf("%02d:%02d:%02d",$hour,$min,$sec)},'Z',sub {&tz2zone(undef,undef,$isdst)})}sub fracprintf {my($t,$s)=@_;my($p)=sprintf($t,$s-int($s));$p=~s/^0+//;$p}sub asctime_n {my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$TZname)=@_;($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst,$TZname)=localtime($sec)unless defined$min;$year += 1900;$TZname .= ' ' if$TZname;sprintf("%s %s %2d %2d:%02d:%02d %s%4d",$DoW[$wday],$MoY[$mon],$mday,$hour,$min,$sec,$TZname,$year)}sub asctime {return asctime_n(@_)."\n"}sub wkyr {my($wstart,$wday,$yday)=@_;$wday=($wday + 7 - $wstart)% 7;return int(($yday - $wday + 13)/ 7 - 1)}sub ctime {my($time)=@_;asctime(localtime($time),&tz2zone(undef,$time))}sub ctime_n {my($time)=@_;asctime_n(localtime($time),&tz2zone(undef,$time))}sub strftime {local ($template,$sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=@_;undef $@;$template =~ s/%([%aAbBcdDefFhHIjklmMnopQrRStTUvwWxXyYZ])/&{$Time::CTime::strftime_conversion{$1}}()/egs;die $@ if $@;return$template}1; +TIME_CTIME + +$fatpacked{"Time/DaysInMonth.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_DAYSINMONTH'; + package Time::DaysInMonth;use Carp;require 5.000;@ISA=qw(Exporter);@EXPORT=qw(days_in is_leap);@EXPORT_OK=qw(%mltable);use strict;use vars qw($VERSION %mltable);$VERSION=99.1117;CONFIG: {%mltable=qw(1 31 3 31 4 30 5 31 6 30 7 31 8 31 9 30 10 31 11 30 12 31)}sub days_in {my ($year,$month)=@_;return$mltable{$month+0}unless$month==2;return 28 unless&is_leap($year);return 29}sub is_leap {my ($year)=@_;return 0 unless$year % 4==0;return 1 unless$year % 100==0;return 0 unless$year % 400==0;return 1}1; +TIME_DAYSINMONTH + +$fatpacked{"Time/JulianDay.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_JULIANDAY'; + package Time::JulianDay;require 5.000;use Carp;use Time::Timezone;@ISA=qw(Exporter);@EXPORT=qw(julian_day inverse_julian_day day_of_week jd_secondsgm jd_secondslocal jd_timegm jd_timelocal gm_julian_day local_julian_day);@EXPORT_OK=qw($brit_jd);use strict;use integer;use vars qw($brit_jd $jd_epoch $jd_epoch_remainder $VERSION);$VERSION=2011.0505;sub julian_day {my($year,$month,$day)=@_;my($tmp);use Carp;$tmp=$day - 32075 + 1461 * ($year + 4800 - (14 - $month)/ 12)/4 + 367 * ($month - 2 + ((14 - $month)/ 12)* 12)/ 12 - 3 * (($year + 4900 - (14 - $month)/ 12)/ 100)/ 4 ;return($tmp)}sub gm_julian_day {my($secs)=@_;my($sec,$min,$hour,$mon,$year,$day,$month);($sec,$min,$hour,$day,$mon,$year)=gmtime($secs);$month=$mon + 1;$year += 1900;return julian_day($year,$month,$day)}sub local_julian_day {my($secs)=@_;my($sec,$min,$hour,$mon,$year,$day,$month);($sec,$min,$hour,$day,$mon,$year)=localtime($secs);$month=$mon + 1;$year += 1900;return julian_day($year,$month,$day)}sub day_of_week {my ($jd)=@_;return (($jd + 1)% 7)}$brit_jd=2361222;sub inverse_julian_day {my($jd)=@_;my($jdate_tmp);my($m,$d,$y);carp("warning: julian date $jd pre-dates British use of Gregorian calendar\n")if ($jd < $brit_jd);$jdate_tmp=$jd - 1721119;$y=(4 * $jdate_tmp - 1)/146097;$jdate_tmp=4 * $jdate_tmp - 1 - 146097 * $y;$d=$jdate_tmp/4;$jdate_tmp=(4 * $d + 3)/1461;$d=4 * $d + 3 - 1461 * $jdate_tmp;$d=($d + 4)/4;$m=(5 * $d - 3)/153;$d=5 * $d - 3 - 153 * $m;$d=($d + 5)/ 5;$y=100 * $y + $jdate_tmp;if($m < 10){$m += 3}else {$m -= 9;++$y}return ($y,$m,$d)}{my($sec,$min,$hour,$day,$mon,$year)=gmtime(0);$year += 1900;if ($year==1970 && $mon==0 && $day==1){$jd_epoch=2440588}else {$jd_epoch=julian_day($year,$mon+1,$day)}$jd_epoch_remainder=$hour*3600 + $min*60 + $sec}sub jd_secondsgm {my($jd,$hr,$min,$sec)=@_;my($r)=(($jd - $jd_epoch)* 86400 + $hr * 3600 + $min * 60 - $jd_epoch_remainder);no integer;return ($r + $sec);use integer}sub jd_secondslocal {my($jd,$hr,$min,$sec)=@_;my$jds=jd_secondsgm($jd,$hr,$min,$sec);return$jds - tz_local_offset($jds)}sub jd_timelocal {my ($sec,$min,$hours,$mday,$mon,$year)=@_;$year += 1900 unless$year > 1000;my$jd=julian_day($year,$mon+1,$mday);my$jds=jd_secondsgm($jd,$hours,$min,$sec);return$jds - tz_local_offset($jds)}sub jd_timegm {my ($sec,$min,$hours,$mday,$mon,$year)=@_;$year += 1900 unless$year > 1000;my$jd=julian_day($year,$mon+1,$mday);return jd_secondsgm($jd,$hours,$min,$sec)}1; +TIME_JULIANDAY + +$fatpacked{"Time/ParseDate.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_PARSEDATE'; + package Time::ParseDate;require 5.000;use Carp;use Time::Timezone;use Time::JulianDay;require Exporter;@ISA=qw(Exporter);@EXPORT=qw(parsedate);@EXPORT_OK=qw(pd_raw %mtable %umult %wdays);use strict;use vars qw(%mtable %umult %wdays $VERSION);$VERSION=2013.1113;use vars qw($debug);use vars qw($parse);my%mtable;my%umult;my%wdays;my$y2k;CONFIG: {%mtable=qw(Jan 1 Jan. 1 January 1 Feb 2 Feb. 2 February 2 Mar 3 Mar. 3 March 3 Apr 4 Apr. 4 April 4 May 5 Jun 6 Jun. 6 June 6 Jul 7 Jul. 7 July 7 Aug 8 Aug. 8 August 8 Sep 9 Sep. 9 September 9 Sept 9 Oct 10 Oct. 10 October 10 Nov 11 Nov. 11 November 11 Dec 12 Dec. 12 December 12);%umult=qw(sec 1 second 1 min 60 minute 60 hour 3600 day 86400 week 604800 fortnight 1209600);%wdays=qw(sun 0 sunday 0 mon 1 monday 1 tue 2 tuesday 2 wed 3 wednesday 3 thu 4 thursday 4 fri 5 friday 5 sat 6 saturday 6);$y2k=946684800}my$break=qr{(?:\s+|\Z|\b(?![-:.,/]\d))};sub parsedate {my ($t,%options)=@_;my ($y,$m,$d);my ($H,$M,$S);my$tz;my$tzo;my ($rd,$rs);my$rel;my$isspec;my$now=defined($options{NOW})? $options{NOW}: time;my$passes=0;my$uk=defined($options{UK})? $options{UK}: 0;local$parse='';if ($t =~ s#^ ([ \d]\d) + / (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) + / (\d\d\d\d) + : (\d\d) + : (\d\d) + : (\d\d) + (?: + [ ] + ([-+] \d\d\d\d) + (?: \("?(?:(?:[A-Z]{1,4}[TCW56])|IDLE)\))? + )? + $break + ##xi){($d,$m,$y,$H,$M,$S,$tzo)=($1,$mtable{"\u\L$2"},$3,$4,$5,$6,$7 ? &mkoff($7): ($tzo || undef));$parse .= " ".__LINE__ if$debug}elsif ($t =~ s#^(\d\d)/(\d\d)/(\d\d)\.(\d\d)\:(\d\d)($break)##){($y,$m,$d,$H,$M,$S)=($1,$2,$3,$4,$5,0);$parse .= " ".__LINE__ if$debug}else {while(1){if (!defined$m and!defined$rd and!defined$y and!($passes==0 and $options{'TIMEFIRST'})){if (&parse_date_only(\$t,\$y,\$m,\$d,$uk)){$parse .= " ".__LINE__ if$debug;next}}if (!defined$H and!defined$rs){if (&parse_time_only(\$t,\$H,\$M,\$S,\$tz,%options)){$parse .= " ".__LINE__ if$debug;next}}next if$passes==0 and $options{'TIMEFIRST'};if (!defined$y){if (&parse_year_only(\$t,\$y,$now,%options)){$parse .= " ".__LINE__ if$debug;next}}if (!defined$tz and!defined$tzo and!defined$rs and (defined$m or defined$H)){if (&parse_tz_only(\$t,\$tz,\$tzo)){$parse .= " ".__LINE__ if$debug;next}}if (!defined$H and!defined$rs){if (&parse_time_offset(\$t,\$rs,%options)){$rel=1;$parse .= " ".__LINE__ if$debug;next}}if (!defined$m and!defined$rd and!defined$y){if (&parse_date_offset(\$t,$now,\$y,\$m,\$d,\$rd,\$rs,%options)){$rel=1;$parse .= " ".__LINE__ if$debug;next}}if (defined$M or defined$rd){if ($t =~ s/^\s*(?:at|\@|\+)($break)//x){$rel=1;$parse .= " ".__LINE__ if$debug;next}}last}continue {$passes++;&debug_display($tz,$tzo,$H,$M,$S,$m,$d,$y,$rs,$rd,$rel,$passes,$parse,$t)if$debug}if ($passes==0){print "nothing matched\n" if$debug;return (undef,"no match on time/date")if wantarray();return undef}}&debug_display($tz,$tzo,$H,$M,$S,$m,$d,$y,$rs,$rd,$rel,$passes,$parse,$t)if$debug;$t =~ s/^\s+//;if ($t ne ''){print "NOT WHOLE\n" if$debug;if ($options{WHOLE}){return (undef,"characters left over after parse")if wantarray();return undef}}if (!defined$y and!defined$m and!defined$rd){print "no date defined, trying to find one." if$debug;if (defined$rs or defined$H){if ($options{DATE_REQUIRED}){return (undef,"no date specified")if wantarray();return undef}if (defined$rs){print "simple offset: $rs\n" if$debug;my$rv=$now + $rs;return ($rv,$t)if wantarray();return$rv}$rd=0}else {print "no time either!\n" if$debug;return (undef,"no time specified")if wantarray();return undef}}if ($options{TIME_REQUIRED}&&!defined($rs)&&!defined($H)&&!defined($rd)){return (undef,"no time found")if wantarray();return undef}my$secs;my$jd;if (defined$rd){if (defined$rs ||!(defined($H)|| defined($M)|| defined($S))){print "fully relative\n" if$debug;my ($j,$in,$it);my$definedrs=defined($rs)? $rs : 0;my ($isdst_now,$isdst_then);my$r=$now + $rd * 86400 + $definedrs;$isdst_now=(localtime($r))[8];$isdst_then=(localtime($now))[8];if (($isdst_now==$isdst_then)|| $options{GMT}){return ($r,$t)if wantarray();return$r}print "localtime changed DST during time period!\n" if$debug}print "relative date\n" if$debug;$jd=$options{GMT}? gm_julian_day($now): local_julian_day($now);print "jd($now) = $jd\n" if$debug;$jd += $rd}else {unless (defined$y){if ($options{PREFER_PAST}){my ($day,$mon011);($day,$mon011,$y)=(&righttime($now))[3,4,5];print "calc year -past $day-$d $mon011-$m $y\n" if$debug;$y -= 1 if ($mon011+1 < $m)|| (($mon011+1==$m)&& ($day < $d))}elsif ($options{PREFER_FUTURE}){print "calc year -future\n" if$debug;my ($day,$mon011);($day,$mon011,$y)=(&righttime($now))[3,4,5];$y += 1 if ($mon011 >= $m)|| (($mon011+1==$m)&& ($day > $d))}else {print "calc year -this\n" if$debug;$y=(localtime($now))[5]}$y += 1900}$y=expand_two_digit_year($y,$now,%options)if$y < 100;if ($options{VALIDATE}){require Time::DaysInMonth;my$dim=Time::DaysInMonth::days_in($y,$m);if ($y < 1000 or $m < 1 or $d < 1 or $y > 9999 or $m > 12 or $d > $dim){return (undef,"illegal YMD: $y, $m, $d")if wantarray();return undef}}$jd=julian_day($y,$m,$d);print "jd($y, $m, $d) = $jd\n" if$debug}if (!defined($H)){if (defined($rd)|| defined($rs)){($S,$M,$H)=&righttime($now,%options);print "HMS set to $H $M $S\n" if$debug}}my$carry;print "before ",(defined($rs)? "$rs" : "")," $jd $H $M $S\n" if$debug;$S=0 unless$S;$M=0 unless$M;$H=0 unless$H;if ($options{VALIDATE}and ($S < 0 or $M < 0 or $H < 0 or $S > 59 or $M > 59 or $H > 23)){return (undef,"illegal HMS: $H, $M, $S")if wantarray();return undef}$S += $rs if defined$rs;$carry=int($S / 60)- ($S < 0 && $S % 60 && 1);$S -= $carry * 60;$M += $carry;$carry=int($M / 60)- ($M < 0 && $M % 60 && 1);$M %= 60;$H += $carry;$carry=int($H / 24)- ($H < 0 && $H % 24 && 1);$H %= 24;$jd += $carry;print "after rs $jd $H $M $S\n" if$debug;$secs=jd_secondsgm($jd,$H,$M,$S);print "jd_secondsgm($jd, $H, $M, $S) = $secs\n" if$debug;my$tzadj;if ($tz){$tzadj=tz_offset($tz,$secs);if (defined$tzadj){print "adjusting secs for $tz: $tzadj\n" if$debug;$tzadj=tz_offset($tz,$secs-$tzadj);$secs -= $tzadj}else {print "unknown timezone: $tz\n" if$debug;undef$secs;undef$t}}elsif (defined$tzo){print "adjusting time for offset: $tzo\n" if$debug;$secs -= $tzo}else {unless ($options{GMT}){if ($options{ZONE}){$tzadj=tz_offset($options{ZONE},$secs)|| 0;$tzadj=tz_offset($options{ZONE},$secs-$tzadj);unless (defined($tzadj)){return (undef,"could not convert '$options{ZONE}' to time offset")if wantarray();return undef}print "adjusting secs for $options{ZONE}: $tzadj\n" if$debug;$secs -= $tzadj}else {$tzadj=tz_local_offset($secs);print "adjusting secs for local offset: $tzadj\n" if$debug;$tzadj=tz_local_offset($secs-$tzadj);$secs -= $tzadj}}}print "returning $secs.\n" if$debug;return ($secs,$t)if wantarray();return$secs}sub mkoff {my($offset)=@_;if (defined$offset and $offset =~ s#^([-+])(\d\d):?(\d\d)$##){return ($1 eq '+' ? 3600 * $2 + 60 * $3 : -3600 * $2 + -60 * $3)}return undef}sub parse_tz_only {my($tr,$tz,$tzo)=@_;$$tr =~ s#^\s+##;my$o;if ($$tr =~ s#^ + ([-+]\d\d:?\d\d) + \s+ + \( + "? + (?: + (?: + [A-Z]{1,4}[TCW56] + ) + | + IDLE + ) + \) + $break + ##x){$$tzo=&mkoff($1);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})($break)##x){$o=$1;if ($o < 24 and $o !~ /^0/){printf "adjusted at %d. ($o 00)\n",__LINE__ if$debug;$o="${o}00"}$o =~ s/\b(\d\d\d)/0$1/;$$tzo=&mkoff($o);printf "matched at %d. ($$tzo, $o)\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?:GMT\s*)?([-+]\d\d:?\d\d)($break)##x){$o=$1;$$tzo=&mkoff($o);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^"?((?:[A-Z]{1,4}[TCW56])|IDLE)$break##x){$$tz=$1;$$tz .= " DST" if $$tz eq 'MET' && $$tr =~ s#^DST$break##x;printf "matched at %d: '$$tz'.\n",__LINE__ if$debug;return 1}return 0}sub parse_date_only {my ($tr,$yr,$mr,$dr,$uk)=@_;$$tr =~ s#^\s+##;if ($$tr =~ s#^(\d\d\d\d)([-./])(\d\d?)\2(\d\d?)(T|$break)##){($$yr,$$mr,$$dr)=($1,$3,$4);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(\d\d?)([-./])(\d\d?)\2(\d\d\d\d?)($break)##){if ($uk || $1>12){($$yr,$$mr,$$dr)=($4,$3,$1)}else {($$yr,$$mr,$$dr)=($4,$1,$3)}printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(\d\d\d\d)/(\d\d?)$break##x){($$yr,$$mr,$$dr)=($1,$2,1);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (?: + (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday| + Thu|Thursday|Fri|Friday| + Sat|Saturday|Sun|Sunday),? + \s+ + )? + (\d\d?) + (\s+ | - | \. | /) + (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.? + (?: + \2 + (\d\d (?:\d\d)? ) + )? + $break + ##){($$yr,$$mr,$$dr)=($4,$mtable{"\u\L$3"},$1);printf "%d: %s - %s - %s\n",__LINE__,$1,$2,$3 if$debug;print "y undef\n" if ($debug &&!defined($$yr));return 1}elsif ($$tr =~ s#^(?xi) + (?: + (?:Mon|Monday|Tue|Tuesday|Wed|Wednesday| + Thu|Thursday|Fri|Friday| + Sat|Saturday|Sun|Sunday),? + \s+ + )? + (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)\.? + ((\s)+ | - | \. | /) + + (\d\d?) + ,? + (?: + (?: \2|\3+) + (\d\d (?: \d\d)?) + )? + $break + ##){($$yr,$$mr,$$dr)=($5,$mtable{"\u\L$1"},$4);printf "%d: %s - %s - %s\n",__LINE__,$1,$2,$4 if$debug;print "y undef\n" if ($debug &&!defined($$yr));return 1}elsif ($$tr =~ s#^(?xi) + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + \s+ + (\d+) + (?:st|nd|rd|th)? + \,? + (?: + \s+ + (?: + (\d\d\d\d) + |(?:\' (\d\d)) + ) + )? + $break + ##){($$yr,$$mr,$$dr)=($3 || $4,$mtable{"\u\L$1"},$2);printf "%d: %s - %s - %s - %s\n",__LINE__,$1,$2,$3,$4 if$debug;print "y undef\n" if ($debug &&!defined($$yr));printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(\d\d?)([-/.])(\d\d?)\2(\d\d?)($break)##x){if ($1 > 31 || (!$uk && $1 > 12 && $4 < 32)){($$yr,$$mr,$$dr)=($1,$3,$4)}elsif ($1 > 12 || $uk){($$yr,$$mr,$$dr)=($4,$3,$1)}else {($$yr,$$mr,$$dr)=($4,$1,$3)}printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(\d\d?)/(\d\d?)($break)##x){if ($1 > 31 || (!$uk && $1 > 12)){($$yr,$$mr,$$dr)=($1,$2,1)}elsif ($2 > 31 || ($uk && $2 > 12)){($$yr,$$mr,$$dr)=($2,$1,1)}elsif ($1 > 12 || $uk){($$mr,$$dr)=($2,$1)}else {($$mr,$$dr)=($1,$2)}printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(\d\d)(\d\d)(\d\d)($break)##x){if ($1 > 31 || (!$uk && $1 > 12)){($$yr,$$mr,$$dr)=($1,$2,$3)}elsif ($1 > 12 || $uk){($$yr,$$mr,$$dr)=($3,$2,$1)}else {($$yr,$$mr,$$dr)=($3,$1,$2)}printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (\d{1,2}) + (\s+ | - | \. | /) + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + (?: + \2 + ( + \d\d + (?:\d\d)? + ) + ) + $break + ##){($$yr,$$mr,$$dr)=($4,$mtable{"\u\L$3"},$1);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (\d+) + (?:st|nd|rd|th)? + \s+ + (January|Jan\.?|February|Feb\.?|March|Mar\.?|April|Apr\.?|May| + June|Jun\.?|July|Jul\.?|August|Aug\.?|September|Sep\.?| + October|Oct\.?|November|Nov\.?|December|Dec\.?) + (?: + \,? + \s+ + (\d\d\d\d) + )? + $break + ##){($$yr,$$mr,$$dr)=($3,$mtable{"\u\L$2"},$1);printf "%d: %s - %s - %s - %s\n",__LINE__,$1,$2,$3,$4 if$debug;print "y undef\n" if ($debug &&!defined($$yr));printf "matched at %d.\n",__LINE__ if$debug;return 1}return 0}sub parse_time_only {my ($tr,$hr,$mr,$sr,$tzr,%options)=@_;$$tr =~ s#^\s+##;if ($$tr =~ s!^(?x) + (?: + (?: + ([012]\d) (?# $1) + (?: + ([0-5]\d) (?# $2) + (?: + ([0-5]\d) (?# $3) + )? + ) + \s* + ([apAP][mM])? (?# $4) + ) | (?: + (\d{1,2}) (?# $5) + (?: + \: + (\d\d) (?# $6) + (?: + \: + (\d\d) (?# $7) + ( + (?# don't barf on database sub-second timings) + [:.,] + \d+ + )? (?# $8) + )? + ) + \s* + ([apAP][mM])? (?# $9) + ) | (?: + (\d{1,2}) (?# $10) + ([apAP][mM]) (?# ${11}) + ) + ) + (?: + \s+ + "? + ( (?# ${12}) + (?: [A-Z]{1,4}[TCW56] ) + | + IDLE + ) + )? + $break + !!){my$ampm;$$hr=$1 || $5 || $10 || 0;$$mr=$2 || $6 || 0;$$sr=$3 || $7 || 0;if (defined($8)&& exists($options{SUBSECOND})&& $options{SUBSECOND}){my($frac)=$8;substr($frac,0,1)='.';$$sr += $frac}print "S = $$sr\n" if$debug;$ampm=$4 || $9 || $11 || '';$$tzr=$12;$$hr += 12 if$ampm and "\U$ampm" eq "PM" && $$hr!=12;$$hr=0 if $$hr==12 && "\U$ampm" eq "AM";printf "matched at %d, rem = %s.\n",__LINE__,$$tr if$debug;return 1}elsif ($$tr =~ s#^noon$break##ix){($$hr,$$mr,$$sr)=(12,0,0);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^midnight$break##ix){($$hr,$$mr,$$sr)=(0,0,0);printf "matched at %d.\n",__LINE__ if$debug;return 1}return 0}sub parse_time_offset {my ($tr,$rsr,%options)=@_;$$tr =~ s/^\s+//;return 0 if$options{NO_RELATIVE};if ($$tr =~ s{^(?xi) + (?: + (-) (?# 1) + | + [+] + )? + \s* + (?: + (\d+(?:\.\d+)?) (?# 2) + | + (?:(\d+)\s+(\d+)/(\d+)) (?# 3 4/5) + ) + \s* + (sec|second|min|minute|hour)s? (?# 6) + ( + \s+ + ago (?# 7) + )? + $break + }{}){$$rsr=0 unless defined $$rsr;return 0 if defined($5)&& $5==0;my$num=defined($2)? $2 : $3 + $4/$5;$num=-$num if $1;$$rsr += $umult{"\L$6"}* $num;$$rsr=-$$rsr if $7 || $$tr =~ /\b(day|mon|month|year)s?\s*ago\b/;printf "matched at %d.\n",__LINE__ if$debug;return 1}return 0}sub expand_two_digit_year {my ($yr,$now,%options)=@_;return$yr if$yr > 100;my ($y)=(&righttime($now,%options))[5];$y += 1900;my$century=int($y / 100)* 100;my$within=$y % 100;my$r=$yr + $century;if ($options{PREFER_PAST}){if ($yr > $within){$r=$yr + $century - 100}}elsif ($options{PREFER_FUTURE}){if ($yr < $within-20){$r=$yr + $century + 100}}elsif ($options{UNAMBIGUOUS}){return undef}else {if ($within > 80 && $within - $yr > 60){$r=$yr + $century + 100}if ($within < 30 && $yr - $within > 59){$r=$yr + $century - 100}}print "two digit year '$yr' expanded into $r\n" if$debug;return$r}sub calc {my ($rsr,$yr,$mr,$dr,$rdr,$now,$units,$count,%options)=@_;confess unless$units;$units="\L$units";print "calc based on $units\n" if$debug;if ($units eq 'day'){$$rdr=$count}elsif ($units eq 'week'){$$rdr=$count * 7}elsif ($umult{$units}){$$rsr=$count * $umult{$units}}elsif ($units eq 'mon' || $units eq 'month'){($$yr,$$mr,$$dr)=&monthoff($now,$count,%options);$$rsr=0 unless $$rsr}elsif ($units eq 'year'){($$yr,$$mr,$$dr)=&monthoff($now,$count * 12,%options);$$rsr=0 unless $$rsr}else {carp "interal error"}print "calced rsr $$rsr rdr $$rdr, yr $$yr mr $$mr dr $$dr.\n" if$debug}sub monthoff {my ($now,$months,%options)=@_;my ($d,$m11,$y)=(&righttime($now,%options))[3,4,5 ];$y += 1900;print "m11 = $m11 + $months, y = $y\n" if$debug;$m11 += $months;print "m11 = $m11, y = $y\n" if$debug;if ($m11 > 11 || $m11 < 0){$y -= 1 if$m11 < 0 && ($m11 % 12!=0);$y += int($m11/12);no integer;$m11 %= 12}print "m11 = $m11, y = $y\n" if$debug;if ($d > 30 or ($d > 28 && $m11==1)){require Time::DaysInMonth;my$dim=Time::DaysInMonth::days_in($y,$m11+1);print "dim($y,$m11+1)= $dim\n" if$debug;$d=$dim if$d > $dim}return ($y,$m11+1,$d)}sub righttime {my ($time,%options)=@_;if ($options{GMT}){return gmtime($time)}else {return localtime($time)}}sub parse_year_only {my ($tr,$yr,$now,%options)=@_;$$tr =~ s#^\s+##;if ($$tr =~ s#^(\d\d\d\d)$break##){$$yr=$1;printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#\'(\d\d)$break##){$$yr=expand_two_digit_year($1,$now,%options);printf "matched at %d.\n",__LINE__ if$debug;return 1}return 0}sub parse_date_offset {my ($tr,$now,$yr,$mr,$dr,$rdr,$rsr,%options)=@_;return 0 if$options{NO_RELATIVE};my$j;my$wday=(&righttime($now,%options))[6];$$tr =~ s#^\s+##;if ($$tr =~ s#^(?xi) + \s* + (\d+) + \s* + (day|week|month|year)s? + ( + \s+ + ago + )? + $break + ##){my$amt=$1 + 0;my$units=$2;$amt=-$amt if $3 || $$tr =~ m#\b(sec|second|min|minute|hour)s?\s*ago\b#;&calc($rsr,$yr,$mr,$dr,$rdr,$now,$units,$amt,%options);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (?: + (?: + now + \s+ + )? + (\+ | \-) + \s* + )? + (\d+) + \s* + (day|week|month|year)s? + $break + ##){my$one=$1 || '';my$two=$2 || '';my$amt="$one$two"+0;&calc($rsr,$yr,$mr,$dr,$rdr,$now,$3,$amt,%options);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + \s+ + after + \s+ + next + $break + ##){$$rdr=$wdays{"\L$1"}- $wday + ($wdays{"\L$1"}> $wday ? 7 : 14);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + \s+ + before + \s+ + last + $break + ##){$$rdr=$wdays{"\L$1"}- $wday - ($wdays{"\L$1"}< $wday ? 7 : 14);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + next\s+ + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break + ##){$$rdr=$wdays{"\L$1"}- $wday + ($wdays{"\L$1"}> $wday ? 0 : 7);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^(?xi) + last\s+ + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break##){printf "c %d - %d + ( %d < %d ? 0 : -7 \n",$wdays{"\L$1"},$wday,$wdays{"\L$1"},$wday if$debug;$$rdr=$wdays{"\L$1"}- $wday + ($wdays{"\L$1"}< $wday ? 0 : -7);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($options{PREFER_PAST}and $$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break##){printf "c %d - %d + ( %d < %d ? 0 : -7 \n",$wdays{"\L$1"},$wday,$wdays{"\L$1"},$wday if$debug;$$rdr=$wdays{"\L$1"}- $wday + ($wdays{"\L$1"}< $wday ? 0 : -7);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($options{PREFER_FUTURE}and $$tr =~ s#^(?xi) + (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday + |Wednesday|Thursday|Friday|Saturday|Sunday) + $break + ##){$$rdr=$wdays{"\L$1"}- $wday + ($wdays{"\L$1"}> $wday ? 0 : 7);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^today$break##xi){$$rdr=0;printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^tomorrow$break##xi){$$rdr=1;printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^yesterday$break##xi){$$rdr=-1;printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^last\s+(week|month|year)$break##xi){&calc($rsr,$yr,$mr,$dr,$rdr,$now,$1,-1,%options);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^next\s+(week|month|year)$break##xi){&calc($rsr,$yr,$mr,$dr,$rdr,$now,$1,1,%options);printf "matched at %d.\n",__LINE__ if$debug;return 1}elsif ($$tr =~ s#^now $break##x){$$rdr=0;return 1}return 0}sub debug_display {my ($tz,$tzo,$H,$M,$S,$m,$d,$y,$rs,$rd,$rel,$passes,$parse,$t)=@_;print "---------<<\n";print defined($tz)? "tz: $tz.\n" : "no tz\n";print defined($tzo)? "tzo: $tzo.\n" : "no tzo\n";print "HMS: ";print defined($H)? "$H, " : "no H, ";print defined($M)? "$M, " : "no M, ";print defined($S)? "$S\n" : "no S.\n";print "mdy: ";print defined($m)? "$m, " : "no m, ";print defined($d)? "$d, " : "no d, ";print defined($y)? "$y\n" : "no y.\n";print defined($rs)? "rs: $rs.\n" : "no rs\n";print defined($rd)? "rd: $rd.\n" : "no rd\n";print$rel ? "relative\n" : "not relative\n";print "passes: $passes\n";print "parse:$parse\n";print "t: $t.\n";print "--------->>\n"}1; +TIME_PARSEDATE + +$fatpacked{"Time/Timezone.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'TIME_TIMEZONE'; + package Time::Timezone;require 5.002;require Exporter;@ISA=qw(Exporter);@EXPORT=qw(tz2zone tz_local_offset tz_offset tz_name);@EXPORT_OK=qw();use Carp;use strict;use vars qw($VERSION);$VERSION=2006.0814;sub tz2zone {my($TZ,$time,$isdst)=@_;use vars qw(%tzn_cache);$TZ=defined($ENV{'TZ'})? ($ENV{'TZ'}? $ENV{'TZ'}: 'GMT'): '' unless$TZ;if (!defined$isdst){my$j;$time=time()unless$time;($j,$j,$j,$j,$j,$j,$j,$j,$isdst)=localtime($time)}if (defined$tzn_cache{$TZ}->[$isdst]){return$tzn_cache{$TZ}->[$isdst]}if ($TZ =~ /^ + ( [^:\d+\-,] {3,} ) + ( [+-] ? + \d {1,2} + ( : \d {1,2} ) {0,2} + ) + ( [^\d+\-,] {3,} )? + /x){$TZ=$isdst ? $4 : $1;$tzn_cache{$TZ}=[$1,$4 ]}else {$tzn_cache{$TZ}=[$TZ,$TZ ]}return$TZ}sub tz_local_offset {my ($time)=@_;$time=time()unless$time;return&calc_off($time)}sub calc_off {my ($time)=@_;my (@l)=localtime($time);my (@g)=gmtime($time);my$off;$off=$l[0]- $g[0]+ ($l[1]- $g[1])* 60 + ($l[2]- $g[2])* 3600;if ($l[7]==$g[7]){}elsif ($l[7]==$g[7]+ 1){$off += 86400}elsif ($l[7]==$g[7]- 1){$off -= 86400}elsif ($l[7]< $g[7]){$off += 86400}else {$off -= 86400}return$off}CONFIG: {use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);%dstZone=("brst"=>-2*3600,"adt"=>-3*3600,"edt"=>-4*3600,"cdt"=>-5*3600,"mdt"=>-6*3600,"pdt"=>-7*3600,"ydt"=>-8*3600,"hdt"=>-9*3600,"bst"=>+1*3600,"mest"=>+2*3600,"met dst"=>+2*3600,"sst"=>+2*3600,"fst"=>+2*3600,"eest"=>+3*3600,"cest"=>+2*3600,"wadt"=>+8*3600,"kdt"=>+10*3600,"eadt"=>+11*3600,"nzdt"=>+13*3600,);%Zone=("gmt"=>0,"ut"=>0,"utc"=>0,"wet"=>0,"wat"=>-1*3600,"azost"=>-1*3600,"cvt"=>-1*3600,"at"=>-2*3600,"fnt"=>-2*3600,"ndt"=>-2*3600-1800,"art"=>-3*3600,"nft"=>-3*3600-1800,"mnt"=>-4*3600,"ewt"=>-4*3600,"ast"=>-4*3600,"bot"=>-4*3600,"vet"=>-4*3600,"est"=>-5*3600,"cot"=>-5*3600,"act"=>-5*3600,"pet"=>-5*3600,"cst"=>-6*3600,"cest"=>+2*3600,"mst"=>-7*3600,"pst"=>-8*3600,"yst"=>-9*3600,"hst"=>-10*3600,"cat"=>-10*3600,"ahst"=>-10*3600,"taht"=>-10*3600,"nt"=>-11*3600,"idlw"=>-12*3600,"cet"=>+1*3600,"mez"=>+1*3600,"met"=>+1*3600,"mewt"=>+1*3600,"swt"=>+1*3600,"set"=>+1*3600,"fwt"=>+1*3600,"west"=>+1*3600,"eet"=>+2*3600,"ukr"=>+2*3600,"sast"=>+2*3600,"bt"=>+3*3600,"eat"=>+3*3600,"irst"=>+3*3600+1800,"zp4"=>+4*3600,"msd"=>+4*3600,"sct"=>+4*3600,"zp5"=>+5*3600,"azst"=>+5*3600,"mvt"=>+5*3600,"uzt"=>+5*3600,"ist"=>+5*3600+1800,"zp6"=>+6*3600,"lkt"=>+6*3600,"pkst"=>+6*3600,"yekst"=>+6*3600,"wast"=>+7*3600,"ict"=>+7*3600,"wit"=>+7*3600,"cct"=>+8*3600,"wst"=>+8*3600,"hkt"=>+8*3600,"bnt"=>+8*3600,"cit"=>+8*3600,"myt"=>+8*3600,"pht"=>+8*3600,"sgt"=>+8*3600,"jst"=>+9*3600,"kst"=>+9*3600,"east"=>+10*3600,"gst"=>+10*3600,"nct"=>+11*3600,"nzt"=>+12*3600,"nzst"=>+12*3600,"fjt"=>+12*3600,"idle"=>+12*3600,);%zoneOff=reverse(%Zone);%dstZoneOff=reverse(%dstZone);$zoneOff{0}='gmt';$dstZoneOff{3600}='bst'}sub tz_offset {my ($zone,$time)=@_;return&tz_local_offset()unless($zone);$time=time()unless$time;my(@l)=localtime($time);my$dst=$l[8];$zone=lc$zone;if ($zone =~ /^([\-\+]\d{3,4})$/){my$sign=$1 < 0 ? -1 : 1 ;my$v=abs(0 + $1);return$sign * 60 * (int($v / 100)* 60 + ($v % 100))}elsif (exists$dstZone{$zone}&& ($dst ||!exists$Zone{$zone})){return$dstZone{$zone}}elsif(exists$Zone{$zone}){return$Zone{$zone}}undef}sub tz_name {my ($off,$time)=@_;$time=time()unless$time;my(@l)=localtime($time);my$dst=$l[8];if (exists$dstZoneOff{$off}&& ($dst ||!exists$zoneOff{$off})){return$dstZoneOff{$off}}elsif (exists$zoneOff{$off}){return$zoneOff{$off}}sprintf("%+05d",int($off / 60)* 100 + $off % 60)}1; +TIME_TIMEZONE + s/^ //mg for values %fatpacked; my $class = 'FatPacked::'.(0+\%fatpacked); @@ -6641,7 +6919,7 @@ use strict; use warnings; no warnings 'exec'; -our $VERSION = '4.0.24'; +our $VERSION = '4.0.24-2-gb741f19'; our $FATPACKED = 1; use App::RecordStream; From 5b6c8ca113ee0ff42e6040fba84842fa6cb51a09 Mon Sep 17 00:00:00 2001 From: Thomas Sibley Date: Wed, 6 Jun 2018 08:40:43 -0700 Subject: [PATCH 4/4] wip! --- tests/RecordStream/Operation/parsedate.t | 36 +++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/tests/RecordStream/Operation/parsedate.t b/tests/RecordStream/Operation/parsedate.t index 5fece62..f022091 100644 --- a/tests/RecordStream/Operation/parsedate.t +++ b/tests/RecordStream/Operation/parsedate.t @@ -170,10 +170,44 @@ note '--relative: +2d'; } # XXX TODO +# https://github.com/benbernard/RecordStream/pull/74 +# https://github.com/bestpractical/hiveminder/blob/master/lib/BTDT/DateTime.pm#L163-L186 +# https://metacpan.org/pod/distribution/Date-Manip/lib/Date/Manip/DM5.pod#ParseDate note 'Special handling'; { - # epochs... unparseable without special casing? # ISO8601 + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --to-tz UTC --format ], '%F %T'], + '{"when":"2016-02-28T10:45:18-0800"}', + '{"when":"2016-02-28 18:45:18"}', + "2016-02-28T10:45:18-0800 is 2016-02-28 18:45:18", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --to-tz UTC --format ], '%F %T'], + '{"when":"2016-02-28T10:45:18"}', + '{"when":"2016-02-28 18:45:18"}', + "2016-02-28T10:45:18 is 2016-02-28 18:45:18", + ); + + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --to-tz UTC --format ], '%F %T'], + '{"when":"2016-02-28T10:45:18Z"}', + '{"when":"2016-02-28 10:45:18"}', + "2016-02-28T10:45:18Z is 2016-02-28 10:45:18", + ); + + # epochs... unparseable without special casing? + App::RecordStream::Test::OperationHelper->do_match( + 'parsedate', + [qw[ -k when --to-tz UTC --format ], '%F %T'], + '{"when":"1456685118"}', + '{"when":"2016-02-28 18:45:18"}', + "1456685118 is 2016-02-28 18:45:18", + ); }; note 'Bug: datetimes on and around the epoch';