Commit f88961a8 authored by Eric Wong's avatar Eric Wong Committed by Martin Langhoff

archimport: remove String::ShellQuote dependency.

use safe_pipe_capture() or system() over backticks where
shellquoting may have been necessary.
More changes planned, so I'm not touching the parts I'm
planning on replacing entirely.
Signed-off-by: default avatarEric Wong <normalperson@yhbt.net>
Signed-off-by: default avatarMartin Langhoff <martin@catalyst.net.nz>
parent 2777ef76
...@@ -55,9 +55,8 @@ =head1 Devel Notes ...@@ -55,9 +55,8 @@ =head1 Devel Notes
use Getopt::Std; use Getopt::Std;
use File::Spec; use File::Spec;
use File::Temp qw(tempfile tempdir); use File::Temp qw(tempfile tempdir);
use File::Path qw(mkpath); use File::Path qw(mkpath rmtree);
use File::Basename qw(basename dirname); use File::Basename qw(basename dirname);
use String::ShellQuote;
use Time::Local; use Time::Local;
use IO::Socket; use IO::Socket;
use IO::Pipe; use IO::Pipe;
...@@ -306,7 +305,7 @@ sub old_style_branchname { ...@@ -306,7 +305,7 @@ sub old_style_branchname {
unless ($import) { # skip for import unless ($import) { # skip for import
if ( -e "$git_dir/refs/heads/$ps->{branch}") { if ( -e "$git_dir/refs/heads/$ps->{branch}") {
# we know about this branch # we know about this branch
`git checkout $ps->{branch}`; system('git-checkout',$ps->{branch});
} else { } else {
# new branch! we need to verify a few things # new branch! we need to verify a few things
die "Branch on a non-tag!" unless $ps->{type} eq 't'; die "Branch on a non-tag!" unless $ps->{type} eq 't';
...@@ -315,7 +314,7 @@ sub old_style_branchname { ...@@ -315,7 +314,7 @@ sub old_style_branchname {
unless $branchpoint; unless $branchpoint;
# find where we are supposed to branch from # find where we are supposed to branch from
`git checkout -b $ps->{branch} $branchpoint`; system('git-checkout','-b',$ps->{branch},$branchpoint);
# If we trust Arch with the fact that this is just # If we trust Arch with the fact that this is just
# a tag, and it does not affect the state of the tree # a tag, and it does not affect the state of the tree
...@@ -344,7 +343,7 @@ sub old_style_branchname { ...@@ -344,7 +343,7 @@ sub old_style_branchname {
# #
my $tree; my $tree;
my $commitlog = `tla cat-archive-log -A $ps->{repo} $ps->{id}`; my $commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
die "Error in cat-archive-log: $!" if $?; die "Error in cat-archive-log: $!" if $?;
# parselog will git-add/rm files # parselog will git-add/rm files
...@@ -422,7 +421,7 @@ sub old_style_branchname { ...@@ -422,7 +421,7 @@ sub old_style_branchname {
# #
my @par; my @par;
if ( -e "$git_dir/refs/heads/$ps->{branch}") { if ( -e "$git_dir/refs/heads/$ps->{branch}") {
if (open HEAD, "<$git_dir/refs/heads/$ps->{branch}") { if (open HEAD, "<","$git_dir/refs/heads/$ps->{branch}") {
my $p = <HEAD>; my $p = <HEAD>;
close HEAD; close HEAD;
chomp $p; chomp $p;
...@@ -437,7 +436,6 @@ sub old_style_branchname { ...@@ -437,7 +436,6 @@ sub old_style_branchname {
if ($ps->{merges}) { if ($ps->{merges}) {
push @par, find_parents($ps); push @par, find_parents($ps);
} }
my $par = join (' ', @par);
# #
# Commit, tag and clean state # Commit, tag and clean state
...@@ -454,7 +452,7 @@ sub old_style_branchname { ...@@ -454,7 +452,7 @@ sub old_style_branchname {
$commit_rh = 'commit_rh'; $commit_rh = 'commit_rh';
$commit_wh = 'commit_wh'; $commit_wh = 'commit_wh';
$pid = open2(*READER, *WRITER, "git-commit-tree $tree $par") $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
or die $!; or die $!;
print WRITER $logmessage; # write print WRITER $logmessage; # write
close WRITER; close WRITER;
...@@ -469,7 +467,7 @@ sub old_style_branchname { ...@@ -469,7 +467,7 @@ sub old_style_branchname {
# #
# Update the branch # Update the branch
# #
open HEAD, ">$git_dir/refs/heads/$ps->{branch}"; open HEAD, ">","$git_dir/refs/heads/$ps->{branch}";
print HEAD $commitid; print HEAD $commitid;
close HEAD; close HEAD;
system('git-update-ref', 'HEAD', "$ps->{branch}"); system('git-update-ref', 'HEAD', "$ps->{branch}");
...@@ -483,21 +481,23 @@ sub old_style_branchname { ...@@ -483,21 +481,23 @@ sub old_style_branchname {
print " + tree $tree\n"; print " + tree $tree\n";
print " + commit $commitid\n"; print " + commit $commitid\n";
$opt_v && print " + commit date is $ps->{date} \n"; $opt_v && print " + commit date is $ps->{date} \n";
$opt_v && print " + parents: $par \n"; $opt_v && print " + parents: ",join(' ',@par),"\n";
} }
sub apply_import { sub apply_import {
my $ps = shift; my $ps = shift;
my $bname = git_branchname($ps->{id}); my $bname = git_branchname($ps->{id});
`mkdir -p $tmp`; mkpath($tmp);
`tla get -s --no-pristine -A $ps->{repo} $ps->{id} $tmp/import`; safe_pipe_capture($TLA,'get','-s','--no-pristine',$ps->{id},"$tmp/import");
die "Cannot get import: $!" if $?; die "Cannot get import: $!" if $?;
`rsync -v --archive --delete --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`; system('rsync','-aI','--delete', '--exclude',$git_dir,
'--exclude','.arch-ids','--exclude','{arch}',
"$tmp/import/", './');
die "Cannot rsync import:$!" if $?; die "Cannot rsync import:$!" if $?;
`rm -fr $tmp/import`; rmtree("$tmp/import");
die "Cannot remove tempdir: $!" if $?; die "Cannot remove tempdir: $!" if $?;
...@@ -507,10 +507,10 @@ sub apply_import { ...@@ -507,10 +507,10 @@ sub apply_import {
sub apply_cset { sub apply_cset {
my $ps = shift; my $ps = shift;
`mkdir -p $tmp`; mkpath($tmp);
# get the changeset # get the changeset
`tla get-changeset -A $ps->{repo} $ps->{id} $tmp/changeset`; safe_pipe_capture($TLA,'get-changeset',$ps->{id},"$tmp/changeset");
die "Cannot get changeset: $!" if $?; die "Cannot get changeset: $!" if $?;
# apply patches # apply patches
...@@ -534,17 +534,20 @@ sub apply_cset { ...@@ -534,17 +534,20 @@ sub apply_cset {
$orig =~ s/\.modified$//; # lazy $orig =~ s/\.modified$//; # lazy
$orig =~ s!^\Q$tmp\E/changeset/patches/!!; $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
#print "rsync -p '$mod' '$orig'"; #print "rsync -p '$mod' '$orig'";
`rsync -p $mod ./$orig`; system('rsync','-p',$mod,"./$orig");
die "Problem applying binary changes! $!" if $?; die "Problem applying binary changes! $!" if $?;
} }
} }
# bring in new files # bring in new files
`rsync --archive --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`; system('rsync','-aI','--exclude',$git_dir,
'--exclude','.arch-ids',
'--exclude', '{arch}',
"$tmp/changeset/new-files-archive/",'./');
# deleted files are hinted from the commitlog processing # deleted files are hinted from the commitlog processing
`rm -fr $tmp/changeset`; rmtree("$tmp/changeset");
} }
...@@ -622,9 +625,9 @@ sub parselog { ...@@ -622,9 +625,9 @@ sub parselog {
# tla cat-archive-log will give us filenames with spaces as file\(sp)name - why? # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
# we can assume that any filename with \ indicates some pika escaping that we want to get rid of. # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
if ($t =~ /\\/ ){ if ($t =~ /\\/ ){
$t = `tla escape --unescaped '$t'`; $t = (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0];
} }
push (@tmp, shell_quote($t)); push (@tmp, $t);
} }
@$ref = @tmp; @$ref = @tmp;
} }
...@@ -827,8 +830,10 @@ sub find_parents { ...@@ -827,8 +830,10 @@ sub find_parents {
} }
} }
} }
@parents = keys %parents; @parents = ();
@parents = map { " -p " . ptag($_) } @parents; foreach (keys %parents) {
push @parents, '-p', ptag($_);
}
return @parents; return @parents;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment