view release on metacpan or  search on metacpan

lib/libs/deepwalk.pl  view on Meta::CPAN

}

sub dw_copy_file
{
 my $source = shift;
 my $target = shift;
 my $umask  = shift;
 local * SRCFILE;
 local * DSTFILE;
 my $orig_mask;
 my $buffer;
 
 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat($source);
 
 if($umask ne undef)
  {
   $orig_mask = umask $umask;
  }
 
 open(SRCFILE,$source) or return(-1);
 binmode SRCFILE;
 
 open(DSTFILE,'>'.$target) or do {
  close SRCFILE;
  return(-2);
 };
 
 binmode DSTFILE;
 
 while(1)
   {
    my $result = read(SRCFILE,$buffer,$deepWalk_file_buffer);
    if($result == 0)
      {
       last;
      }
    if($result eq undef)               # Error!
      {
       close SRCFILE;
       close DSTFILE;
       return(-3);
      }
    if(!(print DSTFILE $buffer))
      {
       close SRCFILE;
       close DSTFILE;
       return(-4);
      }
   }
 
 close SRCFILE;
 close DSTFILE;
 
 if($umask eq undef)
  {
   chmod ($mode, $target);
  }
  
 if($< == 0)
  {
   chown $uid, $gid, $target;
  }
 
 utime ($atime, $mtime, $target);
 umask $orig_mask;
 return(1);
}

sub recursive_mkdir
{
 my $folder = shift;
 my $umask  = shift;
 
 my $q_slash = quotemeta($system_slash);
 my @paths = split(/$q_slash/s,$folder);
 
 my $path;
 my $full_path = '';
 foreach $path (@paths)
  {
   $full_path .= $path.$system_slash;
   if($umask ne undef)
     {
      my $orig_mask = umask $umask;
      mkdir($full_path,0777);
      umask $orig_mask;
     }
    else
     {
      mkdir($full_path,0777);
     }
  }
}

sub dw_copy
{
 return(-1) if(scalar(@_) < 2);
 my $source = shift;
 my $target = shift;
 my $umask  = $_[0] eq '' ? shift : undef;
 my $folder;
 my $counter_strike = 0;
 
 my $q_slash = quotemeta($system_slash);
 
 # Repair wrong slashes: \\ to / in Unix like OS and / to \\ in Dos like OS.
 if($system_slash =~ m/\\/si)
  {
   $source =~ s/\//$system_slash/sg;
   $target =~ s/\//$system_slash/sg;
  }
 if($system_slash =~ m/\//si)
  {
   $source =~ s/\\/$system_slash/sg;
   $target =~ s/\\/$system_slash/sg;
  }
 
 if(-d $source)
  {
   $target =~ s/$q_slash$//s;
   if(!($source =~ m/$q_slash$/s))