From: buzz@bear.com (Buzz Moschetti)
Newsgroups: comp.lang.perl
Subject: date.pl - A date handling library
Date: 27 Jan 93 16:58:29 GMT
Reply-To: buzz@bear.com (Buzz Moschetti)
Organization: Bear, Stearns & Co. - FAST

This is a library of routines that manipulate dates.  Features:

	* No spawning of date or cal for superior performance.
	* Dates may be compared and have days, months, or years 
	  added to them.
	* Dates recognized in a variety of formats, including
	  MM/DD/YYYY, DD MON YYYY, etc.
	* Full support for leap years, pre-Gregorian calendars,
	  and September 1752.

Comments, suggestions, etc. are welcome.

#
#  DEXID
#	date.3PL
#
#  NAME
#	date - perl date handling library
#
#  SYNOPSIS
#	require "date.pl";
#
#	$days = &date_cmp($date1, $date2);
#
#	$days = &date_cmp_months($date1, $date2);
#
#	($m, $d, $y) = &date_to_mdy($date);
#
#	$date = &date_mdy_to_date($m, $d, $y);
#
#	$date = &date_plus_days($date, $days);
#
#	$date = &date_plus_months($date, $months);
#
#	$date = &date_plus_years($date, $years);
#
#	$rc = &date_is_leap($date)
#
#	$day = &date_day_of_week($date);
#
#	&date_set_date_style($type);
#
#
#  DESCRIPTION
#	The date library is a collection of routines to 
#	manipulate dates.  Functions calling for date-type arguments may
#	be passed simple strings in any one of these forms:
#
#		MM/DD/YYYY
#		YYYYMMDD
#		DD-MON-YYYY
#		DD MON YYYY
#		MONTH DD, YYYY
#
#	MON and MONTH may be mixed case (e.g. aUgUsT) on input but will be
#	uppercased, lowercased, or capitalized on return based on the case
#	of the first and second characters.  If char 1 is lowercase, then
#	the whole name will be lowercased.  If char 1 and char 2 are
#	uppercase, then the whole name will be uppercased.  In all other
#	permutations, the name will be capitalized (e.g. April).
#
#	The forms may be mixed in those functions calling for two
#	date-type arguments.  For example, 
#
#		$diff = &date_cmp("12/4/1964", "01-Jul-1992");
#
#	is a valid statement.
#
#	Functions that return date-type scalar strings will format them in
#	the same format as their first date-tyoe argument.  Examples:
#		
#		"12/05/1992" = &date_plus_days("12/03/1992", 2);
#		"9-NOV-1992" = &date_plus_months("9-OCT-1992", 1);
#	The exception is &date_mdy_to_date(), which will use the format of
#	the last such command since it is passed individual month, day,
#	and year.
#
#	Leap years, post-Gregorian calendars, and the Sep. 1752 anomaly are
#	all taken into account when performing date calculations.
#
#
#	&date_cmp() returns the difference in days between two dates.  The
#	number is < 0 if $date1 is before $date2, 0 if they are the same
#	date, or > 0 if $date1 is after $date2.
#
#	&date_cmp_months() is similar to &date_cmp() except that the
#	difference in months is returned.
#
#	&date_to_mdy() takes a date-type scalar string and returns a list
#	containing the month, day, and year.  The m/d/y values are in
#	"regular" format; that is, month is an integer from 1 to 12 and
#	the year is the actual year, centuries included.  Fans of the Un*x
#	(struct tm) datatype may find this confounding at first since
#	in the (struct tm) resource months are returned as (real month - 1)
#	and years are returned as (real year - 1900).
#
#	&date_mdy_to_date() returns a date-type scalar string given a list
#	containing month, day, and year.  The format of the string will be
#	the same as the last date-type passed as the first argument to one
#	of the other functions that takes a date-type scalar string as an
#	argument.  NOTE:  If &date_mdy_to_date() is called before any
#	function that requires a date-type scalar string, then the format
#	will default to MM/DD/YYYY.
#
#	&date_plus_days(), &date_plus_months(), and &date_plus_years() add
#	an integer number of days, months, or years, respectively, to a
#	given date and return the new date.  The integer may be negative,
#	resulting in a new date that is before the given date.
#
#	&date_is_leap() returns 1 if the given date is a leap year or 0 if
#	it is not.
#
#	&date_day_of_week() returns the ordinal day of the week with
#	Sunday being 0.
#
#	&date_set_date_style() forces all date-type scalar strings
#	returned by other functions to match the format in the input
#	argument.  Any valid date may be used.  If no argument is
#	supplied then the current style is "unset"; that is, the returned
#	strings will once again match the input format.
#
#  NOTES
#	perl constantly creates doubles (floating point) during division.
#	We are only interested in the integer component, so we must call
#	int() to strip the fractional component off.
#
#	The algorithms have been optimized somewhat for performance sake
#	at the expence of clarity.  For example,
#
#	     if($epoch_day < ((1752-1)*365 + (1752-1)/4)) {
#
#	which lets you know it's targeting the special year 1752 and
#	checks for leap years {(1752-1)/4} has been replaced with
#
#	    if($epoch_day < 639552) {
#
#	The un-optimized code has been commented out so you can see what
#	is going on.
#
#  BUGS
#	No NULL/undef date handling as of yet.
#
#
#  COPYRIGHT
#	Copyright 1993  Buzz Moschetti
#
#	Permission to use, copy, modify, distribute, and sell this
#	software and its documentation for any purpose is hereby granted
#	without fee, provided that this copyright notice appear in all
#	copies and that both that copyright notice and this permission
#	notice appear in supporting documentation, and that the name of
#	Buzz Moschetti or contractions or abbreviations of the same not be
#	used in advertising or publicity pertaining to distribution of the
#	software without prior specific, written permission.  The author
#	makes no representations about the suitability of this software
#	for any purpose.  It is provided "as is" without express or
#	implied warranty.
#
#	BUZZ MOSCHETTI (THE "AUTHOR") DISCLAIMS ALL WARRANTIES WITH REGARD
#	TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF
#	MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL THE AUTHOR BE
#	LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
#	DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
#	WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS
#	ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
#	PERFORMANCE OF THIS SOFTWARE.
#
#  AUTHOR
#	Buzz Moschetti
# 



