# junkDates.pl
# $Header: /afs/sipb/contrib/perl/nntp/RCS/junkDates.pl,v 1.1 1992/09/17 04:11:44 ckclark Exp $
#
# This code is originally from the Dates.pl package written by Alan K.
# Stebbens at UCSB.  Randall S. Krebs has modified this package to
# recognize dates in Usenet News format.  Randall may have made changes
# to this package which Alan does not approve of.  Alan is the one
# true author and sole maintainer of Dates.pl and Randall does not
# intend to tread on that turf.  You can use and distribute this
# code under the terms stipulated by Alan and it will probably work
# with Randall's nntpfetch program for a while.  Someday, Alan may
# undo Randall's twisted changes and modify Dates.pl to recognize
# Usenet News date format properly.  At that point, you would be
# wise to get rid of this file and use the one true Dates.pl from
# Alan.  Honest.

# Written by Alan K. Stebbens, Univ. of CA, Santa Barbara, Copyright
# 1991, under the GNU GENERAL PUBLIC LICENSE.  (This means this code is
# unwarranted, free, freely distributable, and will continue to be so;
# it also means that if you change the code you must make it clear that
# you have done so and where; it also means that you shouldn't pretend
# you wrote it).
#

# The calculations used in the functions below were taken from
# "Calendrical Calculations", pg. 906, by N. Dershowitz and E. M.
# Reingold, Software-Practice and Experience, Vol 20(9), Sep. 1990.
# Copyright 1990 by John Wiley & Sons, Ltd.

# Last Edited:
# 
# Wed Sep 18 09:57:06 1991 by Alan Stebbens (aks at anywhere.ucsb.edu)
# 	 Added package Dates.
# 
# Fri Sep 13 23:49:03 1991 by Alan Stebbens (aks at anywhere.ucsb.edu)
# 	 Added TimeZones.  Sort of.
# 
# Fri Sep 13 23:04:02 1991 by Alan Stebbens (aks at anywhere.ucsb.edu)
# 	 Added Str2Time and Time2Str subs.
# 
# Wed Sep 11 16:41:44 1991 by Alan Stebbens (aks at anywhere.ucsb.edu)
# 	 First cut.

# D A T E   S U B R O U T I N E S
#
# The functions defined by this module are:
#
# Str2Date   - convert a string to a date (@MDY)
#
#   Call:  ($fmt,$str,@mdy) = &Str2Date($datestring)
#
#   $fmt is a string indicating the format of the date string; if
#   null, no date was parsed.  $str is the unparsed portion of the
#   $datestring.  @mdy is an array containing the numeric values
#   indicating the month (1..12), the day of the month (1..31),
#   and the year (0..9999).  The $fmt string can be used with
#   Date2Str to reformat the values into a date string.
#
#   This routine will supply reasonable defaults for missing
#   values.  If the year is given as two digits, it will be
#   assumed that a current date is desired, and the two digit year
#   will be converted to a current four digit year with yy += (yy
#   >= 50 ? 1900 ? 2000).
#
#   If a dayname is given (Mon..Sun) by itself, the default date
#   returned will be the closest date, with that dayname, in the
#   same week.
#
#   If no year is given, the current year will be assumed.  If no
#   month is given, the current month will be assumed.
#
#   The default day of the month is 1. Thus, "Aug 1991" will yield 
#   a result of ('Dmmm yyyyy','',(7,1,1991)).
#
#   The format string returned will not reflect the defaults; it
#   will indicated the exact input string format.
#
# Date2Str   - convert a date to string, given a format
#
# Date2Abs   - convert a date (@mdy) to absolute days
# Abs2Date   - convert absolute days to a date (@mdy)
# CmpDates   - compare two dates
# Abs2Secs   - convert abs. days into seconds (big number!)
# Secs2Abs   - convert seconds into abs. days
#
# JDate2Abs  - convert a Julian @date to absolute days
# Abs2JDate  - convert absolute days to Julian date
#
# DayName    - return name of the day ('Sun'..'Sat') given a date
#
# The order of a date parse is MM DD YY (US dates), unless the
# external variable $EURO_DATES is set, in which case the order is
# YY MM DD.
#
# T I M E   S U B R O U T I N E S
#
# Str2Time   - convert a string to a time (@HMSZ)
#
#   Call:  ($fmt,$str,@hmsz) = &Str2Time($timestring)
#
#   $fmt is a string indicating the format of the time string; if
#   null, no time was parsed.  $str is the unparsed portion of the
#   $timestring.  @hmsz is an array containing the numeric values
#   of the hour (0..23), minutes (0..59), seconds (0..59), and GMT
#   timezone offset (-23..0..+23).  A timezone offset of 0 means
#   GMT time.
#
#   NOTE: The timezone stuff is not well tested, and there
#   currently is no automatic detection of daylight savings time.
#   Also, the TZ environment variable should be queried for
#   default timezone offsets.
#
# Str2DT     - convert a string to a date and time (@MDY,@HMSZ)
#
#   Call:  ($dfmt,$tfmt,$str,@mdy,@hmsz) = &Str2DT($date_timestring)
#
#   $dfmt is a string indicating the date format, $tfmt is a
#   string indicating the time format, $str is the unparsed
#   remainer of the original input string.  @mdy and @hmsz are the
#   same as in the previous subroutines.
#
# Time2Str   - convert a time to string, given a format
# Time2Secs  - convert a time into seconds
# Secs2Time  - convert seconds into time (@hmsz)
# CmpTimes   - compare two times.

