Article 10805 of comp.lang.perl:
Path: feenix.metronet.com!news.utdallas.edu!wupost!math.ohio-state.edu!howland.reston.ans.net!pipex!sunic!trane.uninett.no!alf.uib.no!alf.uib.no!usenet
From: [email protected] (Ove Ruben R Olsen)
Newsgroups: comp.lang.perl
Subject: Re: Date Function Library ?
Date: 19 Feb 1994 22:10:35 +0100
Organization: University of Bergen
Lines: 315
Message-ID: <[email protected]>
References: <[email protected]>
NNTP-Posting-Host: alf.uib.no

Frazer Worley:
>Does anybody know of a library containing functions for
>manipulating dates, eg the time between 2 dates.


I never got around to finish this:


# Time.pl - A perl timelibrary.
#
# Created by: Ove Ruben R Olsen ([email protected])
#
# Can be used by the perl-handling programs.
#
# Some ideas by Barry Shein, Boston University, used in this implementation.
#
# NOT SUPPORTED: LOCALES months/weekday names.
#                tzset tzsetwall
#                strftime %Z %U %W
#
################################################################################
#
# Copyright (c) Ove Ruben R Olsen (Gnarfer from hell)
#
# Permission to use, copy, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation.
# This also apply your own incarnations of any or all of this code.
# If you use portions of this code, you MUST include a apropriate notice
# where you "stole" it from.
#
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Email:  [email protected]
#
#
# THIS WORK IS DEDICATED TO Anne Marit Fjeldstad the one and only.
#
################################################################################
#                                                                              #
#                   This is ABSOLUTELY FREE SOFTWARE.                          #
#                                                                              #
#                                                                              #
#          BUT: If you find this software usefull, please contribute           #
#               aprox 10 USD to your country's cancer research.                #
#                                                                              #
#                                                                              #
#                             END OF NOTICE                                    #
#                                                                              #
################################################################################
#
# LOCALES various formats
#
# Change this to suit your local way.
#

 @LC_AMPM  = ('am','pm');
 $LC_DATE  = "%d/%m/%y" ;
 $LC_TIME  = "%T" ;
 $LC_LDTF  = "%A %d. %B 19%y $LC_TIME" ;

################################################################################
#
#  NO NEED TO GO BEYOUND THIS LINE EXCEPT FOR DEBUGING.
#
################################################################################

#
# Days
#

@sdays   = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
@ldays   = ( 'Sunday', 'Monday', 'Tuesday', 'Wednesday', 'Thursday',
             'Friday', 'Saturday' );
#
# Months
#

@smonths = ('Jan','Feb','Mar','Apr','May','Jun',
            'Jul','Aug','Sep','Oct','Nov','Dec');
@lmonths = ( 'January', 'February', 'March', 'April', 'May', 'June', 'July',
             'August', 'September', 'October', 'November', 'December' );
@mdays   = ( '31', '28', '31', '30', '31', '30',
             '31', '31', '30', '31', '30', '31' ) ;

#
# Difference in LOCALTIME / GMT
#
 @difftimeGMTLOCAL = difftimeGMTLOCAL ;



# difftimeGMTLOCAL => GMT.seconds - LOCALTIME.secondes , bit
sub difftimeGMTLOCAL {
 local (@gm) = gmtime (time);
 local (@lo) = localtime (time);
 local ($junk) ;
 $junk = &time2sec(@gm[0],@gm[1],@gm[2],@gm[7])  -
     &time2sec(@lo[0],@lo[1],@lo[2],@lo[7]) ;
return (sqrt($junk * $junk) , 1)  if ($junk < 0 ) ;
return ($junk, -1) ;
}


# time2sec (ss,mm,hh,days) => seconds
sub time2sec {
 local(@a) = @_ ;
 (@a[3] * 86400) + (@a[2] * 3600) + (@a[1] * 60) + @a[0] ;
}


# sec2time (sconds) => ss,mm,hh,days
sub sec2time {
  local ($a,$b,$c,$d)  ;
   $a = int (@_[0] % 60);
   $b = int ((@_[0] % 3600) / 60);
   $c = int ((@_[0] % (24*3600)) / 3600);
   $d = int (@_[0] / (24 * 3600));
   return ($a,$b,$c,$d);
}