package date;


#
#  Various resources:
#
@abbrev_month_names = ('JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC');
@full_month_names = ('JANUARY','FEBRUARY','MARCH','APRIL','MAY','JUNE','JULY','AUGUST','SEPTEMBER','OCTOBER','NOVEMBER','DECEMBER');

@month_names = @abbrev_month_names;		# default

#
#  month styles (case of returned month name)
#	1 - lowercase
#	2 - uppercase
#	3 - caps
#
$set_month_style = 0;
$default_month_style = 3;


#
#  date styles:
#	1 - MM/DD/YYYY
#	2 - YYYYMMDD
#	3 - DD-MON-YYYY
#	4 - DD MON YYYY
#	5 - DD MONTH YYYY
#	6 - MONTH DD, YYYY
#
$set_date_style = 0;  # no style has been set.
$default_date_style = 1;


@norm_upto = (0, 31, 59,                        # Jan, Feb, Mar 
	      90, 120, 151,                     # Apr, May, Jun
	      181, 212, 243,                    # Jul, Aug, Sep
	      273, 304, 334,                    # Oct, Nov, Dec
	      365);                             # end of year
		
@leap_upto = (0, 31, 60,                        
	      91, 121, 152,                     
	      182, 213, 244,                    
	      274, 305, 335,                    
	      366);

# That odd-ball year, 1752.  Note September!
@y1752_upto = (0, 31, 60,
	      91, 121, 152,
	      182, 213, 244,
	      263, 294, 324,
	      355);

#  End of month dates for normal and leap year months
@norm_year = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
@leap_year = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);



#
#  $days = &date_cmp($date1, $date2);
#
sub date_cmp {
	local($d1, $d2) = @_;
	local($e1, $e2);

	$e1 = &date_mdy2epod(&date_to_mdy($d1));
	$e2 = &date_mdy2epod(&date_to_mdy($d2));

	return $e1 - $e2;
}

#
#  $days = &date_cmp_months($date1, $date2);
#
sub date_cmp_months {
	local($d1, $d2) = @_;
	local(@mdy1, @mdy2);

	@mdy1 = &date_to_mdy($date1);
	@mdy2 = &date_to_mdy($date2);

	return $mdy1[1] - $mdy2[1];
}