package Dates;

# The array %Month will index with either a number or a name and return
# the corresponding value.

# %Month{'Jan'} == 1
# %Month{'December'} == 12;
# %Month{12} == 'December';

# internal functions:

# MonthDays  - return # of days for a Gregorian month
# JMonthDays - return # of days in a Julian month
# Mod        - arithmetic mod func
# Yr	     - convert 'yy' into 'yyyy'
# UnYr	     - convert 'yyyy' into 'yy'

# The following formats are used and recognized by these routines The
# date formats begin with "Dxxxxx", where "xxxx" is a string of
# characters driving the output conversion process.  The time formats
# begin with "Txxxxx" where "xxxx" is a string of characters also.  The
# same characters in either kind of format will have different meanings.

# Date string formats:
#
# D<string> where <string> is a list of characters indicating the
# parse of the input argument, which didn't match one of the DateN
# formats above.  The string characters are:
#
#   yy	     year as 'yy' encountered (two digit number greater than 31)
#   yyyy     year as 'yyyy' encountered
#   mm	     month as 'mm' encountered (two digit number less than 13)
#   mmm	     month name as 'mmm' (eg. "Sep")
#   mmmm     month name as 'mmmm' (eg. "September")
#   dd       day number encountered (two digit number greater than 12, <= 31)
#   day      short name of the day ("Mon", ..., "Sun")
#   weekday  long name of the day ("Monday",...,"Sunday")
#   <char>   any other char is inserted as is.

# The date formats are returned by Str2Date, and may subsequently be used by
# Date2Str to recreate the identical input.

# A date in the form: ``01/92'' would yield a format of "Dmm/yy"
# A date in the form: ``91.01.13'' would yield a format of "Dyy.mm.dd"

# All of the date routines use a @Date structure which looks like:
# ($mm,$dd,$yy), where $mm is 1..12, and $yy is 0..xxxx

# Time string formats:

# hh	   hours in 12 hours format
# HH       hours in 24 hours format
# mm       minutes
# ss       seconds
# am       AM or PM, appropriately
# pm       same as am
# zone     zone name (PST, PDT, MST, MST, CDT, CST, EST, EDT, GMT, ...)
# <x>      any other chars are substituted directly

$[ = 0;				# force origin zero indexing

# Create the %Month and @Month structures

@Month = ('',			# origin one array
	  'January','February','March','April','May','June',
	  'July','August','September','October','November','December');
@names = @Month;
@names = @Month;
@snames = @Month;
@numbers = (1,2,3,4,5,6,7,8,9,10,11,12);
%Month = ();
@Month{@Month[@numbers]}             = @numbers;
@Month{grep(s/^(...).*/$1/,@snames)} = @numbers;
@Month{grep(y/A-Z/a-z/,@names)}      = @numbers;
@Month{grep(y/A-Z/a-z/,@snames)}     = @numbers;

# Create the %Day and @Day structures

@Day = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday', 
	'Friday', 'Saturday');
