summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Date/Parse.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Date/Parse.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Date/Parse.pm380
1 files changed, 380 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Date/Parse.pm b/Master/tlpkg/tlperl/lib/Date/Parse.pm
new file mode 100644
index 00000000000..12b04c14ad0
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Date/Parse.pm
@@ -0,0 +1,380 @@
+# Copyright (c) 1995-2009 Graham Barr. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+package Date::Parse;
+
+require 5.000;
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+use Time::Local;
+use Carp;
+use Time::Zone;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&strtotime &str2time &strptime);
+
+$VERSION = "2.30";
+
+my %month = (
+ january => 0,
+ february => 1,
+ march => 2,
+ april => 3,
+ may => 4,
+ june => 5,
+ july => 6,
+ august => 7,
+ september => 8,
+ sept => 8,
+ october => 9,
+ november => 10,
+ december => 11,
+ );
+
+my %day = (
+ sunday => 0,
+ monday => 1,
+ tuesday => 2,
+ tues => 2,
+ wednesday => 3,
+ wednes => 3,
+ thursday => 4,
+ thur => 4,
+ thurs => 4,
+ friday => 5,
+ saturday => 6,
+ );
+
+my @suf = (qw(th st nd rd th th th th th th)) x 3;
+@suf[11,12,13] = qw(th th th);
+
+#Abbreviations
+
+map { $month{substr($_,0,3)} = $month{$_} } keys %month;
+map { $day{substr($_,0,3)} = $day{$_} } keys %day;
+
+my $strptime = <<'ESQ';
+ my %month = map { lc $_ } %$mon_ref;
+ my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
+ my $monpat = join("|", reverse sort keys %month);
+ my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
+
+ my %ampm = (
+ 'a' => 0, # AM
+ 'p' => 12, # PM
+ );
+
+ my($AM, $PM) = (0,12);
+
+sub {
+
+ my $dtstr = lc shift;
+ my $merid = 24;
+
+ my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
+
+ $zone = tz_offset(shift) if @_;
+
+ 1 while $dtstr =~ s#\([^\(\)]*\)# #o;
+
+ $dtstr =~ s#(\A|\n|\Z)# #sog;
+
+ # ignore day names
+ $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
+ $dtstr =~ s/,/ /g;
+ $dtstr =~ s#($daypat)\s*(den\s)?\b# #o;
+ # Time: 12:00 or 12:00:00 with optional am/pm
+
+ return unless $dtstr =~ /\S/;
+
+ if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
+ ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
+ }
+
+ unless (defined $hh) {
+ if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?(z)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
+ ($hh,$mm,$ss) = ($1,$2,$4);
+ $zone = 0 if $5;
+ $merid = $ampm{$6} if $6;
+ }
+
+ # Time: 12 am
+
+ elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
+ ($hh,$mm,$ss) = ($1,0,0);
+ $merid = $ampm{$2};
+ }
+ }
+
+ if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
+ $merid = $ampm{$1};
+ }
+
+
+ unless (defined $year) {
+ # Date: 12-June-96 (using - . or /)
+
+ if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
+ ($month,$day) = ($month{$3},$1);
+ $year = $5 if $5;
+ }
+
+ # Date: 12-12-96 (using '-', '.' or '/' )
+
+ elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
+ ($month,$day) = ($1 - 1,$3);
+
+ if ($5) {
+ $year = $5;
+ # Possible match for 1995-01-24 (short mainframe date format);
+ ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
+ return if length($year) > 2 and $year < 1901;
+ }
+ }
+ elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
+ ($month,$day) = ($month{$3},$1);
+ }
+ elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
+ ($month,$day) = ($month{$1},$2);
+ }
+ elsif ($dtstr =~ s#($monpat)([\/-])(\d+)[\/-]# #o) {
+ ($month,$day) = ($month{$1},$3);
+ }
+
+ # Date: 961212
+
+ elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
+ ($year,$month,$day) = ($1,$2-1,$3);
+ }
+
+ $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
+
+ }
+
+ # Zone
+
+ $dst = 1 if $dtstr =~ s#\bdst\b##o;
+
+ if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
+ $dst = 1 if $2 and $2 eq 'dst';
+ $zone = tz_offset($1);
+ return unless defined $zone;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ if ($dtstr =~ /\S/) {
+ # now for some dumb dates
+ if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
+ $zone = 0;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ return if $dtstr =~ /\S/o;
+ }
+
+ if (defined $hh) {
+ if ($hh == 12) {
+ $hh = 0 if $merid == $AM;
+ }
+ elsif ($merid == $PM) {
+ $hh += 12;
+ }
+ }
+
+ $year -= 1900 if defined $year && $year > 1900;
+
+ $zone += 3600 if defined $zone && $dst;
+ $ss += "0.$frac" if $frac;
+
+ return ($ss,$mm,$hh,$day,$month,$year,$zone);
+}
+ESQ
+
+use vars qw($day_ref $mon_ref $suf_ref $obj);
+
+sub gen_parser
+{
+ local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
+
+ if($obj)
+ {
+ my $obj_strptime = $strptime;
+ substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
+ shift; # package
+ESQ
+ my $sub = eval "$obj_strptime" or die $@;
+ return $sub;
+ }
+
+ eval "$strptime" or die $@;
+
+}
+
+*strptime = gen_parser(\%day,\%month,\@suf);
+
+sub str2time
+{
+ my @t = strptime(@_);
+
+ return undef
+ unless @t;
+
+ my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
+ my @lt = localtime(time);
+
+ $hh ||= 0;
+ $mm ||= 0;
+ $ss ||= 0;
+
+ my $frac = $ss - int($ss);
+ $ss = int $ss;
+
+ $month = $lt[4]
+ unless(defined $month);
+
+ $day = $lt[3]
+ unless(defined $day);
+
+ $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
+ unless(defined $year);
+
+ return undef
+ unless($month <= 11 && $day >= 1 && $day <= 31
+ && $hh <= 23 && $mm <= 59 && $ss <= 59);
+
+ my $result;
+
+ if (defined $zone) {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timegm($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne "595923311169";
+ $result -= $zone;
+ }
+ else {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timelocal($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne join("",(localtime(-1))[0..5]);
+ }
+
+ return $result + $frac;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Date::Parse - Parse date strings into time values
+
+=head1 SYNOPSIS
+
+ use Date::Parse;
+
+ $time = str2time($date);
+
+ ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
+
+=head1 DESCRIPTION
+
+C<Date::Parse> provides two routines for parsing date strings into time values.
+
+=over 4
+
+=item str2time(DATE [, ZONE])
+
+C<str2time> parses C<DATE> and returns a unix time value, or undef upon failure.
+C<ZONE>, if given, specifies the timezone to assume when parsing if the
+date string does not specify a timezone.
+
+=item strptime(DATE [, ZONE])
+
+C<strptime> takes the same arguments as str2time but returns an array of
+values C<($ss,$mm,$hh,$day,$month,$year,$zone)>. Elements are only defined
+if they could be extracted from the date string. The C<$zone> element is
+the timezone offset in seconds from GMT. An empty array is returned upon
+failure.
+
+=head1 MULTI-LANGUAGE SUPPORT
+
+Date::Parse is capable of parsing dates in several languages, these include
+English, French, German and Italian.
+
+ $lang = Date::Language->new('German');
+ $lang->str2time("25 Jun 1996 21:09:55 +0100");
+
+=head1 EXAMPLE DATES
+
+Below is a sample list of dates that are known to be parsable with Date::Parse
+
+ 1995:01:24T09:08:17.1823213 ISO-8601
+ 1995-01-24T09:08:17.1823213
+ Wed, 16 Jun 94 07:29:35 CST Comma and day name are optional
+ Thu, 13 Oct 94 10:13:13 -0700
+ Wed, 9 Nov 1994 09:50:32 -0500 (EST) Text in ()'s will be ignored.
+ 21 dec 17:05 Will be parsed in the current time zone
+ 21-dec 17:05
+ 21/dec 17:05
+ 21/dec/93 17:05
+ 1999 10:02:18 "GMT"
+ 16 Nov 94 22:28:20 PST
+
+=head1 LIMITATION
+
+Date::Parse uses L<Time::Local> internally, so is limited to only parsing dates
+which result in valid values for Time::Local::timelocal. This generally means dates
+between 1901-12-17 00:00:00 GMT and 2038-01-16 23:59:59 GMT
+
+=head1 BUGS
+
+When both the month and the date are specified in the date as numbers
+they are always parsed assuming that the month number comes before the
+date. This is the usual format used in American dates.
+
+The reason why it is like this and not dynamic is that it must be
+deterministic. Several people have suggested using the current locale,
+but this will not work as the date being parsed may not be in the format
+of the current locale.
+
+My plans to address this, which will be in a future release, is to allow
+the programmer to state what order they want these values parsed in.
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-2009 Graham Barr. This program is free
+software; you can redistribute it and/or modify it under the same terms
+as Perl itself.
+
+=cut
+