#
#  ($m, $d, $y) = &date_to_mdy($date);
#
#  In addition to being a handy app-level function in its own right,
#  &date_to_mdy() is used internally by many of the date routines
#  since it is capable of taking a variable-format scalar string and
#  converting into a well-defined array containing discrete entries
#  for month, day, and year.
#
sub date_to_mdy {
	local($date) = @_;
	local($m, $d, $y) = (-1,-1,-1);

	if($date =~ /(\d+)\/(\d+)\/(\d{4,4})/) {
		$m = $1;
		$d = $2;
		$y = $3;
		$default_date_style = 1;
	} elsif($date =~ /(\d{4,4})(\d{2,2})(\d{2,2})/) {
		$m = $2;
		$d = $3;
		$y = $1;
		$default_date_style = 2;
	} elsif($date =~ /(\d+)-(\w{3,3})-(\d{4,4})/) {
		$m = $2;
		@month_names = @abbrev_month_names;

		#  month name string $m will become month number $m:
		if(($m = &month_to_idx($m, @month_names)) != -1) {
			$m += 1;
			$y = $3;	
			$d = $1;

			&setup_month_style($2);
			$default_date_style = 3;
		}
	} elsif($date =~ /(\d+)\s+(\w{3,3})\s+(\d{4,4})/) {
		$m = $2;
		@month_names = @abbrev_month_names;

		#  month name string $m will become month number $m:
		if(($m = &month_to_idx($m, @month_names)) != -1) {
			$m += 1;
			$y = $3;	
			$d = $1;

			&setup_month_style($2);
			$default_date_style = 4;
		}

	}  elsif($date =~ /(\d+)\s+(\w{4,9})\s+(\d{4,4})/) {
		$m = $2;
		@month_names = @full_month_names;

		#  month name string $m will become month number $m:
		if(($m = &month_to_idx($m, @month_names)) != -1) {
			$m += 1;
			$y = $3;	
			$d = $1;

			&setup_month_style($2);
			$default_date_style = 5;
		}
	} elsif($date =~ /(\w{4,9})\s+(\d+),\s*(\d{4,4})/) {
		$m = $1;
		@month_names = @full_month_names;

		#  month name string $m will become month number $m:
		if(($m = &month_to_idx($m, @month_names)) != -1) {
			$m += 1;
			$y = $3;	
			$d = $2;

			&setup_month_style($1);
			$default_date_style = 6;
		}
	}


	@rc = ($m, $d, $y);
}

#
#  $date = &date_mdy_to_date($m, $d, $y)
#
sub date_mdy_to_date {
	local($m,$d,$y) = @_;
	local($date_fmt);

	if($set_date_style) {
		$date_fmt = $set_date_style;
	} else {
		$date_fmt = $default_date_style;
	}
	
	if($date_fmt == 1) {
		$rc = sprintf("%02d/%02d/%4d", $m, $d, $y) ;
	} elsif($date_fmt == 2) {
		$rc = sprintf("%4d%02d%02d", $y, $m, $d) ;
	} elsif($date_fmt == 3) {
		$rc = sprintf("%02d-%s-%4d", $d, &make_month_name($m), $y);
	} elsif($date_fmt == 4) {
		$rc = sprintf("%02d %s %4d", $d, &make_month_name($m), $y);
	} elsif($date_fmt == 5) {
		$rc = sprintf("%d %s %4d", $d, &make_month_name($m), $y);
	} elsif($date_fmt == 6) {
		$rc = sprintf("%s %d, %4d", &make_month_name($m), $d, $y);
	}

	$rc;
}



#
#	$ndate = &date_plus_months($date, $months);
#
sub date_plus_months {
	local($d1, $months) = @_;

	@mdy = &date_to_mdy($d1);

	$mdy[0] += $months;

	if($mdy[0] > 0) {
		while ($mdy[0] >= 12) {
		    $mdy[0] -= 12;
		    $mdy[2]++;
		}
	} else {
		while ($mdy[0] < 0) {
		    $mdy[0] += 12;
		    $mdy[2]--;
		}
	}

    #
    #  Dont go past the valid end-of-month.  Also, notice the adjustment
    #  of the month[] index ($mdy[0] - 1).  Don't worry about 
    #  Sep, 1752:  The last day of that weird month it *still* 30, so  
    #  we can use @norm_year or @leap_year.
    #
    if(&date_is_leap(&date_mdy_to_date(@mdy))) {
	@month = @leap_year;
    } else {
	@month = @norm_year;
    }

    if ($month[$mdy[0] - 1] < $mdy[1]) {
	$mdy[1] = $month[$mdy[0] - 1];
    }

    $rc = &date_mdy_to_date(@mdy);
}




