# datlib.pm Daniel Brockman 20070121 Utility date and time routines
#
#################################################
# The author grants permission to use for any   #
# purpose, including copying and modification,  #
# provided the user acknowledges the author by  #
# name. (Creative Commons Attribution License   #
# http://creativecommons.org/licenses/by/2.5/ ) #
# -- Daniel Brockman, author, 20070121          #
#################################################

#
# Note:
# * Valid dates are integers expressing the date 
# in yyyymmdd or yymmdd format. For examples, 
# 19981013 is a valid date, October 13, 1998, 
# and 20050431 is not a valid date because April 
# doesn't have 31 days.
# * Valid times are integers expressing the time
# in HHMMSS format, with a 24-hour clock. This 
# implies 3:00pm is correctly expressed as 150000. 
# * See notes 4 & 5 below.
#
# Routines...
# 1. $d=&today(\$dow)
#       Today's date. $dow=0 for Sun, 6 for Sat.
# 2. $tf=&isvld($d)
#       $tf==1 if $d is a valid date. $tf==0 otherwise.
# 3. $n=&dbtd($d1,$d2)
#       $n is the number of days between $d1 and $d2.
#       ex: -4==&dbtd(20040302,20040227)
# 4. $d2=&dpn($d1,$n)
#       $d2 follows $d1 by $n days.
#       ex: $d2=&dpn($d1,10);
#           $n=&dbtd($d1,$d2);
#           print "$n\n";
#             ... prints "10";
# 5. $tf=&islpyr($y)
#       $tf==1 if $y is a leap year. $tf==0 otherwise.
# 6. $d=&mkd($y,$m,$dy)
#       Combines year number $y, month number $m and 
#       day number $dy into a date $d.
#       ex: 20030817==&mkd(3,8,17)
# 7. &bkd($d,\$y,\$m,\$dy)
#       Decomposes date $d into year number $y, 
#       month number $m and day number $dy.
#       ex: &bkd(160402,\$y,\$m,\$dy);
#           print "$y $m $dy\n");
#             ... prints "2016 4 17"
# 8. $dy=&lastday($y,$m)
#       $dy is the number of the last day of month
#       number $m, year $y.
# 9. $smtwtfs=&dow($d)
#       $smtwtfs is 0 for Sunday, 1 for Monday, ...
#       6 for Saturday.
# 10. $d8=&d628($d6)
#       $d8 is yyyymmdd if $d6 is yymmdd, 
#       $d8 within 50 years of today.
# 11. $tf=&isvt($t)
#       $tf==1 if $t is a valid time of day
#       , ==0 otherwise. In assessing the 
#       validity of $t, &isvt() interprets $t
#       as an integer expression of a time of 
#       day in the format HHMMSS. If 
#       0  <=  HH  <= 24, and 
#       0  <=  MM  <= 60, and 
#       0  <=  SS  <= 60, then $tf==1.
# 12. $t=&mkt($H,$M,$S,\$cd)
#       Combines hours, minutes and seconds into 
#       time number $t. If the time specified 
#       exceeds one day, then $t is a normalized
#       time, and $cd is the number of days carried.
#       Results for negative or non-integral 
#       $H, $M, $S aren't reliable.
# 13. &bkt($t,\$H,\$M,\$S)
#       Decomposes $t into hours $H, minutes $M
#       and seconds $S.
# 14. $t2=&tphms($t1,$H,$M,$S,\$cd)
#       Adds $H hours, $M minutes and $S seconds to 
#       time number $t1. If the result
#       exceeds one day, then $t2 is a normalized
#       time, and $cd is the number of days carried.
# 15. $t=&dft($df,\$cd)
#       Converts floating point number 0<=$df<=1 
#       into a time number $t, interpreting $df as 
#       a floating point number of days. If $df is 
#       outside interval (0,1) then $cd days are 
#       added or subtracted and then $df is
#       converted to a time number.
# 16. $df=&tdf($t)
#       Converts time number $t into a 
#       floating point number of days $df.
# 17. $t2=&tpdf($t1,$df,\$cd)
#       Adds floating point number of days $df 
#       to time number $t1 to get time number $t2
#       and $cd carry days.
# 18. $df=&dbtt($t1,$t2)
#       $df is floating point number of days between
#       time $t1 and time $t2. If $t1>$t2, then $df<0.
# 19. $t=&tnow()
#       $t=Current time of day HHMMSS per system clock
#       
#
# Lore: datlib.pm is the current evolution of a set of date routines 
# created by the author in FORTRAN circa 1984.
#       
#
# Comments:
# 1. Most of these routines require one or more 
# dates as or times as arguments. If you do not 
# provide valid input arguments, the outputs may 
# not be valid.
# 2. &isvld() tests for date validity. &isvld() 
# produces 0 (FALSE) given invalid input and 
# 1 (TRUE) given valid input. No other routine
# assuredly tests for date validity.
# Similarly, &isvt() tests for time validity.
# 3. If the input arguments for these routines 
# are valid, then the outputs are valid.
# If the outputs are invalid, then the inputs
# are invalid.
# 4. Valid dates are integers expressing the date 
# in yyyymmdd or yymmdd format. For examples, 
# 19981013 is a valid date, October 13, 1998, 
# and 20050431 is not a valid date because April 
# doesn't have 31 days.
# 5. Valid times are integers expressing the time
# in HHMMSS format, with a 24-hour clock. This 
# implies 3:00pm is correctly expressed as 150000. 
# 6. These routines will produce valid results 
# for valid dates between 10000101 and 89991231.
# WARNING: any intermediate calculation that 
# implies a date outside this interval may 
# produce an invalid result.
# 7. There are 86400 seconds in one day.
# 8. These routines truncate fractional seconds.
# 
# 

