# Time.pl - A perl timelibrary.
#
# Created by: Ove Ruben R Olsen (ruben@uib.no)
#
# 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:  Ruben@uib.no 
#
#
# 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;