#
#  $ndate = &date_plus_days($date, $days);
#
sub date_plus_days {
	local($date, $days) = @_;
	local($edays);

	$edays = &date_mdy2epod(&date_to_mdy($date));
	$edays += $days;

	$rc = &date_mdy_to_date(&date_epod2mdy($edays));
}


#
#  $rc = &date_is_leap($d1)
#
sub date_is_leap {
	local($d1) = @_;

	@mdy = &date_to_mdy($d1);
	
	$y = $mdy[2];

	$rc = ((($y)<1752 && ($y)%4) ||(($y)>1752 && (($y)%4==0&&(($y)%100!=0||($y)%400==0))))
}


#
#  $ndate = &date_plus_years($date, $years);
#
sub date_plus_years {
	local($d1, $years) = @_;

	@mdy = &date_to_mdy($d1);

	$mdy[2] += $years;

	#
	#  Make sure we dont add years simply to 29th feb on a leap year
	#
	if (! &date_is_leap(&date_mdy_to_date(@mdy)) &&
		$mdy[1] == 1 &&
		$mdy[2] == 29) {
	    $mdy[1] = 28;
	}

	$rc = &date_mdy_to_date(@mdy);
}



sub date_day_of_week {
	local($date) = @_;

	$rc = (&date_mdy2epod(&date_to_mdy($date)) + 5) % 7;

	if($rc < 0) {
		$rc += 7;
	}

	$rc;
}


sub date_set_date_style {
	local($date) = @_;

	if(!$date) {
		$set_date_style = 0;
		$set_month_style = 0;
	} else {
		#  Force the styles to be set:
		&date_to_mdy($date);

		#  Assign them permanently;
		$set_date_style = $default_date_style;
		$set_month_style = $default_month_style;
	}
}


#
#
#   P R I V A T E   F U N C T I O N S
#
#
#
sub setup_month_style {
	local($m) = @_;

	#  Ultra-simple rules:
	#  If first char is lower case, then the whole thing is
	#  lower case.
	#  If the first char is upper case and the second char is
	#  lower case, then the month is capitalized.
	#  If the first char is upper case and the second char is
	#  also upper case, then the month is upper cased.
	#
	$c1 = substr($m, 0, 1);
	$c2 = substr($m, 1, 1);

	if($c1 ge 'a' && $c1 le 'z') {
		$default_month_style = 1;  # lowercase
	} elsif($c1 ge 'A' && $c1 le 'Z' &&
		$c2 ge 'A' && $c2 le 'Z') {
		$default_month_style = 2;  # uppercase
	} else {
		$default_month_style = 3;  # caps (default)
	}
}

#  Assumes @month_names and $month_style have been set!
sub make_month_name {
	local($m) = @_;
	local($style, $str);

	#  $m is "correct" number; subtract 1 to get offset!
	$str = @month_names[$m - 1];

	#  If month_style is 2 (all uppercase), then don't do anything.
	#  Yes, this is not particularly robust coding...
	if($set_month_style) {
		$style = $set_month_style;
	} else {
		$style = $default_month_style;	
	}

	if($style == 1) {
		$str =~ tr/A-Z/a-z/;
	} elsif($style == 3) {
		$str[0] =~ tr/a-z/A-Z/;
		substr($str, 1) = (substr($str, 1) =~ tr/A-Z/a-z/);
	}

	$str;
}

	

sub month_to_idx {
	local($str, @m_arr) = @_;

	# Force uppercase for comparison!
    	$str =~ tr/a-z/A-Z/;

	for($i = 0; $i < 12; $i++) {
		if($m_arr[$i] eq $str) {
			return $i;
		}
	}

	-1;
}