use strict 'vars';
use strict 'subs';

#----------------------------------------------------------
sub today($) {      # today's date and day of week

 my( $wd ) = @_ ;         # day of week

 my( $ss, $mm, $hh, $md, $mo, $yr, $yd, $is, $today,
 );

 # see desc of localtime for desc of these args.
 ($ss, $mm, $hh, $md, $mo, $yr, $$wd, $yd, $is)=localtime;
 $today=(1900+$yr)*10000+(1+$mo)*100+$md;
 return($today);
}

#----------------------------------------------------------
sub bkd($$$$) {

  my ($d,$y,$m,$dy) = @_;

  $d=&d628(int($d));
  $$y=int($d/10000);
  $$m=int(($d-$$y*10000)/100);
  $$dy=$d-$$y*10000-$$m*100;

}

#----------------------------------------------------------
sub isvld($) {

  my ($date)=@_;

#    local (
#      $tf,        # 0=false, 1=true
#    );

  my (
    $tf,          # 0=false, 1=true
    $y,
    $m,
    $d,
  );

  $tf=1;                         # assume good date
  &bkd($date,\$y,\$m,\$d);       # decompose date
  if ($y<1 or $y>9999){          # year out of range ?
    $tf=0 ;
  } elsif ($m<1 or $m>12) {      # month out of range?
    $tf=0 ;
  } elsif ($d<1 or $d>31) {      # day out of range?
    $tf=0;
  } elsif ($m==2){
    if (&islpyr($y) ){     # leap year?
      if ( $d>29) {
        $tf=0;
      } 
    } elsif ($d>28) {         # not leap year
      $tf=0;
    }
  } elsif ($m==9 or $m==4 or $m==6 or $m==11) {
    if ($d>30) {
      $tf=0;
    }
  } 
  return($tf);
}
  
#----------------------------------------------------------
sub islpyr($) {          # is yr a leap year?

  my (
    $y,    # year
  ) = @_;

  my (
    $tf,               # 0=false, 1=true
    $y4, $y100, $y400, # year mod 4, mod 100, mod 400
  );

  $tf=0;              # assume not leap year

  $y4= $y % 4;
  $y100= $y % 100;
  $y400= $y % 400;

  if ($y400==0) {         # yr divisible by 400?
    $tf=1;                # it's leap yr
  } elsif ($y100==0) {    # yr divisible by 100?
    $tf=0;                # not leap year
  } elsif ($y4==0) {      # yr divisible by 4?
    $tf=1;                # leap year
  }

  if ($y4==0) {           # yr divisible by 4?
    $tf=1;                # it's leap year
    if ($y100==0 and $y400!=0) {  # exception for most centuries
      $tf=0;              # not leap year
    }
  }

  return($tf);
}