# datesub (dd,mm,yyyy,dd,mm,yyyy) => number of days
sub datesub {
 local(@a) = @_ ;
 local ($ds);
 local ($d1,$m1,$y1,$d2,$m2,$y2) = @_ ;
 return -1 if ( $y2 < $y1 ) ;
 return -1 if ( ($m1 < 1)  || ($m1 > 12)  ||
                ($m2 < 1)  || ($m2 > 12) ) ;
 return -1 if ( ($d1 < 1)  || ($d2 < 1 ) ) ;
 return -1 if ( ($d1 > @mdays[$m1]) && (&dysize($y1) == 365));
 return -1 if ( ($d2 > @mdays[$m2]) && (&dysize($y2) == 365));
 return -1 if ( ($d1 > 29) && (&dysize($y1) == 366));
 return -1 if ( ($d2 > 29) && (&dysize($y2) == 366));

 $m1 -- ; $m2 -- ; # We use base = 0 ! base = 1 ;

 # DAYS
 $ds = $d2 + (@mdays[$m1] - $d1) ;
 # MONTHS
 $m1 ++ ; $m2 -- ;
 if ($m1 < 13) { for ($m1..11) { $ds += @mdays[$_] ;} }
 if ($m2 > 0 ) { for (0..$m2)  { $ds += @mdays[$_] ; } }
 # YEAR
 $y1 ++ ; $y2 -- ;
 for ($y1 .. $y2) { $ds += &dysize($_) ; }
 return ($ds) ;
}




# ctime ([seconds])  => current date and time
sub ctime { #
 local($tm);
 $tm =  time ;
 $tm = @_[0] if (@_[0] ne '') ;
 local (@a) = localtime($tm);
 &asctime(@a);
}



# asctime (ss,mm,hh,mday,mon,year,wday)  => current date and time
sub asctime {
 local (@a) = @_ ;
 @a[5] = 1900 + @a[5] if (@a[5] < 1900) ;
 foreach (0..3) {@a[$_] = "0@a[$_]" if (@a[$_] < 10 ) ;}
 "$sdays[@a[6]] $smonths[@a[4]] @a[3] @a[2]:@a[1]$mi:@a[0] @a[5]";
}



# dysize (year)  => number of days in year || -1
sub dysize {
 local($y,$yr) = (@_[0],365) ;
 return -1 if ($y < 0 ) ;
 return 347 if ($y == 1752);
 # $y += 1900 if($y < 1970) ;
 $yr = 366 if((($y % 4) == 0) && ( ($y % 100) || (($y % 400)==0) )) ;
 return  $yr ;
}



#  DoYR (day,month,year)  => daynumber in year  || -1
sub DoYR { # day, month, year
 local ($day,$mon,$year,$i,$j) = (@_[0],@_[1],@_[2],0,0);
 return -1 if ($day < 1);
 return -1 if (($day > $mdays[$mon]) && (&dysize($year) == 365));
 return -1 if (($day > 29) && (&dysize($year) == 366));
 $j = (($mon > 2) && ( &dysize ($year) == 366)) ? 1 : 0 ;
 for($i=1 ; $i < $mon ; $i++) { $j += $mdays[$i-1] ; }
 return ($j + $day ) ;
}



# jan1 (year)  => weekday of jan 1 in year
sub jan1 {
 local ($yr,$dg) = (@_[0],0,0);
 $dg = 4+$yr+($yr+3)/4;
 if ($yr > 1800) {          # Julian cal regualr gregorian hav
   $dg -= ($yr-1701)/100;   # less three days pr 400.
   $dg += ($yr-1601)/400;
 }
 $dg += 3 if($yr > 1752) ; # The year 1752
 return ($dg % 7);
}



# tzset  => NOT USED
sub tzset { }

# tzsetwall  => NOT USED
sub tzsetwall { }

