Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
The stupid question is the question not asked
 
PerlMonks  

Simple Directory Mirror

by sifukurt (Hermit)
on Aug 31, 2001 at 21:59 UTC ( #109461=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info Kurt Kincaid (sifukurt@yahoo.com)
Description: This is a quickie script I wrote to backup files in my work directory to a backup directory. I thought it was handy, so I thought I'd post it here.
#!/usr/bin/perl

#--------------------------------------------------------------------#
# Simple Directory Mirror
#       Date Written:   29-Aug-2001 04:35:58 PM
#       Last Modified:  31-Aug-2001 12:36:17 PM
#       Author:         Kurt Kincaid (sifukurt@yahoo.com)
#
# Makes backups of all files in a directory, and only copies the
# file again if it has changed. It does not go through subdirectories.
# This specifically was a feature I did not want. However, it
# shouldn't be too difficult to add that feature if you are so
# inclined.
#
# This is free software and may be redistributed and/or modified
# under the same terms as Perl itself.
#--------------------------------------------------------------------#

use Digest::MD5 qw(md5_hex);
use File::Copy;
use strict;

our ( $work_dir, $bu_dir, $file, $digest, $sleep_time );
our ( @files, @new_files, @deleted, %File );

#--------------------------------------------------------------------#
# Configuration options
#--------------------------------------------------------------------#
$sleep_time = 300; # seconds
$work_dir = '/kurt/work';
$bu_dir = '/kurt/perl/backup';

Files( $work_dir, \@files );
foreach $file ( @files ) {
    if ( -d $file ) { next }
    open (FILE, "$work_dir\/$file");
    binmode(FILE);
    $File{$file} = Digest::MD5->new->addfile(*FILE)->hexdigest();
    close (FILE);
    copy( "$work_dir\/$file", "$bu_dir\/$file" );
}

for (;;) {
    sleep( $sleep_time );
    Files( $work_dir, \@new_files );
    @deleted = Compare( \@files, \@new_files );
    foreach $file ( @deleted ) {
        unlink "$bu_dir\/$file";
        delete $File{$file};
        @files = keys %File;
    }
    foreach $file ( @new_files ) {
        if ( -d $file ) { next }
        open (FILE, "$work_dir\/$file");
        binmode(FILE);
        $digest = Digest::MD5->new->addfile(*FILE)->hexdigest();
        close (FILE);
        unless ( $digest eq $File{$file} ) {
            $File{$file} = $digest;
            copy( "$work_dir\/$file", "$bu_dir\/$file" );
        }
    }
}

sub Files {
    my ( $file, $array ) = @_;
    opendir ITEMS, $file;
    @$array = grep !/^\./, readdir ITEMS;
    closedir ITEMS;
    chomp @$array;
    return @$array;
}

sub Compare {
    my ( $arrayref1, $arrayref2 ) = @_;
    unless ( defined $arrayref1 && defined $arrayref2 && @$arrayref1 >
+ 0 && @$arrayref2 > 0 ) {
        return undef;
    }
    my %seen;
    my @aonly;
    my $item;
    foreach $item (@$arrayref2) { $seen{$item} = 1 }
    foreach $item (@$arrayref1) {
        unless ( $seen{$item} ) {
            push ( @aonly, $item );
        }
    }
    return @aonly;
}

Comment on Simple Directory Mirror
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (15)
As of 2014-04-23 17:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (551 votes), past polls