#----------------------------------------------------------
sub dpn($$) {

  # add n days to d
  my ($d1, $n) = @_; 

  my ($yr,$mo,$dy,          # working date
      $data, $datb,         # aux dates
      $i,$j,$k,             # aux
      $Q,                   # days per 400 years
      $c,                   # days per century
      $q,                   # days per 4-year
     );

  $q=365*3+366;
  $c=25*$q-1;
  $Q=4*$c+1;

  &bkd($d1,\$yr,\$mo,\$dy); # decompose date

  while ($n>0) {
    
    if ($mo==2 and $dy==29) {  # Feb 29?
      $n--;
      $mo=3;
      $dy=1;

    } elsif ($n<=31) {           # moving less than about a month?
      $i=&lastday($yr,$mo);        # last day of current month
      $j=($i-$dy);                 # remaining days this month
      if ($n<$j) {
        $dy+=$n;                   # move remaining n days
        $n=0;
      } elsif ($j>0) {
        $n-=$j;
        $dy=$i;                    # move to last day
      } elsif ($j==0) {
        $n--;                      # move to 1st day of next mo
        $dy=1;
        $mo++;
        if ($mo>12) {              # past end of year?
          $mo=1;
          $yr++;                   
        }
      }
    
    } elsif ($n<=366) {     # moving less than about a year?
      
      for ($i=1; $i<=12; $i++) {
        if ($n<=31) { last } ;    # leave loop
        $j=&lastday($yr,$mo)-$dy;      # days to eom
        $n-=($j+1);
        $dy=1;    # move to next mo
        $mo++;
        if ($mo>12) {                  # past end of year?
          $mo=1;
          $yr++;                   
        }
      }     # end for i

    } elsif ( $n<=($q+1)      # moving less than 4 yrs 
         or ( int($yr/100) ne int(($yr+4)/100) )   # or 4 more yrs is diff century
         or ( ($yr+4)%100 eq 0 )     # or century year?
         or ( $yr%100 eq 0 )   ){    # or century year?
      
      # move 1 yr
      if ($mo>=3) {                   # March or later?
        $yr++;
        $n=$n-365-&islpyr($yr);
      } else {                        # Feb 28 or earlier?
        $n=$n-365-&islpyr($yr);
        $yr++;
      }

    } elsif ( ($n<=($c+1) )    # moving less than about 1 century
         or   ( int(($yr+100)/400) ne int($yr/400) )  # or diff quad-century 
         or   ( $yr%400 eq 0 )       # or quad-century year?
         or   ( ($yr+100%400) eq 0 ) ){    # or quad-century year?
      $yr+=4;                      # move 4 yrs
      $n-=$q;

    } elsif ($n<=($Q+1)) {   # moving less than about 4 centuries
      $yr+=100;                    # move 100 yrs
      $n-=$c;

    } elsif ($n>$Q) {        # moving more than 4 centuries
      $yr+=400;
      $n-=$Q;
    
    } else {
      die "Programming error L263";
    }

  }  # end while n > 0

                      #=-=-=-=-=-=-=-=-

  while (-$n>0) {
    
    if ($mo==2 and $dy==29) {  # Feb 29?
      $n++;
      $dy=28;

    } elsif (-$n<=31) {           # moving less than about a month?
      if (-$n<$dy) {
        $dy+=$n;                   # move remaining n days
        $n=0;
      } else {
        #print "D276 yr:$yr mo:$mo dy:$dy n:$n\n";
        &mtldpm(\$yr,\$mo,\$dy,\$n); # move to last day of prev mo
      }
    
    } elsif (-$n<=366) {     # moving less than about a year?
      
      for ($i=1; $i<=12; $i++) {
        if (-$n<=31) { last } ;    # leave loop
        &mtldpm(\$yr,\$mo,\$dy,\$n); # move to last day of prev mo
      }     # end for i

    } elsif ( -$n<=($q+1)      # moving less than 4 yrs 
         or ( int($yr/100) ne int(($yr-4)/100) )   # or 4 more yrs is diff century
         or ( ($yr-4)%100 eq 0 )     # or century year?
         or ( $yr%100 eq 0 ) ){    # or century year?
      
      # move 1 yr
      if ($mo>=3) {                   # March or later?
        $n=$n+365+&islpyr($yr);
        $yr--;
      } else {                        # Feb 28 or earlier?
        $yr--;
        $n=$n+365+&islpyr($yr);
      }

    } elsif ( (-$n>=(-$c-1) )  # moving less than about 1 century
         or   ( int(($yr-100)/400) ne int($yr/400) )  # or diff quad-century 
         or   ( $yr%400 eq 0 )       # or quad-century year?
         or   ( ($yr-100)%400 eq 0 ) ){    # or quad-century year?
      $yr-=4;                      # move 4 yrs
      $n+=$q;

    } elsif (-$n<=($Q+1)) {   # moving less than about 4 centuries
      $yr-=100;                    # move 100 yrs
      $n+=$c;

    } elsif (-$n>$Q) {        # moving more than 4 centuries
      $yr-=400;
      $n+=$Q;
    
    } else {
      die "Programming error L322";
    }

  }  # end while -n > 0


  $data=&mkd($yr,$mo,$dy);    # new date is day moved n days.
  return($data);              # new date is day moved n days.

}  # end sub dpn
      
    
#----------------------------------------------------------
sub lastday($$) {
# 8. $dy=&lastday($y,$m)

  my ($y,$m)=@_;

  my (
    $ly,        #    =1=L. y., =0=otherwise 
    @days,            # number of days in each month
    $d,         # aux
  );

  @days=(0,31,28,31,30,31,30,31,31,30,31,30,31);
  $d=$days[$m];
  if (( $m == 2 ) and &islpyr($y)) {
    $d++;
  }
  
  return($d);
}
#----------------------------------------------------------
sub mtldpm($$$$) {      # move to last day of prev mo
  # this subr intended for invocationonly from &dpn
  my( $y,$m,$d,$n ) =@_;    # all pointers
        $$n+=$$d;                      # move to last day of prev mo
        $$m--;
        if($$m<1) {
          $$y--;
          $$m=12;
        }
        $$d=&lastday($$y,$$m);
} # end sub mtldpm
  
