view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

    #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)=@_;
    @a=@ARGV if @_<=2;
    my %def=map{/(\w)(:?)/;($1=>$2?2:1)}$def=~/(\w:?)/g;
    my $o1=join"",grep$def{$_}==1,sort keys%def;
    my $o= join"",                sort keys%def;
    my @r;
    while(@a){
	my $a=shift(@a);
	if($a=~/^-([$o1])([$o].*)$/){
	    unshift@a,"-$1","-$2";
	}
	elsif($a=~/^-(\w)(.*)$/){
	    my $d=$def{$1}//0;
	    push@{$$hashref{$1}},$d==1 && length($2) ? croak"opt -$1 has no arg (is $2 here)"
		                :$d==1               ? 1
				:$d==2 && length($2) ? $2
				:$d==2               ? shift(@a)
				:croak"unknown opt -$1";
	}
	elsif($a eq '--'){
	    last;
	}
	else {
	    push @r, $a;
	}
    }
    $_=join",",@$_ for values %$hashref;
    (@r,@a)
}

#cat Tools.pm|perl -I. /usr/local/bin/zsize -tp
#cat Tools.pm|perl -I. /usr/local/bin/zsize -tp -
#cat Tools.pm|perl -I. /usr/local/bin/zsize -tp Tools.pm
sub cmd_zsize {
  my %o;
  my @argv=opts("heEpts",\%o,@_);
  my $stdin=!@argv || join(",",@argv) eq '-';
  @argv=("/tmp/acme-tools.$$.stdin") if $stdin;
  writefile($argv[0],join("",<STDIN>)) if $stdin;
  my @prog=grep qx(which $_), qw(gzip bzip2 xz zstd brotli);
  for my $f (@argv){
      my $sf=-s$f;
      print "--- $f does not exists\n" and next if !-e$f;
      print "--- $f is not a file\n" and next if !-f$f;
      print "--- $f ($sf b) is not readable\n" and next if !-r$f;
      print "--- $sf b  ".bytes_readable($sf)."  ".($stdin?"-":$f)."\n";
      next if !$sf;
      my(@t,@s);
      for my $prog (@prog){
          next if !qx(which $prog);
          my @l=1..9;
          push @l,map"e$_",1..9 if $prog eq 'xz' and $o{e};
          @l=map"e$_",1..9      if $prog eq 'xz' and $o{E};
          @l=map 10+$_,@l       if $prog eq 'zstd';