Date subroutines and calculator 
Author Message
 Date subroutines and calculator

In a recent posting someone was looking for perl routines that
manipulate dates.  Here's a perl library that implements the standard
jday and jdate functions (as described in Collected Algorithms of
the ACM).  There are also routines which return the month name and
weekday name given a month number of weekday number.  And there are routines
that return the Julian day number for today, tomorrow and yesterday.

As a bonus prize, you also get an RPN-style date calculator.  Similar to bc,
it also allows you to push perl expressions onto the stack -- thanks to
the magic of `eval'.  Moreover, your expression can contain dates (like
Jan 1, 1991) or functions like `today', `tomorrow' or `yesterday'.

Just cut everything below the cut line and feed it to sh.  You'll get
date.pl (the subroutine library) and dtc (the calculator).  You'll
probably want to edit the first line of dtc.

I would have like to have included routines that scan for any date format
and extract it, but I haven't gotten around to it yet.  Consequently, dtc
supports only a few date formats.  Sorry, but what's here is useful enough.

Disclaimer:  no warranty is expressed or implied

Right to copy:  you can do anything you want with this (but if you make
                lots of money from it, send me some)

------------------------ cut line ------------------------------------
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#       date.pl
#       dtc
# This archive created: Wed Feb  6 23:45:04 1991
# By:   Gary Puckering ()
export PATH; PATH=/bin:$PATH
if test -f 'date.pl'
then
        echo shar: over-writing existing file "'date.pl'"
fi
cat << \SHAR_EOF > 'date.pl'
package date;

# 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;

sub main'jdate
# Usage:  ($month,$day,$year,$weekday) = &jdate($julian_day)
{

        local($jdate_tmp);
        local($m,$d,$y,$wkday);

        warn("warning:  pre-dates British use of Gregorian calendar\n")
                if ($jd < $brit_jd);

        $wkday = ($jd + 1) % 7;       # calculate weekday (0=Sun,6=Sat)
        $jdate_tmp = $jd - 1721119;
        $y = int((4 * $jdate_tmp - 1)/146097);
        $jdate_tmp = 4 * $jdate_tmp - 1 - 146097 * $y;
        $d = int($jdate_tmp/4);
        $jdate_tmp = int((4 * $d + 3)/1461);
        $d = 4 * $d + 3 - 1461 * $jdate_tmp;
        $d = int(($d + 4)/4);
        $m = int((5 * $d - 3)/153);
        $d = 5 * $d - 3 - 153 * $m;
        $d = int(($d + 5) / 5);
        $y = 100 * $y + $jdate_tmp;
        if($m < 10) {
                $m += 3;
        } else {
                $m -= 9;
                ++$y;
        }
        ($m, $d, $y, $wkday);

Quote:
}

sub main'jday
# Usage:  $julian_day = &jday($month,$day,$year)
{

        local($ya,$c);

        $y = (localtime(time))[5] + 1900  if ($y eq '');

        if ($m > 2) {
                $m -= 3;
        } else {
                $m += 9;
                --$y;
        }
        $c = int($y/100);
        $ya = $y - (100 * $c);
        $jd =  int((146097 * $c) / 4) +
                   int((1461 * $ya) / 4) +
                   int((153 * $m + 2) / 5) +
                   $d + 1721119;
        warn("warning:  pre-dates British use of Gregorian calendar\n")
                if ($jd < $brit_jd);
        $jd;

Quote:
}

sub main'is_jday
{
# Usage:  if (&is_jday($number)) { print "yep - looks like a jday"; }
        local($is_jday) = 0;
        $is_jday = 1 if ($_[0] > 1721119);

Quote:
}

sub main'monthname
# Usage:  $month_name = &monthname($month_no)
{


                         'July','August','September','October','November',
                         'December');
        if ($m ne '') {
                substr($names[$n-1],0,$m);
        } else {
                $names[$n-1];
        }

Quote:
}

sub main'monthnum
# Usage:  $month_number = &monthnum($month_name)
{

        local(%names) = (
                'JAN',1,'FEB',2,'MAR',3,'APR',4,'MAY',5,'JUN',6,'JUL',7,'AUG',8,
                'SEP',9,'OCT',10,'NOV',11,'DEC',12);
        $name =~ tr/a-z/A-Z/;
        $name = substr($name,0,3);
        $names{$name};

Quote:
}

sub main'weekday
# Usage:  $weekday_name = &weekday($weekday_number)
{

        ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wd];

Quote:
}

sub main'today
# Usage:  $today_julian_day = &today()
{

        local($d) = $today[3];
        local($m) = $today[4];
        local($y) = $today[5];
        $m += 1;
        $y += 1900;
        &main'jday($m,$d,$y);

Quote:
}

sub main'yesterday
# Usage:  $yesterday_julian_day = &yesterday()
{
        &main'today() - 1;

Quote:
}

sub main'tomorrow
# Usage:  $tomorrow_julian_day = &tomorrow()
{
        &main'today() + 1;

Quote:
}

SHAR_EOF
if test -f 'dtc'
then
        echo shar: over-writing existing file "'dtc'"
fi
cat << \SHAR_EOF > 'dtc'
#!/usr/local/bin/perl -I/home/garyp/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);

                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);

                next;
        }
        elsif (/^\s*([-]?\d+)\s*$/) {                                   # [-]n

                next;
        }
        elsif (index("clear",$command)==0) {                  # clear

                next;
        }
        elsif (index("duplicate",$command)==0) {              # duplicate

                next;
        }
        elsif (index("exchange",$command)==0 ||
               $command eq 'x') {                                               # exchange




                next;
        }
        elsif (index("print",$command)==0) {                  # print
                do print($stack[$#stack]);
                next;
        }
        elsif (index("today",$command)==0) {                  # today

                do print($stack[$#stack]);
                next;
        }
        elsif (/^\s*[+]\s*$/) {                                                 # add


                if (&is_jday($x) && &is_jday($y)) {
                        print stderr "** cannot add two dates\n";


                        next;
                }
                $r = $x + $y;

                do print($r);
                next;
        }
        elsif (m:^\s*([\-*/%])\s*$:) {                                  # (-) (*) (/) and (%)


                $r = eval "$x $+ $y";


                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";

                do print($stack[$#stack]);
                next;
        }
#       else { warn "** invalid command - try \"help\"\n" unless ($_ eq "\n"); }

Quote:
} continue {

        print "> ";
        $command = "";

Quote:
}

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";
                }
        }

Quote:
}

sub dump
{
        for ($i = 0; $i <= $#stack; $i++) {
                print "stack[",$i,"] ";
                do print($stack[$i]);
        }
Quote:
}

SHAR_EOF
chmod +x 'dtc'
#       End of shell archive
exit 0
--
Gary Puckering                             Cognos Incorporated
  VOICE: (613) 738-1338 x6100              P.O. Box 9707
  UUCP:  uunet!mitel!cunews!cognos!garyp   Ottawa, Ontario



Mon, 26 Jul 1993 12:58:10 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Financial Calculators & time/date stamps

2. ANNOUNCE: DateManip.pl-4.1 (date/time manip. and date calculator)

3. error: undefined subroutine &Date::Parse::strptime

4. subroutine to compare date??

5. **Need Calculator Script*

6. How to optimize this? (a check-sum calculator)

7. HP-style calculator in perl

8. Limited form of eval() - just a calculator

9. Perl as a pocket calculator

10. gtkperl finacial calculator NEW!

11. Simple Permutation Calculator

12. financial calculator

 

 
Powered by phpBB® Forum Software