Acme-Tools
view release on metacpan or search on metacpan
#':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.
=cut
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) }
=head2 time_fp
No input arguments.
Return the same number as perls C<time()> except with decimals (fractions of a second, _fp as in floating point number).
print time_fp(),"\n";
print time(),"\n";
Could write:
1116776232.38632
...if that is the time now.
Or just:
1116776232
...from perl's internal C<time()> if C<Time::HiRes> isn't installed and available.
=cut
sub time_fp { # {return 0+gettimeofday} is just as well?
eval{ require Time::HiRes } or return time();
my($sec,$mic)=Time::HiRes::gettimeofday();
return $sec+$mic/1e6; #1e6 not portable?
}
sub timems {
eval{ require Time::HiRes } or return time();
my($sec,$mic)=Time::HiRes::gettimeofday();
return $sec*1000+$mic/1e3;
}
=head2 sleep_fp
sleep_fp() work as the built in C<< sleep() >> but also accepts fractional seconds:
sleep_fp(0.020); # sleeps for 20 milliseconds
Sub sleep_fp do a C<require Time::HiRes>, thus it might take some
extra time the first call. To avoid that, add C<< use Time::HiRes >>
to your code. Sleep_fp should not be trusted for accuracy to more than
a tenth of a second. Virtual machines tend to be less accurate (sleep
longer) than physical ones. This was tested on VMware and RHEL
(Linux). See also L<Time::HiRes>.
=head2 sleeps
=head2 sleepms
if($jump>0){ while($x<$y){ push @r, $x; $x+=$jump } }
else { while($x>$y){ push @r, $x; $x+=$jump } }
return @r;
}
#jumps derivative, double der., trippled der usw
sub _range_accellerated {
my($x,$y,@jump)=@_;
my @r;
my $test = $jump[0]>=0 ? sub{$x<$y} : sub{$x>$y};
while(&$test()){
push @r, $x;
$x+=$jump[0];
$jump[$_-1]+=$jump[$_] for 1..$#jump;
}
return @r;
}
=head2 globr
Works like and uses Perls builtin C<< glob() >> but adds support for ranges
with C<< {from..to} >> and C<< {from..to..step} >>. Like brace expansion in bash.
Examples:
my @arr = glob "X{a,b,c,d}Z"; # @arr now have four elements: XaZ XbZ XcZ XdZ
my @arr = globr "X{a,b,c,d}Z"; # same as above
my @arr = globr "X{a..d}Z"; # same as above
my @arr = globr "X{a..f..2}"; # step 2, returns array: Xa Xc Xe
my @arr = globr "{aa..bz..13}Z"; # aaZ anZ baZ bnZ
my @arr = globr "{1..12}b"; # 1b 2b 3b 4b 5b 6b 7b 8b 9b 10b 11b 12b
my @arr = globr "{01..11}b"; # 01b 02b 03b 04b 05b 06b 07b 08b 09b 10b 11b (keep leading zero)
my @arr = globr "{01..12..3}b"; # 01b 04b 07b 10b
=cut
sub globr($) {
my $p=shift;
$p=~s{
\{(-?\w+)\.\.(-?\w+)(\.\.(-?\d+))?\}
}{
my $i=0;
my @r=$1 le $2 ? ($1..$2) : reverse($2..$1);
@r=grep !($i++%$4),@r if $4;
"{" . join(",",@r) . "}"
}xeg;
glob $p;
}
=head2 permutations
How many ways (permutations) can six people be placed around a table:
One person: one way
Two persons: two ways (they can swap places)
Three persons: 6
Four persons: 24
Five persons: 120
Six persons: 720
The formula is C<x!> where the postfix unary operator C<!>, also known as I<faculty> is defined as:
C<x! = x * (x-1) * (x-2) ... * 1>. Example: C<5! = 5 * 4 * 3 * 2 * 1 = 120>.Run this to see the 100 first C<< n! >>
perl -MAcme::Tools -le'$i=big(1);print "$_!=",$i*=$_ for 1..100'
1! = 1
2! = 2
3! = 6
4! = 24
5! = 120
6! = 720
7! = 5040
8! = 40320
9! = 362880
10! = 3628800
.
.
.
100! = 93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
C<permutations()> takes a list and return a list of arrayrefs for each
of the permutations of the input list:
permutations('a','b'); #returns (['a','b'],['b','a'])
permutations('a','b','c'); #returns (['a','b','c'],['a','c','b'],
# ['b','a','c'],['b','c','a'],
# ['c','a','b'],['c','b','a'])
Up to five input arguments C<permutations()> is probably as fast as it
can be in this pure perl implementation (see source). For more than
five, it could be faster. How fast is it now: Running with different
n, this many time took that many seconds:
n times seconds
-- ------- ---------
2 100000 0.32
3 10000 0.09
4 10000 0.33
5 1000 0.18
6 100 0.27
7 10 0.21
8 1 0.17
9 1 1.63
10 1 17.00
If the first argument is a coderef, that sub will be called for each permutation and the return from those calls with be the real return from C<permutations()>. For example this:
print for permutations(sub{join"",@_},1..3);
...will print the same as:
print for map join("",@$_), permutations(1..3);
...but the first of those two uses less RAM if 3 has been say 9.
Changing 3 with 10, and many computers hasn't enough memory
for the latter.
The examples prints:
123
( run in 0.715 second using v1.01-cache-2.11-cpan-39bf76dae61 )