Acme-Tools

 view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

    $_[0] =~ $Re_isnum  and @lt=localtime($_[0]) and return sprintf("%04d%02d%02d-%02d:%02d:%02d",1900+$lt[5],1+$lt[4],@lt[3,2,1,0]);
  }
  my($format,$time,$is_date)=@_;
  $time=time_fp() if !defined$time;
  ($time,$format)=($format,$time) if @_>=2 and $format=~/^[\d+\:\-\.]+$/; #swap /hm/
  my @lt=localtime($time);
  #todo? $is_date=0 if $time=~s/^\@(\-?\d)/$1/; #@n where n is sec since epoch makes it clear that its not a formatted, as in `date`
  #todo? date --date='TZ="America/Los_Angeles" 09:00 next Fri' #`info date`
  #      Fri Nov 13 18:00:00 CET 2015
  #date --date="next Friday"  #--date or -d
  #date --date="last friday"
  #date --date="2 days ago"
  #date --date="yesterday" #or tomorrow
  #date --date="-1 day"  #date --date='10 week'

  if( $is_date ){
    my $yy2c=sub{10+$_[0]>$lt[5]%100?"20":"19"}; #hm 10+
    $time=totime(&$yy2c($1)."$1$2$3")."000000" if $time=~/^(\d\d)(\d\d)(\d\d)$/;
    $time=totime("$1$2${3}000000")             if $time=~/^((?:18|19|20)\d\d)(\d\d)(\d\d)$/; #hm 18-20?
  }
  else {
    $time = yyyymmddhh24miss_time("$1$2$3$4$5$6") #yyyymmddhh24miss_time ???
      if $time=~/^((?:19|20|18)\d\d)          #yyyy
                  (0[1-9]|1[012])             #mm
                  (0[1-9]|[12]\d|3[01]) \-?   #dd
                  ([01]\d|2[0-3])       \:?   #hh24
                  ([0-5]\d)             \:?   #mi
                  ([0-5]\d)             $/x;  #ss
  }
  tms_init() if !$_tms_inited;
  return sprintf("%04d%02d%02d-%02d:%02d:%02d",1900+$lt[5],1+$lt[4],@lt[3,2,1,0]) if !$format;
  my %p=('%'=>'%',
	 a=>'Dy',
	 A=>'Day',
	 b=>'Mon',
	 b=>'Month',
	 c=>'Dy Mon D HH:MI:SS YYYY',
	 C=>'CC',
	 d=>'DD',
	 D=>'MM/DD/YY',
	 e=>'D',
	 F=>'YYYY-MM-DD',
        #G=>'',
	 h=>'Month', H=>'HH24', I=>'HH12',
	 j=>'DoY', #day of year
	 k=>'H24', _H=>'H24',
	 l=>'H12', _I=>'H12',
	 m=>'MM', M=>'MI',
	 n=>"\n",
	#N=>'NS', #sprintf%09d,1e9*(time_fp()-time()) #000000000..999999999
	 p=>'AM', #AM|PM upper (yes, opposite: date +%H%M%S%P%p)
	 P=>'am', #am|pm lower
	 S=>'SS',
	 t=>"\t",
	 T=>'HH24:MI:SS',
	 u=>'DoW',  #day of week 1..7, 1=mon 7=sun
	 w=>'DoW0', #day of week 0..6, 1=mon 0=sun
	#U=>'WoYs', #week num of year 00..53, sunday as first day of week
	#V=>'UKE',  #ISO week num of year 01..53, monday as first day of week
	#W=>'WoYm', #week num of year 00..53, monday as first day of week, not ISO!
	#x=>$ENV{locale's date representation}, #e.g. MM/DD/YY
	#X=>$ENV{locale's time representation}, #e.g. HH/MI/SS
	 y=>'YY',
	 Y=>'YYYY',
	#z=>'TZHHMI', #time zone hour minute e.g. -0430
	#':z'=>'TZHH:MI',
	#'::z'=>'TZHH:MI:SS',
	#':::z'=>'TZ', #number of :'s necessary precision, e.g. -02 or +03:30
	#Z=>'TZN', #e.g. CET, EDT, ...
      );
  my $pkeys=join"|",keys%p;
  $format=~s,\%($pkeys),$p{$1},g;
  $format=~s/($Tms_pattern)/$Tms_str{$1}[1+$lt[$Tms_str{$1}[0]]]/g;
  $format=~s/YYYY              / 1900+$lt[5]                    /gxe;
  $format=~s/(\s?)yyyy         / $lt[5]==(localtime)[5]?"":$1.(1900+$lt[5])/gxe;
  $format=~s/YY                / sprintf("%02d",$lt[5]%100)     /gxei;
  $format=~s|CC                | sprintf("%02d",(1900+$lt[5])/100) |gxei;
  $format=~s/MM                / sprintf("%02d",$lt[4]+1)       /gxe;
  $format=~s/mm                / sprintf("%d",$lt[4]+1)         /gxe;
  $format=~s,M/                ,               ($lt[4]+1).'/'   ,gxe;
  $format=~s,/M                ,           '/'.($lt[4]+1)       ,gxe;
  $format=~s/DD                / sprintf("%02d",$lt[3])         /gxe;
  $format=~s/d0w|dow0          / $lt[6]                         /gxei;
  $format=~s/dow               / $lt[6]?$lt[6]:7                /gxei;
  $format=~s/d0y|doy0          / $lt[7]                         /gxei; #0-364 (365 leap)
  $format=~s/doy               / $lt[7]+1                       /gxei; #1-365 (366 leap)
  $format=~s/D(?![AaGgYyEeNn]) / $lt[3]                         /gxe;  #EN pga desember og wednesday
  $format=~s/dd                / sprintf("%d",$lt[3])           /gxe;
  $format=~s/hh12|HH12         / sprintf("%02d",$lt[2]<13?$lt[2]||12:$lt[2]-12)/gxe;
  $format=~s/HH24|HH24|HH|hh   / sprintf("%02d",$lt[2])         /gxe;
  $format=~s/MI                / sprintf("%02d",$lt[1])         /gxei;
  $format=~s{SS\.([1-9])      }{ sprintf("%0*.$1f",3+$1,$lt[0]+(repl($time,qr/^[^\.]+/)||0)) }gxei;
  $format=~s/SS(?:\.0)?        / sprintf("%02d",$lt[0])         /gxei;
  $format=~s/(?:am|pm|apm|xm)  / $lt[2]<13 ? 'am' : 'pm'        /gxe;
  $format=~s/(?:AM|PM|APM|XM)  / $lt[2]<13 ? 'AM' : 'PM'        /gxe;
  $format=~s/WWI|WW            / sprintf("%02d",weeknum($time)) /gxei;
  $format=~s/W                 / weeknum($time)                 /gxei;
  $format;
}

=head2 easter

Input: A year (a four digit number)

Output: array of two numbers: day and month of Easter Sunday that year. Month 3 means March and 4 means April.

 sub easter { use integer;my$Y=shift;my$C=$Y/100;my$L=($C-$C/4-($C-($C-17)/25)/3+$Y%19*19+15)%30;
             (($L-=$L>28||($L>27?1-(21-$Y%19)/11:0))-=($Y+$Y/4+$L+2-$C+$C/4)%7)<4?($L+28,3):($L-3,4) }

...is a "golfed" version of Oudins algorithm (1940) L<http://astro.nmsu.edu/~lhuber/leaphist.html>
(see also http://www.smart.net/~mmontes/ec-cal.html )

Valid for any Gregorian year. Dates repeat themselves after 70499183
lunations = 2081882250 days = ca 5699845 years. However, our planet will
by then have a different rotation and spin time...

Example:

 ( $day, $month ) = easter( 2012 ); # $day == 8 and $month == 4

Example 2:



( run in 2.928 seconds using v1.01-cache-2.11-cpan-98e64b0badf )