Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked

Simple r-copy style backup

by gman (Friar)
on Jul 07, 2009 at 16:30 UTC ( #777931=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info
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($@);

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


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?

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

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2023-11-30 05:29 GMT
Find Nodes?
    Voting Booth?

    No recent polls found