sub date_mdy2epod {

	local($m, $d, $y) = @_;


	@upto = @norm_upto;


	#  Adjust for struct tm conventions:
	$m--;


	if($y<1 || $y>9999 || $m<0 || $m>11 || $d<1 || $d>31) {
		return -1;
	}

	
    $day = ($y-1) * 365;	#  Well, most years have at 
				#  least this many days

    $day += int(($y-1)/4);		#  account for all leap years 

    if ($y > 1800) {		#  Adjust Post-Gregorian correction
	 $day -= int(($y-1701)/100);	#  less 1 day per century
	 $day += int(($y-1601)/400);	#  but one more per 400 years
    }



    if($y < 1752) {			# pre strange year
	if ($y % 4 == 0) {		# choose leap year table
	    @upto = @leap_upto;
	}
    } elsif($y > 1752) {		# after strange year 
	if($y % 4 == 0 && ($y % 100 != 0 || $y % 400 == 0)) {
	    @upto = @leap_upto;	#  new leap year
	}
	$day -= 11;		# account for 1752 
    } else {		# year must be 1752 
    
	@upto = @y1752_upto;

	if($m == 8) {
	    if($d > 2 && $d < 14) {
		warn("InternalError; invalid day $d in Sep. 1752");
		return -1;
 	    } elsif($d >= 14)	{	# fake day of month 
		$d -= 11;
	    }
	}
    }

    if($d > ($upto[$m + 1] - $upto[$m])) {	# check for bad day of month 
	warn("InternalError; calc error; $d not valid day of month.\n");
	return -1;
    }
    
    return $day + $upto[$m] + $d;
}



sub date_epod2mdy {
	local($epoch_day) = @_;

	$tmp_year = 0;
	@upto = @norm_upto;


     # Converting in this direction is immensely more difficult
     # than the preceding routine. We have to keep pecking away
     # until we figure out which year the day falls in, then
     # find the month and day. All of this works more easily if
     # the is day 0-based, rather than 1-based, so we start
     # by subtracting 1.
     #

	$epoch_day--;

	# Years up to 1752
##    if($epoch_day < ((1752-1)*365 + int((1752-1)/4))) {
    if($epoch_day < 639552) {
	($epoch_day, $tmp_year) = &date_doleap($epoch_day, $tmp_year, 3); # simple Julian procedure; 
					   # first leap year is 3 hence 
	if($tmp_year % 4 == 3) {	       # leap year (zero-based) 
	    @upto = @leap_upto;      # An integer array in dates.h 
	}
    }
     # Year 1752 only
##    elsif($epoch_day < ((1753-1)*365 + int((1753-1)/4) - 11)) {
    elsif($epoch_day < 639907) {
##	$epoch_day -= (1752-1)*365 + int((1752-1)/4);
	$epoch_day -= 639552;
##	$tmp_year = 1752 - 1;	# years are zero-based 
	$tmp_year = 1751;	# years are zero-based 
	@upto = @y1752_upto;
    }

     # Years 1753 to 1800
##   elsif($epoch_day < ((1800-1)*365 + int((1800-1)/4) - 11)) {
    elsif($epoch_day < 657073) {

	 # Treat this like pre-1752,
	 # since no funny leap year until 1800.
	 # Therefore, cheat by adding back missing 11 days.

	$epoch_day += 11;

	# first leap yr is 1756 

##	($epoch_day, $tmp_year) = &date_doleap($epoch_day, $tmp_year, 1756-1753);
	($epoch_day, $tmp_year) = &date_doleap($epoch_day, $tmp_year, 3);

	if($tmp_year % 4 == 3) {    # use leap year table 
	    @upto = @leap_upto;   
	}
    }

     # Years 1800 to 2000.
     # Deduct century year correction, leave 1752
     # correction.
##   elsif($epoch_day < ((2000-1)*365 + int((2000-1)/4) - 2 - 11)) {
    elsif($epoch_day < 730121) {

	 # Change basis to be first day of 1800

##	$epoch_day -= (1800-1)*365 + int((1800-1)/4) - 11;
	$epoch_day -= 657073;
	$tmp_year = 1799;		# zero-based, remember 

	($epoch_day, $tmp_year) = &date_do100($epoch_day, $tmp_year); # century handling

	if($tmp_year % 4 == 3 && $tmp_year % 100 != 99) {
	    @upto = @leap_upto;	 # year is a leap year 
	}
    }

     # Years 2000 and after.
     # Base things from first day of year 2000.
    else {
##	$epoch_day -= (2000-1)*365 + int((2000-1)/4) - 2 - 11;
	$epoch_day -= 730121;
	$tmp_year = 1999;
	# get accurate year, day :
	($epoch_day, $tmp_year) = &date_do400($epoch_day, $tmp_year);

	 # check for leap year
	if($tmp_year % 4 == 3 &&
			($tmp_year % 100 != 99 || $tmp_year % 400 == 399)) {
	    @upto = @leap_upto;
	}
    }


     # At this point the hard stuff is done.
     # "year" is the correct year minus 1.
     # "epoch_day" has changed from being the actual number of days since
     #		Jan 1, 0 to the day of the year within "year" (zero-based:
     #		1/1 is zero), e.g. Feb 5 is 35.
     # 
    for($tmp_month = 1;
	$epoch_day >= $upto[$tmp_month] && $tmp_month <= 12;
	$tmp_month++) {
    }

    if($tmp_month > 12) {
	warn("InternalError; calc error: day of year > 365.");
	return (-1,-1,-1);
    }

    $tmp_month--;


    $year = $tmp_year + 1;
    $mon = $tmp_month + 1;
    $day = $epoch_day - $upto[$tmp_month] + 1;


     # Fudge for 1752 anomaly
    if($tmp_year == 1751 && $tmp_month == 8 && $day > 2) {
	$day += 11;
    }

    @rc = ($mon, $day, $year);
}


