Yesterday I came across a problem to sync files between two computers in a network, but only those that had been created or modified within the last 60 days. Unfortunately rsync doesn't come with such a functionality (or it doesn't seem to - maybe I've overlooked something). It could well be that I've gone to work in a more complicated manner than necessary but I couldn't come up with anything better.
So I took the extra step to copy the files that need to be synchronised to a temporary directory, preserving the original directory structure. Then the files can be effortlessly synced with rsync.
Maybe this will come in handy for somebody else.
#!/usr/bin/perl
use strict;
use warnings;
use File::Path;
use File::Basename;
use File::Spec;
use File::Copy;
use Cwd;
use Getopt::Long;
# make output unbuffered
$| = 1;
my $path = getcwd;
my $mtime = 1;
my $dest;
my $verbose = '';
my $showhelp = '';
my $result = GetOptions("source=s" => \$path,
"mtime=i" => \$mtime,
"dest=s" => \$dest,
"help" => \$showhelp,
"verbose" => \$verbose);
# DEBUG
# print "\$path = $path\n\$mtime = $mtime\n\$dest = $dest\n\$showhelp
+= $showhelp\n\$verbose = $verbose\n";
# exit(0);
my $usage = "Usage: $0 --dest <destination-path>\n\t" .
"[--source <source-path> | --mtime <mtime> | --verbose] [
+--help]\n\t" .
"Type $0 --help for more information.";
my $help = <<EOHELP;
$0 - Copy file hierarchies selectively
based on their modification times
Options:
-s | --source=SourceDir Source path. Default: pwd
-m | --mtime mtime (see man find). Default: 1
-d | --dest=DestDir Destination path. Mandatory option.
-h | --help Print this help screen.
-v | --verbose Be more verbose. Default: false
EOHELP
if ($showhelp) {
print $help;
exit(0);
}
unless ($dest) {
die "$usage\n";
}
# remove trailing slash from $dest
$dest =~ s/\/$//;
my $find = "find $path -type f -mtime -$mtime";
my @files = `$find`;
my %dirs_created;
foreach (@files) {
# debug
print;
chomp;
s/^\.\///;
my ($filename, $directories, $suffix) = fileparse($_);
my $new_dir = File::Spec->canonpath(File::Spec->catdir($dest, $dir
+ectories));
unless (exists $dirs_created{$new_dir}) {
$dirs_created{$new_dir} = mkpath($new_dir);
print "Created $new_dir\n" if $verbose;
}
copy($_, File::Spec->catfile($new_dir, "$filename$suffix"));
print File::Spec->catfile($new_dir, "$filename$suffix") . "\n" if
+$verbose;
}
exit(0);
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|