view release on metacpan or  search on metacpan

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

    $opt ="-${opt}p";
    $opt =~ tr/ri/Rf/;
    $s->parent->oscmd('cp', $opt, @_)
 }
 else {
    my $rsp =($opt =~/d/i ? 'D' : $opt =~/f/i ? 'F' : '');
    $opt =~s/(r)/SE/i; $opt =~s/(i)/C/i; $opt =~s/[fd]//ig; $opt =~s/(.{1})/\/$1/gi;
    my @cmd =('xcopy',"/H/R/K/Q$opt","\"$src\"","\"$dst\"");
    push @cmd, sub{print($rsp)} if $rsp && ($ENV{OS} && $ENV{OS}=~/windows_nt/i ? !-e $dst : !-d $dst);
    $s->parent->oscmd(@cmd)
 }
}



sub delete {
 my $s   =shift;
 my $opt =$_[0] =~/^\-/ || $_[0] eq '' ? shift : '';
 my $ret =1;
 $s->pushmsg("delete " .join(', ', @_));
 foreach my $par (@_) {
   foreach my $elem ($s->glob($par)) {
     if (-d $elem) {                 # '-r' - recurse subdirectories
        if ($opt =~/r/i && !$s->delete($opt,"$elem/*")) {
              $ret =0
        }
        elsif (!rmdir($elem)) {
              $ret =0;
              $opt =~/i/i || die("delete('$elem'): $!\n");
        }
     }
     elsif (-f $elem && !unlink($elem)) {
           $ret =0;
           $opt =~/i/i || die("delete('$elem'): $!\n");
     }
   }
 }
 $ret
}



sub find {
 my $s   =shift;
 my $opt =($_[0] =~/^\-/i ? shift : '');
 my ($sub, $i, $ret) =(0,0,0);
 local $_            if $opt !~/-\$/i;
 $opt =$opt ."-\$"   if $opt !~/-\$/i;
 foreach my $dir (@_) {
   $i++;
   if    ((!$sub || ref($dir)) && ref($_[$#_]) && $i <=$#_) {
         foreach my $elem (@_[$i..$#_]){if(ref($elem)){$sub =$elem; last}};
         next if ref($dir)
   }
   elsif (ref($dir)) {
         $sub =$dir; next
   }
   my $fs;
   foreach my $elem ($s->glob($dir)) {
     $_ =$elem;
     my @stat =stat($elem);
     my @nme  =(/^(.*)[\/\\]([^\/\\]+)$/ ? ($1,$2) : ('',''));
     if    (@stat ==0 && ($opt =~/[^!]*i/i || ($^O eq 'MSWin32' && $elem =~/[\?]/i))) {next} # bug in stat!
     elsif (@stat ==0) {die("stat('$elem'): $!\n"); undef($_); return(0)}
     elsif ($stat[2] & 0120000 && $opt =~/!.*s/i) {next} # symlink
     elsif (!defined($fs)) {$fs =$stat[2]}
     elsif ($fs !=$stat[2] && $opt =~/!.*m/i)  {next}    # mountpoint?
     if ($stat[2] & 0040000 && $opt =~/!.*l/i) {         # finddepth
        $ret +=$s->find($opt, "$elem/*", $sub); defined($_) || return(0);
        $_ =$elem;
     }
     if    ($stat[2] & 0040000 && $opt =~/!.*d/i) {}     # exclude dirs
     elsif (&$sub(\@stat,@nme)) {$ret +=1};
     defined($_) || return(0);                      # error stop: undef($_)
     if ($stat[2] & 0040000 && $opt !~/!.*[rl]/i) { # no recurse, $_[0]->[2] =0
        $ret +=$s->find($opt, "$elem/*", $sub); defined($_) || return(0);
     }
   }
 }
 $ret
}


sub glob {
 my $s =shift;
 my @ret;
 if    ($^O ne 'MSWin32') {
    CORE::glob(@_)
 }
 elsif (-e $_[0]) {
    push @ret, $_[0];
    @ret
 }
 else {
    my $msk =($_[0] =~/([^\/\\]+)$/i ? $1 : '');
    my $pth =substr($_[0],0,-length($msk));
    $msk =~s/\*\.\*/*/g;
    $msk =~s:(\(\)[].+^\-\${}[|]):\\$1:g;
    $msk =~s/\*/.*/g;
    $msk =~s/\?/.?/g;
    local (*DIR, $_); opendir(DIR, $pth eq '' ? './' : $pth) || die("open '$pth': $!\n");
    while(defined($_ =readdir(DIR))) {
      next if $_ eq '.' || $_ eq '..' || $_ !~/^$msk$/i;
      push @ret, "${pth}$_";
    }
    closedir(DIR) || die("close '$pth': $!\n");
    @ret
 }
}



sub globn {
 map {$_ =~/[\\\/]([^\\\/]+)$/ ? $1 : $_} shift->glob(@_)
}



sub mkdir {
 my ($s, $p, $m) =@_;
 $m =0777 if !$m;
 if (!-d $p) {
    $s->pushmsg("mkdir $p");
    my @p =split /[\\\/]/, $p;