view release on metacpan or  search on metacpan

lib/Batch/Batchrun/Retain.pm  view on Meta::CPAN

  $currentfile =~ s%/%\\%g if ($^O =~ /mswin/i);               
  if ($Retain{INSTANCE} == $Retain{LIMIT}) 
    {
    if (-e $currentfile )
      {
      unlink($currentfile);
      }
    }

  #------------------------------------------------------------------------
  # Check if file exists if so call retain again to move it      
  #------------------------------------------------------------------------

  elsif (-e $currentfile)  
    {
    print " " x $Retain{INSTANCE},
          $currentfile, "\n" if ($Retain{VERBOSE});
    print " " x $Retain{INSTANCE},
          "^- File exists: RETAIN will be called again!\n\n"    if ($Retain{VERBOSE});
    my(%tmpRetain) = %Retain;
    $tmpRetain{INSTANCE}++;
    &retain(%tmpRetain) or return(0);
    }

  #========================================================================
  # Recursion falls through here 
  #========================================================================
  
  #------------------------------------------------------------------------
  # If at first retain level copy and optionally compress and delete file 
  #------------------------------------------------------------------------
  $tmpdir = "$Retain{DIR}/$Retain{PREFIX}$Retain{INSTANCE}";
  if ($Retain{INSTANCE} == 1) 
    {
    if (not -d $tmpdir ) 
      {
      if (not mkpath($tmpdir,1,0775) )
        {
        warn("*** No Directory exists and can't make it: $!\n");
        return(0);
        }
      }
      
    if ($Retain{COMPRESS})
      {
      if (not compress("< $Retain{ORIGINAL} > $currentfile") )
        {
        warn("*** Compress from $Retain{ORIGINAL}\n***    to $currentfile \n *** FAILED: $!\n");
        return(0);
        };
      }
    else
      {
      if (not copy($Retain{ORIGINAL},$currentfile) )
        {
        warn("*** Copy from $Retain{ORIGINAL}\n***    to $currentfile \n *** FAILED: $!\n");
        return(0);
        }
      }
      
    if ( $Retain{CHMOD} and not chmod $Retain{CHMOD},$currentfile )
        {
        warn("*** CHMOD $Retain{CHMOD} of $currentfile\n FAILED: $!\n");
        }  
        
    if ( $Retain{DELETE} and not unlink($Retain{ORIGINAL}) )
      {
      warn("*** CHMOD $Retain{CHMOD} of $currentfile\n FAILED: $!\n");
      }         
      
    return(1);
    }

  #------------------------------------------------------------------------
  # Otherwise move from one retain dir to the next                        
  #------------------------------------------------------------------------

  else
    {
    $oldfile = "$Retain{DIR}/$Retain{PREFIX}". eval($Retain{INSTANCE}-1) ."/$Retain{FILE}"; 
    $newfile = "$Retain{DIR}/$Retain{PREFIX}$Retain{INSTANCE}/$Retain{FILE}";
    $tmpdir  = "$Retain{DIR}/$Retain{PREFIX}$Retain{INSTANCE}";   
    $oldfile =~ s%/%\\%g if ($^O =~ /mswin/i); 
    $newfile =~ s%/%\\%g if ($^O =~ /mswin/i); 
    $tmpdir  =~ s%/%\\%g if ($^O =~ /mswin/i);  
    
    print "MOVING:$oldfile\n" if ($Retain{VERBOSE});
    print "TO--->:$newfile\n" if ($Retain{VERBOSE});
    
    if (not -d $tmpdir ) 
      {
      if (not mkpath($tmpdir,1,0775) )
        {
        warn("*** No Directory exists and can't make it: $!\n");
        return(0);
        }
      }
   
    if (not move($oldfile,$newfile) )
      {
      warn("*** Move from $oldfile\n***    to $newfile \n *** FAILED: $!\n");
      return(0);
      }
    return(1);
    }
}

sub compress
  {
  my($filename) = @_;
  my($sys_result,$exit_val) = (0,0);
 
  $sys_result = system("$Retain::Compress $filename");
  if ($sys_result)
    {
    $exit_val = int($sys_result / 256);
    if ($exit_val == 2)
      {
      warn("Compress actually made $filename bigger!\n");
      $exit_val = 0;
      }