From 749eda39be93e0d78a6bcacf3c724d5ceffdd047 Mon Sep 17 00:00:00 2001 From: Simon Howard Date: Thu, 8 Jun 2006 20:39:08 +0000 Subject: [PATCH] Remove building of latest.wad. The code to do this is hugely overcomplicated and doesn't work properly. The proper way to do this is through some kind of WAD diffing tool, not through examining timestamps. --- Makefile | 21 - Time/CTime.pm | 200 ------- Time/DaysInMonth.pm | 78 --- Time/JulianDay.pm | 206 ------- Time/ParseDate.pm | 1254 ------------------------------------------- Time/Timezone.pm | 283 ---------- build | 17 - latest_force.txt | 4 - wadinfo-builder.pl | 40 +- 9 files changed, 3 insertions(+), 2100 deletions(-) delete mode 100644 Time/CTime.pm delete mode 100644 Time/DaysInMonth.pm delete mode 100644 Time/JulianDay.pm delete mode 100644 Time/ParseDate.pm delete mode 100644 Time/Timezone.pm delete mode 100755 build delete mode 100644 latest_force.txt diff --git a/Makefile b/Makefile index e49613c9..74835a61 100644 --- a/Makefile +++ b/Makefile @@ -25,9 +25,6 @@ OBJS = \ # disable this for now # $(WADS_DIR)/freedoom_hires.zip -usebuild : - @echo please use the ./build wrapper script - all : $(OBJS) subdirs: @@ -59,10 +56,6 @@ $(WADS_DIR): wadinfo.txt: buildcfg.txt force textures/doom2/pnames.txt $(CPP) -P -DDOOM2 < $< | ./wadinfo-builder.pl > $@ -wadinfo_ulatest.txt: buildcfg.txt force textures/doom/pnames.txt - $(CPP) -P -DDOOM1 < $< | ./wadinfo-builder.pl -since $(LAST_RELEASE_DATE) > $@ -wadinfo_latest.txt: buildcfg.txt force textures/doom2/pnames.txt - $(CPP) -P -DDOOM2 < $< | ./wadinfo-builder.pl -since $(LAST_RELEASE_DATE) > $@ wadinfo_sw.txt: buildcfg.txt force textures/shareware/pnames.txt $(CPP) -P -DSHAREWARE < $< | ./wadinfo-builder.pl -dummy > $@ wadinfo_iwad.txt: buildcfg.txt force textures/doom2/pnames.txt @@ -76,20 +69,6 @@ wadinfo_freedm.txt : buildcfg.txt force textures/freedm/pnames.txt md5sum $<.gz > $<.md5sum rm -f $< -#--------------------------------------------------------- -# incremental wad - -latest/ulatest.wad: wadinfo_ulatest.txt subdirs force - # TODO: check this - ln -sf doom/texture1.txt textures/texture1.txt - rm -f $@ - $(DEUTEX) $(DEUTEX_BASIC_ARGS) -doom bootstrap/ -textures -lumps -patch -flats -sounds -musics -graphics -sprites -levels -build wadinfo_ulatest.txt $@ - -latest/latest.wad: wadinfo_latest.txt subdirs force - ln -sf doom2/texture1.txt textures/texture1.txt - rm -f $@ - $(DEUTEX) $(DEUTEX_BASIC_ARGS) -doom2 bootstrap/ -textures -lumps -patch -flats -sounds -musics -graphics -sprites -levels -build wadinfo_latest.txt $@ - #--------------------------------------------------------- # build wad diff --git a/Time/CTime.pm b/Time/CTime.pm deleted file mode 100644 index ecd02494..00000000 --- a/Time/CTime.pm +++ /dev/null @@ -1,200 +0,0 @@ -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 = 99.06_22_01; - -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) }, - '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"; -} - -# 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/%([%aAbBcdDefFhHIjklmMnopQrRStTUwWxXyYZ])/&{$Time::CTime::strftime_conversion{$1}}()/egs; - die $@ if $@; - return $template; -} - -1; - -__DATA__ - -=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 - %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 - %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 -coversions -- 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-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.com. - diff --git a/Time/DaysInMonth.pm b/Time/DaysInMonth.pm deleted file mode 100644 index 2b664414..00000000 --- a/Time/DaysInMonth.pm +++ /dev/null @@ -1,78 +0,0 @@ -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; - -__DATA__ - -=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 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.com. - diff --git a/Time/JulianDay.pm b/Time/JulianDay.pm deleted file mode 100644 index 3f20bf27..00000000 --- a/Time/JulianDay.pm +++ /dev/null @@ -1,206 +0,0 @@ -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 = 99.061501; - -# 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; - -__DATA__ - -=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 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 muir@idiom.com. - diff --git a/Time/ParseDate.pm b/Time/ParseDate.pm deleted file mode 100644 index 1e878397..00000000 --- a/Time/ParseDate.pm +++ /dev/null @@ -1,1254 +0,0 @@ - -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; - -# constants -use vars qw(%mtable %umult %wdays $VERSION); - -$VERSION = 2003.0211; - -# 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 - 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 ); - %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 -} - -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 = $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)\))? - )? - ##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)(\s+|$)##) { - # 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|\+)\s*(\s+|$)//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 = 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); - my($frac) = $S - int($S); - $S = int($S); - $S %= 60; - $S += $frac; - $M += $carry; - $carry = int($M / 60); - $M %= 60; - $H += $carry; - $carry = int($H / 24); - $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); - print "adjusting secs for $tz: $tzadj\n" if $debug; - $tzadj = tz_offset($tz, $secs-$tzadj); - $secs -= $tzadj; - } 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); - $tzadj = tz_offset($options{ZONE}, $secs-$tzadj); - 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 - ) - \) - (?: - \s+ - | - $ - ) - ##x) { #"emacs - $$tzo = &mkoff($1); - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#^GMT\s*([-+]\d{1,2})(\s+|$)##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)(\s+|$)##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)(?:\s+|$ )##x) { #" - $$tz = $1; - $$tz .= " DST" - if $$tz eq 'MET' && $$tr =~ s#^DST(?:\s+|$ )##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?)(\s+|$)##) { - # 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?)(\s+|$)##) { - # mm/dd/yyyy - is this safe? No. - # -- or dd/mm/yyyy! If $1>12, then it's umabiguous. - # 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?)(?:\s|$ )##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)? ) - )? - (?: - \s+ - | - $ - ) - ##) { - # [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)?) - )? - (?: - \s+ - | - $ - ) - ##) { - # [Dow,] Mon dd [yyyy] - ($$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)) - ) - )? - (?: - \s+ - | - $ - ) - ##) { - # Month day{st,nd,rd,th}, 'yy - # Month day{st,nd,rd,th}, 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?)(\s+|$)##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?)(\s+|$)##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)(\s+|$)##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)? - ) - ) - (:? - \s+ - | - $ - ) - ##) { - # 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) - )? - (:? - \s+ - | - $ - ) - ##) { - # 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* - ([ap]m)? (?# $4) - ) | (?: - (\d{1,2}) (?# $5) - (?: - \: - (\d\d) (?# $6) - (?: - \: - (\d\d) (?# $7) - ( - (?# don't barf on database sub-second timings) - (?:\:|\.) - \d{1,6} - )? (?# $8) - )? - ) - \s* - ([apAP][mM])? (?# $9) - ) | (?: - (\d{1,2}) (?# $10) - ([apAP][mM]) (?# ${11}) - ) - ) - (?: - \s+ - "? - ( (?# ${12}) - (?: [A-Z]{1,4}[TCW56] ) - | - IDLE - ) - )? - (?: - \s* - | - $ - ) - !!) { #"emacs - # HH[[:]MM[:SS]]meridan [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"; - $$hr = 0 if $$hr == 24; - printf "matched at %d, rem = %s.\n", __LINE__, $$tr if $debug; - return 1; - } elsif ($$tr =~ s#noon(?:\s+|$ )##ix) { - # noon - ($$hr, $$mr, $$sr) = (12, 0, 0); - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#midnight(?:\s+|$ )##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) - ([-+]?) - \s* - (\d+) - \s* - (sec|second|min|minute|hour)s? - ( - \s+ - ago - )? - (?: - \s+ - | - $ - ) - ##) { - # count units - $$rsr = 0 unless defined $$rsr; - $$rsr += $umult{"\L$3"} * "$1$2"; - - $$rsr = -$$rsr if $4 || - $$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)(?:\s+|$)##) { - $$yr = $1; - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#\'(\d\d)(?:\s+|$ )##) { - $$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 - relatvie 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 - )? - (?: - \s+ - | - $ - ) - ##) { - 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? - (?: - \s+ - | - $ - ) - ##) { - 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 - (?: \s+ | $ ) - ##) { - # 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) - next\s+ - (Mon|Tue|Wed|Thu|Fri|Sat|Sun|Monday|Tuesday - |Wednesday|Thursday|Friday|Saturday|Sunday) - (?:\s+|$ ) - ##) { - # "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) - (?:\s+|$ )##) { - # "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) - (?:\s+|$ )##) { - # 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) - (?:\s+|$ ) - ##) { - # 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(?:\s+|$ )##xi) { - # today - $$rdr = 0; - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#^tomorrow(?:\s+|$ )##xi) { - $$rdr = 1; - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#^yesterday(?:\s+|$ )##xi) { - $$rdr = -1; - printf "matched at %d.\n", __LINE__ if $debug; - return 1; - } elsif ($$tr =~ s#^last\s+(week|month|year)(?:\s+|$ )##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)(?:\s+|$ )##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 (?: \s+ | $ )##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; - -__DATA__ - -=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 - 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 (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 "minuts" - 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 contect, then it will return two -elements. On sucessful parses, it will return the seconds and what -remains of its input string. On unsucessful 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, $remaining) = parsedate("today is the day"); - ($seconds, $error) = parsedate("today is", WHOLE=>1); - -=head1 AUTHOR - -David Muir Sharnoff . - -=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.com. - diff --git a/Time/Timezone.pm b/Time/Timezone.pm deleted file mode 100644 index 9fd11a0e..00000000 --- a/Time/Timezone.pm +++ /dev/null @@ -1,283 +0,0 @@ - -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 = 2003.0211; - -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; - my (@l) = localtime($time); - my $isdst = $l[8] || 0; - my $tzenv = defined($ENV{TZ}) ? $ENV{TZ} : "__notz"; - - if ($Timezone::tz_local{$tzenv} && - defined($Timezone::tz_local{$tzenv}[$isdst])) { - return $Timezone::tz_local{$tzenv}[$isdst]; - } - - $Timezone::tz_local{$tzenv}[$isdst] = &calc_off($time); - - return $Timezone::tz_local{$tzenv}[$isdst]; -} - -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 boundry! - # 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 comes from Graham Barr - -CONFIG: { - use vars qw(%dstZone %zoneOff %dstZoneOff %Zone); - - %dstZone = ( - # "ndt" => -2*3600-1800, # Newfoundland 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 - "wadt" => +8*3600, # West Australian Daylight - # "cadt" => +10*3600+1800, # Central Australian Daylight - "eadt" => +11*3600, # Eastern Australian Daylight - "nzdt" => +13*3600, # New Zealand Daylight - ); - - %Zone = ( - "gmt" => 0, # Greenwich Mean - "ut" => 0, # Universal (Coordinated) - "utc" => 0, - "wet" => 0, # Western European - "wat" => -1*3600, # West Africa - "at" => -2*3600, # Azores - # For completeness. BST is also British Summer, and GST is also Guam Standard. - # "bst" => -3*3600, # Brazil Standard - # "gst" => -3*3600, # Greenland Standard - # "nft" => -3*3600-1800,# Newfoundland - # "nst" => -3*3600-1800,# Newfoundland Standard - "ast" => -4*3600, # Atlantic Standard - "est" => -5*3600, # Eastern Standard - "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 - "nt" => -11*3600, # Nome - "idlw" => -12*3600, # International Date Line West - "cet" => +1*3600, # Central European - "met" => +1*3600, # Middle European - "mewt" => +1*3600, # Middle European Winter - "swt" => +1*3600, # Swedish Winter - "fwt" => +1*3600, # French Winter - "eet" => +2*3600, # Eastern Europe, USSR Zone 1 - "bt" => +3*3600, # Baghdad, USSR Zone 2 - # "it" => +3*3600+1800,# Iran - "zp4" => +4*3600, # USSR Zone 3 - "zp5" => +5*3600, # USSR Zone 4 - "ist" => +5*3600+1800,# Indian Standard - "zp6" => +6*3600, # USSR Zone 5 - # 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 - # "jt" => +7*3600+1800,# Java (3pm in Cronusland!) - "cct" => +8*3600, # China Coast, USSR Zone 7 - "jst" => +9*3600, # Japan Standard, USSR Zone 8 - # "cast" => +9*3600+1800,# Central Australian Standard - "east" => +10*3600, # Eastern Australian Standard - "gst" => +10*3600, # Guam Standard, USSR Zone 9 - "nzt" => +12*3600, # New Zealand - "nzst" => +12*3600, # New Zealand Standard - "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; - -__DATA__ - -=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 opionally takes -a timezone string, a time, and a is-dst flag. - -C determins 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/build b/build deleted file mode 100755 index 486ddbbc..00000000 --- a/build +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/sh -# -# build wrapper -# this runs make, redirecting all output to build.output for the -# public to see. a tail process is spawned in the background -# to send the output to the console as well. - -export VERSION="0.4" - -if [ x$* == x ] ; then -# make all $* >> build.output 2>&1 - make latest/latest.wad.gz $* 2>&1 | tee build.output - make latest/ulatest.wad.gz $* 2>&1 | tee -a build.output -else - make $* 2>&1 | tee build.output -fi - diff --git a/latest_force.txt b/latest_force.txt deleted file mode 100644 index a6fbc055..00000000 --- a/latest_force.txt +++ /dev/null @@ -1,4 +0,0 @@ -# these lumps are forced to be in latest.wad despite their modification time - - - diff --git a/wadinfo-builder.pl b/wadinfo-builder.pl index 813ee9b2..178c2eef 100755 --- a/wadinfo-builder.pl +++ b/wadinfo-builder.pl @@ -6,27 +6,9 @@ # # You may consider this GPLed. -use Time::ParseDate; use strict; -my %forced_lump; my $dummy = 0; -my $sincetime = 0; - -# hack to override the date comparison and force certain -# lumps to be in the wad - -if (open(FORCE, "latest_force.txt")) { - while () { - chomp; - next if /^\#/ || /^\s*$/; - my ($lumpname) = /\s*(\S+)/; - $lumpname = lc($lumpname); - $forced_lump{$lumpname} = 1; - } - - close(FORCE); -} sub findfile { my ($section, $name) = @_; @@ -39,24 +21,12 @@ sub findfile { return $list[0]; } -sub recent { - my ($filename) = @_; - - # check the file has been modified since the last release - - my @stat = stat($filename); - - return $stat[9] > $sincetime; -} - for (my $i=0; $i) { } if ($filename) { - if (!$forced_lump{$resname} && !recent($filename)) { - $_ = ";$_"; - } - } else { - if ($forced_lump{$resname} || $dummy) { + if ($dummy) { # this hasnt been submitted yet - use a dummy lump # instead