# tzname  => TimeZonename
sub tzname {
 # BEWARE: A truly ugly hack !
 local (@tz) = split(/\s+/,`date`) ;
 return @tz[4] ;
}


# timegm (ss,mm,hh,mday,mon,year)  =>  seconds
sub timegm {
local(@a) = @_ ;
@a[5] += 1900 ;
local($dy) = &datesub(1,1,1970,@a[3],@a[4],@a[5]) ;
# print "DEBUG $dy\n";
return &time2sec(@a[0],@a[1],@a[2],$dy) ;
}


# timelocal (ss,mm,hh,mday,mon,year)  =>  seconds
sub timelocal {
 local ($dy) = &timegm(@_);
 return ($dy + (@difftimeGMTLOCAL[0] * @difftimeGMTLOCAL[1])) ;
}


# WeekDay (day,month,year)  => weekday of day.month.year
sub WeekDay {
 local ($day,$mon,$year) = (@_[0],@_[1],@_[2]);
 local ($ds) = &DoYR($day,$mon,$year) ;
 return ( (&jan1($year) + $ds-1 ) % 7 ) ;
}


#  strftime (fmtstr,ss,mm,hh,mday,mon,year,wday,yday)  => string
sub strftime {
 #
 # Formats not included:  %U %W
 #
 local($fmt) =  shift (@_);
 local(@a) = (@_);
 local(@b) = (@_);
 foreach (0..7) {@a[$_] = "0@a[$_]" if (@a[$_] < 10 ) ;}
 foreach (0..7) {@b[$_] = " @b[$_]" if (@b[$_] < 10 ) ;}
 local($ampm1) = (@a[2] > 12) ? (24-@a[2]) : @a[2] ;
 local($ampm2) = (@b[2] > 12) ? (24-@b[2]) : @b[2] ;
 local($ampm3) = (@b[2] > 12) ? @LC_AMPM[1] : @LC_AMPM[0] ;
 local($yday) = "0" x ( 3 - length (@a[7])) . @a[7] ;

 $fmt =~ s/%r/%I:%M:%S %p/g ;
 $fmt =~ s/%R/%H:%M/g ;
 $fmt =~ s/%T/%H:%M:%S/g ;
 $fmt =~ s/%C/$LC_LDTF/g;

 $fmt =~ s/%a/@sdays[@a[7]]/g ;
 $fmt =~ s/%A/@ldays[@a[7]]/g ;
 $fmt =~ s/%b/@smonths[@a[7]]/g ;
 $fmt =~ s/%B/@lmonths[@a[7]]/g ;
 $fmt =~ s/%h/@smonths[@a[7]]/g ;
 $fmt =~ s/%D/@a[4]@a[3]@a[5]/g;
 $fmt =~ s/%e/@b[3]/g ;
 $fmt =~ s/%H/@a[2]/g ;
 $fmt =~ s/%I/$ampm1/g ;
 $fmt =~ s/%j/$yday/g ;
 $fmt =~ s/%k/@b[2]/g ;
 $fmt =~ s/%l/$ampm2/g ;
 $fmt =~ s/%m/@a[4]/g ;
 $fmt =~ s/%M/@a[1]/g ;
 $fmt =~ s/%n/\n/g ;
 $fmt =~ s/%p/$ampm3/g ;
 $fmt =~ s/%S/@a[0]/g ;
 $fmt =~ s/%t/\t/g ;
 $fmt =~ s/%w/@a[6]/g ;
 $fmt =~ s/%y/@a[5]/g ;
 $fmt =~ s/%x/$LC_DATE/g ;
 $fmt =~ s/%X/$LC_TIME/g ;
 $fmt =~ s/%Y/19@a[5]/g ;
 $fmt =~ s/%Z//g ;

 $fmt =~ s/%%/%/g ;
 return $fmt ;
}

1;


--
Ove Ruben "Gnarfer" R Olsen a VI user. IRCNO Secretary.  Preffered: [email protected]
Maintaining the EX/VI-archive and a couple of comp.editors FAQ's and other FAQ's
People that are ignorant tend to live a frustrated  life, at least when it comes
            to editing. But I do believe this is a general rule in life.

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.