#!/usr/bin/perl use strict; # --------------------------------------------------------------------- # # gauss.pl exploring Gauss' formula for weekday calculation # (Gregorian Calendar) # # Input: year/month/day [{+|-} offset] # # Output: Weekday, date, Julian Calendar date, day of the year, # week of the year, Julian day number (since -4713/11/24), # Unix day number (since 1970/01/01) # # Sample: gauss.pl 2004/01/01+94 # Sun 2004/04/04, JC 2004/03/22, D# 95 W# 14 J# 2453100 X# 12512 # # $Date: 2009-03-10 16:09:53 $ # $Revision: 1.12 $ # # Copyright (C) 2004-2009 Berndt Schwerdtfeger # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # --------------------------------------------------------------------- # set global constants and initialize variables my @d = qw / 0 31 28 31 30 31 30 31 31 30 31 30 31 /; my @e = (); $e[0] = 0; for (1..12) { $e[$_] = $e[$_-1] + $d[$_-1]; # days in previous months } @d = qw / Mon Tue Wed Thu Fri Sat Sun /; my ($y,$m,$d) = (); # --------------------------------------------------------------------- # Subroutines # div(a,b) = int a/b (corrected integer divide, works if a < 0) # leap(year) = 1 if year is a leap year # date(offset, year) = 'y/m/d' Gregorian Calendar date # jdate(offset, year) = 'JC y/m/d' Julian Calendar date # offset(y,m,d) = offset into year y # weekday(y,m,d) = {0|1|2|3|4|5|6} (Gauss formula) 0 = Monday # julian(y,m,d) = integer, number of days since JC -4712/01/01 # --------------------------------------------------------------------- # --------------------------------------------------------------------- sub div { my ($a,$b) = @_; my $x = int $a / $b; if ($a < 0) { # negative correction $x -= $a % $b != 0 } return $x; } # --------------------------------------------------------------------- sub leap { my ($y) = @_; my $c = &div($y,100); my $g = $y % 100; return ( $g != 0 && $g % 4 == 0 ) || ( $g == 0 && $c % 4 == 0 ); } # --------------------------------------------------------------------- sub date { my ($d,$y) = @_; # offset, year $y += 0; # remove trailing blank while ($d > 365 + &leap($y)) { # if offset is too large $d -= 365 + &leap($y++); # ... find the correct year } while ($d <= 0) { # if offset is negative $d += 365 + &leap(--$y); # ... adjust year and offset } my @l = qw / 0 0 0 /; for (1..10) { push @l,&leap($y); # adjust for leap day } my $m = 12; while ($d <= $e[$m] + $l[$m]) { # searching for the month $m--; } if ($m < 10) { $m = "0" . $m; } $d -= $e[$m] + $l[$m]; if ($d < 10) { $d = "0" . $d; } return ($y .'/'. $m . '/' . $d) } # --------------------------------------------------------------------- sub jdate { my ($d,$y) = @_; # offset, year while ($d > 365 + ($y%4==0)) { # if offset is too large $d -= 365 + ($y++%4==0); # ... find the correct year } while ($d <= 0) { # if offset is negative $d += 365 + (--$y%4==0); # ... adjust year and offset } my @l = qw / 0 0 0 /; for (1..10) { push @l,($y%4==0); # adjust for leap day } my $m = 12; while ($d <= $e[$m] + $l[$m]) { # searching for the month $m--; } if ($m < 10) { $m = "0" . $m; } $d -= $e[$m] + $l[$m]; if ($d < 10) { $d = "0" . $d; } return (', JC '. $y .'/'. $m . '/' . $d .',') } # --------------------------------------------------------------------- sub offset { my ($y,$m,$d) = @_; my @l = qw / 0 0 0 /; for (1..10) { push @l,&leap($y); # adjust for leap day } return $d + $e[$m] + $l[$m]; # offset into this year } # --------------------------------------------------------------------- sub weekday { my ($y,$m,$d) = @_; if ($m < 3) {$y--;} my $c = &div($y,100); my $g = $y%100; my $f = 5 * ($c%4); my $e = $e[$m]; if ($m > 2) {$e--;}; # Gauss' formula return (-1 + $d + $e + $f + $g + int($g/4)) % 7; } # --------------------------------------------------------------------- sub julian { my ($y,$m,$d) = @_; my $e = 0; if ($m < 3) { $y--; $e = 365; } my $c = &div($y,100); my $g = $y%100; $e += $e[$m]; return 1721060+$d+$e+365*$y+&div($c,4)+24*$c+int($g/4); } # --------------------------------------------------------------------- # Main program # --------------------------------------------------------------------- # get the arguments my $date = ''; for (@ARGV) { $date .= $_; } ($y,$m,$d) = split /\//,$date; if ($y eq '?' || $y eq '' || $m eq '' || $d eq '') { print "\nGregorian Calendar (since 1582/10/15)\n\n"; print " Input: year/month/day) [{+|-} offset]\n\n"; print " Output: Weekday, date, Julian Calendar date, day of the year,\n"; print " week of the year, Julian day number, Unix day number\n\n"; print " Sample: gauss.pl 2004/01/01 + 94\n"; print " Sun 2004/04/04, JC 2004/03/22, D# 95 W# 14 J# 2453100 X# 12512\n\n"; exit } while (1) { my $n = 0; if ($d =~ /\+/) { # if offset provided ($d,$n) = split /\+/,$d; # get the offset } if ($d =~ /-/) { # if negative offset ($d,$n) = split /-/,$d; # get the offset $n = -$n; } $n += &offset($y,$m,$d); # get correct offset $date = &date($n,$y); # get correct date ($y,$m,$d) = split /\//,$date; # parse vars my $j = &julian($y,$m,$d); # get Julian day number my $x = $j - 2440588; # get Unix day number my $jdate = &jdate($j+1,-4712); # get Julian date $n = &offset($y,$m,$d); # get offset in this year my $w = &weekday($y,$m,$d); # get weekday (Gauss) my $week = "W# "; $week .= int (($n-$w+11)/7); # week number print "$d[$w] $date"."$jdate D# $n $week J# $j X# $x \n"; ($y,$m,$d) = split /\//,; chomp $d; if ($y eq '' || $m eq '' || $d eq '') {exit} }