view release on metacpan or  search on metacpan

script/rsync-new2old  view on Meta::CPAN

#!perl

our $DATE = '2019-03-28'; # DATE
our $VERSION = '0.008'; # VERSION

use strict;
use warnings;

use File::Path qw(make_path);
use File::Spec;
use File::Which;
use Getopt::Long;

sub process_path {
    my $path = shift;
    my $path_ends_in_slash = $path =~ s{/+\z}{} ? 1:0;
    my $abs_path = File::Spec->rel2abs($path);
    my (undef, undef, $path_leaf) = File::Spec->splitpath($abs_path);
    return ($abs_path, $path_leaf, $path_ends_in_slash);
}

sub find_newest_mtime {
    my $path = shift;

    my @st = lstat($path) or return (0, $path);
    my $is_dir = (-d _);
    my $mtime = $st[9];
    if ($is_dir) {
        opendir my($dh), $path
            or die "rsync-new2old: Can't opendir $path: $!\n";
        my @entries = grep { $_ ne '.' && $_ ne '..' } readdir($dh);
        my @res = map { [find_newest_mtime("$path/$_")] } @entries;
        my $max_path = $path;
        my $max_mtime = $mtime;
        for my $r (@res) {
            if ($r->[0] > $max_mtime) {
                $max_mtime = $r->[0];
                $max_path = $r->[1];
            }
        }
        return ($max_mtime, $max_path);
    }
    ($mtime, $path);
}

my %Opts = (create_target_if_not_exists => 0);

Getopt::Long::Configure('bundling', 'pass_through', 'no_auto_abbrev', 'permute');
GetOptions(
    'help|h|?' => sub {
        print <<'_';
Usage: rsync-new2old [options] <source> <target>

Options:
  --help, -h, -?  Show this message and exit.
  --version       Show program version and exit.
  --create-target-if-not-exists
                  Create target if not exists.

All the other options will be passed to rsync.

See manpage for more detailed documentation.
_
        exit 0;
    },
    'version' => sub {
        no warnings 'once';
        print "rsync-new2old version ", ($main::VERSION || "dev"),
            ($main::DATE ? " ($main::DATE)" : ""), "\n";
        exit 0;
    },
    'create-target-if-not-exists' => \$Opts{create_target_if_not_exists},
);

my ($source, $target);
for (@ARGV) {
    if (/\A-/) {
        next;
    } elsif (!defined($source)) {
        $source = $_;
    } elsif (!defined($target)) {
        $target = $_;
    } else {
        last;
    }
}
#use DD; dd {source=>$source, target=>$target, opts=>\%Opts};
die "rsync-new2old: Please specify both source and target\n"
    unless defined $source && defined $target;

die "rsync-new2old: Can't find source '$source', must already exist and a local path\n"
    unless -e $source;
my ($abs_source, $source_leaf, $source_ends_in_slash) = process_path($source);
my ($abs_target, $target_leaf, $target_ends_in_slash) = process_path($target);
my $real_target = $source_ends_in_slash ? $target : "$abs_target/$source_leaf";
if ($Opts{create_target_if_not_exists}) {
    unless (-e $real_target) {
        if (-d $source) {
            make_path($real_target) or die "rsync-new2old: Can't make_path '$real_target': $!\n";
        } else {
            open my $fh, ">", $real_target or die "rsync-new2old: Can't create file '$real_target': $!\n";
            close $fh;
        }
        utime 0, 0, $real_target or die "rsync-new2old: Can't set mtime of '$real_target': $!\n";
    }
} else {
    die "rsync-new2old: Can't find target '$real_target', must already exist and a local path\n"
        unless -e $real_target;
}

my ($newest_mtime_source, $newest_path_source) = find_newest_mtime($source);
my ($newest_mtime_target, $newest_path_target) = find_newest_mtime($real_target);

if ($newest_mtime_target > $newest_mtime_source) {
    warn sprintf("rsync-new2old: Aborting rsync from '%s' to '%s' ".
                     "because newest file/subdir in source ('%s', mtime %s) is older than ".
                         "newest file/subdir in target ('%s', mtime %s)\n",
                 $source, $real_target,
                 $newest_path_source, scalar(localtime $newest_mtime_source),
                 $newest_path_target, scalar(localtime $newest_mtime_target),
             );
    exit 2;
}

my $rsync_cmd = $ENV{RSYNC_NEW2OLD_RSYNC_CMD} ||
    (which("rsynccolor") ? "rsynccolor" : "rsync");
exec {$rsync_cmd} $rsync_cmd, @ARGV;

# ABSTRACT: Rsync wrapper to make sure we sync new data to old, not otherwise
# PODNAME: rsync-new2old

__END__

=pod

=encoding UTF-8

=head1 NAME

rsync-new2old - Rsync wrapper to make sure we sync new data to old, not otherwise

=head1 VERSION

This document describes version 0.008 of rsync-new2old (from Perl distribution App-rsync-new2old), released on 2019-03-28.

=head1 SYNOPSIS

Use like you would use B<rsync>:

 % rsync-new2old -avz [other options...] <source> <target>

=head1 DESCRIPTION

Rsync is a fast and versatile directory mirroring tool. I often use it to
synchronize my large media/software directory from one computer to another.
However, sometimes I add/delete stuffs from this directory on one computer (say