Acme-Tools
view release on metacpan or search on metacpan
NPR => 0.075316, #nepal rupee
NZD => 5.745187, #new zealand dollar
OMR => 20.234592, #oman rial
PHP => 0.148869, #philippines peso
PKR => 0.070338, #pakistan rupee
PLN => 2.319848, #poland zloty
QAR => 2.137418, #qatar rial
RON => 2.070137, #romaina new nei
RUB => 0.137791, #russia rouble / rubel
SAR => 2.074720, #saudi arabia riyal
SEK => 0.976704, #swedish kroner
SGD => 5.931982, #singapore dollar
THB => 0.248282, #thailand baht
TRY => 2.076265, #turkish new lira
TTD => 1.150931, #trinidad/tobago dollar
TWD => 0.267321, #taiwan dollar
USD => 7.780201, #us dollar
'$' => 7.780201, #us doller, symbol
VEF => 0.778994, #venezuelan bolivares fuertes
XBT => 84864.0984477, #synonym for BTC
XRP => 8.96808208868, #ripple
ZAR => 0.667117, #south africa rand
},
numbers =>{
dec=>1,hex=>1,bin=>1,oct=>1,roman=>1, des=>1,#des: spelling error in v0.15-0.16
dusin=>1,dozen=>1,doz=>1,dz=>1,gross=>144,gr=>144,gro=>144,great_gross=>12*144,small_gross=>10*12,
}
);
our $conv_prepare_time=0;
our $conv_prepare_money_time=0;
sub conv_prepare {
my %b =(da =>1e+1, h =>1e+2, k =>1e+3, M =>1e+6, G =>1e+9, T =>1e+12, P =>1e+15, E =>1e+18, Z =>1e+21, Y =>1e+24, H =>1e+27);
my %big =(deca=>1e+1, hecto=>1e+2, kilo =>1e+3, mega =>1e+6, giga=>1e+9, tera=>1e+12, peta =>1e+15, exa =>1e+18, zetta=>1e+21, yotta=>1e+24, hella=>1e+27);
my %s =(d =>1e-1, c =>1e-2, m =>1e-3,'µ' =>1e-6, u=>1e-6, n =>1e-9, p =>1e-12, f =>1e-15, a =>1e-18, z =>1e-21, y =>1e-24);
my %small=(deci=>1e-1, centi=>1e-2, milli=>1e-3, micro =>1e-6, nano=>1e-9, pico=>1e-12, femto=>1e-15, atto=>1e-18, zepto=>1e-21, yocto=>1e-24);
# myria=> 10000 #obsolete
# demi => 1/2, double => 2 #obsolete
# lakh => 1e5, crore => 1e7 #south asian
my %x = (%s,%b);
for my $type (keys%conv) {
for(grep/^_/,keys%{$conv{$type}}) {
my $c=$conv{$type}{$_};
delete$conv{$type}{$_};
my $unit=substr($_,1);
$conv{$type}{$_.$unit}=$x{$_}*$c for keys%x;
}
}
$conv_prepare_time=time();
}
our $Currency_rates_url = 'http://calthis.com/currency-rates';
our $Currency_rates_expire = 6*3600;
sub conv_prepare_money {
eval {
require LWP::Simple;
my $td=$^O=~/^(?:linux|cygwin)$/?"/tmp":"/tmp"; #hm wrong!
my $fn="$td/acme-tools-currency-rates.data";
if( !-e$fn or time() - (stat($fn))[9] >= $Currency_rates_expire){
LWP::Simple::getstore($Currency_rates_url,"$fn.$$.tmp"); # get ... see getrates.cmd
die "nothing downloaded" if !-s"$fn.$$.tmp";
rename "$fn.$$.tmp",$fn;
chmod 0666,$fn;
}
my $d=readfile($fn);
my %r=$d=~/^\s*([A-Z]{3}) +(\d+\.\d+)\b/gm;
$r{lc($_)}=$r{$_} for keys%r;
#warn serialize([minus([sort keys(%r)],[sort keys(%{$conv{money}})])],'minus'); #ARS,AED,COP,BWP,LVL,BHD,NPR,LKR,QAR,KWD,LYD,SAR,KZT,CLP,IRR,VEF,TTD,OMR,MUR,BND
#warn serialize([minus([sort keys(%{$conv{money}})],[sort keys(%r)])],'minus'); #LTC,I44,BTC,BYR,TWI,NOK,XDR
$conv{money}={%{$conv{money}},%r} if keys(%r)>20;
};
carp "conv: conv_prepare_money (currency conversion automatic daily updated rates) - $@\n" if $@;
$conv{money}{"m$_"}=$conv{money}{$_}/1000 for qw/BTC XBT/;
$conv_prepare_money_time=time();
1; #not yet
}
sub conv {
my($num,$from,$to)=@_;
croak "conf requires 3 args" if @_!=3;
conv_prepare() if !$conv_prepare_time;
my $types=sub{ my $unit=shift; [sort grep$conv{$_}{$unit}, keys%conv] };
my @types=map{ my $ru=$_; my $r;$r=&$types($_) and @$r and $$ru=$_ and last for ($$ru,uc($$ru),lc($$ru)); $r }(\$from,\$to);
my @err=map "Unit ".[$from,$to]->[$_]." is unknown",grep!@{$types[$_]},0..1;
my @type=intersect(@types);
push @err, "from=$from and to=$to has more than one possible conversions: ".join(", ", @type) if @type>1;
push @err, "from $from (".(join(",",@{$types[0]})||'?').") and "
."to $to (" .(join(",",@{$types[1]})||'?').") has no known common dimension (unit type).\n" if @type<1;
croak join"\n",map"conv: $_",@err if @err;
my $type=$type[0];
conv_prepare_money() if $type eq 'money' and time() >= $conv_prepare_money_time + $Currency_rates_expire;
return conv_temperature(@_) if $type eq 'temperature';
return conv_numbers(@_) if $type eq 'numbers';
my $c=$conv{$type};
my($cf,$ct)=@{$conv{$type}}{$from,$to};
my $r= $cf>0 && $ct<0 ? -$ct/$num/$cf
: $cf<0 && $ct>0 ? -$cf/$num/$ct
: $cf*$num/$ct;
# print STDERR "$num $from => $to from=$ff to=$ft r=$r\n";
return $r;
}
sub conv_temperature { #http://en.wikipedia.org/wiki/Temperature#Conversion
my($t,$from,$to)=(shift(),map uc(substr($_,0,1)),@_);
$from=~s/K/C/ and $t-=273.15;
#$from=~s/R/F/ and $t-=459.67; #rankine
return $t if $from eq $to;
{CK=>sub{$t+273.15},
FC=>sub{($t-32)*5/9},
CF=>sub{$t*9/5+32},
FK=>sub{($t-32)*5/9+273.15},
}->{$from.$to}->();
}
sub conv_numbers {
my($n,$fr,$to)=@_;
my $dec=$fr eq 'dec' ? $n
:$fr eq 'hex' ? hex($n)
:$fr eq 'oct' ? oct($n)
:$fr eq 'bin' ? oct("0b$n")
:$fr =~ /^(dusin|dozen|doz|dz)$/ ? $n*12
:$fr =~ /^(gross|gr|gro)$/ ? $n*144
return if !-f$_;
return if $qrexcl and defined $File::Find::name and $File::Find::name=~$qrexcl;
my($sz,$xtime)=(stat($_))[7,$x];
my $ext=m/$r/?$1:'';
$ext=lc($ext) if $o{i};
$cnt++; $c{$ext}++;
$bts+=$sz; $b{$ext}+=$sz;
$xtime{$ext}.=",$xtime" if $o{M} || $o{C} || $o{A} || $o{P};
1;
} },@argv);
}
my($f,$s)=$o{k}?("%14.2f kb",sub{$_[0]/1024})
:$o{K}?("%14.2f Kb",sub{$_[0]/1000})
:$o{m}?("%14.2f mb",sub{$_[0]/1024**2})
:$o{h}?("%14s", sub{bytes_readable($_[0])})
: ("%14d b", sub{$_[0]});
my @e=$o{a}?(sort(keys%c))
:$o{c}?(sort{$c{$a}<=>$c{$b} or $a cmp $b}keys%c)
: (sort{$b{$a}<=>$b{$b} or $a cmp $b}keys%c);
my $perc=!$o{M}&&!$o{C}&&!$o{A}&&!$o{P}?sub{""}:
sub{
my @p=$o{P}?(10,50,90):(50);
my @m=@_>0 ? do {grep$_, split",", $xtime{$_[0]}}
: do {grep$_, map {split","} values %xtime};
my @r=percentile(\@p,@m);
@r=(min(@m),@r,max(@m)) if $o{M}||$o{C}||$o{A};
@r=map int($_), @r;
my $fmt=$o{t}?'YYYY/MM/DD-MM:MI:SS':'YYYY/MM/DD';
@r=map tms($_,$fmt), @r;
" ".join(" ",@r);
};
my $width=max( 10, grep $_, map length($_), @e );
@e=@e[-10..-1] if $o{t} and @e>10; #-t tail
printf("%-*s %8d $f %7.2f%%%s\n",$width,$_,$c{$_},&$s($b{$_}),100*$b{$_}/$bts,&$perc($_)) for @e;
printf("%-*s %8d $f %7.2f%%%s\n",$width,"Sum",$cnt,&$s($bts),100,&$perc());
}
sub cmd_resubst {
my %o;
my $zo="123456789e";
my @argv=opts("f:t:vno:gi$zo",\%o,@_);
if(exists$o{t}){ $o{t}=~s,\\,\$, } else { $o{t}='' }
my($i,$tc,$tbfr,$tbto)=(0,0,0,0);
for my $file (@argv){
my $zopt=join" ",map"-$_",grep$o{$_},split//,$zo;
my $oext=$o{o}?$o{o}:$file=~/\.(gz|bz2|xz)$/i?$1:'';
my $open_out_pre=$oext?"|".openstr_prog({qw/gz gzip bz2 bzip2 xz xz/}->{lc($oext)})." $zopt":'';
my $open_out="$open_out_pre > $file.tmp$$";
my $open_in=openstr($file);
# die srlz(\%o,'o','',1);
open my $I, $open_in or croak"ERR: open $open_in failed. $! $?\n";
open my $O, $open_out or croak"ERR: open $open_out failed. $! $?\n";
my $c=0;
my $mod=join"",grep$o{$_},qw(g i);
eval"while(<\$I>){ \$c+=s/\$o{f}/$o{t}/$mod;print \$O \$_ }";
$tc+=$c;
close($I);close($O);
chall($file,"$file.tmp$$") or croak"ERR: chall $file\n" if !$o{n};
my($bfr,$bto)=(-s$file,-s"$file.tmp$$");
unlink $file or croak"ERR: cant rm $file\n";
my $newfile=$o{o}?repl($file,qr/\.(gz|bz2|xz)$/i,".$oext"):$file;
rename("$file.tmp$$",$newfile) or croak"ERR: rename $file.tmp$$ -> $newfile failed\n";
if($o{v}){
my $pr=$bfr?100*$bto/$bfr:0;
printf "%*d/%d %*s %7d =>%8d b (%2d%%) %s\n",
length(0+@argv), ++$i, 0+@argv, -15, "$tc/$c", $bfr, $bto, $pr, $file;
$tbfr+=$bfr;
$tbto+=$bto;
}
}
if($o{v} and @argv>1){
printf "Replaces: %d Bytes before: %d After: %d Change: %.1f%%\n",
$tc, $tbfr, $tbto, $tbfr?100*($tbto-$tbfr)/$tbfr:0
}
$tc;
}
sub cmd_xcat {
for my $fn (@_){
my $os=openstr($fn);
open my $FH, $os or warn "xcat: cannot open $os ($!)\n" and next;
#binmode($FH);#hm?
print while <$FH>;
close($FH);
}
}
sub cmd_freq {
my(@f,$i);
map $f[$_]++, unpack("C*",$_) while <>;
my $s=" " x 12;map{print"$_$s$_$s$_\n"}("BYTE CHAR COUNT","---- ----- -------");
my %m=(145,"DOS-æ",155,"DOS-ø",134,"DOS-å",146,"DOS-Æ",157,"DOS-Ø",143,"DOS-Å",map{($_," ")}0..31);
printf("%4d %5s%8d".(++$i%3?$s:"\n"),$_,$m{$_}||chr,$f[$_]) for grep$f[$_],0..255;print "\n";
my @no=grep!$f[$_],0..255; print "No bytes for these ".@no.": ".join(" ",@no)."\n";
}
sub cmd_deldup {
cmd_finddup('-d',@_);
}
sub cmd_finddup {
# http://www.commandlinefu.com/commands/view/3555/find-duplicate-files-based-on-size-first-then-md5-hash
# die "todo: finddup not ready yet"
my %o;
my @argv=opts("ak:dhsnqv0P:FMRp",\%o,@_); $o{P}=1024*8 if!defined$o{P}; $o{k}='' if!defined$o{k};
croak"ERR: cannot combine -a with -d, -s or -h" if $o{a} and $o{d}||$o{s}||$o{h};
require File::Find;
@argv=map{
my @f;
if(-d$_){ File::Find::find({follow=>0,wanted=>sub{return if !-f$_;push@f,$File::Find::name;1}},$_) }
else { @f=($_) }
@f;
}@argv;
my %md5sum;
my $md5sum=sub{$md5sum{$_[0]}=md5sum($_[0]) if!defined$md5sum{$_[0]}}; #memoize
my $md5sum_1st_part=sub{
open my $fh, "<", $_[0] or die "ERR: Could not read $_[0]";
binmode($fh);
my $buf; read($fh,$buf,$o{P});
close($fh);
md5sum(\$buf);
};
my @checks=( #todo: stat()[0,1] (or[0,1,7]?) and diff filename => no need for md5, is hardlink! just linux?
sub{-s$_[0]},
sub{-s$_[0]<=$o{P}?md5sum($_[0]):&$md5sum_1st_part($_[0])},
sub{md5sum($_[0])}
my @argv=opts("n:k0123456789",\%o,@_);
die if 1<grep exists$o{$_},'n',0..9;
$o{$_} and $o{n}=$_ for 0..9;
wipe($_,$o{n},$o{k}) for @argv;
}
sub which { my $prog=shift; -x "$_/$prog" and return "$_/$prog" for split /:/, $ENV{PATH} }
sub cmd_2gz {cmd_z2z("-t","gz", @_)}
sub cmd_2gzip {cmd_z2z("-t","gz", @_)}
sub cmd_2bz2 {cmd_z2z("-t","bz2",@_)}
sub cmd_2bzip2 {cmd_z2z("-t","bz2",@_)}
sub cmd_2xz {cmd_z2z("-t","xz", @_)}
#todo: sub cmd_7z
#todo: .tgz same as .tar.gz (but not .tbz2/.txz)
sub cmd_z2z {
my %o;
my $pvopts="L:D:i:lIq";
my @argv=opts("pt:kvhon123456789es:$pvopts",\%o,@_);
my $t=repl(lc$o{t},qw/gzip gz bzip2 bz2/);
die "due: unknown compression type $o{t}, known are gz, bz2 and xz" if $t!~/^(gz|bz2|xz)$/;
$o{p}=1 if!defined$o{p} and grep$pvopts=~/$_/,keys%o;
delete $o{e} if $o{e} and $o{t} ne 'xz' and warn "-e available only for type xz\n";
my $sum=sum(map -s$_,@argv);
print "Converting ".@argv." files, total ".bytes_readable($sum)."\n" if $o{v} and @argv>1;
my $cat='cat';
if($o{p}){ if(which('pv')){ $cat='pv' } else { warn repl(<<"",qr/^\s+/) } }
due: pv for -p not found, install with sudo yum install pv, sudo apt-get install pv or similar
$o{$_} and $o{$_}=" " for qw(l q); #still true, but no cmd arg for:
$o{I} and $o{I}="-pterb";
exists$o{$_} and $cat=~s,pv,pv -$_ $o{$_}, for $pvopts=~/(\w)/g; #warn "cat: $cat\n";
my $sumnew=0;
my $start=time_fp();
my($i,$bsf)=(0,0);#bytes so far
$Eta{'z2z'}=[];eta('z2z',0,$sum);
#@argv=map$$_[1],sort{$$a[0]cmp$$b[0]}map{[$opt{
for(@argv){
my $new=$_; $new=~s/(\.(gz|bz2|xz))?$/.$t/i or die;
my $ext=defined($2)?lc($2):'';
my $same=/^$new$/; $new.=".tmp" if $same; die if $o{k} and $same;
next if !-e$_ and warn"$_ do not exists\n";
next if !-r$_ and warn"$_ is not readable\n";
next if -e$new and !$o{o} and warn"$new already exists, skipping (use -o to overwrite)\n";
my $unz={qw/gz gunzip bz2 bunzip2 xz unxz/}->{$ext}||'';
#todo: my $cntfile="/tmp/acme-tools-z2z-wc-c.$$";
#todo: my $cnt="tee >(wc -c>$cntfile)" if $ENV{SHELL}=~/bash/ and $o{v}; #hm dash vs bash
my $z= {qw/gz gzip bz2 bzip2 xz xz/}->{$t};
$z.=" -$_" for grep$o{$_},1..9,'e';
$z.=" -$_ $o{$_}" for grep exists$o{$_},'L';
my $cmd=qq($cat "$_"|$unz|$z>"$new");
#todo: "$cat $_|$unz|$cnt|$z>$new";
#cat /tmp/kontroll-linux.xz|unxz|tee >(wc -c>/tmp/p)|gzip|wc -c;cat /tmp/p
$cmd=~s,\|+,|,g; #print "cmd: $cmd\n";
sys($cmd);
chall($_,$new) or croak("$0 cannot chmod|chown|touch $new") if !$o{n};
my($szold,$sznew)=map{-s$_}($_,$new);
$bsf+=-s$_;
unlink $_ if !$o{k};
rename($new, replace($new,qr/.tmp$/)) or die if $same;
if($o{v}){
$sumnew+=$sznew;
my $pr=sprintf"%0.1f%%",$szold?100*$sznew/$szold:0;
#todo: my $szuncmp=-s$cntfile&&time()-(stat($cntfile))[9]<10 ? qx(cat $cntfile) : '';
#todo: $o{h} ? printf("%6.1f%% %9s => %9s => %9s %s\n", $pr,(map bytes_readable($_),$szold,$szuncmp,$sznew),$_)
#todo: : printf("%6.1f%% %11d b => %11d b => %11 b %s\n",$pr,$szold,$szuncmp,$sznew,$_)
my $str= $o{h}
? sprintf("%-7s %9s => %9s", $pr,(map bytes_readable($_),$szold,$sznew))
: sprintf("%-7s %11d b => %11d b", $pr,$szold,$sznew);
if(@argv>1){
$i++;
$str=$i<@argv
? " ETA:".sprintf("%-8s",sec_readable(eta('z2z',$bsf,$sum)-time_fp()))." $str"
: " TA: 0s $str"
if $sum>1e6;
$str="$i/".@argv." $str";
}
print "$str $new\n";
}
}
if($o{v} and @argv>1){
my $bytes=$o{h}?'':'bytes ';
my $str=
sprintf "%d files compressed in %.3f seconds from %s to %s $bytes (%s bytes) %.1f%% of original\n",
0+@argv,
time_fp()-$start,
(map{$o{h}?bytes_readable($_):$_}($sum,$sumnew,$sumnew-$sum)),
100*$sumnew/$sum;
$str=~s,\((\d),(+$1,;
print $str;
}
}
=head2 args
Parses command line options and arguments:
my %opt;
my @argv=Acme::Tools::args('i:nJ123',\%opt,@ARGV); #returns remaining command line elements after C<-o ptions> are parsed into C<%opt>.
Uses C<Getopt::Std::getopts()>. First arg names the different one char
options and an optional C<:> behind the letter or digit marks that the
switch takes an argument.
=cut
sub args {
my $switches=shift;
my $hashref=shift;
my $re_sw='^([a-z0-9]:?)+$';
croak "ERR: args: first arg $switches dont match $re_sw\n" if $switches !~ /$re_sw/i;
croak "ERR: second arg to args() not hashref\n" if ref($hashref) ne 'HASH';
local @ARGV=@_;
require Getopt::Std;
Getopt::Std::getopts($switches => $hashref);
(@ARGV);
}
sub opts {
my($def, $hashref, @a)=@_;
( run in 1.731 second using v1.01-cache-2.11-cpan-39bf76dae61 )