Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Lady /DATE

by Steeeeeve (Initiate)
on Feb 02, 2001 at 03:20 UTC ( [id://55901]=sourcecode: print w/replies, xml ) Need Help??
Category: Utilities
Author/Contact Info Charles Prichard greentv@paulbunyan.net
Description: Julian Dating Utility (does not yet account for leap years) Precomputes the date to Julian format. Add and subtract large quantities of time, in minutes. Updated version works with strict pragma.
#########################################################
# PRE-RELEASE MODULE
# Module: LADY /DATE.pm   (JULIAN)LADY Dating Methods
# Version BETA 1.0 r 1  02-06-2001
# Author: C. Prichard
# COPYRIGHT: GREENTVŠ Charles Prichard -1999- All Rights Reserved.
# greentv@paulbunyan.net
#
# This module is a collection of methods needed
# to access and set a date in a format that is
# applicable to computer aging methods.
package Lady_DATE;

use strict;
#################################################
#  Sub new                                  #
#################################################
#################################################
#   PUBLIC Subroutine                           #
#################################################
sub new (;$){

    my $class = shift;

    my $self = {};
    
    bless $self, ref $class || $class;
    
    $self->{current_century} = 21;
    $self->{this_century} = undef;
    $self->{this_year_days} = undef;
    $self->{lady_time} = undef;
    $self->{lady_date} = undef;
    $self->{time} = undef;
    
    $self->{calculated_time} = undef;

    $self->{MONTHDAYS} = [];
    
    $self->init(@_);
    
    return $self;

}
sub init(;$){
    
    my $self = shift;
    
    $self->{MONTHDAYS} = (31,28,31,30,31,30,31,31,30,31,30,31);

    $self->{this_century} = $self->get_century();
    
    if ($_[0]){$self->{lady_time} = shift;}
    
    else{ 
    
        $self->{lady_date} = $self->get_this_century_lady_date (0,0,0)
+;
    
        $self->{time} = $self->get_time();
        
        $self->{lady_time} = $self->{this_century} . $self->{lady_date
+} . $self->{time};
    
    }

    return;
}
#################################################
#  Sub lady_time                            #
#################################################
sub lady_time(){
    
    my $self = shift;
        
return $self->{lady_time};
}
#################################################
#  Sub print_lady_date                          #
#################################################
sub print_lady_date(;$$$){
    
    my $self = shift;
    
    my ($yr,$mo,$da) = @_;
    
    if(($yr+$mo+$da) == 0){
            
            $self->{lady_date} = $self->get_this_century_lady_date (0,
+0,0);
    }
    else{
    
        $mo++;
    
        $self->lady_date = $self->get_this_century_lady_date ($yr,$mo,
+$da);
    
    }
    
    print "Lady Date: $self->lady_date\n";
}
#################################################
#     Sub get_this_century_lady_date            #
#################################################
sub get_this_century_lady_date(;$$$){    
    
    my $self = shift;
    
    my ($yr, $mo, $da) = @_;
    
    if ((($yr < 100) && ($yr >= 0)) && (($mo < 12) && ($mo >= 0)) && (
+($da < 32) && ($da > 0))){
        
        $self->{lady_date} = $self->get_lady_date($yr, $mo, $da);
    }
    else{    
    
        ($yr, $mo, $da) = (localtime)[5,4,3];

        $self->{lady_date} = $self->get_lady_date($yr, $mo, $da);
    }
    
    return;
}
#################################################
#     Sub get_date                               #
#################################################
sub get_lady_date{

    my $self = shift;

    my ($yr, $mo, $da) = @_;

    $self->{lady_date};
    
    if ($mo > 0){
    
        --$mo;
    
        $self->{this_year_days} = $self->get_days_since_new_year($mo,$
+da);
    }
    else{ $self->{this_year_days} = $da;}

    $self->{lady_date} = (($yr * 1000) + $self->{this_year_days}) % 10
+0000; 

    my $i;

    my $zeros = 5 - length($self->{lady_date});
    
    for ($i=1; $i <= $zeros; $i++){$self->{lady_date} = "0".$self->{la
+dy_date};}
    
    return $self->{lady_date};
}

#################################################
#     Sub get_days_since_new_year               #
#################################################
sub get_days_since_new_year{

    my $self = shift;

    my ($mo, $da) = @_;

    $self->{this_year_days} = 0;

    while ($mo >= 0){
        
        my @TEMP = $self->{MONTHDAYS};
        
            $self->{this_year_days} = $self->{this_year_days} + $TEMP[
+$mo];
            --$mo;
    }
    
    $self->{this_year_days} = $self->{this_year_days} + $da;
    
    return $self->{this_year_days};
}

#################################################
#     Sub get_time                       #
#################################################
sub get_time(){
    
    my $self = shift;
    
        my ($hr, $min, $sec) = (localtime)[2,1,0];
        
        if ($hr  < 10){$hr =  "0".$hr;}
        if ($min < 10){$min = "0".$min;}
        if ($sec < 10){$sec = "0".$sec;}
        
        $self->{time} = $hr.$min.$sec;
        
        return $self->{time};
}

#################################################
#     Sub get_century                       #
#################################################
sub get_century(){
    
    my $self = shift;
    
    $self->{this_century} = $self->{current_century} - 1;

    return $self->{this_century};
}

#################################################
#     Sub Add_minutes_to_lady_time              #
#################################################
sub add_minutes_to_this_lady_time($;$){
    
    my $self = shift;

    my $minutes_to_add = shift;
    
    my $this_time;
    
    if (!$_[0]){$this_time = $self->{lady_time};}
    
    chop $this_time;# Eliminate seconds.
    chop $this_time;
    
    my $years_to_add = int($minutes_to_add / 525600) * 10000000;
    my $days_to_add  = int($minutes_to_add / 1440) % 365 * 10000;
    my $hours_to_add = int($minutes_to_add / 60) % 24 * 100;
    
    $minutes_to_add = $minutes_to_add % 60;
    
    my $time_to_add = $years_to_add + $days_to_add + $hours_to_add + $
+minutes_to_add;
    
    my $this_time_years = int($this_time / 10000000);
    my $this_time_days = (($this_time - $this_time_years * 10000000) /
+ 10000) % 365;
    my $this_time_hours = ((($this_time - $this_time_years * 10000000)
+ - $this_time_days * 10000) / 100) % 24;
    my $this_time_minutes = ((($this_time - $this_time_years * 1000000
+0) - $this_time_days * 10000) - $this_time_hours * 100) % 60;
    my $new_time_minutes = ($this_time_minutes + $minutes_to_add) % 60
+;
    
    if ($new_time_minutes < 10){$new_time_minutes = "0".$new_time_minu
+tes;}
    my $new_time_hours = ($this_time_hours + $hours_to_add/100 + int((
+$this_time_minutes + $minutes_to_add) / 60)) % 24;
    
    if ($new_time_hours < 10){$new_time_hours = "0".$new_time_hours;}
    my $new_time_days = ($this_time_days + ($days_to_add / 10000) + in
+t(($this_time_hours + $hours_to_add/100) / 24)) % 365;
    
    if (($new_time_days < 100) && ($new_time_days > 9)){$new_time_days
+ = "0".$new_time_days;}
    if ($new_time_days < 10){$new_time_days = "00".$new_time_days;}
    my $new_time_years = $this_time_years + $years_to_add + int(($this
+_time_days + $days_to_add / 10000) / 365);
    
    return ($self->{calculated_time} = $new_time_years.$new_time_days.
+$new_time_hours.$new_time_minutes."00");

}
#################################################
#     Sub Subtract_minutes_from_lady_time       #
#################################################
sub subtract_minutes_from_this_lady_time($;$){
    
    my $self = shift;
    
    my $minutes_to_subtract = shift;
    
    my $this_time;
    
    if (!$_[0]){$this_time = $self->{lady_time};}
    
    chop $this_time; #Eliminate seconds.
    chop $this_time; 
    
    my $years_to_subtract = int($minutes_to_subtract / 525600) * 10000
+000;
    my $days_to_subtract = int($minutes_to_subtract / 1440) % 365 * 10
+000;
    my $hours_to_subtract = int($minutes_to_subtract / 60) % 24 * 100;
    
    $minutes_to_subtract = $minutes_to_subtract % 60;
    
    my $this_time_years = int($this_time / 10000000);
    my $this_time_days = (($this_time - $this_time_years * 10000000) /
+ 10000) % 365;
    my $this_time_hours = ((($this_time - $this_time_years * 10000000)
+ - $this_time_days * 10000) / 100) % 24;
    my $this_time_minutes = ((($this_time - $this_time_years * 1000000
+0) - $this_time_days * 10000) - $this_time_hours * 100) % 60;
    my $new_time_minutes = $this_time_minutes - $minutes_to_subtract;
    if ($new_time_minutes < 0){
        $this_time_hours--;
        $new_time_minutes = 60 + $new_time_minutes;
        if ($this_time_hours < 0){
            $this_time_days--;
            $this_time_hours = 23;
            if ($this_time_days < 1){
                $this_time_years--;
                $this_time_days = 365;
                
            }
        }
    }
    if ($new_time_minutes < 10){$new_time_minutes = "0".$new_time_minu
+tes;}
    my $new_time_hours = $this_time_hours - $hours_to_subtract/100;
    if ($new_time_hours < 0){
        $this_time_days--;
        $new_time_hours = 24 + $new_time_hours;
        if ($this_time_days < 1){
            $this_time_years--;
            $this_time_days = 365;
            
        }
    }        
    if ($new_time_hours < 10){$new_time_hours = "0".$new_time_hours;}
    my $new_time_days = $this_time_days - $days_to_subtract/10000;
    if ($new_time_days < 1){
        $new_time_days = 365 + $new_time_days;
        $this_time_years--;
    }        
    if (($new_time_days < 100) && ($new_time_days > 9)){$new_time_days
+ = "0".$new_time_days;}
    if ($new_time_days < 10){$new_time_days = "00".$new_time_days;}
    my $new_time_years = $this_time_years - $years_to_subtract/1000000
+0;
    if ($new_time_years < 0){print "ERROR<BR>";}
    
    return ($self->{calculated_time} = $new_time_years.$new_time_days.
+$new_time_hours.$new_time_minutes."00");    
    
}

1;
Replies are listed 'Best First'.
Re: Lady /DATE
by a (Friar) on Feb 02, 2001 at 09:22 UTC
    Uh ... looks like you've done lots of work but, well, what's w/ all the 'lady' stuff. Just tried a bit, but:
    use lib '.'; use lady_date; my $date = new Lady_DATE; print $date->get_days_since_new_year(3,1);
    wouldn't work (or pass -w) until:
    sub get_days_since_new_year{ my $self = shift; my ($__month, $__day) = @_; my (@monthdays); @monthdays = ("31","28","31","30","31","30","31","31","30","31","30"," +31"); my $days = 0; # you want to skip this month and only go back Feb. Jan # 01/01 should return 1, not 31+1 while (--$__month > 0){ $days = $days + $monthdays[$__month]; }

    a

      No,, The date today should be 20010331801.

      2001 033 rd day of the year and 1801 for 601 pm (If its that time of course.)

      Julian system counts the days of the solar year. 1 to 365. Its theoretically prudent to precompute the Julian date for making fast comparisons later. Just my theory. Also can quickly add and subtract quantities of time using this format.

      Lady was my diabetic Golden Retriever. I dedicated lots of my early Perl to her.

      -Steeeeeve
        okay:
        while ($__month >= 0){ $days = $days + $monthdays[$__month]; --$__month; }
        for "2/1" $__month is 2, you'll add 28 + 31 + 1 and get '60'.
        So my fix didn't work so well. Either knock one off the month to start w/ or put "0" at the beginning of the month array so that $__month == 0 adds zero, not 31. i.e.
        @monthdays = ("0", "31","28","31","30","31","30","31","31","30","31"," +30","31"); my $days = 0; while (--$__month >= $[){ $days = $days + $monthdays[$__month]; #--$__month; } $days = $days + $__day;
        while (--$__month >= 0 )

        a

Re: Lady /DATE
by doran (Deacon) on Feb 06, 2001 at 03:04 UTC
    And here I thought this was just a haute monde version of Bone::Easy.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://55901]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2024-04-24 04:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found