- NAME
- SYNOPSIS
- ABSTRACT
- DESCRIPTION
- INSTALLATION
- EXPORT
- NUMBERS
- STRINGS
- ARRAYS
- STATISTICS
- RANDOM
- SETS
- HASHES
- COMPRESSION
- NET, WEB, CGI-STUFF
- FILES, DIRECTORIES
- TIME FUNCTIONS
- OTHER
- JUST FOR FUN
- BLOOM FILTER SUBROUTINES
- COMMANDS
- DATABASE STUFF - NOT IMPLEMENTED YET
- HISTORY
- SEE ALSO
- AUTHOR
- LICENSE
NAME
Acme::Tools - Lots of more or less useful subs lumped together and exported into your namespace
SYNOPSIS
use Acme::Tools; print sum(1,2,3); # 6 print avg(2,3,4,6); # 3.75 print median(2,3,4,6); # 3.5 print percentile(25, 101..199); # 125 my @list = minus(\@listA, \@listB); # set operation my @list = union(\@listA, \@listB); # set operation print length(gzip("abc" x 1000)); # far less than 3000 writefile("/dir/filename",$string); # convenient my $s=readfile("/dir/filename"); # also convenient print "yes!" if between($PI,3,4); print percentile(0.05, @numbers); my @even = range(1000,2000,2); # even numbers between 1000 and 2000 my @odd = range(1001,2001,2); my $dice = random(1,6); my $color = random(['red','green','blue','yellow','orange']); pushr $arrayref[$num], @stuff; # push @{ $arrayref[$num] }, @stuff ... popr, shiftr, unshiftr print 2**200; # 1.60693804425899e+60 print big(2)**200; # 1606938044258990275541962092341162602522202993782792835301376 ...and much more.
ABSTRACT
About 120 more or less useful perl subroutines lumped together and exported into your namespace.
DESCRIPTION
Subs created and collected since the mid-90s.
INSTALLATION
sudo cpan Acme::Tools sudo cpanm Acme::Tools # after: sudo apt-get install cpanminus make # for Ubuntu 12.04
Or to get the very newest:
git clone cd Acme-Tools perl Makefile.PL make test sudo make install
EXPORT
Almost every sub, about 90 of them.
Beware of namespace pollution. But what did you expect from an Acme module?
NUMBERS
num2code
See "code2num" FF (base
length("0123456789ABCDEF") ) which is 2 digits of 0-9 or A-F. ...and 14 are converted to 0E, with leading 0 because of the second argument 2.
Example:
print num2code(1234,16,"01")
Prints the 16 binary digits 0000010011010010 which is 1234 converted to binary zeros and ones.-_"; print num2code("241274432",5,$chars); # prints EOOv0 print code2num("EOOv0",$chars); # prints 241274432
gcd
 is common to all three args)
