view release on metacpan or  search on metacpan

Tools.pm  view on Meta::CPAN

      seek($WIFH,$_*1024,0);
      print $WIFH $block;
    }
  }
  close($WIFH);
  $keep || unlink($file);
}

=head2 chall

Does chmod + utime + chown on one or more files.

Returns the number of files of which those operations was successful.

Mode, uid, gid, atime and mtime are set from the array ref in the first argument.

The first argument references an array which is exactly like an array returned from perls internal C<stat($filename)> -function.

Example:

 my @stat=stat($filenameA);
 chall( \@stat,       $filenameB, $filenameC, ... );  # by stat-array
 chall( $filenameA,   $filenameB, $filenameC, ... );  # by file name

Copies the chmod, owner, group, access time and modify time from file A to file B and C.

See C<perldoc -f stat>, C<perldoc -f chmod>, C<perldoc -f chown>, C<perldoc -f utime>

=cut


sub chall {
  my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks )
    = ref($_[0]) ? @{shift()} : stat(shift());
  my $successful=0;
  for(@_){ chmod($mode,$_) && utime($atime,$mtime,$_) && chown($uid,$gid,$_) && $successful++ }
  return $successful;
}

=head2 makedir

Input: One or two arguments.

Works like perls C<mkdir()> except that C<makedir()> will create nesessary parent directories if they dont exists.

First input argument: A directory name (absolute, starting with C< / > or relative).

Tools.pm  view on Meta::CPAN

    #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,$_)

t/02_general.t  view on Meta::CPAN

#--chall
my $tmp=tmp();
if($^O eq 'linux' and -w$tmp){
  my $f1="$tmp/tmpf1";
  my $f2="$tmp/tmpf2";
  chmod(0777,$f1,$f2) and unlink($f1, $f2);
  open my $fh1,">",$f1 or die$!;
  open my $fh2,">",$f2 or die$!;
  close($fh1);close($fh2); #sleep_fp(0.5);
  chmod(0457,$f1);#chmod(02457,$f1);
  my $chown=chown(666,777,$f1);# or warn " -- Not checking chown, ok if not root\n";
  utime(1e9,1.1e9,$f1);
  my @stat=stat($f1);
  my $chall_ant=chall(\@stat,$f2);
  ok(!$chown || $chall_ant==1, "chall returned $chall_ant");
  for(($f1,$f2)){
    print "$_\n";
    my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks ) = stat($_);
    ok($mode%010000 == 0457, sprintf("mode=%05o",$mode));
    ok(!$chown || $uid == 666,    "uid=$uid");
    ok(!$chown || $gid == 777,    "gid=$gid");
    ok($atime==1e9,    "atime=$atime");
    ok($mtime==1.1e9,  "mtime=$mtime");
  }
  chmod(0777,$f1,$f2) and unlink($f1, $f2);
}
else {ok(1) for 1..11}   # not linux

#--writefile, readfile
if($^O eq 'linux' and -w$tmp){
  my $fn="$tmp/tmptestfile$$";