Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Simple r-copy style backup

by gman (Friar)
on Jul 07, 2009 at 16:30 UTC ( [id://777931]=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info http://perlmonks.org/?node_id=77032
Description: Simple script I used to back up my Laptop before lease exchange. Was not looking to reinvent the wheel, saw rcopy after I wrote this and rcopy requires rsync. I was running XP with activestate perl, so seemed just as easy to write something quick that would do the job. update: Thanks graff for pointing out the error I had with mkpath
eval { mkpath (["$copy_to/$dir"]); }; die "Could not create Path $copy_to $dir $@" if($@);
#!perl.exe



use strict;
use warnings;
use File::Path "mkpath";
use File::Copy;
use File::Spec;
use Archive::zip;

my $copy_from = 'C:/My Documents';
# local net copy
my $copy_to = 'x:\backup';  # my network share

rCopy($copy_from,$copy_to);

sub rCopy {
    my $src = shift;
    my $dest = shift;
    $dest = $dest . ".zip";
    #print "**** $src\n";
    if( -f $src ) {  # if file  on unix also include -l from sym link
            print "DEBUG: " . (stat($src))[9] . " - " . (stat($dest))[
+9] . "$dest\n";
        if(-f $dest && (stat($src))[9] <= (stat($dest))[9]) { 
        # target file exists and in older
        print "--- Skipping file $dest\n";
        } else {
        my $zip = Archive::Zip->new();
        my $file = $zip->addFile($src);
        print "Createing Zip File $dest\n";
        unless ($zip->writeToFileNamed($dest) == 0 ) { warn "--- Could
+ not create zip file\n"; }; 
        #print "+++Coping file $src to $dest\n\r";
        #copy $src, "$dest" || print "$!\n";
        }
    } elsif( -d $src ) {
        # $src is a directory, open dir read contents.
        my ($volume,$dir,$file) = File::Spec->splitpath( $src,1 );
        print "*****Creating Dir: $copy_to/$dir\n\r";
        eval { mkpath (["$copy_to/$dir"]); }; 
        die "Could not create Path $copy_to $dir $@" if($@);

        my $dh = undef;
        opendir( $dh, $src );
        my @files = grep { (! /\.$/) } readdir($dh);
        foreach my $rSrc (@files) {
        print "Calling rCopy($src\/$rSrc,$copy_to\/$dest\/$rSrc)\n\r";
            rCopy("$src" . "/$rSrc", "$copy_to/$dir/$rSrc");
        #print "Skipping Dir: $src\n";
        }
    }
}
Replies are listed 'Best First'.
Re: Simple r-copy style backup
by graff (Chancellor) on Jul 07, 2009 at 22:04 UTC
    You seem to be checking for a failure of "mkpath" (using an eval block), but in the case where that actually fails, you keep moving ahead as if it succeeded.

    I would recommend that you put an additional check before the "opendir()" call:

    if ( ! -d "$copy_to/$dir" ) { warn "Cannot copy/zip $src because $copy_to/$dir does not +exist\n"; next; } opendir( $dh, $src ); ...

    Update: on closer inspection, I realize that you really are not checking for failure in that eval block:

    eval { mkpath (["$copy_to/$dir"]); 1}
    That always returns true (because of the "1" at the end) regardless of return value from mkpath. In other words, there's no need for the eval at all, because you are defeating its purpose with the final "1".
      Maybe there is a missing use autodie;?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://777931]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others romping around the Monastery: (2)
As of 2024-11-03 03:53 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    chatterbot is...






    Results (13 votes). Check out past polls.