X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=2434f6a2fb5c2e23d67aa3cd6e02633449a11f9a;hp=89633444a5979c570bd0b4bf2514bd7e33f2d313;hb=b3e6081e1bdfa93adc1dc962de085754428fa7e4;hpb=bf5e40c8a56c5d7c3f78b50d354bd6568190375a diff --git a/dgit b/dgit index 89633444..2434f6a2 100755 --- a/dgit +++ b/dgit @@ -1382,11 +1382,12 @@ sub generate_commit_from_dsc () { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - link "../../../$f", $f + link_ltarget "../../../$f", $f or $!==&ENOENT or die "$f $!"; - complete_file_from_dsc('.', $fi); + complete_file_from_dsc('.', $fi) + or next; if (is_orig_file($f)) { link $f, "../../../../$f" @@ -1481,10 +1482,10 @@ sub complete_file_from_dsc ($$) { my $furl = $dscurl; $furl =~ s{/[^/]+$}{}; $furl .= "/$f"; - die "$f ?" unless $f =~ m/^${package}_/; + die "$f ?" unless $f =~ m/^\Q${package}\E_/; die "$f ?" if $f =~ m#/#; runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl"; - next if !act_local(); + return 0 if !act_local(); $downloaded = 1; } @@ -1498,13 +1499,16 @@ sub complete_file_from_dsc ($$) { " demands hash $fi->{Hash} ". ($downloaded ? "(got wrong file from archive!)" : "(perhaps you should delete this file?)"); + + return 1; } sub ensure_we_have_orig () { foreach my $fi (dsc_files_info()) { my $f = $fi->{Filename}; next unless is_orig_file($f); - complete_file_from_dsc('..', $fi); + complete_file_from_dsc('..', $fi) + or next; } } @@ -1757,6 +1761,10 @@ sub check_not_dirty () { } else { failedcmd @cmd; } + + if (stat_exists "debian/source/local-options") { + fail "git tree contains debian/source/local-options"; + } } sub commit_admin ($) { @@ -1779,7 +1787,8 @@ sub commit_quilty_patch () { progress "nothing quilty to commit, ok."; return; } - runcmd_ordryrun_local @git, qw(add), sort keys %adds; + my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds; + runcmd_ordryrun_local @git, qw(add -f), @adds; commit_admin "Commit Debian 3.0 (quilt) metadata"; } @@ -2521,7 +2530,7 @@ sub quiltify ($$) { remove_stray_gits(); mktree_in_ud_here(); rmtree '.pc'; - runcmd @git, 'add', '.'; + runcmd @git, qw(add -Af .); my $oldtiptree=git_write_tree(); changedir '../work'; @@ -2622,7 +2631,7 @@ sub quiltify ($$) { my $abbrev = sub { my $x = $_[0]{Commit}; $x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/; - return $; + return $x; }; my $reportnot = sub { my ($notp) = @_; @@ -2794,13 +2803,14 @@ END foreach my $f (<../../../../*>) { #/){ my $b=$f; $b =~ s{.*/}{}; next unless is_orig_file $b, srcfn $upstreamversion,''; - link $f, $b or die "$b $!"; + link_ltarget $f, $b or die "$b $!"; $dscaddfile->($b); } my @files=qw(debian/source/format debian/rules); - if (stat_exists '../../../debian/patches') { - push @files, 'debian/patches'; + foreach my $maybe (qw(debian/patches)) { + next unless stat_exists "../../../$maybe"; + push @files, $maybe; } my $debtar= srcfn $fakeversion,'.debian.tar.gz'; @@ -3111,20 +3121,40 @@ sub cmd_version { our (%valopts_long, %valopts_short); our @rvalopts; -sub defvalopt ($$$&) { - my ($long,$short,$val_re,$fn) = @_; - my $oi = { Long => $long, Short => $short, Re => $val_re, Fn => $fn }; +sub defvalopt ($$$$) { + my ($long,$short,$val_re,$how) = @_; + my $oi = { Long => $long, Short => $short, Re => $val_re, How => $how }; $valopts_long{$long} = $oi; $valopts_short{$short} = $oi; - # $fn subref should: + # $how subref should: # do whatever assignemnt or thing it likes with $_[0] # if the option should not be passed on to remote, @rvalopts=() + # or $how can be a scalar ref, meaning simply assign the value } -defvalopt '--since-version', '-v', '[^_]+|_', sub { - ($changes_since_version) = @_; +defvalopt '--since-version', '-v', '[^_]+|_', \$changes_since_version; +defvalopt '--distro', '-d', '.+', \$idistro; +defvalopt '', '-k', '.+', \$keyid; +defvalopt '--existing-package','', '.*', \$existing_package; +defvalopt '--build-products-dir','','.*', \$buildproductsdir; +defvalopt '--clean', '', $cleanmode_re, \$cleanmode; +defvalopt '--quilt', '', $quilt_modes_re, \$quilt_mode; + +defvalopt '', '-c', '.*=.*', sub { push @git, '-c', @_; }; + +defvalopt '', '-C', '.+', sub { + ($changesfile) = (@_); + if ($changesfile =~ s#^(.*)/##) { + $buildproductsdir = $1; + } +}; + +defvalopt '--initiator-tempdir','','.*', sub { + ($initiator_tempdir) = (@_); + $initiator_tempdir =~ m#^/# or + badusage "--initiator-tempdir must be used specify an". + " absolute, not relative, directory." }; -defvalopt '--distro', '-d', '.+', sub { ($idistro) = (@_); }; sub parseopts () { my $om; @@ -3141,13 +3171,18 @@ sub parseopts () { my ($what) = @_; @rvalopts = ($_); if (!defined $val) { - badusage "$what needs a value" unless length @ARGV; + badusage "$what needs a value" unless @ARGV; $val = shift @ARGV; push @rvalopts, $val; } badusage "bad value \`$val' for $what" unless $val =~ m/^$oi->{Re}$(?!\n)/s; - $oi->{Fn}($val); + my $how = $oi->{How}; + if (ref($how) eq 'SCALAR') { + $$how = $val; + } else { + $how->($val); + } push @ropts, @rvalopts; }; @@ -3182,27 +3217,6 @@ sub parseopts () { ($om = $opts_opt_map{$1})) { push @ropts, $_; push @$om, $2; - } elsif (m/^--existing-package=(.*)/s) { - push @ropts, $_; - $existing_package = $1; - } elsif (m/^--initiator-tempdir=(.*)/s) { - $initiator_tempdir = $1; - $initiator_tempdir =~ m#^/# or - badusage "--initiator-tempdir must be used specify an". - " absolute, not relative, directory." - } elsif (m/^--build-products-dir=(.*)/s) { - push @ropts, $_; - $buildproductsdir = $1; - } elsif (m/^--clean=($cleanmode_re)$/os) { - push @ropts, $_; - $cleanmode = $1; - } elsif (m/^--clean=(.*)$/s) { - badusage "unknown cleaning mode \`$1'"; - } elsif (m/^--quilt=($quilt_modes_re)$/s) { - push @ropts, $_; - $quilt_mode = $1; - } elsif (m/^--quilt=(.*)$/s) { - badusage "unknown quilt fixup mode \`$1'"; } elsif (m/^--ignore-dirty$/s) { push @ropts, $_; $ignoredirty = 1; @@ -3242,20 +3256,6 @@ sub parseopts () { push @ropts, $&; push @changesopts, $_; $_ = ''; - } elsif (s/^-c(.*=.*)//s) { - push @ropts, $&; - push @git, '-c', $1; - } elsif (s/^-C(.+)//s) { - push @ropts, $&; - $changesfile = $1; - if ($changesfile =~ s#^(.*)/##) { - $buildproductsdir = $1; - } - } elsif (s/^-k(.+)//s) { - $keyid=$1; - } elsif (m/^-[dCk]$/) { - badusage - "option \`$_' requires an argument (and no space before the argument)"; } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none';