@numbers = (0,1,2,3,4,5,6);	# algorithm returns origin 0 = Sunday
@names = @Day;
@snames = @Day;
%Day = ();
@Day{@Day[@numbers]}               = @numbers;
@Day{grep(s/^(...).*/$1/,@snames)} = @numbers;
@Day{grep(y/A-Z/a-z/,@names)}      = @numbers;
@Day{grep(y/A-Z/a-z/,@snames)}     = @numbers;

# Create the TimeZone hashed array
# Use the assoc. array for indexing with both names
# and signed offsets

%TimeZone = ();
for ($off = -12; $off <= 12; $off++) {
    # timezones of form GMT-6, GMT-7, etc.
    $zonename = 'GMT' . ($off < 0 ? "$off" : $off == 0 ? '' : "+$off");
    $TimeZone{$zonename} = $off;

    # timezones of form +0600, +0700, etc.
    $zonename = sprintf("%s%04d", ($off < 0) ? "-" : "+",
			($off >= 0) ? $off * 100 : -$off * 100);
    $TimeZone{$zonename} = $off;
}
foreach (split(/\n/,<<'EOF')) {
   10  JDT
    9  JST
    0  UTC
   -4  EDT
   -5  EST CDT
   -6  CST MDT
   -7  MST PDT
   -8  PST YDT
   -9  YST
  -10  HST
EOF
    ($off,@names) = split(' ');
    foreach $zonename (@names) {
	$TimeZone{$zonename} = $off;
    }
}

undef @names;
undef $off;
undef $zonename;
undef @numbers;
undef @names;
undef @snames;

# Create the Days in a month vector

@MonthDays = ('',31,28,31,30,31,30,31,31,30,31,30,31);

# Constants for time conversions

$SECS = 1;
$MINS = 60 * $SECS;
$HOURS = 60 * $MINS;
$DAYS = 24 * $HOURS;
$YEARS = 365 * $DAYS;

#
# Dates.pl -- Begin the function defns

# $yyyy = &Yr($yy);   # Convert from two digit year into four digit year.

sub Yr {
    local($yy) = shift;
    return $yy unless length($yy) == 2;
    $yy + ($yy >= 50 ? 1900 : 2000);
}

# $yy = &UnYr($yyyy); # Convert from four digit year into two digit year.

sub UnYr {
    local($yyyy) = @_;
    int($yyyy) % 100;
}

# $mod = &Mod($x,$y) -- compute modulus of x and y (works with floating
# point).  Use this function on large numbers.  '%' is not defined for
# integers larger than 31 bits.  DP floating has 48 bits precision, and Perl
# does all numeric ops in DP floating.

sub Mod {
    local($x,$y) = @_;
    int($x - (int($x / $y) * $y));
}

# &MonthDays($mm,$yy)

# Return the # of days in the month given, $mm (origin 1) and $yy;

