Acme-Tools
view release on metacpan or search on metacpan
$s=~s/\bFebruar\b/February/; $s=~s/\bfebruar\b/february/; $s=~s/\bFEBRUAR\b/FEBRUARY/;
$s=~s/\bjuli\b/July/i;
$s=~s/\bjuni\b/June/i;
}
elsif($s =~ /^[19]\d{9}$/){ $s=localtime($s) } #hm, make faster
elsif($s =~ /^[19]\d{12}$/
and int($s/1000) =~ /^[19]\d{9}$/){ $s=localtime($s/1000) } #hm
elsif($s=~/^((?:17|18|19|20|21)\d\d)(0[1-9]|1[012])(0[1-9]|[12]\d|3[01])$/){#hm
$s="$1-$2-$3T00:00:00";
}
return Date::Parse::str2time($s) if !@_;
return tms(Date::Parse::str2time($s),shift(@_)) if 0+@_ == 1;
return map tms(Date::Parse::str2time($s),$_), @_;
}
sub date_ok {
my($y,$m,$d)=@_;
return date_ok($1,$2,$3) if @_==1 and $_[0]=~/^(\d{4})(\d\d)(\d\d)$/;
return 0 if $y!~/^\d\d\d\d$/;
return 0 if $m<1||$m>12||$d<1||$d>(31,$y%4||$y%100==0&&$y%400?28:29,31,30,31,30,31,31,30,31,30,31)[$m-1];
return 1;
}
sub weeknum {
return weeknum(tms('YYYYMMDD')) if @_<1;
return weeknum($1,$2,$3) if @_==1 and $_[0]=~/^(\d{4})(\d\d)(\d\d)$/;
my($year,$month,$day)= @_;
eval{
if(@_<2){
if($year=~/^\d{8}$/) { ($year,$month,$day)=unpack("A4A2A2",$year) }
elsif($year>99999999){ ($year,$month,$day)=(localtime($year))[5,4,3]; $year+=1900; $month++ }
else {die}
}
elsif(@_!=3){croak}
croak if !date_ok(sprintf("%04d%02d%02d",$year,$month,$day));
};
croak "ERROR: Wrong args Acme::Tools::weeknum(".join(",",@_).")" if $@;
use integer;#heltallsdivisjon
my $y=$year+4800-(14-$month)/12;
my $j=$day+(153*($month+(14-$month)/12*12-3)+2)/5+365*$y+$y/4-$y/100+$y/400-32045;
my $d=($j+31741-$j%7)%146097%36524%1461;
return (($d-$d/1460)%365+$d/1460)/7+1;
}
#perl -MAcme::Tools -le 'print "$_ ".tms($_."0501","day",1) for 2015..2026'
sub tms {
return undef if @_>1 and not defined $_[1]; #time=undef => undef
if(@_==1){
my @lt=localtime();
$_[0] eq 'YYYY' and return 1900+$lt[5];
$_[0] eq 'YYYYMMDD' and return sprintf("%04d%02d%02d",1900+$lt[5],1+$lt[4],$lt[3]);
$_[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:
my @e=map sprintf("%02d%02d", reverse(easter($_))), 1800..300000;
print "First: ".min(@e)." Last: ".max(@e)."\n"; # First: 0322 Last: 0425
Note: The Spencer Jones formula differs Oudins used in C<easter()> in some years
before 1498. However, in that period the Julian calendar with a different formula was
used anyway. Countries introduced the current Gregorian calendar between 1583 and 1926.
( run in 0.486 second using v1.01-cache-2.11-cpan-39bf76dae61 )