#----------------------------------------------------------
sub dbtd($$) {

# 3. $n=&dbtd($d1,$d2)
#       $n is the number of days between $d1 and $d2.
#       ex: -4==&dbtd(20040302,20040227)

  my (
    $d1,     # early date 
    $d2,     # later date
  )  = @_ ;

  my (
    $n,      # number of days
    $y1,$m1,$dy1, # year, month, day for two dates
    $y2,$m2,$dy2, # year, month, day for two dates
    $i, $j, $k, # aux
    $ld,$md,$hd, # lo, medium, hi dates for binary search
    $ln,$mn,$hn,  # lo, md, hi n-values for binary search
    $sign,        # =1 if $d1 is not later than $d2, =-1 otherwise
  );

  $d1=&d628($d1); # assure yyyymmdd
  $d2=&d628($d2); # assure yyyymmdd

  # d2 earlier?
  if ($d2<$d1) {
    $sign=-1;
    $i=$d1;$d1=$d2;$d2=$i;         # swap order
  }else{
    $sign=1;
  }

  # now we know d2 is the later date

  &bkd($d1,\$y1,\$m1,\$dy1);    # break
  &bkd($d2,\$y2,\$m2,\$dy2);    # break

  $n=0;                         # init est

  # take dy1 to first day of m1
  $n+=1-$dy1; 
  $dy1=1;
  # take dy2 to first day of m2
  $n+=$dy2-1;
  $dy2=1;

  # take m1 to january
  while ($m1>1) {
    $m1--;
    $n-=&lastday($y1,$m1);
  }
  # take m2 to january
  while ($m2>1) {
    $m2--;
    $n+=&lastday($y2,$m2);
  }

  # now we are at Jan 1 of two possibly different years.
  #print "L420 d1:$d1 $y1 $m1 $dy1 d2:$d2 $y2 $m2 $dy2 n:$n\n";

  if($y1!=$y2) { 

    # we no longer count days, we iterate toward solution
    #
    $ln=(int($d2/10000)-int($d1/10000)-1)*365   ;           # lower bound
    $ld=&dpn($d1,$ln);                  # corresponding date
    if($ld==$d2){                   # got it?
      $n=$ln;
    }else{

      $hn=(int($d2/10000)-int($d1/10000)+1)*366   ;         # upper bound
      $hd=&dpn($d1,$hn);
      if($hd==$d2){                 # got it?
        $n=$hn;
      }else{

        # binary search
        for($i=1;$i<50;$i++){ 
          $n=$ln+int(($hn-$ln+1)/2) ;
          $md=&dpn($d1,$n);
          #print "L439 d1:$d1 d2:$d2 md:$md n:$n ln:$ln hn:$hn i:$i\n";
          if($md==$d2){            # got it ?
            last;
          }elsif($md>$d2) {        # $md too late?
            $hn=$n;
          }else{
            $ln=$n;
          }

        }  # end for i

      }

    }
    
  }  # if y1 != y2


  return($n*$sign);                 # number of days

} # end sub dbtd
#----------------------------------------------------------
#----------------------------------------------------------
sub d628($) {

  my ($d6) = @_;   # input 6-dig date

  my (
    $d8,           #output 8-dig date
    $today,        # today's date
    $dow,          # today's day of week
    $tcc,          # today's century
    $d8y,          # year number of $d8
    $ty,           # year number of $today
  ); 

  $d8=$d6;                     # assume work already done.
  if ($d6<1000000) {           # ignore if not 6-dig date
    $today=&today(\$dow);
    $tcc=int($today/1000000);  # get today's century numbers
    $ty=int($today/10000);     # get year number
    $d8=$tcc*1000000+$d6;      # consider $d8 in same century
    $d8y=int($d8/10000);       # get century number
    if ($ty-$d8y>50) {         # today more than 50 years after $d8?
      $d8+=1000000;            # add 100 years to $d8
    } elsif ($ty-$d8y<-50) {   # today more than 50 years earlier?
      $d8-=1000000;            # subtract 100 years from $d8
    }
  }

  return($d8);
}