Implementation:
sub gcd { my($a,$b,@r)=@_; @r ? gcd($a,gcd($b,@r)) : $b==0 ? $a : gcd($b, $a % $b) }
One way of putting it: Keep replacing the larger of the two numbers with the difference between them until you got two equal numbers. Then thats the answer.
lcm) }
resolve
Resolves an equation by Newtons method.
Input: 1-6 arguments. At least one argument.
First argument: must be a coderef to a subroutine (a function)
Second argument: if present,{ $_**2 - 4*$_ - 21 }); # -3 with $_ as your x print resolve(sub{ my $x=shift; $x**2 - 4*$x - 21 }); # -3 more elaborate call; my $equation = sub{ $_ - 1 - 1/$_ }; my $gr1 = resolve( $equation, 0, 1 ); # my $gr2 = resolve( $equation, 0, bigf(1) ); # 1/2 + sqrt(5)/2 bigscale(50); my $gr3 = resolve( $equation, 0, bigf(1) ); # 1/2 + sqrt(5)/2 print 1/2 + sqrt(5)/2, "\n"; print "Golden ratio 1: $gr1\n"; print "Golden ratio 2: $gr2\n"; print "Golden ratio 3: $gr3\n";
Output:
1.61803398874989:
resolve_equation
This prints 2:
print resolve_equation "x + 13*(3-x) = 17 - x"
A string containing at least one x is converted into a perl function. Then x is found by using resolve. The string conversion is done by replacing every x with $_ and if a
= char is present it converts
leftside = rightside into
(leftside) - (rightside) = 0 which is the default behaviour of resolve.
conv 4 , cm, mm,, BeV, erg, ergs, foot-pound, foot-pounds, ftlb, joule, kWh, MWh, GWh, TWh, angstrom mileage:, mBTC, XBT Currency rates are automatically updated from the net at least every 24h since last update (on linux/cygwin). numbers: dec, hex, bin, oct, roman, dozen, doz, dz, dusin, gross, gro, gr, great_gross, small_gross (not supported: decimal, km/h, km/t, kmh, kmph, kmt, m/s, mi/h, mph, mps, kn, knot, knots, kt, kts, mach, machs, c, fps, ft/s, ft, ft3, in3, liter, liters, litre, litres, gal, gallon, gallon_imp, gallon_uk, gallon_us, gallons, pint, pint_imp, pint_uk, pint_us, tsp, tablespoon, teaspoon, floz, floz_uk, therm, thm, fat, bbl, Mbbl, MMbbl, drum, container (or container20), container40, container40HC, container45HC
See:
bytes_readable
Converts a number of bytes to something human readable.
Input 1: a number
Input 2: optionally the number of decimals if >1000 B. Default is 2.
Output: a string containing:); # 1000 B print bytes_readable(1001); # print bytes_readable(1088516511498.24*1000,3); # 990.000 TB print bytes_readable(1088516511498.24*1000,1); # 990.0 TB
sec_readable
Time written as
14h 37m is often more humanly comprehensible than
52620 seconds .
print sec_readable( 0 ); # 0s print sec_readable( 0.0123 ); # 0.0123s print sec_readable(-0.0123 ); # -0.0123s print sec_readable( 1.23 ); # 1.23s print sec_readable( 1 ); # 1s print sec_readable( 9.87 ); # 9.87s print sec_readable( 10 ); # 10s print sec_readable( 10.1 ); # 10.1s print sec_readable( 59 ); # 59s print sec_readable( 59.123 ); # 59.1s print sec_readable( 60 ); # 1m 0s print sec_readable( 60.1 ); # 1m 0s print sec_readable( 121 ); # 2m 1s print sec_readable( 131 ); # 2m 11s print sec_readable( 1331 ); # 22m 11s print sec_readable(-1331 ); # -22m 11s print sec_readable( 13331 ); # 3h 42m print sec_readable( 133331 ); # 1d 13h print sec_readable( 1333331 ); # 15d 10h print sec_readable( 13333331 ); # 154d 7h print sec_readable( 133333331 ); # 4yr 82d print sec_readable( 1333333331 ); # 42yr 91d
int2roman
roman2int("MCMLXXI") == 1971
distance
Input: the four decimal numbers of two GPS positions: latutude1, longitude1, latitude2, longitude2
Output: the air distance in meters between the two points
bigscale
big, bigi, bigf, bigr and bigscale are sometimes convenient shorthands for using
Math::BigInt->new(),
Math::BigFloat->new() and
Math::BigRat->new() (preferably with the GMP for faster calculations)., see bigf below:
isnum
Input: String to be tested on this regexp:
/^ \s* [\-\+]? (?: \d*\.\d+ | \d+ ) (?:[eE][\-\+]?\d+)?\s*$/x
If no argument is given isnum checks
$_.
Output: True or false (1 or 0)
use Acme::Tools; my @e=(' +32.12354E-21 ', 2.2, '9' x 99999, ' -123.12', '29,323.31', '29 323.31'); print isnum() ? 'num' : 'str' for @e; #prints num for every element except the last two print $_=~$Re_isnum ? 'num' : 'str' for @e; #same but slighhly faster
between
Input: Three arguments.
Returns: Something true if the first argument is numerically between the two next.
curb
Input: Three arguments: value, minumum, maximum.
Output: Returns the value if its between the given minumum and maximum. Returns minimum if the value is less or maximum if the value is more. Changes the variable if 1st arg is a scalarref.
my $enthusiasm = 11; print curb( $enthusiasm, 1, 20 ); # prints 11, within bounds print curb( $enthusiasm, 1, 10 ); # prints 10 print curb( $enthusiasm, 20, 100 ); # prints 20 print curb(\$enthusiasm, 1, 10 ); # prints 10 and sets $enthusiasm = 10 print $enthusiasm; # prints 10
log10
log2
logn
print log10(1000); # prints 3 print log10(10000*sqtr(10)); # prints 4.5 print log2(16); # prints 4 print logn(4096, 8); # prints 4 (12/3=4) print logn($PI, 2.71828182845905); # same as print log($PI) using perls builtin log()
STRINGS
upper
lower
Returns input string as uppercase or lowercase.
Can be used if Perls build in
uc() and
lc() for some reason does not convert æøå or other latin1 letters outsize a-z.
Converts
æøåäëïöüÿâêîôûãõàèìòùáéíóúýñð to and from
ÆØÅÄËÏÖÜ?ÂÊÎÔÛÃÕÀÈÌÒÙÁÉÍÓÚÝÑÐ
See also
perldoc -f uc and
perldoc -f lc
trim\n") @untrimmedstrings = map trim, @untrimmedstrings; # same, works on $_ trim(\$_) for @untrimmedstrings; # same, works on \$_
lpad
rpad
Left or right pads a string to the given length by adding one or more spaces at the end for rpad or at the start for'
cpad'
trigram.
sliding
Same as trigram (except there is no default width). Works also with arrayref instead of string.
Example:
sliding( ["Reven","rasker","over","isen"], 2 )
Result:
( ['Reven','rasker'], ['rasker','over'], ['over','isen'] )
chunks
chars("Tittentei"); # ('T','i','t','t','e','n','t','e','i')
repl
Synonym for replace().
replace
Return the string in the first input argument, but where pairs of search-replace strings (or rather regexes) has been run.
Works as
replace() in Oracle, or rather regexp_replace() in Oracle 10 and onward.
ARRAYS
subarr
The equivalent of
substr on arrays or
splice without changing the array. Input: 1) array or arrayref, 2) offset and optionally 3) length. Without a third argument, subarr returns the rest of the array.
@top10 = subarr( @array, 0, 10); # first 10 @last_two = subarr( @array, -2, 2); # last 2 @last_two = subarr( $array_ref, -2); # also last 2 @last_six = subarr $array_ref, -6; # parens are optional
The same can be obtained from
@array[$from..$to] but that dont work the same way with negative offsets and boundary control of length.
min
max
Returns the largest number in a list. Undef is ignored.
@heights=(123,90,134,undef,132); $highest = max(@heights); # 134
mins
Just as "min", except for strings.
print min(2,7,10); # 2 print mins("2","7","10"); # 10 print mins(2,7,10); # 10
maxs
Just as "mix", except for strings.
print max(2,7,10); # 10 print maxs("2","7","10"); # 7 print maxs(2,7,10); # 7
zip
...or any input argument is not an array ref.
sim
Input: Two or more strings
Output: A number 0 - 1 indicating the similarity between two strings.
Requires String::Similarity where the real magic happens.
sim("Donald Duck", "Donald E. Knuth"); # returns 0.615 sim("Kalle Anka", "Kalle And")' # returns 0.842 sim("Kalle Anka", "Kalle Anka"); # returns 1 sim("Kalle Anka", "kalle anka"); # returns 0.8 sim(map lc, "Kalle Anka", "kalle anka"); # returns 1
Todo: more doc
sim_perm
Input: Two strings
Output: A number 0 - 1 indicating the maximum similarity between two strings tested against all permutations of both strings split on
[\s,]+ and where the string with most words (i.e. names) are cut to as many words as the one with least words.
Requires String::Similarity where the real magic happens.
While sim() is case sensitive, sim_perm() is not.
Name1 Name2 sim() sim_perm() ---------------------------------- ------------------------------------- ----- ---------- Humphrey DeForest Bogart Bogart Humphrey DeForest 0.71 1.00 Humphrey Bogart Humphrey Gump Bogart 0.86 1.00 Humphrey deforest Bogart Bogart DeForest 0.41 1.00 Humfrey DeForest Boghart BOGART HUMPHREY 0.05 0.87 Humphrey Bogart Humphrey 0.70 1.00 Humfrey Deforest Boghart BOGART D. HUMFREY 0.15 0.78 *)
sim_perm() was written to identify double-profiles in databases: two people with either the same (or similar) email or phone number or zip code and similar enough names are going on the list of probable doubles.
*) Todo: should be higher than 0.78, deal with initials better
pushsort
Adds one or more element to a numerically sorted array and keeps it sorted.
pushsort @a, 13; # this... push @a, 13; @a = sort {$a<=>$b} @a; # is the same as this, but the former is faster if @a is large
pushsortstr
binsearch true, whether result not found should return undef or a fractional position.
If the third argument is false binsearch either:
a code-ref that alters the way binsearch compares two elements, default is
sub{$_[0]<=>$_[1]}
a string that works as a hash key (column name), see example below
Examples: my @data=( map { {num=>$_, sqrt=>sqrt($_), square=>$_**2} } grep !$_%7, 1..1000000 ); my $i = binsearch( {num=>913374}, \@data, undef, sub {$_[0]{num} <=> $_[1]{num}} ); my $i = binsearch( {num=>913374}, \@data, undef, 'num' ); #same as previous line my $found_hashref = defined $i ? $data[$i] : undef;
binsearchstr
Same as binsearch except that the arrays is sorted alphanumerically (cmp) instead of numerically (<=>) and the searched element is a string, not a number. See "binsearch".
rank
Input: Two or three arguments. N and an arrayref for the list to look at.
In scalar context: Returns the nth smallest number in an array. The array doesn't have to be sorted.
In array context: Returns the n smallest numbers in an array.
To return the n(th) largest number(s) instead of smallest, just negate n.
An optional third argument can be a sub that is used to compare the elements of the input array.
Examples:
my $second_smallest = rank(2, [11,12,13,14]); # 12 my @top10 = rank(-10, [1..100]); # 100, 99, 98, 97, 96, 95, 94, 93, 92, 91 my $max = rank(-1, [101,102,103,102,101]); #103 my @contest = ({name=>"Alice",score=>14},{name=>"Bob",score=>13},{name=>"Eve",score=>12}); my $second = rank(2, \@contest, sub{$_[1]{score}<=>$_[0]{score}})->{name}; #Bob
rankstr
Just as
rank but sorts alphanumerically (strings, cmp) instead of numerically.
egrep
Extended grep.
Works like grep but with more insight: local vars $i, $n, $prev, $next, $prevr and $nextr are available:
$i is the current index, starts with 0, ends with the length of the input array minus one
$n is the current element number, starts with 1, $n = $i + 1
$prev is the previous value (undef if current is first)
$next is the next value (undef if current is last)
$prevr is the previous value, rotated so that the previous of the first element is the last element
$nextr is the next value, rotated so that the next of the last element is the first element
$_ is the current value, just as with Perls built-in grep
my @a = (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20); # 1..20 my @r = egrep { $_ % 3 == 0 } @a; # @r is 3, 6, 9, 12, 15, 18. Plain grep could have been used here my @r = egrep { $i==1 or $next==12 or $prev==14 } @a; # @r is now 2, 11, 15 my @a=2..44; egrep { $prev =~/4$/ or $next =~/2$/ } @a; # 5, 11, 15, 21, 25, 31, 35, 41 egrep { $prevr=~/4$/ or $nextr=~/2$/ } @a; # 2, 5, 11, 15, 21, 25, 31, 35, 41, 44 egrep { $i%7==0 } @a; # 2, 9, 16, 23, 30, 37, 44 egrep { $n%7==0 } @a; # 8, 15, 22, 29, 36, 43
eqarr)
sorted}};
sortedstr
Return true if the input array is alphanumerically sorted.
@a=(1..10); print "array is sorted" if sortedstr @a; #false @a=("01".."10"); print "array is sorted" if sortedstr @a; #true
part)
parth'] )
parta.
refa
refh
refs
refaa
refah
refha
refhh
Returns true or false (1 or 0) if the argument is an arrayref, hashref, scalarref, ref to an array of arrays, ref to an array of hashes
Examples:
my $ref_to_array = [1,2,3]; my $ref_to_hash = {1,100,2,200,3,300}; my $ref_to_scalar = \"String"; print "arrayref" if ref($ref_to_array) eq 'ARRAY'; #true print "hashref" if ref($ref_to_hash) eq 'HASH'; #true print "scalarref" if ref($ref_to_scalar) eq 'SCALAR'; #true print "arrayref" if refa($ref_to_array); #also true, without: eq 'ARRAY' print "hashref" if refh($ref_to_hash); #also true, without: eq 'HASH' print "scalarref" if refs($ref_to_scalar); #also true, without: eq 'SCALAR' my $ref_to_array_of_arrays = [ [1,2,3], [2,4,8], [10,100,1000] ]; my $ref_to_array_of_hashes = [ {1=>10, 2=>100}, {first=>1, second=>2} ]; my $ref_to_hash_of_arrays = { alice=>[1,2,3], bob=>[2,4,8], eve=>[10,100,1000] }; my $ref_to_hash_of_hashes = { alice=>{a=>22,b=>11}, bob=>{a=>33,b=>66} }; print "aa" if refaa($ref_to_array_of_arrays); #true print "ah" if refah($ref_to_array_of_hashes); #true print "ha" if refha($ref_to_hash_of_arrays); #true print "hh" if refhh($ref_to_hash_of_hashes); #true
pushr
popr
shiftr
unshiftr
splicer
keysr
valuesr
eachr
In Perl versions 5.12 - 5.22 push, pop, shift, unshift, splice, keys, values and each handled references to arrays and references to hashes just as if they where arrays and hashes. Examples:
my $person={name=>'Gaga', array=>[1,2,3]}; push $person{array} , 4; #works in perl 5.12-5.22 but not before and after push @{ $person{array} }, 4; #works in all perl5 versions pushr $person{array} , 4; #use Acme::Tools and this should work in perl >= 5.8 popr $person{array}; #returns 4
aoh2sql
my @oceania=( {Area=>undef, Capital=>'Pago Pago', Code=>'AS', Name=>'American Samoa', Population=>54343}, {Area=>7686850, Capital=>'Canberra', Code=>'AU', Name=>'Australia', Population=>22751014}, {Area=>undef, Capital=>'West Island', Code=>'CC', Name=>'Cocos (Keeling) Islands', Population=>596}, {Area=>240, Capital=>'Avarua', Code=>'CK', Name=>'Cook Islands', Population=>9838}, {Area=>undef, Capital=>'Flying Fish Cove', Code=>'CX', Name=>'Christmas Island', Population=>1530}, {Area=>18270, Capital=>'Suva', Code=>'FJ', Name=>'Fiji', Population=>909389}, {Area=>702, Capital=>'Palikir', Code=>'FM', Name=>'Micronesia, Federated States of', Population=>105216}, {Area=>549, Capital=>'Hagatna (Agana)', Code=>'GU', Name=>'Guam', Population=>161785}, {Area=>811, Capital=>'Tarawa', Code=>'KI', Name=>'Kiribati', Population=>105711}, {Area=>181.3, Capital=>'Majuro', Code=>'MH', Name=>'Marshall Islands', Population=>72191}, {Area=>19060, Capital=>'Noumea', Code=>'NC', Name=>'New Caledonia', Population=>271615}, {Area=>undef, Capital=>'Kingston', Code=>'NF', Name=>'Norfolk Island', Population=>2210}, {Area=>21, Capital=>'Yaren District', Code=>'NR', Name=>'Nauru', Population=>9540}, {Area=>260, Capital=>'Alofi', Code=>'NU', Name=>'Niue', Population=>1190}, {Area=>268680, Capital=>'Wellington', Code=>'NZ', Name=>'New Zealand', Population=>4438393}, {Area=>undef, Capital=>'Papeete', Code=>'PF', Name=>'French Polynesia', Population=>282703}, {Area=>462840, Capital=>'Port Moresby', Code=>'PG', Name=>'Papua New Guinea', Population=>6672429}, {Area=>undef, Capital=>'Adamstown', Code=>'PN', Name=>'Pitcairn', Population=>48}, {Area=>458, Capital=>'Melekeok', Code=>'PW', Name=>'Palau', Population=>21265}, {Area=>28450, Capital=>'Honiara', Code=>'SB', Name=>'Solomon Islands', Population=>622469}, {Area=>undef, Capital=>undef, Code=>'TK', Name=>'Tokelau', Population=>1337}, {Area=>26, Capital=>'Funafuti', Code=>'TV', Name=>'Tuvalu', Population=>10869}, {Area=>12200, Capital=>'Port-Vila', Code=>'VU', Name=>'Vanuatu', Population=>272264}, {Area=>undef, Capital=>'Mata-Utu', Code=>'WF', Name=>'Wallis and Futuna', Population=>15500}, {Area=>2944, Capital=>'Apia', Code=>'WS', Name=>'Samoa (Western)', Population=>197773} ); print aoh2sql(\@oceania,{ name=>'country', drop=>2, #number=>'numeric', #default #varchar=>'varchar', #default, change to varchar2 if Oracle #date=>'date', #default, perhaps change to 'timestamp with time zone' if postgres #varchar_maxlen=>4000, #default, 4000 (used to be?) is max in Oracle #create=>1, #default, use 0 to dont include create table #drop=>0, #default 0: dont include drop table x; 1: drop table x; 2: drop table if exists x; #end=>"commit;\n", #begin=>"begin;\n", #fix_colnames=>0, });
Returns:
begin; drop table if exists country; create table country ( Area numeric(9,1), Capital varchar(16), Code varchar(2) not null, Name varchar(36) not null, Population numeric(9) ); insert into country values (null,'Pago Pago','AS','American Samoa',54343); insert into country values (7686850,'Canberra','AU','Australia',22751014); insert into country values (null,'West Island','CC','Cocos (Keeling) Islands',596); insert into country values (240,'Avarua','CK','Cook Islands',9838); insert into country values (null,'Flying Fish Cove','CX','Christmas Island',1530); insert into country values (18270,'Suva','FJ','Fiji',909389); insert into country values (702,'Palikir','FM','Micronesia, Federated States of',105216); insert into country values (549,'Hagatna (Agana)','GU','Guam',161785); insert into country values (811,'Tarawa','KI','Kiribati',105711); insert into country values (181.3,'Majuro','MH','Marshall Islands',72191); insert into country values (19060,'Noumea','NC','New Caledonia',271615); insert into country values (null,'Kingston','NF','Norfolk Island',2210); insert into country values (21,'Yaren District','NR','Nauru',9540); insert into country values (260,'Alofi','NU','Niue',1190); insert into country values (268680,'Wellington','NZ','New Zealand',4438393); insert into country values (null,'Papeete','PF','French Polynesia',282703); insert into country values (462840,'Port Moresby','PG','Papua New Guinea',6672429); insert into country values (null,'Adamstown','PN','Pitcairn',48); insert into country values (458,'Melekeok','PW','Palau',21265); insert into country values (28450,'Honiara','SB','Solomon Islands',622469); insert into country values (null,null,'TK','Tokelau',1337); insert into country values (26,'Funafuti','TV','Tuvalu',10869); insert into country values (12200,'Port-Vila','VU','Vanuatu',272264); insert into country values (null,'Mata-Utu','WF','Wallis and Futuna',15500); insert into country values (2944,'Apia','WS','Samoa (Western)',197773); commit;
STATISTICS
sum
Returns the sum of a list of numbers. Undef is ignored.
print sum(1,3,undef,8); # 12 print sum(1..1000); # 500500 print sum(undef); # undef
avg.
geomavg
harmonicavg
Returns the harmonic average (a.k.a geometric mean) of a list of numbers.
print harmonicavg(10,11,12); # 3 / ( 1/10 + 1/11 + 1/12) = 10.939226519337
variance
variance = ( sum (x[i]-Average)**2)/(n-1)
stddev
Standard_Deviation = sqrt(variance)(@testscores) + stddev(@testscores) # = the score for one stddev above avg, 115 avg(@testscores) - stddev(@testscores) # = the score for one stddev below avg, 85
rstddev
Relative stddev = stddev / avg
median
Returns the median value of a list of numbers. The list do.
percentile ( select 0+regexp_substr('1,4,6,7,8,9,22,24,39,49,555,992','[^,]+',1,i) n from dual,(select level i from dual connect by level <= 12) );
(Oracle also provides a similar function:
percentile_disc where disc is short for discrete, meaning no interpolation is taking place. Instead the closest number from the data set is picked.)
RANDOM
random
random_gauss
Mixes an array in random order. In-place if given an array reference or not if given an array.
mix() could also have been named
shuffle(), as in shuffling a deck of cards.
Example::
- 1. Either a reference to an array as the only input. This array will then be mixed in-place. The array will be changed:
This:
@a=mix(@a)is the same as:
mix(\@a).
- 2. Or an array of zero, one or more elements.
-)
Note:
List::Util::shuffle() is approximately four times faster. Both respects the Perl built-in
srand().
pwgen
Generates random passwords.
Input: 0-n args
* First arg: length of password(s), default 8
* Second arg: number of passwords, default 1
* Third arg: string containing legal chars in password, default A-Za-z0-9,-./&%_!
* Fourth to n'th arg: list of requirements for passwords, default if the third arg is false/undef (so default third arg is used) is:
sub{/^[a-zA-Z0-9].*[a-zA-Z0-9]$/ and /[a-z]/ and /[A-Z]/ and /\d/ and /[,-.\/&%_!]/}
...meaning the password should: * start and end with: a letter a-z (lower- or uppercase) or a digit 0-9 * should contain at least one char from each of the groups lower, upper, digit and special char
To keep the default requirement-sub but add additional ones just set the fourth arg to false/undef and add your own requirements in the fifth arg and forward (examples below). Sub pwgen uses perls own
rand() internally.
$Acme::Tools::Pwgen_max_sec and
$Acme::Tools::Pwgen_max_trials can be set to adjust for how long pwgen tries to find a password. Defaults for those are 0.01 and 10000. Whenever one of the two limits is reached, a first generates a croak.
Examples:
my $pw=pwgen(); # a random 8 chars password A-Z a-z 0-9 ,-./&%!_ (8 is default length) my $pw=pwgen(12); # a random 12 chars password A-Z a-z 0-9 ,-./&%!_ my @pw=pwgen(0,10); # 10 random 8 chars passwords, containing the same possible chars my @pw=pwgen(0,1000,'A-Z'); # 1000 random 8 chars passwords containing just uppercase letters from A to Z pwgen(3); # dies, defaults require chars in each of 4 group (see above) pwgen(5,1,'A-C0-9', qr/^\D{3}\d{2}$/); # a 5 char string starting with three A, B or Cs and endring with two digits pwgen(5,1,'ABC0-9',sub{/^\D{3}\d{2}$/}); # same as above
Examples of adding additional requirements to the default ones:
my @pwreq = ( qr/^[A-C]/ ); pwgen(8,1,'','',@pwreq); # use defaults for allowed chars and the standard requirements # but also demand that the password must start with A, B or C push @pwreq, sub{ not /[a-z]{3}/i }; pwgen(8,1,'','',@pwreq); # as above and in addition the password should not contain three # or more consecutive letters (to avoid "offensive" words perhaps)
SETS
distinct
in.
in_num
union
minus
Input: Two arrayrefs.
Output: An array containing all elements in the first input array but not in the second.
Example:
perl -MAcme::Tools -le 'print join " ", minus( ["five", "FIVE", 1, 2, 3.0, 4], [4, 3, "FIVE"] )'
Output is
five 1 2.
intersect
Input: Two arrayrefs
Output: An array containing all elements which exists in both input arrays.
Example:
perl -MAcme::Tools -le 'print join" ", intersect( ["five", 1, 2, 3.0, 4], [4, 2+1, "five"] )' # 4 3 five
Output:
4 3 five
not_intersect
Input: Two arrayrefs
Output: An array containing all elements member of just one of the input arrays (not both).
Example:
perl -MAcme::Tools -le ' print join " ", not_intersect( ["five", 1, 2, 3.0, 4], [4, 2+1, "five"] )'
The output is
1 2.
uniq
HASHES
subhash= versions >= 5.20 subhashes (hash slices returning keys as well as values) is built in like this:
%scandinavia = %population{'Norway','Sweden','Denmark'};
hashtrans'} );
a2h
Input: array of arrays
Output: array of hashes
Transforms an array of arrays (arrayrefs) to an array of hashes (hashrefs).
Example:
my @h = a2h( ['Name', 'Age', 'Gender'], #1st row become keys ['Alice', 20, 'F'], ['Bob', 30, 'M'], ['Eve', undef, 'F'] );
Result array @h:
( {Name=>'Alice', Age=>20, Gender=>'F'}, {Name=>'Bob', Age=>30, Gender=>'M'}, {Name=>'Eve', Age=>undef, Gender=>'F'}, );
h2a
Input: array of hashes
Output: array of arrays
COMPRESSION
"zipb64", "unzipb64", "zipbin", "unzipbin", "gzip", and "gunzip" compresses and uncompresses strings to save space in disk, memory, database or network transfer. Trades time for space. (Beware of wormholes)
zipb64
zipbin() does the same as
zipb64() except that zipbin() does not base64 encode the result. Returns binary data.
See "zip" for documentation.
unzipb64
Input:
First argument: A string made by "zipb64"
Second argument: (optional) a dictionary string which where used in "zipb64".
Output: The original string (be it text or binary).
unzipbin
unzipbin() does the same as "unzip" except that
unzipbin() wants a pure binary compressed string as input, not base64.
See "unzipb64" for documentation.
gzip
Input: A string or reference to a string you want to compress. Text or binary.
Output: The binary compressed representation of that input string.
gzip() is really just a wrapper for
Compress:Zlib::memGzip() and uses the same compression algorithm as the well known GNU program gzip found in most unix/linux/cygwin distros. Except
gzip() does this in-memory. (Both using the C-library
zlib).
writefile( "file.gz", gzip("some string") );
gunzip
Input: A binary compressed string or a reference to such a string. I.e. something returned from
gzip() earlier or read from a
.gz file.
Output: The original larger non-compressed string. Text or binary.
gunzip() is a wrapper for Compress::Zlib::memGunzip()
print gunzip( gzip("some string") ); #some string
bzip2
Same as "gzip" and "gunzip" except with a different compression algorithm (compresses more but is slower). Wrapper for Compress::Bzip2::memBzip.
Compared to gzip/gunzip, bzip2 compression is much slower, bunzip2 decompression not so much.
See also Compress::Bzip2,
man Compress::Bzip2,
man bzip2,
man bunzip2.
writefile( "file.bz2", bzip2("some string") ); print bunzip2( bzip2("some string") ); #some string
bunzip2
Decompressed something compressed by bzip2() or data from a
.bz2 file. See "bzip2".
NET, WEB, CGI-STUFF
ipaddr.
webparams.
urlenc
urldec
Example, this returns '
ø'. That is space and
ø.
urldec('+%C3')
ht2;.
FILES, DIRECTORIES
writefile croak really) happens.
Second input argument is one of:
Either a scaler. That is a normal string to be written to the file.
Or a reference to a scalar. That referred text is written to the file.
Or a reference to an array of scalars. This array is the written to the file element by element'], ]);
Automatic compression:
writefile('file.txt.gz','my text is compressed by /bin/gzip before written to the file');
Extentions
.gz,
.bz2 and
.xz are recognized for compression. See also
readfile() and
openstr().
Output: Nothing (for the time being).
die()s (
croak($!) really) if something goes wrong.
readfile().
Automatic decompression:
my $txt = readfile('file.txt.gz'); #uses /bin/gunzip to decompress content
Extentions
.gz,
.bz2 and
.xz are recognized for decompression. See also
writefile() and
openstr().
readdirectory];
basename
The basename and dirname functions behaves like the *nix shell commands with the same names.
Input: One or two arguments: Filename and an optional suffix
Output: Returns the filename with any directory and (if given) the suffix removed.
basename('/usr/bin/perl') # returns 'perl' basename('/usr/local/bin/report.pl','.pl') # returns 'report' since .pl at the end is removed basename('report2.pl','.pl') # returns 'report2' basename('report2.pl','.\w+') # returns 'report2.pl', probably not what you meant basename('report2.pl',qr/.\w+/) # returns 'report2', use qr for regex
dirname
Input: A filename including path
Output: Removes the filename path and returns just the directory path up until but not including the last /. Return just a one char
. (period string) if there is no directory in the input.
dirname('/usr/bin/perl') # returns '/usr/bin' dirname('perl') # returns '.'
username
Returns the current linux/unix username, for example the string root
print username(); #just (getpwuid($<))[0] but more readable perhaps
wipe
Deletes a file by "wiping" it on the disk. Overwrites the file before deleting. (May not work properly on SSDs)
Input: * Arg 1: A filename * Optional arg 2: number of times to overwrite file. Default is 3 if omitted, 0 or undef * Optional arg 3: keep (true/false), wipe() but no delete of file
Output: Same as the
unlink() (remove file): 1 for success, 0 or false for failure.
See also:,
chall, ... ); #
makedir and for speed). Thus directories removed during running the script is not discovered by makedir.
See also
perldoc -f mkdir,
man umask
md5sum
Input: a filename (or a scalar ref to a string, see below)
Output: a string of 32 hexadecimal chars from 0-9 or a-f.
Example, the md5sum gnu/linux command without options could be implementet like this:
use Acme::Tools; print eval{ md5sum($_)." $_\n" } || $@ for @ARGV;
This sub requires Digest::MD5, which is a core perl-module since version 5.?.? It does not slurp the files or spawn new processes.
If the input argument is a scalar ref then the MD5 of the string referenced is returned in hex.
which
Returns the first executable program in $ENV{PATH} paths (split by : colon) with the given name.
echo $PATH perl -MAcme::Tools -le 'print which("gzip")' # maybe prints /bin/gzip
read_conf
First argument: A file name or a reference to a string with settings in the format described below.
Second argument, optional: A reference to a hash. This hash will have the settings from the file (or stringref). The hash do not have to be empty beforehand.
Returns a hash with the settings as in this examples:
my %conf = read_conf('/etc/your/thing.conf'); print $conf{sectionA}{knobble}; #prints ABC if the file is as shown below print $conf{sectionA}{gobble}; #prints ZZZ, the last gobble print $conf{switch}; #prints OK here as well, unsectioned value print $conf{part2}{password}; #prints oh:no= x
File use for the above example:
switch: OK #before first section, the '' (empty) section [sectionA] knobble: ABC gobble: XYZ #this gobble is overwritten by the gobble on the next line gobble: ZZZ [part2] password: oh:no= x #should be better text: { values starting with { continues until reaching a line with }
Everything from # and behind is regarded comments and ignored. Comments can be on any line. To keep a # char, put a \ in front of it.
A
: or
= separates keys and values. Spaces at the beginning or end of lines are ignored (after removal of #comments), as are any spaces before and after : and = separators.
Empty lines or lines with no
: or
= is also ignored. Keys and values can contain internal spaces and tabs, but not at the beginning or end.
Multi-line values must start and end with { and }. Using { and } keep spaces at the start or end in both one-line and multi-line values.
Sections are marked with
[sectionname]. Section names, keys and values is case sensitive.
Key:values above the first section or below and empty
[] is placed both in the empty section in the returned hash and as top level key/values.
read_conf can be a simpler alternative to the core module Config::Std which has its own hassles.
$Acme::Tools::Read_conf_empty_section=1; #default 0 (was 1 in version 0.16) my %conf = read_conf('/etc/your/thing.conf'); print $conf{''}{switch}; #prints OK with the file above print $conf{switch}; #prints OK here as well
openstr
# returned from openstr: open my $FH, openstr("fil.txt") or die; # fil.txt open my $FH, openstr("fil.gz") or die; # zcat fil.gz | open my $FH, openstr("fil.bz2") or die; # bzcat fil.bz2 | open my $FH, openstr("fil.xz") or die; # xzcat fil.xz | open my $FH, openstr(">fil.txt") or die; # > fil.txt open my $FH, openstr(">fil.gz") or die; # | gzip > fil.gz open my $FH, openstr(">fil.bz2") or die; # | bzip2 > fil.bz2 open my $FH, openstr(">fil.xz") or die; # | xz > fil.bz2
Environment variable PATH is used. So in the examples above, /bin/gzip is returned instead of gzip if /bin is the first directory in $ENV{PATH} containing an executable file gzip. Dirs /usr/bin, /bin and /usr/local/bin is added to PATH in openstr(). They are checked even if PATH is empty.
See also
writefile() and
readfile() for automatic compression and decompression using
openstr.
printed
Redirects
printf from STDOUT to a string which is returned.
my $p = printed { print "hello!" }; # now $p eq 'hello!' my $p = printed { some_sub() }; # now $p contains whatever was printed by some_sub() and the subs call from it
TIME FUNCTIONS
tms
Timestring, works somewhat like the Gnu/Linux
date command and Oracle's
to_char()
Converts timestamps to more readable forms of time strings.
Converts seconds since epoch and time strings on the form
YYYYMMDD-HH24:MI:SS to other forms.
Input: One, two or three arguments.
First argument: A format string.
Second argument: (optional) An epock
time() number or a time string of the form YYYYMMDD-HH24:MI:SS or YYYYMMDDTHH:MI:SS or YYYY-MM-DDTHH:MI:SS (in which T is litteral and HH is the 24-hour version of hours) or YYYYMMDD. Uses the current
time() if the second argument is missing.
TODO: Formats with % as in
man date (
%Y%m%d and so on)
Third argument: (optional True or false. If true and first argument is eight digits: Its interpreted as a date like YYYYMMDD time string, not an epoch time. If true and first argument is six digits its interpreted as a date like DDMMYY (not YYMMDD!).
Output: a date or clock string on the wanted form.
Examples:
Prints
3. july 1997 if thats the dato today:
perl -MAcme::Tools -le 'print timestr("D. month YYYY")' print tms("HH24:MI"); # prints 23:55 if thats the time now tms("HH24:MI",time()); # ...same,since time() is the default tms("HH:MI",time()-5*60); # 23:50 if that was the time 5 minutes ago tms("HH:MI",time()-5*60*60); # 18:55 if thats the time 5 hours ago tms("Day Month Dth YYYY HH:MI"); # Saturday July 1st 2004 23:55 (big S, big J) tms("Day D. Month YYYY HH:MI"); # Saturday 8. July 2004 23:55 (big S, big J) tms("DAY D. MONTH YYYY HH:MI"); # SATURDAY 8. JULY 2004 23:55 (upper) tms("dy D. month YYYY HH:MI"); # sat 8. july 2004 23:55 (small s, small j) tms("Dy DD. MON YYYY HH12:MI am"); # Sat 08. JUL 2004 11:55 pm (HH12, am becomes pm if after 12) tms("DD-MON-YYYY"); # 03-MAY-2004 (mon, english)
The following list of codes in the first argument will be replaced:
YYYY Year, four digits YY Year, two digits, i.e. 04 instead of 2004 yyyy Year, four digits, but nothing if its the current year YYYY|HH:MI Year if its another year than the current, a time in hours and minutes elsewise MM Month, two digits. I.e. 08 for August DD Day of month, two digits. I.e. 01 (not 1) for the first day in a month D Day of month, one digit. I.e. 1 (not 01) HH Hour. From 00 to 23. HH24 Same as HH. HH12 12 becomes 12 (never 00), 13 becomes 01, 14 02 and so on. Note: 00 after midnight becomes 12 (am). Tip: always include the code am in a format string that uses HH12. MI Minutt. Fra 00 til 59. SS Sekund. Fra 00 til 59. am Becomes am or pm pm Same AM Becomes AM or PM (upper case) PM Same Month The full name of the month in English from January to December MONTH Same in upper case (JANUARY) month Same in lower case (january) Mont Jan Feb Mars Apr May June July Aug Sep Oct Nov Dec Mont. Jan. Feb. Mars Apr. May June July Aug. Sep. Oct. Nov. Dec. (always four chars) Mon Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec (always three chars) Day The full name of the weekday. Sunday to Saturday Dy Three letters: Sun Mon Tue Wed Thu Fri Sat DAY Upper case DY Upper case Dth 1st 2nd 3rd 4th 5th ... 11th 12th ... 20th 21st 22nd 23rd 24th ... 30th 31st WW Week number of the year 01-53 according to the ISO8601-definition (which most countries uses) WWUS Week number of the year 01-53 according to the most used definition in the USA. Other definitions also exists. epoch Converts a time string from YYYYMMDD-HH24:MI:SS, YYYYMMDD-HH24:MI:SS, YYYYMMDDTHH:MI:SS, YYYY-MM-DDTHH:MI:SS or YYYYMMDD to the number of seconds since January 1st 1970. Commonly known as the Unix epoch. JDN Julian day number. Integer. The number of days since the day starting at noon on January 1 4713 BC JD Same as JDN but a float accounting for the time of day
TODO: sub smt() (tms backward... or something better named, converts the other way) As to_date and to_char in Oracle. Se maybe Date::Parse instead
Third argument: (optional) Is_date. False|true, default false. If true, the second argument is interpreted as a date of the form YYYYMMDD, not as a number of seconds since epoch (January 1st 1970).
easter
Input: A year (a four digit number)
Output: array of two numbers: day and month
Note: The Spencer Jones formula differs Oudins used in
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.
time_fp
sleep_fp() work as the built in
sleep() but also accepts fractional seconds:
sleep_fp(0.020); #.
sleeps
sleepms
sleepus
sleepns
sleep_fp(0.020); #sleeps for 20 milliseconds sleeps(0.020); #sleeps for 20 milliseconds, sleeps() is a synonym to sleep_fp() sleepms(20); #sleeps for 20 milliseconds sleepus(20000); #sleeps for 20000 microseconds = 20 milliseconds sleepns(20000000); #sleeps for 20 million nanoseconds = 20 milliseconds
eta
Estimated time of arrival (ETA).
for(@files){ ...do work on file... my $eta = eta( ++$i, 0+@files ); # file now, number of files print "" . localtime($eta); } ..DOC MISSING..
etahhmm
...NOT YET
sleep_until.
leapyear
Input: A year. A four digit number.
Output: True (1) or false (0) of whether the year is a leap year or not. (Uses current calendar even for periods before leapyears was used).
print join(", ",grep leapyear($_), 1900..2014)."\n"; 1904, 1908, 1912, 1916, 1920, 1924, 1928, 1932, 1936, 1940, 1944, 1948, 1952, 1956, 1960, 1964, 1968, 1972, 1976, 1980, 1984, 1988, 1992, 1996, 2000, 2004, 2008, 2012
Note: 1900 is not a leap year, but 2000 is. Years divided by 100 is a leap year only if it can be divided by 400.
OTHER
nvl
The no value function (or null value function)
nvl() takes two or more arguments. (Oracles nvl-function.
decode_num
decode. often faster way of doing the same:
{123=>3, 214=>7}->{$a} || $a # (beware of 0)
qrlist.\E)$/ my @filtered= grep { $_ =~ $filter } @list; # returns DEF and XYZ, but not XYZ because the . char is taken literally
Note: Filtering with hash lookups are WAY faster.
Source:
sub qrlist (@) { my $str=join"|",map quotemeta, @_; qr/^($str)$/ }
ansicolor
Perhaps easier to use than Term::ANSIColor ?
Input: One argument. A string where the char
¤ have special meaning and is replaced by color codings depending on the letter following the
¤.
Output: The same string, but with
¤letter replaced.
ccn_ok.
KID_ok
range
Input:
One or more numeric arguments:
First: x (first returned element)
Second: y (up to y but not including y)
Third: step, default 1. The step between each returned element
If a fourth, fifth and so on arguments are given, they change the step for each returned element. As first derivative, second derivative.
Output:
If one argument: returns the array
(0 .. x-1)
If two arguments: returns the array
(x .. y-1)
If three arguments: The default step is 1. Use a third argument to use a different step.
Examples:
print join ",", range(11); # prints 0,1,2,3,4,5,6,7,8,9,10 (but not 11) print join ",", range(2,11); # 2,3,4,5,6,7,8,9,10 (but not 11) print join ",", range(11,2,-1); # 11,10,9,8,7,6,5,4,3 print join ",", range(2,11,3); # 2,5,8 print join ",", range(11,2,-3); # 11,8,5 print join ",", range(11,2,+3); # prints nothing print join ", ",range(2,11,1,0.1); # 2, 3, 4.1, 5.3, 6.6, 8, 9.5 adds 0.1 to step each time print join ", ",range(2,11,1,0.1,-0.01); # 2, 3, 4.1, 5.29, 6.56, 7.9, 9.3, 10.75
Note: In the Python language and others,
range is a build in iterator (a generator), not an array. This saves memory for large sets and sometimes time. Use
range in List::Gen to get a similar lazy generator in Perl.
globr
Works like and uses Perls builtin
glob() function but adds support for ranges with
{from..to} and
{from..to..step}. Like brace expansion in bash.
Examples:
my @arr = glob "X{a,b,c,d}Z"; # return four element array: 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..d..2}Z"; # step 2, returns array: XaZ XcZ my @arr = globr "X{aa..bz..13}Z"; # XaaZ XanZ XbaZ XbnZ my @arr = globr "{1..12}b"; # 1b 2b 3b 4b 5b 6b 7b 8b 9b 10b 11b 12b my @arr = globr "{01..12}b"; # 01b 02b 03b 04b 05b 06b 07b 08b 09b 10b 11b 12b my @arr = globr "{01..12..3}b"; # 01b 04b 07b 10b
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
x! where the postfix unary operator
!, also known as faculty is defined as:
x! = x * (x-1) * (x-2) ... * 1. Example:
5! = 5 * 4 * 3 * 2 * 1 = 120.Run this to see the 100 first
n!
perl -MAcme::Tools -le'$i=big.
cart than one table"; } } }
This: with a condition: the sum of the first two should be divisible");
Example, hash-mode:
Returns hashrefs instead of arrayrefs:
my @cards=cart( # @card gets 5200 hashrefs, 100 decks of 52 cards deck => [1..100], rank => [qw(2 3 4 5 6 7 8 9 10 J Q K A)], suit => [qw(heart diamond club star)], ); for my $card ( mix(@cards) ) { print "From deck number $$card{deck} we got $$card{rank} $$card{suit}\n"; }
Note: using sub-ref filters do not work (yet) in hash-mode. Use grep on result instead.
reduce} @_) / @_ }
pivot
tablestring.
serialize. More on decompiling Perl-code: Storable or B::Deparse.
dserialize
Debug-serialize, dumping data structures for you to look at.
Same as
serialize() but the output is given a newline every 80th character. (Every 80th or whatever
$Acme::Tools::Dserialize_width contains)
srlz
Synonym to "serialize", but remove unnecessary single quote chars around
\w+-keys and number values (except numbers with leading zeros). Example:
serialize:
%s=('action'=>{'del'=>'0','ins'=>'0','upd'=>'18'},'post'=>'1348','pre'=>'1348', 'updcol'=>{'Laerestednr'=>'18','Studietypenr'=>'18','Undervisningssted'=>'7','Url'=>'11'}, 'where'=>'where 1=1');
srlz:
%s=(action=>{del=>0,ins=>0,upd=>18},post=>1348,pre=>1348, updcol=>{Laerestednr=>18,Studietypenr=>18,Undervisningssted=>7,Url=>11}, where=>'where 1=1');
Todo: update "serialize" to do the same, but in the right way. (For now srlz runs the string from serialize() through two
s///, this will break in certain cases). "srlz" will be kept as a synonym (or the other way around).
cnttbl
my %nordic_country_population=(Norway=>5214890,Sweden=>9845155,Denmark=>5699220,Finland=>5496907,Iceland=>331310); print cnttbl(\%nordic_country_population); Iceland 331310 1.25% Norway 5214890 19.61% Finland 5496907 20.67% Denmark 5699220 21.44% Sweden 9845155 37.03% SUM 26587482 100.00%
Todo: Levels...:
my %sales=( Toyota=>{Prius=>19,RAV=>12,Auris=>18,Avensis=>7}, Volvo=>{V40=>14, XC90=>4}, Nissan=>{Leaf=>19,Qashqai=>17}, Tesla=>{ModelS=>8} ); print cnttbl(\%sales); Toyota SUM 56 Volvo SUM 18 Nissan SUM 36 Tesla SUM 8 SUM SUM 56 100%
ref_deep
NOT IMPLEMENTED
Same as ref, but goes deeper.
print ref_deep( { 10=>[1,'ten'], 100=>[2,'houndred'], 1000=>[3,'thousand'] } ); # prints HASH_of_ARRAYS print ref_deep( { 10=>'ten', 100=>[2,'houndred'], 1000=>[3,'thousand'] } ); # prints same (mixed, deepest) print ref_deep( { 1=>[{a=>3,b=>6},{a=>1,b=>8}], 5=>[{a=>2,b=>5},{a=>7,b=>1}] } ); # HASH_of_ARRAYS_of_HASHES
(Todo, not supported: circular, alternatives for mixed)
nicenum
print 14.3 - 14.0; # 0.300000000000001 print 34.3 - 34.0; # 0.299999999999997 print nicenum( 14.3 - 14.0 ); # 0.3 print nicenum( 34.3 - 34.0 ); # 0.3
sys
Call instead of
system if you want
die (Carp::croak) when something fails.
sub sys($){ my$s=shift; my$r=system($s); $r==0 or croak"ERROR: system($s)==$r ($!) ($?)" }
recursed
Returns true or false (actually 1 or 0) depending on whether the current sub has been called by itself or not.
sub xyz { xyz() if not recursed; }
ed
String editor commands
literals: a-z 0-9 space move cursor: FBAEPN MF MB ME delete: D Md up/low/camelcase word U L C backspace: - search: S return/enter: R meta/esc/alt: M shift: T cut to eol: K caps lock: C yank: Y start and end: < > macro start/end/play: { } ! times for next cmd: M<number> (i.e. M24a inserts 24 a's)
(TODO: alfa...and more docs needed)
changed
while(<>){ my $line=$_; print "\n" if changed(/^\d\d\d\d-\d\d-(\d\d)/); print "\n" if changed(substr($_,8,2)); }
Returns undef, 0 or 1. Undef if its the first time
changed is called on that perl line. 0 if not the first time and the parameters differ from the last call on that line. 1 if not the first time and the parameters is the exact same as they where on the previous call on that line of perl source code.
JUST FOR FUN
brainfu
Input: one or two arguments
First argument: a string, source code of the brainfu language. String containing the eight charachters + - < > [ ] . , Every other char is ignored silently.
Second argument: if the source code contains commas (,) the second argument is the input characters in a string.
Output: The resulting output from the program.
Example:
print brainfu(<<""); #prints "Hallo Verden!\n" ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>---.+++++++++++..+++.>++.<<++++++++++++++ .>----------.+++++++++++++.--------------.+.+++++++++.>+.>.
See
brainfu2perl
Just as "brainfu" but instead it return the perl code to which the brainfu code is translated. Just
eval() this perl code to run.
Example:
print brainfu;
brainfu2perl_optimized
Just as "brainfu2perl" but optimizes the perl code. The same example as above with brainfu2perl_optimized returns this equivalent but shorter perl code:
$b[++$c]+=8;while($b[$c]){$b[--$c]+=8;--$b[++$c]}$b[--$c]+=8;out;$b[++$c]+=6; while($b[$c]){$b[--$c]+=6;--$b[++$c]}$b[--$c]-=3;out;$o;
BLOOM FILTER SUBROUTINES 91230 bytes if you accept that you can only check the data structure for existence of a string and accept false positives with an error rate of 0.03 (that is three percent, error rates are given in numbers larger than
bfinit
Initialize a new Bloom Filter:
my $bf = bfinit( error_rate=>0.01, capacity=>100000 );
The same:
my $bf = bfinit( 0.01, 100000 );
since two arguments is interpreted as error_rate and capacity accordingly.
bfadd
bfadd($bf, $_) for @phone_numbers; # Adding strings one at a time bfadd($bf, @phone_numbers); # ...or all at once (faster)
Returns 1 on success. Dies (croaks) if more strings than capacity is added.
bfcheck, uses less memory if @keys is large
Returns an array the same size as @keys where each element is true or false accordingly.
bfgrep
Same as
bfcheck except it returns the keys that exists in the bloom filter
@found = bfgrep($bf, @keys); # or ... @found = bfgrep($bf, \@keys); # better, uses less memory if @keys is large, or ... @found = grep bfcheck($bf,$_), @keys; # same but slower
bfgrepnot
Same as
bfgrep except it returns the keys that do NOT exists in the bloom filter:
@not_found = bfgrepnot($bf, @keys); # or ... @not_found = bfgrepnot($bf, \@keys); # better, uses less memory if @keys is large, or ... @not_found = grep !bfcheck($bf,$_), @keys); # same but slower
bfdelete do not currently support
counting_bits => 3 so 4 and 8 are the only practical alternatives where 8 is almost always overkill.
my $bf=bfinit( error_rate => 0.001, capacity => 10000000, counting_bits => 4 # power of 2, that is 2, 4, 8, 16 or 32 ); bfadd( $bf, @unique_phone_numbers); bfdelete($bf, @unique_phone_numbers);
Example: = %d\n",$c{$_},$_ for sort{$a<=>$b}keys%c;
The output:
28689562 counters = 0 19947673 counters = 1 6941082 counters = 2 1608250 counters = 3 280107 counters = 4 38859 counters = 5 4533 counters = 6 445 counters = 7 46 counters = 8 1 counters = 9
Even after the error_rate is changed from 0.001 to a percent of that, 0.00001, the limit of 16 (4 bits) is still far away:
47162242 counters = 0 33457237 counters = 1 11865217 counters = 2 2804447 counters = 3 497308 counters = 4 70608 counters = 5 8359 counters = 6 858 counters = 7 65 counters = 8 4 counters = 9
In algorithmic terms the number of bits needed is
ln of ln of n. Thats why 4 bits (counters up to 15) is "always" good enough except for extremely large capasities or extremely small error rates. (Except when adding the same key many times, which should be avoided, and Acme::Tools::bfadd do not check for that, perhaps in future versions). makes
bfdelete die (croak).
bfdelete
Deletes from a counting bloom filter:
bfdelete($bf, @keys); bfdelete($bf, \@keys);
Returns
$bf after deletion.
Croaks (dies) on deleting a non-existing key or deleting from an previouly overflown counter in a counting bloom filter.
bfaddbf.)
bfs).
bfdimensions
bfstore
Storing and retrieving bloom filters to and from disk uses Storables
store and
retrieve. This:
bfstore($bf,'filename.bf');
It the same as:
use Storable qw(store retrieve); ... store($bf,'filename.bf');
bfretrieve
This:
my $bf=bfretrieve('filename.bf');
Or this:
my $bf=bfinit('filename.bf');
Is the same as:
use Storable qw(store retrieve); my $bf=retrieve('filename.bf');
bfclone
Deep copies the bloom filter data structure. (Which btw is not very deep, two levels at most)
This:
my $bfc = bfclone($bf);
Works just as:
use Storable; my $bfc=Storable::dclone($bf);
Object oriented interface to bloom filters
use Acme::Tools; my $bf=new Acme::Tools::BloomFilter(0.1,1000); # the same as bfinit, see bfinit above.
Internals and speed at once (speedup). Using different salts to the key on each md5 results in different hash functions.
Digest::SHA512 would have been even better since it returns more bits, if it werent for the fact that it's much)
Md5 seems to be an ok choice both for speed and avoiding collitions due to skewed data keys.
Theory and math behind bloom filters
See also Scaleable Bloom Filters: (not implemented in Acme::Tools)
...and perhaps
COMMANDS
install_acme_command_tools
sudo perl -MAcme::Tools -e install_acme_command_tools Wrote executable /usr/local/bin/conv Wrote executable /usr/local/bin/due Wrote executable /usr/local/bin/xcat Wrote executable /usr/local/bin/freq Wrote executable /usr/local/bin/deldup Wrote executable /usr/local/bin/ccmd Wrote executable /usr/local/bin/z2z Wrote executable /usr/local/bin/2gz Wrote executable /usr/local/bin/2gzip Wrote executable /usr/local/bin/2bz2 Wrote executable /usr/local/bin/2bzip2 Wrote executable /usr/local/bin/2xz Wrote executable /usr/local/bin/resubst
Examples of commands then made available:
conv 1 USD EUR #might show 0.88029 if thats the current currency rate. Uses conv() conv .5 in cm #reveals that 1/2 inch is 1.27 cm, see doc on conv() for all supported units due [-h] /path/1/ /path/2/ #like du, but show statistics on file extentions instead of subdirs xcat file #like cat, zcat, bzcat or xzcat in one. Uses file extention to decide. Uses openstr() freq file #reads file(s) or stdin and view counts of each byte 0-255 ccmd grep string /huge/file #caches stdout+stderr for 15 minutes (default) for much faster results later ccmd "sleep 2;echo hello" #slow first time. Note the quotes! ccmd "du -s ~/*|sort -n|tail" #ccmd store stdout+stderr in /tmp files (default) z2z [-pvk1-9oe -t type] files #convert from/to .gz/bz2/xz files, -p progress, -v verbose (output result), #-k keep org file, -o overwrite, 1-9 compression degree, -e for xz does "extreme" #compressions, very slow. For some data types this reduces size significantly #2xz and 2bz2 depends on xz and bzip2 being installed on system 2xz #same as z2z with -t xz 2bz2 #same as z2z with -t bz2 2gz #same as z2z with -t gz rttop trunc file(s) wipe file(s)
z2z
2xz
2bz2
2gz
The commands
2xz,
2bz2 and
2gz are just synonyms for
z2z with an implicitly added option
-t xz,
-t xz or
-t gz accordingly.
z2z [-p -k -v -o -1 -2 -3 -4 -5 -6 -7 -8 -9 ] files
Converts (recompresses) files from one compression type to another. For instance from .gz to .bz2
due
Like
du command but views space used by file extentions instead of dirs. Options:
due [-options] [dirs] [files] due -h View bytes "human readable", i.e. C<8.72 MB> instead of C<9145662 b> (bytes) due -k | -m View bytes in kilobytes | megabytes (1024 | 1048576) due -K Like -k but uses 1000 instead of 1024 due -z View two extentions if .z .Z .gz .bz2 .rz or .xz (.tar.gz, not just .gz) due -M Also show min, medium and max date (mtime) of files, give an idea of their age due -P Also show 10, 50 (medium) and 90 percentile of file date due -MP Both -M and -P, shows min, 10p, 50p, 90p and max due -a Sort output alphabetically by extention (default order is by size) due -c Sort output by number of files due -i Ignore case, .GZ and .gz is the same, output in lower case due -t Adds time of day to -M and -P output due -e 'regex' Exclude files (full path) matching regex. Ex: due -e '\.git' TODO: due -l TODO: Exclude hardlinks (dont count "same" file more than once, "man du") ls -l | due Parses output of ls -l, find -ls, tar tvf for size+filename and reports find | due List of filenames from stdin produces same as just command 'due' ls | due Reports on just files in current dir without recursing into subdirs
finddup
Find duplicate files. Three steps to speed this up in case of many large files: 1) Find files of same size, 2) of those: find files with the same first 8 kilobytes, 3) of those: find duplicate files by finding the MD5sums of the whole files.
finddup [-d -s -h] paths/ files/* ... #reports (+deletes with -d) duplicate files #-s for symlinkings dups, -h for hardlink finddup <files> # print duplicate files, <files> might be filenames and directories finddup -a <files> # print duplicate files, also print the first file finddup -d <files> # delete duplicate files, use -v to also print them before deletion finddup -s <files> # make symbolic links of duplicate files finddup -h <files> # make hard links of duplicate files finddup -v ... # verbose, print before -d, -s or -h finddup -n -d <files> # dry run: show rm commands without actually running them finddup -n -s <files> # dry run: show ln commands to make symlinks of duplicate files finddup -n -h <files> # dry run: show ln commands to make hard links of duplicate files finddup -q ... # quiet finddup -k o # keep oldest with -d, -s, -h, consider newer files duplicates finddup -k n # keep newest with -d, -s, -h, consider older files duplicates finddup -k O # same as -k o, just use access time instead of modify time finddup -k N # same as -k n, just use access time instead of modify time finddup -0 ... # use ascii 0 instead of the normal \n, for xargs -0
Default ordering of files without
-k n or
-k o is the order they are mentioned on the command line. For directory args the order might be random: use
dir/* to avoid that (but then dot files are not included).
args
Parses command line options and arguments:
my %opt; my @argv=args('i:nJ123',\%opt,@ARGV); #returns remaining command line elements after C<-o ptions> are parsed into C<%opt>.
Uses
Getopt::Std::getopts(). First arg names the different one char options and an optional
: behind the letter or digit marks that the switch takes an argument.
DATABASE STUFF - NOT IMPLEMENTED YET
Uses DBI. Comming soon...
$Dbh dlogin dlogout drow drows drowc drowsc dcols dpk dsel ddo dins dupd ddel dcommit drollback
self_update
Update Acme::Tools to newest version quick and dirty:
function pmview(){ ls -ld `perl -M$1 -le'$m=shift;$mi=$m;$mi=~s,::,/,g;print $INC{"$mi.pm"};warn"Version ".${$m."::VERSION"}."\n"' $1`;} pmview Acme::Tools #view date and version before sudo perl -MAcme::Tools -e Acme::Tools::self_update #update to newest version pmview Acme::Tools #view date and version after
Does
cd to where Acme/Tools.pm are and then wget -N
TODO: cmd_acme_tools_self_update, accept --no-check-certificate to use on curl
HISTORY
Release
SEE ALSO
AUTHOR
Kjetil Skotheim, <kjetil.skotheim@gmail.com>
2008-2019, Kjetil Skotheim
LICENSE
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.