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