our $new_package = 0;
our $ignoredirty = 0;
our $noquilt = 0;
+our $rmonerror = 1;
our $existing_package = 'dpkg';
our $cleanmode = 'dpkg-source';
our $changes_since_version;
our $us = 'dgit';
our $debugprefix = '';
+our @end;
+END {
+ local ($?);
+ foreach my $f (@end) {
+ eval { $f->(); };
+ warn "$us: cleanup: $@" if length $@;
+ }
+};
+
sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
sub fail {
'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
- 'dgit-distro.debian.backports-quirk' => '%-backports*',
+ 'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
'dgit-distro.test-dummy.ssh' => "$td/ssh",
'dgit-distro.test-dummy.username' => "alice",
'RETURN-UNDEF');
if (defined $backports_quirk) {
my $re = $backports_quirk;
- $re =~ s/[^-0-9a-z_\%*]/\\$&/ig;
+ $re =~ s/[^-0-9a-z_\%*()]/\\$&/ig;
$re =~ s/\*/.*/g;
- $re =~ s/\%/([-0-9a-z_]+)/ or badcfg "backports-quirk needs \%";
+ $re =~ s/\%/([-0-9a-z_]+)/
+ or $re =~ m/[()]/ or badcfg "backports-quirk needs \% or ( )";
if ($isuite =~ m/^$re$/) {
return ('backports',"$basedistro-backports",$1);
}
badusage "incorrect arguments to dgit clone";
}
$dstdir ||= "$package";
+
+ my $cwd_remove;
+ if ($rmonerror && !$dryrun_level) {
+ $cwd_remove= getcwd();
+ unshift @end, sub {
+ return unless defined $cwd_remove;
+ if (!chdir "$cwd_remove") {
+ return if $!==&ENOENT;
+ die "chdir $cwd_remove: $!";
+ }
+ rmtree($dstdir) or die "remove $dstdir: $!\n";
+ };
+ }
+
clone($dstdir);
+ $cwd_remove = undef;
}
sub branchsuite () {
} elsif (m/^--no-quilt-fixup$/s) {
push @ropts, $_;
$noquilt = 1;
+ } elsif (m/^--no-rm-on-error$/s) {
+ push @ropts, $_;
+ $rmonerror = 0;
} else {
badusage "unknown long option \`$_'";
}