#----------------------------------------------------------
sub mkd($$$) {
# 6. $d=&mkd($y,$m,$dy)
#       Combines year number $y, month number $m and 
#       day number $dy into a date $d.
#       ex: 20030817==&mkd(3,8,17)
# 

my ($y,$m,$dy) = @_;

my (
  $date,                            # output date
  );

 
$date=&d628($y*10000+$m*100+$dy);          # compose date
while (length($date)<8) {$date="0".$date} ;   # leading zeroes

return($date);

} # end sub mkd
#----------------------------------------------------------
sub dow($) {
# 9. $smtwtfs=&dow($d)
#       $smtwtfs is 0 for Sunday, 1 for Monday, ...
#       6 for Saturday.

  my (
    $d,
  ) = @_;

  my (
    $day,
    $dowd,
    $n,
  );

  $day=20050220; # sunday
  $n=&dbtd($day,$d);
  $dowd=$n%7;

  return($dowd);
}
#----------------------------------------------------------
sub isvt($) {
# 11. $tf=&isvt($t)
#       $tf==1 if $t is a valid time of day
#       , ==0 otherwise. In assessing the 
#       validity of $t, &isvt() interprets $t
#       as an integer expression of a time of 
#       day in the format HHMMSS. If 
#       0  <=  HH  <= 24, and 
#       0  <=  MM  <  60, and 
#       0  <=  SS  <  60, then $tf==1.

  my (
    $t,
    ) = @_;

  my (
    $tf,           # = 1 if $t is valid , = 0 otherwise
    $HH, $MM, $SS, # hours, minutes, seconds
  );
  
  if ($t<0) {return(0)};     # clearly bogus, early exit   

  # break the time number
  &bkt($t,\$HH,\$MM,\$SS);
  
  $tf=1;           # assume ok
  if (  ( $t ne 0 ) and 
        (  ($HH<0 or $HH>24) or
           ($MM<0 or $MM>59) or
           ($SS<0 or $SS>59) ) ) {
    $tf=0;         # bogus
  }

  return($tf);     # render the verdict
} # end isvt
#----------------------------------------------------------
sub mkt ($$$$) {

# 12. $t=&mkt($H,$M,$S,\$cd)
#       Combines hours, minutes and seconds into 
#       time number $t. If the time specified 
#       exceeds one day, then $t is a normalized
#       time, and $cd is the number of days carried.
#       Results for negative or non-integral 
#       $H, $M, $S aren't reliable.

  my (
    $H,$M,$S,
    $cd,
    ) = @_;

  my (
    $t,
    );

  $$cd=0; # init

  # integerize
  $M+=60*($H-int($H)); $H=int($H);
  $S+=60*($M-int($M)); $M=int($M);
  $S=int($S);
  
  # normalize
  $M+=int($S/60); $S%=60;
  $H+=int($M/60); $M%=60;
  $$cd+=int($H/24); $H%=24;      # carry days

  # leading zeroes
  $t=$H*10000+$M*100+$S;
  while (length($t)<6) {
    $t="0".$t;
  }
  
  return($t);

} # end mkt
#----------------------------------------------------------
sub bkt($$$$) {
# 13. &bkt($t,\$H,\$M,\$S)
#       Decomposes $t into hours $H, minutes $M
#       and seconds $S.
  
  my (
    $t, $H, $M, $S, 
  ) = @_;

  $$H=int($t/10000);
  $$M=int(($t - 10000*$$H)/100);
  $$S=int($t - 10000*$$H - 100*$$M);
  if ($$H<10 and $$H>=0) {$$H="0".$$H};
  if ($$M<10 and $$M>=0) {$$M="0".$$M};
  if ($$S<10 and $$S>=0) {$$S="0".$$S};
   
} # end bkt
#----------------------------------------------------------
sub tphms($$$$$) {

# 14. $t2=&tphms($t1,$H,$M,$S,\$cd)
#       Adds $H hours, $M minutes and $S seconds to 
#       time number $t1. If the result
#       exceeds one day, then $t2 is a normalized
#       time, and $cd is the number of days carried.

  my (
    $t1,$H,$M,$S,$cd
  ) = @_;

  my (
    $tinc,             # incremental time
    $dt,$dhms,         # fractional day time, plustime
    $c,                # carry days
    $t2,               # result time
  );

  $dhms=$H/24+$M/1440+$S/86400;  # fractional day expression
  $dt=&tdf($t1);                 # fractional day expression
  $dt=$dt+$dhms;                 # add fractional days
  $t2=&dft($dt,$cd);             # express as time

  return($t2);
  
} # end tphms
#----------------------------------------------------------
sub dft($$) {
# 15. $t=&dft($df,\$cd)
#       Converts floating point number 0<=$df<=1 
#       into a time number $t, interpreting $df as 
#       a floating point number of days. If $df is 
#       outside interval (0,1) then $cd days are 
#       added or subtracted and then $df is
#       converted to a time number.
  my ( $df, $cd) =@_;

  my ( 
    $s,                # seconds
    $fluff, $i,        # aux
    $t2,               # result
  ) ;

  $$cd=0;

  # calculate carry days
  if ( $df<0 ) { 
    $i=($df==int($df))?0:1;
    $$cd=-int(-$df)-$i;
  } else {
    $$cd=int($df)
  }

  # remove carry days for 
  # simple time expression
  $df=$df-$$cd;

  $s=int(86400*$df+0.5);          # seconds
  $t2=&mkt(0,0,$s,\$fluff);   # express time
  
  return($t2);
    

} # end dft
#----------------------------------------------------------
sub tdf($) {
# 16. $df=&tdf($t)
#       Converts time number $t into a 
#       floating point number of days $df.

  my (
    $t,
  ) = @_;

  my (
    $H,$M,$S,    # hour, min, sec
  );

  # break the time
  &bkt($t,\$H,\$M,\$S);
  return($H/24+$M/1440+$S/86400);
} # end tdf 
#----------------------------------------------------------
sub tpdf() {
# 17. $t2=&tpdf($t1,$df,\$cd)
#       Adds floating point number of days $df 
#       to time number $t1 to get time number $t2
#       and $cd carry days.

  my (
    $t1, $df, $cd,
  ) = @_;

  return(&dft(&tdf($t1)+$df,$cd));
} # end tpdf
#----------------------------------------------------------
sub dbtt() {
# 18. $df=&dbtt($t1,$t2)
#       $df is floating point number of days between
#       time $t1 and time $t2. If $t1>$t2, then $df<0.

  my ( $t1, $t2 ) = @_ ;

  return(&tdf($t2)-&tdf($t1));
  
} # end dbtt
#----------------------------------------------------------
sub tnow() {            # time of day now
# 19. $t=&tnow()
#       $t=Current time of day HHMMSS per system clock

 #my() = @_ ;         # no args

 my( $ss, $mm, $hh, $md, $mo, $yr, $yd, $is, $now,
   $wd,
 );

 # see desc of localtime for desc of these args.
 ($ss, $mm, $hh, $md, $mo, $yr, $wd, $yd, $is)=localtime;
 $now=$hh*10000+$mm*100+$ss;
 while (length($now)<6) { $now="0".$now };  # ldg zero
 return($now);
} # end tnow
#----------------------------------------------------------
#----------------------------------------------------------
#----------------------------------------------------------
1