All,
I've put together what seems to function as a module.  If anyone has 
the time and inclination, it needs to be tested and maybe edited to 
see if I've done anything horribly wrong.

The function of this module is to allow the use of Rdates - a 
five-character representation of the date.  For information on Rdate, 
check out http://www.yak.net/rickdate/RickDate.html

Any and all feedback is appreciated!

Here's the module:

============================== cut ==============================
package Date::RDate;

use strict;

BEGIN {
     use Exporter   ();
     use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

     ## set the version for version checking; uncomment to use
     $VERSION     = 1.00;

     @ISA         = qw(Exporter);
     @EXPORT      = qw(toRdate reverse today day_of_week day_of_year 
days_since_zero days_to_rdate add_delta difference_between_rdates);

}
use vars      @EXPORT_OK;

# non-exported package globals go here
use vars      qw( %rdateH $rdatelist @days_til_month $bdatelist $day 
$junk $month $ryear1 $ryear2 $ryear3 $tdate1 $tdate2 $year $i $n_days 
@adate @bdate);

# initialize package globals, first exported ones
%rdateH = (     0 => "0", 1 => "1", 2 => "2", 3 => "3", 4 => "4", 5 
=> "5", 6 => "6", 7 => "7",
                 8 => "8", 9 => "9", 10=> "A", 11=> "B", 12=> "C", 
13=> "D", 14=> "E", 15=> "F",
                 16=> "G", 17=> "H", 18=> "I", 19=> "J", 20=> "K", 
21=> "L", 22=> "M", 23=> "N",
                 24=> "O", 25=> "P", 26=> "Q", 27=> "R", 28=> "S", 
29=> "T", 30=> "U", 31=> "V",
                 32=> "W", 33=> "X", 34=> "Y", 35=> "Z");
$rdatelist = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
@days_til_month = (     [ 0, 0, 31, 59, 90, 120, 151, 181, 212, 243, 
273, 304, 334, 365 ],
                         [ 0, 0, 31, 60, 91, 121, 152, 182, 213, 244, 
274, 305, 335, 366 ] );

# all file-scoped lexicals must be created before
# the functions below that use them.
# file-private lexicals go here

my ($bdatelist, $day, $junk, $month, $ryear1, $ryear2, $ryear3, 
$tdate1, $tdate2, $year) = "";
my ($i, $n_days) = 0;
my (@adate, @bdate) = ((), ());

# make all your functions, whether exported or not;
# remember to put something interesting in the {} stubs
##
sub new {
     my $self = {};
     bless $self;
     return $self;
}
##
##
sub toRdate {
# input: ($month: number, $day: number, $year: number)
         ($month, $day, $year) = ($_[1], $_[2], $_[3]);
         ($ryear1, $ryear2, $ryear3) = (int($year/(36*36)), 
int(($year%(36*36))/36), int($year%36));
         return 
"".$rdateH{$ryear1}.$rdateH{$ryear2}.$rdateH{$ryear3}.$rdateH{$month}.$rdateH{$day};
# returns string: 5 chars representing rdate
}
##
##
sub reverse {
# input: ($RDate: five char string)
         @adate = split(//, $_[0]);
         for (@adate) { $bdatelist .= index($rdatelist,$_)." "; }
         @bdate = split/ /,$bdatelist;
         return ($bdate[3],$bdate[4], 
(($bdate[0]*36*36)+($bdate[1]*36)+$bdate[2]) );
# returns (number: month, number: day, number: year)
}
##
##
sub today {
# input: (none)
         ($junk, $junk, $junk, $day, $month, $year, $junk, $junk, 
$junk) = gmtime(time);
         $year += ($year < 1900) ? 1900 : 0;
         $month += 1;
         return &toRdate($month, $day, $year);
# returns string: 5 chars representing rdate
}
##
##
sub day_of_week {
# input: ($RDate: five char string)
         $n_days = &days_since_zero($_[0]);
         if ($n_days > 0) {
                 $n_days--;
                 $n_days %= 7;
                 $n_days++;
                 return $n_days;
         } else { return -1; }
# returns number: day of week, 1=mon, 2=tue...7=sun
}
##
##
sub day_of_year {
# input: ($RDate: five char string)
         ($year, $month, $day) = &reverse($_[0]);
         return 
($days_til_month[&_isleap($year)][index($rdatelist,$month)] + 
index($rdatelist,$day));
# returns number: day of the year
}
##
##
sub days_since_zero {
# input: ($RDate: five char string)
         ($month, $day, $year) = &reverse($_[0]);
         $n_days = 365 * $year;
         $n_days += ($year >>= 2);
         $year = int ($year / 25);
         $n_days -= $year;
         $n_days += ($year >>  2);
         $n_days += $days_til_month[&_isleap($_[0])][$month] + $day;
         return $n_days;
# returns number: days since day 0
}
##
##
sub days_to_rdate {
# input: ($n_days: number)
         $n_days = $_[0];
         $year = int ( $n_days / 365.2425 );
         $n_days -= int($year * 365.2425);
         for ($i = 1; $i <= 11; $i++) {
                 if 
($days_til_month[&_isleap(&toRdate(1,1,$year))][($i+1)] > $n_days) {
                         $month = $i;
                         $n_days -= 
$days_til_month[(&_isleap(&toRdate(1,1,$year)))][$i];
                         last;
                 }
         }
         $tdate1 = &toRdate($month, $n_days, $year);
         return $tdate1;
# returns string: 5 chars representing rdate
}
##
##
sub add_delta {
# input: ($RDate: five char string, $n_days: number)
         ($tdate1, $n_days) = @_;
         return &days_to_rdate( &days_since_zero($tdate1) + $n_days );
# returns string: 5 chars representing rdate
}
##
##
sub difference_between_rdates {
# input: ($RDate1: five char string, $RDate2: five char string);
         ($tdate1, $tdate2) = @_;
         return ( &days_since_zero($tdate1) - &days_since_zero($tdate2) );
# returns number: number of days between date1 and date2
}
##
##
sub _isleap {
# input: ($RDate: five char string)
         @adate = split//,$_[0];
         $year = 
(index($rdatelist,$adate[0])*36*36)+(index($rdatelist,$adate[1])*36)+index($rdatelist,$adate[2]);
         $ryear1 = int($year/100);
         return ( (($year & 0x03) ==0) && (( $ryear1 * 100 != $year) 
|| (($ryear1 & 0x03) == 0) ) ) ? 1 : 0;
# returns 1 | 0: true or false this is leap year
}
##
##

END { }       # module clean-up code here (global destructor)

1;            # modules must return true
-- 
-----------------------------------------------------------
Ian Cabell - [EMAIL PROTECTED] - There Is More Than One Right Way
PGP Key: C5A5 560D 2E28 FF1F BA6D  C2C7 870C 8ED5 8AF0 79C5

Reply via email to