#!/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;
}
|