sub MonthDays {
    local($m,$y) = @_;
    $m == 2 && !($y % 4) && !(($y % 400) % 100) 
	? 29 : $MonthDays[$m + $[];
}

# &JMonthDays($mm,$yy)  -- return # of days in a Julian month

sub JMonthDays {
    local($m,$y) = @_;
    $m = 2 && !($y % 4) ? 29 : $MonthDays[$m + $[];
}

# <format> = &MDY(*mdy,$token)
#
# Parse the next date token.  The parser accepts items in the order of
# MM DD YY, with reasonable assumptions and range checks.  If
# $EURO_DATES is set, the order is YY MM DD.
# MDY is strictly an internal sub: don't worry about $[ indexing.

sub MDY {
    local(*mdy,$n) = @_;
    if ($'EURO_DATES && !length($mdy[2])) {
	$mdy[2] = &Yr($n);
	return (length($n) == 4 ? 'yyyy' : 'yy');
    } elsif (!$mdy[0] && $n <= 12) { # no month?
	$mdy[0] = $n;
	return 'mm';
    } elsif (!$mdy[1] && $n <= 31) { # no days?
	$mdy[1] = $n;
	return 'dd';
    } elsif (!$'EURO_DATES && !length($mdy[2])) { # no year?
	$mdy[2] = &Yr($n);
	return (length($n) == 4 ? 'yyyy' : 'yy');
    }
    '';
}


package main;

# Date2Abs -- convert @date into absolute days since Jan 3, 1CE.

# These calculations were taken from "Calendrical Calculations", by
# [N. Dershowitz and E. M. Reingold].

sub Date2Abs {
    package Dates;
    local($mm,$dd,$yy) = @_;
    local($m);
    local($days) = $dd;		# count days in the current month
    local($y) = $yy - 1;	# prior years
    $days += 365 * $y;		# count days in prior years
    # count days in prior months
    for ($m = 1; $m < $mm; $m++) { $days += &MonthDays($m,$yy); }
    $days += int($y / 4);	# plus leap days in prior years
    $days -= int($y / 100);	# minus century leap year days
    $days += int($y / 400);	# plus leap century days
    $days;			# return days absolute
}

# Abs2Date -- convert absolute date (days) into Gregorian date.

sub Abs2Date {
    package Dates;
    local($date) = @_;
    local($m,$y,$d);
    $y = int($date / 366);	# approximate the year
    while ($date > &'Date2Abs(1,1,$y+1)) { $y++; } # search for year
    $m = 1;			# do linear search for the month
    while ($date > &'Date2Abs(&MonthDays($m,$y),$m,$y)) { $m++; }
    $d = $date - &'Date2Abs(1,$m,$y) + 1;
    ($m,$d,$y);
}

# CmpDates -- compare two dates

sub CmpDates {
    local(@mdy1,@mdy2) = @_;
    &'Date2Abs(@mdy1) <=> &'Date2Abs(@mdy2);
}

# JDate2Abs -- convert Julian @date to absolute days
# absolute day 1 is Jan 3, 1 C.E.

sub JDate2Abs {
    package Dates;
    local($mm,$dd,$yy) = @_;
    local($m);
    local($days) = $dd;		# count days this month
    local($y) = $yy - 1;	# prior year
    $days += 365 * $y;		# count days in prior years
    # count days in prior months for this year
    for ($m = 1; $m < $mm; $m++) { $days += &JMonthDays($m,$yy); }
    $days += int($y / 4);	# count leap days in prior years
    $days -= 2;			# days elapsed before abs day 1.
    $days;
}

# Abs2JDate -- convert absolute days to Julian @Date
# (absolute date Jan 1, 1 CE == Julian date Jan 3, 1 CE)

sub Abs2JDate {
    package Dates;
    local($date) = @_;
    local($m,$y,$d);
    $y = int(($date + 2) / 366); # approximate the year
    while ($date > &'JDate2Abs(1,1,$y+1)) { $y++; } # search for year
    $m = 1;			# do linear search for the month
    while ($date > &'JDate2Abs(&JMonthDays($m,$y),$m,$y)) { $m++; }
    $d = $date - &'JDate2Abs(1,$m,$y) + 1;
    ($m,$d,$y);
}

# DayName -- return the name of the day of the week, given a @date.

sub DayName {
    package Dates;
    local($days) = &'Date2Abs(@_); # @_ should be @mdy
    $Day[&Mod($days,7) + $[]; 
}

#  ($format,$string,@Date) = &Str2Date(string)

sub Str2Date {
    package Dates;
    local($_) = @_;
    local(@mdy) = ();
    local($[) = 0;
    local($fmt,$f,$1,$2,$n,$m,$s,$day);
    s/^\s+//; s/\s+$//;
    # change "3 Oct 1991" to "Oct 3, 1991"
    s/([0-9])+\s+([a-zA-Z][a-zA-Z.]+)/\2 \1,/;
    $_ .= ' ';
    while (length) {
	if (s=^(\d+)([-./, ]+)==) {
	    ($n,$s) = ($1,$2);
	    last unless $f = &MDY(*mdy,$n);
	    $fmt .= $f.$s;
	} elsif (s=^(\w+)([-./, ]+)==) { # mmm[m]
	    ($n,$s) = ($1,$2);
	    if ($m = $Month{$n}) { # month name?
		$mdy[0] = $m;
		$fmt .= (length($n) == 3 ? 'mmm' : 'mmmm');
	    } elsif (length($day = $Day{$n})) { # day name?
		$fmt .= (length($n) == 3 ? 'day' : 'weekday');
	    } else {
		last;		# not a recognizeable word
	    }
	    $fmt .= $s;
	} else {
	    last;
	}
	($n,$s) = ();
    }
    if ($fmt =~ /^(day|weekday)$/) { # special case default
	(@mdy,$n) = (localtime)[4,3,5,6];
	$mdy[0] += 1;
	$mdy[2] += 1900;
	$mdy[1] += ($day - $n) if length($d); # convert days to named day
    } elsif ($fmt) {		# anything parsed?
	$mdy[2] = 1900+(localtime)[5] if !length($mdy[2]); # supply default year
	$mdy[0] = 1+(localtime)[4]    if !length($mdy[0]); # supply default month
	$mdy[1] = 1		      if !length($mdy[1]); # default day is 1
    }
    $fmt =~ s/ +$//;		# remove trailing space(s)
    $fmt = 'D'.$fmt if $fmt;
    $_ = $n.$s.$_;
    ($fmt,$_,@mdy);
}

# $string = &Date2Str($format,@Date);
#
# Build a string representing @Date, given the $format string.  The
# contents of $format contains special format strings, which are
# substituted by their corresponding value:
#
#  mmmm	   Long Month name
#  mmm     Short month name
#  yyyy    year
#  yy      year as two digits
#  mm      month as two digits
#  dd      day as two digits
#  day     short name of the day ('Mon',...,'Sun')
#  weekday long name of the day ('Monday', ..., 'Sunday')
#  absday  absolute day

@Dates'D2Spatterns = ('mmmm', 'mmm', 'mm', 'yyyy', 'yy', 'dd', 'day', 
		      'weekday', 'absday');

sub Date2Str {
    package Dates;
    local($_,@mdy) = @_;
    return '' unless s/^D//;
    local($mm,$dd,$yyyy) = @mdy;
    local($mmmm) = $Month[$mm + $[]; 
    local($mmm) = substr($mmmm,0,3);
    local($yy) = &UnYr($yyyy);
    local($weekday) = &'DayName(@mdy);
    local($day) = substr($weekday,0,3);
    local($absday) = &'Date2Abs(@mdy);
    local($str,$pat,$1);
  char:while (length) {
	foreach $pat (@D2Spatterns) {
	    next unless s/^$pat//;
	    $str .= eval "\"\$$pat\"";
	    next char;
	}
	$str .= $1 if s/^(.)//;
    }
    $str;
}

# Str2Time -- parse a time string into an @hmsz vector
#
# The time string can have the following format:
#
#   hh:mm:ss [ap]m ZONE
#   hh:mm [ap]m ZONE
#   hh [ap]m ZONE
#   mm:ss


sub Str2Time {
    package Dates;
    local($_) = @_;
    local(@hmsz) = (0,0,0,0);
    local($[,$pm,$zone) = (0,0,0);
    local($fmt,$1,$2,$3,$n,$s);
    s/^\s+//;
    $_ .= ' ';			# add one final breakchar
    if (s=^(\d+):(\d+):(\d+)==) {
	@hmsz[0,1,2] = ($1,$2,$3);
	$fmt = 'hh:mm:ss';
    } elsif (s=^(\d+):(\d+)==) {
	@hmsz[0,1] = ($1,$2);
	$fmt = 'hh:mm';
    } elsif (s=^(\d+)==) {
	$hmsz[0] = $1;
	$fmt = 'hh';
    } else { return ('', $_, @hmsz); }
    $fmt .= ' ' if s/^\s+//;
    substr($fmt,0,2) = 'HH' if $hmsz[0] > 12;
    while (s=^([-\w+]+)==) {
	$n = $1;
	if ($n =~ /[ap]m/i && !$pm++) {
	    $hmsz[0] += 12 if $n =~ /pm/i;
	    $fmt .= 'ap';
	} elsif (defined($TimeZone{$n}) && !$zone++) {
	    $hmsz[3] = $TimeZone{$n};	# get offset
	    $fmt .= 'tz';
	} else { 
	    $_ = $n.$s.$_;	# put back unparsed stuff
	    last;
	}
	$fmt .= ' ' if s/^\s+//;
    }
    # The following is a heuristic to correctly guess that nn:mm
    # is really 'mm:ss' rather than 'hh:mm'.
    if (!$pm && substr($fmt,0,5) eq 'hh:mm' && $hmsz[0] > 23) {
	@hmsz[0,1,2] = (0,@hmsz[0,1]);
	substr($fmt,0,5) = 'mm:ss';
    }
    $fmt = 'T'.$fmt if $fmt;
    $fmt =~ s/\s+$//;		# remove trailing spaces
    ($fmt,$_,@hmsz);
}

# Time2Secs - convert time to seconds

sub Time2Secs {
    package Dates;
    local($h,$m,$s,$tz) = @_;
    local($sum);

    $sum = $h * $HOURS + $m * $MINS + $s * $SECS;
}

sub Time2GMSecs {
    package Dates;
    local($h,$m,$s,$tz) = @_;
    local($sum);

    $sum = $h * $HOURS + $m * $MINS + $s * $SECS - $tz * $HOURS;
}

# Secs2Time - convert seconds into time (modulo one days worth of seconds)

sub Secs2Time {
    package Dates;
    local($s) = @_;
    local($h,$m);
    $s = &Mod($s,$DAYS);	# in case they give us abs seconds
    $h = int($s / $HOURS);	# get hours
    $s = $s % $HOURS;		# get remaining seconds
    $m = int($s / $MINS);	# get minutes of that
    $s = $s % $MINS;		# get remaining seconds
    ($h,$m,$secs,0);		# return h,m,s,z
}

# Abs2Secs - convert absolute days into absolute seconds (big number!)

sub Abs2Secs {
    local($days) = @_;
    $days * $Dates'DAYS;
}

# Secs2Abs - convert abs. seconds into ($days,$secs)

sub Secs2Abs {
    package Dates;
    local($secs) = @_;
    local($days) = int($secs / $DAYS);
    $secs = &Mod($secs,$DAYS);
    ($days,$secs);
}

# CmpTimes - compare two time values

sub CmpTimes {
    local($[) = 0;
    local(@hmsz1) = @_[0..3];
    local(@hmsz2) = @_[4..7];
    &Time2Secs(@hmsz1) <=> &Time2Secs(@hmsz2);
}

# Time2Str -- format a string representation of a time, given a format.
#
# The time argument is given as an @hmsz vector (see above).

# The format string can contain the following patterns:

# hh    - the hours (in 12 hour) format
# HH    - the hours (in 24 hour) format
# mm    - the minutes
# ss    - the seconds
# ap    - AM or PM as appropriate (also use "am" or "pm")
# tz    - time zone name
# <x>   - any other characters are substituted as is.

@Dates'T2Spatterns = ('hh', 'HH', 'mm', 'ss', 'ap', 'am', 'pm', 'tz');

sub Time2Str {
    package Dates;
    local($_,@hmsz) = @_;
    return '' unless s/^T//;
    local($HH,$mm,$ss,$zoff) = @hmsz;
    local($am) = $HH < 12 ? 'AM' : 'PM';
    local($pm,$ap) = ($am,$am);
    local($hh) = $HH < 13 ? $HH : $HH - 12;
    local($tz) = sprintf("%s%04d", ($zoff < 0) ? "-" : "+",
			 ($zoff < 0) ? -$zoff : $zoff);
    local($str,$pat,$1);
  char:while (length) {
      foreach $pat (@T2Spatterns) {
	  next unless s/^$pat//;
	  $str .= eval "\"\$$pat\"";
	  next char;
      }
      $str .= $1 if s/^(.)//;
    }
    $str;
}

# Str2DT - convert a string to a Date and Time.

sub Str2DT {
    package Dates;
    local($str) = @_;
    local($dfmt,$dstr,@mdy) = &'Str2Date($str);
    local($tfmt,$tstr,@hmsz) = $dstr ? &'Str2Time($dstr) : ('','','','','','');
    ($dfmt,$tfmt,$tstr,@mdy,@hmsz);
}


1;				# keep require happy