Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
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;
}
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://109461]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (15)
As of 2017-04-24 13:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I'm a fool:











    Results (439 votes). Check out past polls.