File Coverage

lib/File/Trash.pm

Criterion	Covered	Total	%
statement	70	83	84.3
branch	37	66	56.0
condition	7	30	23.3
subroutine	13	13	100.0
pod	3	3	100.0
total	130	195	66.6

package File::Trash;
use strict;
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA $DEBUG $ABS_TRASH $ABS_BACKUP $errstr);
use Exporter;
use Carp;
use File::Path;
use File::Copy;
$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)/g;
@ISA = qw/Exporter/;
@EXPORT_OK = qw(trash backup restore);
%EXPORT_TAGS = ( all => \@EXPORT_OK );
$ABS_TRASH = '/tmp/trash';
$ABS_BACKUP = '/tmp/backup';


sub trash {
   @_
      or Carp::cluck("no arguments provided")
      and return;

   my $count = scalar @_;
   $count
      or Carp::cluck("no arguments provided")
      and return;


   if ( $count == 1 ){
      return _backup($_[0], 1);
   }


   my $_count = 0;
   for (@_){
      _backup($_, 1) and $_count++;
   }

   $_count == $count
      or $errstr = "Deleted $_count/$count files.";
   $_count;
}

sub restore {
   @_
      or Carp::cluck("no arguments provided")
      and return;

   my $count = scalar @_;
   $count
      or Carp::cluck("no arguments provided")
      and return;


   if ( $count == 1 ){
      return _restore($_[0]);
   }

   my $_count = 0;
   for (@_){
      _restore($_) and $_count++;
   }

   $_count == $count
      or $errstr = "Restored $_count/$count files.";
   $_count;
}


sub backup {
   @_
      or Carp::cluck("no arguments provided")
      and return;
   my $count = scalar @_;
   $count
      or Carp::cluck("no arguments provided")
      and return;

   if ( $count == 1 ){
      return _backup($_[0]);
   }

   my $_count = 0;
   for (@_){
      _backup($_) and $_count++;
   }

   $_count == $count
      or Carp::cluck("Backed up $_count/$count files.");
   $_count;
}


sub _backup {
   my $abs_path = Cwd::abs_path($_[0])
         or Carp::cluck("Can't resolve with Cwd::abs_path : '$_[0]'")
         and return;

   -f $abs_path
         or Carp::cluck("Not a file on disk : '$abs_path'")
         and return;

   my $is_trash = $_[1]; # if true, we delete original after, and we use abs trash instead


   my $abs_to = $is_trash ? "$ABS_TRASH$abs_path" : "$ABS_BACKUP$abs_path";

   $abs_to =~/^(\/.+)\/[^\/]+$/
      or confess("Error with '$abs_to' matching into");
   _abs_dir_assure($1);

   my $backnum;
   no warnings;
   while( -e $abs_to ){
      $abs_to=~s/\.\d+$//;
      $abs_to.='.'.$backnum++;
   }


   if( $is_trash ){
      File::Copy::move($abs_path, $abs_to)
         or confess("can't move '$abs_path' to '$abs_to', $!");
      $DEBUG and warn("moved '$abs_path' to '$abs_to'");
   }
   else {

      File::Copy::copy($abs_path, $abs_to)
         or confess("can't copy '$abs_path' to '$abs_to', $!");

      $DEBUG and warn("copied '$abs_path' to '$abs_to'");
   }

   $abs_to;
}

sub _restore {
   my $abs_path = Cwd::abs_path($_[0])
         or warn($errstr = "Can't resolve with Cwd::abs_path : '$_[0]'")
         and return;
      -f $abs_path
         or warn($errstr = "Not a file on disk : '$abs_path'")
         and return;

   my $abs_to = $abs_path;
   $abs_to=~s/$ABS_TRASH//
      or warn($errstr = "$abs_path not in $ABS_TRASH?")
      and return;

   # TAKE OUT .\d version !!
   if ($abs_to=~/.+\.\d{1,10}$/){
      $abs_to=~s/\.\d+$//;
   }

   -e $abs_to
      and warn($errstr = "Restore to already exists: $abs_to, cannot restore.")
      and return;

   unless( $abs_to =~/^(\/.+)\/[^\/]+$/ ){
      warn("Error with '$abs_to' matching into, getting abs loc");
      return;
   }


   _abs_dir_assure($1);


   File::Copy::move($abs_path, $abs_to)
      or warn( $errstr = "cant File::Copy::move($abs_path, $abs_to) , $!" )
      and return;

   $DEBUG and warn("moved '$abs_path' to '$abs_to'");
   $abs_to;
}




sub _abs_dir_assure {
   -d $_[0] or File::Path::mkpath($_[0]) # throws croak on system error
      or die("cant File::Path::mkpath $_[0], $!"); # just in case
   1;
}








1;

__END__