view release on metacpan or  search on metacpan

lib/CGI/Bus/fut.pm  view on Meta::CPAN

    my $v ='';
    foreach my $d (@p) {
      $v .= $d;
      ($v eq '') ||mkdir($v, $m) ||die("mkdir '$v': $!\n") if !-d $v;
      $v .='/'
    }
 }
 $p
}



sub rmpath {
 my ($s, $p) =@_;
 my $r =0;
 while ($p && -d $p) {
   last if !rmdir($p);
   $r +=1;
   $s->pushmsg("rmpath $p");
   last if !($p =~/[\\\/][^\\\/]+$/);
   $p =$`;
 }
}



sub size {
 my $s   =shift;
 my $opt =($_[0] =~/^\-/i ? shift : '-i');
 my $file=shift;
 my $sub =(ref($_[0]) ? shift : sub{1});
 my $sze =0;
 $s->find($opt, $file, sub{$sze +=$_[0]->[7] if &$sub(@_)});
 $sze
}



#######################
# File Utils
#######################



sub fcompare {
 my $s =shift;
 my $opt =($_[0] =~/^\-/i ? shift : ''); 
 my $ret =eval("use File::Compare; compare(\@_)");
 if ($@ || $ret <0) {die("compare(" .join(', ',@_) ."): $@\n"); 0}
 else {$ret}
}



sub fhandle {
 my ($s,$file,$sub)=@_;
 my $hdl =select();
 my $ret;
 if (ref($file) || ref(\$file) eq 'GLOB') {select(*$file); $ret =&$sub($hdl); select($hdl)}
 else {
   my $c =(caller(1) ? caller(1) .'::' : '');
   local *{"${c}HANDLE"}; open("${c}HANDLE", $file) || die("open '$file': $!\n");
   select ("${c}HANDLE"); $ret =&$sub($hdl); select($hdl);
   close  ("${c}HANDLE") || die("close '$file': $!\n");
 }
 $ret;
}



sub fload {
 my $s   =shift;
 my $opt =($_[0] =~/^\-/i ? shift : ''); # 'a'rray, 's'calar, 'b'inary
    $opt =$opt .'a' if $opt !~/[asb]/i && wantarray;
 my ($file, $sub) =@_;
 my ($row, @rez);
 local *IN;
 eval ('use Fcntl qw(:DEFAULT :flock)');
 ($] < 5.006 ? open(IN, "<$file") : eval 'open(IN, "<", $file)') 
 || die("open '<$file': $!\n");
 flock(IN, LOCK_SH());
 if    ($sub) {
       $row  =1;
       local $_;
       while (!eof(IN)) {
         defined($_ =<IN>) || die("read '<$file': $!\n");
         chomp;
         $opt=~/a/i ? &$sub() && push(@rez,$_)
                    : &$sub();
       }
 }
 elsif ($opt=~/a/i) {
       while (!eof(IN)) {
         defined($row =<IN>) || die("read '<$file': $!\n");
         chomp($row);
         push (@rez, $row);
       }
 }
 else {
       binmode(IN) if $opt =~/b/i;
       defined(read(IN, $row, -s $file)) || die("read '<$file': $!\n");
 }
 close(IN) || die("close '<$file': $!\n");
 $opt=~/a/i ? @rez : $row
}



sub fstore {
 my $s    =shift;
 my $opt  =($_[0] =~/^\-/i ? shift : ''); # 'b'inary
 my $file =shift;
 local *OUT;
 eval ('use Fcntl qw(:DEFAULT :flock)');
 my $mode ='>';
    $mode ='>>' if $opt =~/>/;
 if (substr($file,0,1) eq '>') {
    $mode ='>>';
    $file =substr($file,1);
 }
 ($] < 5.006 ? open(OUT, "${mode}${file}") : eval 'open(OUT, $mode, $file)')