diff options
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/Date/Parse.pm')
-rw-r--r-- | Master/tlpkg/tlperl/site/lib/Date/Parse.pm | 380 |
1 files changed, 0 insertions, 380 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/Date/Parse.pm b/Master/tlpkg/tlperl/site/lib/Date/Parse.pm deleted file mode 100644 index 12b04c14ad0..00000000000 --- a/Master/tlpkg/tlperl/site/lib/Date/Parse.pm +++ /dev/null @@ -1,380 +0,0 @@ -# Copyright (c) 1995-2009 Graham Barr. This program is free -# software; you can redistribute it and/or modify it under the same terms -# as Perl itself. - -package Date::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 - |