package votorola::b::FileSync; # Copyright 2004-2005, 2009, Michael Allan. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Votorola Software"), to deal in the Votorola Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicence, and/or sell copies of the Votorola Software, and to permit persons to whom the Votorola Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Votorola Software. THE VOTOROLA SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE VOTOROLA SOFTWARE OR THE USE OR OTHER DEALINGS IN THE VOTOROLA SOFTWARE. use strict; use warnings; =pod =head1 DESCRIPTION File synchronization. =head1 EXPORTS =over 4 =cut use File::Basename (); use File::Copy (); use File::Find (); use File::stat (); BEGIN { use Exporter (); our @ISA; @ISA = qw( Exporter ); our @EXPORT_OK; @EXPORT_OK = qw( editor_locked $editor_locked_message $from_dir sync_found sync_found_public sync_to_dir sync_to_file $to_dir ); } our @EXPORT_OK; =pod =item B( $I ) Answers whether the file appears to be locked for editing. If it is, $C will contain a helpful error message. =cut sub editor_locked( $ ) { our $editor_locked_message; my $file = shift; if( -l $file && $file =~ m'/\.\#[^/]+$' ) { $editor_locked_message = "Found an Emacs lock file. Do you need to save this buffer? $file"; return 1; } else { $editor_locked_message = "editor lock not detected"; return 0; } } =pod =item $B Helpful error message for C. =cut our $editor_locked_message; =pod =item $B Argument for C. =cut our $from_dir; =pod =item B File::Find "wanted" sub that copies the file to $to_dir, if out-of-date or non-existent there. If the parent directory does not already exist (usually because the caller has filtered it out), then the file is not copied. The source $from_dir must contain the root directory exactly as passed to find. So, given: $from_dir = /var/from/somewhere $_ = /var/from/somewhere/specific/file $to_dir = /var/to/elsewhere then you have: $to_file = /var/to/elsewhere/specific/file Example: File::Find::find ( {follow_fast=>1, no_chdir=>1, wanted=>\&votorola::b::FileSync::sync_found}, $votorola::b::FileSync::from_dir ); =cut sub sync_found() { our $from_dir; our $to_dir; use votorola::b::Console qw( $verbosity ); my $from_file = $File::Find::name; # /var/from/somewhere/specific/file if( editor_locked( $from_file )) { print "\n$editor_locked_message\n"; return; } -e $from_file or warn "file not found: $from_file"; my $rel_from_file = substr( $from_file, length($from_dir) ); # /specific/file my $to_file = $to_dir . $rel_from_file; -d File::Basename::dirname( $to_file ) or return; # no parent, which may occur if the caller is employing a front filter, and has previously rejected the parent directory if( -l $to_file ) { print " $to_file (a link, will not overwrite)\n"; return; # something (maybe custom build target) turned $to_file to a link, don't clobber it } if( -d $from_file ) { -d $to_file and return; $verbosity && print " $to_file/\n"; my $stat_from = File::stat::stat( $from_file ); mkdir( $to_file, $stat_from->mode & 0777 ) or die $! . ": $from_file --> $to_file"; } else # file { my $stat_from = File::stat::stat( $from_file ); if( -e $to_file ) { my $stat_to = File::stat::stat( $to_file ); $stat_from->mtime > $stat_to->mtime + 1 or return; # + to allow for rounding errors of SMB and other remote mounts } $verbosity && print " $to_file\n"; File::Copy::copy( $from_file, $to_file ) or die $! . ": $from_file --> $to_file"; utime( time, $stat_from->mtime, $to_file ) or warn; # force sync, even across hosts with out-of-sync clocks chmod( $stat_from->mode & 0777, $to_file ) or warn; } } =pod =item B A version of sync_found that copies only public files, namely those that are readable by other users. =cut sub sync_found_public() { my $from_file = $File::Find::name; if( editor_locked( $from_file )) { print "\n$editor_locked_message\n"; return; } -e $from_file or die "file not found: $from_file"; my $stat = File::stat::stat( $from_file ); $stat->mode & 04 or return; sync_found(); } =pod =item B( $I, $I ) If the namesake file in $ is older or non-existent, then: copies I to I; sets its modification time to match; and returns the basename of the file. Otherwise returns 0. =cut sub sync_to_dir( $$ ) { my $from_file = shift; my $to_dir = shift; my $basename = File::Basename::basename( $from_file ); if( sync_to_file( $from_file, $to_dir . '/' . $basename )) { return $basename; } return 0; } =pod =item B( $I, $I ) If is older or non-existent, then: copies I to I; sets its modification time to match; and returns I. Otherwise returns 0. =cut sub sync_to_file( $$ ) { use votorola::b::Console qw( $verbosity ); use File::Copy (); my $from_file = shift; my $to_file = shift; my $stat_from = File::stat::stat($from_file); if( -e $to_file ) { my $stat_to = File::stat::stat($to_file); $stat_from->mtime > $stat_to->mtime or return 0; } $verbosity && print " $to_file\n"; File::Copy::copy( $from_file, $to_file ) or die $! . ": $from_file -> $to_file"; utime( time, $stat_from->mtime, $to_file ) or warn; # force sync, even across hosts with out-of-sync clocks chmod( $stat_from->mode & 0777, $to_file ) or warn; return $to_file; } =pod =item $B Argument for C. =cut our $to_dir; =pod =back =cut 1;