#/usr/local/bin/perl require 'date.pl'; $command = ''; print " Date Calculator version 1.0\n"; print " (type `h' for help)\n"; print "> "; while(<stdin>) { ($command) = /^\s*(\w+)\s*$/; last if (index("quit",$command) == 0); if (/^\s*(\d+)\s+(\d+)\s+(\d+)\s*$/) { # quit $j = &jday($1,$2,$3); push(@stack,$j); next; } elsif (/^\s*(\w+)\s+(\d+)(\s+(\d+)?)\s*$/) { # mmm dd yy # assumes this year if year is missing $j = &jday(&monthnum($1),$2,$4); push(@stack,$j); next; } elsif (/^\s*([-]?\d+)\s*$/) { # [-]n push(@stack,$1); next; } elsif (index("clear",$command)==0) { # clear @stack = (); next; } elsif (index("duplicate",$command)==0) { # duplicate push(@stack,$stack[$#stack]); next; } elsif (index("exchange",$command)==0 || $command eq 'x') { # exchange $x = pop(@stack); $y = pop(@stack); push(@stack,$x); push(@stack,$y); next; } elsif (index("print",$command)==0) { # print do print($stack[$#stack]); next; } elsif (index("today",$command)==0) { # today push(@stack,&today()); do print($stack[$#stack]); next; } elsif (/^\s*[+]\s*$/) { # add $y = pop(@stack); $x = pop(@stack); if (&is_jday($x) && &is_jday($y)) { print stderr "** cannot add two dates\n"; push(@stack,$x); push(@stack,$y); next; } $r = $x + $y; push(@stack,$r); do print($r); next; } elsif (m:^\s*([\-*/%])\s*$:) { # (-) (*) (/) and (%) $y = pop(@stack); $x = pop(@stack); $r = eval "$x $+ $y"; warn "** evaluation error $@\n" if $@ ne ""; push(@stack,$r); do print($r); next; } elsif (index("Print",$command)==0) { # dump do dump(); next; } elsif (index("help",$command)==0) { # help print <<EOD ; Commands: mmm dd Push date for current year onto stack mmm dd yyyy Push date onto stack n or -n Push positive/negative constant or interval onto stack + - * / % Add, subtract, multiply, divide, modulo expr Push result of Perl expression onto stack <d>uplicate Push a duplicate of the top value onto the stack <c>lear Clear stack <p>rint Print last value on stack <P>rint Print all stack values <t>oday Put today's date on the stack e<x>change Exchange top two values of stack <q>uit Exit the program Note: expressions are scanned for embedded dates of the form `1991/Jan/2', `Jan 1, 1991' or just `Jan 1'. These dates are translated to Julian Day numbers before the expression is evaluated. Also, the tokens `today', `tomorrow' and `yesterday' are replaced with their respective Julian Day numbers. If the expression does something stupid with Julian Day numbers (like add them) you get silly results. EOD next; } else { chop; # replace yyyy/mmm/dd dates with Julian day number s|(\d{1,4})\W?(\w\w\w)\W?(\d\d?)|&jday(&monthnum($2),$3,$1)|ge; # replace mmm dd yyyy dates with Julian day number s|(\w\w\w)[\W\s](\d\d?)[,]?[\W\s](\d{1,4})|&jday(&monthnum($1),$2,$3)|ge; # replace mmm dd dates with Julian day number (for this year) s|(\w\w\w)[\W\s](\d\d?)|&jday(&monthnum($1),$2)|ge; # replace 'today' with todays jday s|\b(today)\b|&today()|ge; # replace 'tomorrow' with tomorrows jday s|\b(tomorrow)\b|&tomorrow()|ge; # replace 'yesterday' with yesterdays jday s|\b(yesterday)\b|&yesterday()|ge; print $_,"\n"; push(@stack,eval($_)); do print($stack[$#stack]); next; } # else { warn "** invalid command - try \"help\"\n" unless ($_ eq "\n"); } } continue { print "> "; $command = ""; } sub print #(value) { if (&is_jday($_[0])) { ($m,$d,$y,$wd) = &jdate($_[0]); $month = &monthname($m,3); $wkday = &weekday($wd); print "= $wkday $month $d, $y (JD = $_[0])\n"; } else { if ($_[0] > 365 || $_[0] < -365) { $years = int($_[0] / 365.25); $days = $_[0] - int($years * 365.25); print "= $_[0] days ($years years, $days days)\n\n"; } else { print "= $_[0] days\n\n"; } } } sub dump { for ($i = 0; $i <= $#stack; $i++) { print "stack[",$i,"] "; do print($stack[$i]); } }