I adjusted tla-rsync-mirror so that it works with current versions of baz (which don't do the -MIRROR thing).
-- .''`. ** Debian GNU/Linux ** | Andrew Suffield : :' : http://www.debian.org/ | `. `' | `- -><- |
#!/usr/bin/perl
use strict;
use warnings;
use URI;
sub find_archive
{
my $name = shift;
return ($name) if -d $name;
my @locations = `baz whereis-archive --all-locations $name`;
chomp $_ foreach @locations;
return @locations;
}
my $from;
my $to;
if (scalar @ARGV == 2)
{
$from = find_archive(shift);
$to = find_archive(shift);
}
elsif (scalar @ARGV == 1)
{
$from = shift;
my @archives;
($from, @archives) = find_archive($from);
foreach (@archives)
{
my $uri = URI->new($_, "file");
if (not defined $uri->scheme or $uri->scheme eq "file" or $uri->scheme
eq "sftp")
{
$to = $_;
last;
}
}
}
else
{
print <<END;
tla-rsync-mirror FROM TO
tla-rsync-mirror ARCHIVE
FROM and TO can be paths or archive names
ARCHIVE must be a single archive name, for which either a -MIRROR or a
-MIRROR-FROM exists.
END
exit 0;
}
die "Couldn't find FROM path" unless $from;
die "Couldn't find TO path" unless $to;
sub process_location
{
my $location = shift;
my $uri = URI->new($location, "file");
if (not defined $uri->scheme or $uri->scheme eq "file")
{
return $uri->path;
}
elsif ($uri->scheme eq "sftp")
{
$uri->opaque =~ m,^//([^/]+)/(.*)$, or die "Failed to parse sftp URI:
$uri";
my $host = $1;
my $path = $2;
return "$1:/$2";
}
die "Don't know how to handle URI scheme " . $uri->scheme;
}
# Blindly append a trailing / in order to avoid problems with rsync's
# idiosyncratic handling of trailing slashes.
$from = process_location($from) . "/";
$to = process_location($to) . "/";
$ENV{RSYNC_RSH} = "ssh";
system("rsync", "-vtr", "--delete", "--delete-after", "--exclude",
"=meta-info", $from, $to);
signature.asc
Description: Digital signature
_______________________________________________ Gnu-arch-users mailing list [email protected] http://lists.gnu.org/mailman/listinfo/gnu-arch-users GNU arch home page: http://savannah.gnu.org/projects/gnu-arch/