# This routine converts an epoch_day day into the relative
# year and day of year components according to a simple Julian
# calendar (ie. leap year every four years). A zero relative year
# is assumed to be a leap year.

sub date_doleap {
	local($day, $year, $firstleap) = @_;

				    # leap interval 
    if($day < $firstleap*365) {
	$year += int($day/365);	#simple non-leap calc. 
	$day %= 365;

	@rc = ($day, $year);
	return @rc;
    } else {
	$year += $firstleap;	# discard first non-leap interval 
	$day -= 365 * $firstleap;
    }

##    $nquad = int($day/(365*4+1));	# number of 4-year hunks 
    $nquad = int($day/1461);	# number of 4-year hunks 
    $nrem = $day % 1461;	# left-over days from such hunks 



    # The 0th of these years is the leap year
    $tmp_year = 0;			# year in hunk 

##    if($nrem > 366-1) {		# check for beyond leap year 
    if($nrem > 365) {		# check for beyond leap year 
	$tmp_year = int(($nrem-366)/365+1);	# number of full years 
    }

    $year += $nquad*4 + $tmp_year;	# bump relative year 
    $day = $nrem - 365*$tmp_year - ($tmp_year == 0 ? 0:1);
				    # get day number within year 

    @rc = ($day, $year);
}


# This routine converts an epoch_day day into the relative year
# and day in year simply assuming that years on 100 year boundaries
# are not leap years. The zero year is assumed to be divisible by 100.

sub date_do100 {
	local($days, $year) = @_;


##	$ncentury = int($days/(100*365+100/4-1));
	$ncentury = int($days/36524);
				    # number of centuries covered 

##	$days %= int((100*365+100/4-1));	# get new number of days 
	$days %= 36524;			# get new number of days 
    	$year += 100 * $ncentury;		# bump year 

	($days, $year) = &date_doleap($days, $year, 4);	# handle the rest for leap years;
				    # note we won't hit the century 
				    # boundary anomaly; first following 
				    # leap year is 4 away 

	@rc = ($days, $year);
}


# This routine converts an epoch_day day into the relative year
# and day in year simply assuming that we have to be concerned with
# 100 and 400 year anomalies. Leap years are taken into account.
# The zero year is assumed to be divisible by 400.

sub date_do400 {
	local($days, $year) = @_;
    
      $n100 = 0;
##    $n400 = int($days/(400*365+400/4-4+1));
    $n400 = int($days/146097);

##    $days %= int((400*365+400/4-4+1));	# update number of days 
    $days %= 146097;				# update number of days 


     # First century of tetra-centennial has all its leap years
##	if($days > 100*365 + int(100/4)) {
    if($days > 36525) {

##	$n100 = ($days-(100*365+ int(100/4)))/(100*365+int(100/4)-1)+1;
	$n100 = int(($days-36525)/36524) + 1;	    # number of centuries

##   $days -= $n100*(100*365+int(100/4)-1)+1;
	$days -= ($n100 * 36524) + 1; 		    # gives day in century
    }

    $year += (100 * $n100) + (400 * $n400);	# update year 
    ($days, $year) = &date_doleap($days, $year, ($n100 == 0)?0:4);
				    # handle century this way; 
				    # first leap year is current 
				    # year if 400 boundary 
				    # else 4 away 

    @rc = ($days, $year);
}

1;