dgit: Dgit parsing: Refactor into parse_dsc_field

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 9d3584fb7e0abd96b420e70a3f24def0b78ee20e..54b0e6fc7719237d1d357459edfb6e2a3d360c62 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -96,6 +96,7 @@ our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
 
 our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
 our $splitbraincache = 'dgit-intern/quilt-cache';
 
 our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
 our $splitbraincache = 'dgit-intern/quilt-cache';

+our $rewritemap = 'dgit-rewrite/map';

 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);


@@ -141,7 +142,7 @@ our %opts_cfg_insertpos = map {
     scalar @{ $opts_opt_map{$_} }
 } keys %opts_opt_map;
 
     scalar @{ $opts_opt_map{$_} }
 } keys %opts_opt_map;
 

-sub finalise_opts_opts();
+sub parseopts_late_defaults();

 
 our $keyid;
 
 
 our $keyid;
 


@@ -790,11 +791,11 @@ sub pushing () {
 Push failed, before we got started.
 You can retry the push, after fixing the problem, if you like.
 END
 Push failed, before we got started.
 You can retry the push, after fixing the problem, if you like.
 END

-    finalise_opts_opts();
+    parseopts_late_defaults();

 }
 
 sub notpushing () {
 }
 
 sub notpushing () {

-    finalise_opts_opts();
+    parseopts_late_defaults();

 }
 
 sub supplementary_message ($) {
 }
 
 sub supplementary_message ($) {


@@ -2513,6 +2514,7 @@ sub git_fetch_us () {
            \&debiantag_new, \&debiantag_maintview)
         : debiantags('*',access_nomdistro));
     push @specs, server_branch($csuite);
            \&debiantag_new, \&debiantag_maintview)
         : debiantags('*',access_nomdistro));
     push @specs, server_branch($csuite);

+    push @specs, $rewritemap;

     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
     # This is rather miserable:
     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
     # This is rather miserable:


@@ -2698,6 +2700,18 @@ sub fetch_from_archive_record_2 ($) {
     }
 }
 
     }
 }
 

+sub parse_dsc_field ($$) {
+    my ($f, $what) = @_;
+    if (!defined $f) {
+       progress "$what: NO git hash";
+    } elsif ($f =~ m/^\w+/) {
+       $dsc_hash = $&;
+       progress "$what: specified git hash";
+    } else {
+       fail "$what: invalid Dgit info";
+    }
+}
+

 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 
 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 


@@ -2709,19 +2723,26 @@ sub fetch_from_archive () {
     get_archive_dsc();
 
     if ($dsc) {
     get_archive_dsc();
 
     if ($dsc) {

+       my $f;

        foreach my $field (@ourdscfield) {
        foreach my $field (@ourdscfield) {

-           $dsc_hash = $dsc->{$field};
-           last if defined $dsc_hash;
+           $f = $dsc->{$field};
+           last if defined $f;

        }
        }

+       parse_dsc_field($f, 'last upload to archive');
+    } else {
+       progress "no version available from the archive";
+    }
+
+    my $rewritemapdata = git_cat_file lrfetchrefs."/".$rewritemap.':map';
+    if (defined $rewritemapdata
+       && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) {
+       progress "server's git history rewrite map contains a relevant entry!";
+       $dsc_hash = $1;

        if (defined $dsc_hash) {
        if (defined $dsc_hash) {

-           $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'";
-           $dsc_hash = $&;
-           progress "last upload to archive specified git hash";
+           progress "using rewritten git hash in place of .dsc value";

        } else {
        } else {

-           progress "last upload to archive has NO git hash";
+           progress "server data says .dsc hash is to be disregarded";

        }
        }

-    } else {
-       progress "no version available from the archive";

     }
 
     # If the archive's .dsc has a Dgit field, there are three
     }
 
     # If the archive's .dsc has a Dgit field, there are three


@@ -3709,7 +3730,11 @@ sub push_mktags ($$ $$ $) {
 
     die unless $tagwants->[0]{View} eq 'dgit';
 
 
     die unless $tagwants->[0]{View} eq 'dgit';
 

-    $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid};
+    my $declaredistro = access_nomdistro();
+    my $reader_giturl = do { local $access_forpush=0; access_giturl(); };
+    $dsc->{$ourdscfield[0]} = join " ",
+       $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag},
+       $reader_giturl;

     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);
     $dsc->save("$dscfn.tmp") or die $!;
 
     my $changes = parsecontrol($changesfile,$changesfilewhat);


@@ -3726,7 +3751,6 @@ sub push_mktags ($$ $$ $) {
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);

-    my $declaredistro = access_nomdistro();

 
     my $mktag = sub {
        my ($tw) = @_;
 
     my $mktag = sub {
        my ($tw) = @_;


@@ -4062,7 +4086,6 @@ END
 
 sub cmd_clone {
     parseopts();
 
 sub cmd_clone {
     parseopts();

-    notpushing();

     my $dstdir;
     badusage "-p is not allowed with clone; specify as argument instead"
        if defined $package;
     my $dstdir;
     badusage "-p is not allowed with clone; specify as argument instead"
        if defined $package;


@@ -4077,8 +4100,9 @@ sub cmd_clone {
     } else {
        badusage "incorrect arguments to dgit clone";
     }
     } else {
        badusage "incorrect arguments to dgit clone";
     }

-    $dstdir ||= "$package";
+    notpushing();

 
 

+    $dstdir ||= "$package";

     if (stat_exists $dstdir) {
        fail "$dstdir already exists";
     }
     if (stat_exists $dstdir) {
        fail "$dstdir already exists";
     }


@@ -4117,7 +4141,6 @@ sub branchsuite () {
 }
 
 sub fetchpullargs () {
 }
 
 sub fetchpullargs () {

-    notpushing();

     if (!defined $package) {
        my $sourcep = parsecontrol('debian/control','debian/control');
        $package = getfield $sourcep, 'Source';
     if (!defined $package) {
        my $sourcep = parsecontrol('debian/control','debian/control');
        $package = getfield $sourcep, 'Source';


@@ -4133,6 +4156,7 @@ sub fetchpullargs () {
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }

+    notpushing();

 }
 
 sub cmd_fetch {
 }
 
 sub cmd_fetch {


@@ -5623,6 +5647,7 @@ sub postbuild_mergechanges_vanilla ($) {
 }
 
 sub cmd_build {
 }
 
 sub cmd_build {

+    build_prep_early();

     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {


@@ -5715,6 +5740,7 @@ sub cmd_gbp_build {
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 sub build_source {
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
 sub build_source {

+    build_prep_early();

     my $our_cleanmode = $cleanmode;
     if ($need_split_build_invocation) {
        # Pretend that clean is being done some other way.  This
     my $our_cleanmode = $cleanmode;
     if ($need_split_build_invocation) {
        # Pretend that clean is being done some other way.  This


@@ -5775,6 +5801,7 @@ sub build_source {
 }
 
 sub cmd_build_source {
 }
 
 sub cmd_build_source {

+    build_prep_early();

     badusage "build-source takes no additional arguments" if @ARGV;
     build_source();
     maybe_unapply_patches_again();
     badusage "build-source takes no additional arguments" if @ARGV;
     build_source();
     maybe_unapply_patches_again();


@@ -5803,10 +5830,7 @@ END
 
 sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
 
 sub cmd_quilt_fixup {
     badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;

-    my $clogp = parsechangelog();
-    $version = getfield $clogp, 'Version';
-    $package = getfield $clogp, 'Source';
-    check_not_dirty();
+    build_prep_early();

     clean_tree();
     build_maybe_quilt_fixup();
 }
     clean_tree();
     build_maybe_quilt_fixup();
 }


@@ -5874,30 +5898,31 @@ sub cmd_import_dsc {
 
     parse_dscdata();
 
 
     parse_dscdata();
 

-    my $dgit_commit = $dsc->{$ourdscfield[0]};
-    if (defined $dgit_commit && 
-       !forceing [qw(import-dsc-with-dgit-field)]) {
-       $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc";
+    my $dgit_field = $dsc->{$ourdscfield[0]};
+    parse_dsc_field($dgit_field, "$ourdscfield[0] field in .dsc");
+
+    if (defined $dsc_hash
+       && !forceing [qw(import-dsc-with-dgit-field)]) {

        progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
        my @cmd = (qw(sh -ec),
        progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
        my @cmd = (qw(sh -ec),

-                  "echo $dgit_commit | git cat-file --batch-check");
+                  "echo $dsc_hash | git cat-file --batch-check");

        my $objgot = cmdoutput @cmd;
        if ($objgot =~ m#^\w+ missing\b#) {
            fail <<END
        my $objgot = cmdoutput @cmd;
        if ($objgot =~ m#^\w+ missing\b#) {
            fail <<END

-.dsc contains Dgit field referring to object $dgit_commit
+.dsc contains Dgit field referring to object $dsc_hash

 Your git tree does not have that object.  Try `git fetch' from a
 plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
 END
        }
 Your git tree does not have that object.  Try `git fetch' from a
 plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
 END
        }

-       if ($oldhash && !is_fast_fwd $oldhash, $dgit_commit) {
+       if ($oldhash && !is_fast_fwd $oldhash, $dsc_hash) {

            if ($force > 0) {
                progress "Not fast forward, forced update.";
            } else {
            if ($force > 0) {
                progress "Not fast forward, forced update.";
            } else {

-               fail "Not fast forward to $dgit_commit";
+               fail "Not fast forward to $dsc_hash";

            }
        }
        @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",
            }
        }
        @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",

-               $dstbranch, $dgit_commit);
+               $dstbranch, $dsc_hash);

        runcmd @cmd;
        progress "dgit: import-dsc updated git ref $dstbranch";
        return 0;
        runcmd @cmd;
        progress "dgit: import-dsc updated git ref $dstbranch";
        return 0;


@@ -6249,7 +6274,7 @@ END
 }
 
 
 }
 
 

-sub finalise_opts_opts () {
+sub parseopts_late_defaults () {

     foreach my $k (keys %opts_opt_map) {
        my $om = $opts_opt_map{$k};
 
     foreach my $k (keys %opts_opt_map) {
        my $om = $opts_opt_map{$k};
 


@@ -6276,6 +6301,40 @@ sub finalise_opts_opts () {
                     @$om[$insertpos..$#$om] );
        }
     }
                     @$om[$insertpos..$#$om] );
        }
     }

+
+    if (!defined $rmchanges) {
+       local $access_forpush;
+       $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+    }
+
+    if (!defined $quilt_mode) {
+       local $access_forpush;
+       $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
+           // access_cfg('quilt-mode', 'RETURN-UNDEF')
+           // 'linear';
+       $quilt_mode =~ m/^($quilt_modes_re)$/ 
+           or badcfg "unknown quilt-mode \`$quilt_mode'";
+       $quilt_mode = $1;
+    }
+
+    if (!defined $dodep14tag) {
+       local $access_forpush;
+       $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want';
+       $dodep14tag =~ m/^($dodep14tag_re)$/ 
+           or badcfg "unknown dep14tag setting \`$dodep14tag'";
+       $dodep14tag = $1;
+    }
+
+    $need_split_build_invocation ||= quiltmode_splitbrain();
+
+    if (!defined $cleanmode) {
+       local $access_forpush;
+       $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
+       $cleanmode //= 'dpkg-source';
+
+       badcfg "unknown clean-mode \`$cleanmode'" unless
+           $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
+    }

 }
 
 if ($ENV{$fakeeditorenv}) {
 }
 
 if ($ENV{$fakeeditorenv}) {


@@ -6300,40 +6359,6 @@ $cmd =~ y/-/_/;
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 
 my $pre_fn = ${*::}{"pre_$cmd"};
 $pre_fn->() if $pre_fn;
 

-if (!defined $rmchanges) {
-    local $access_forpush;
-    $rmchanges = access_cfg_bool(0, 'rm-old-changes');
-}
-
-if (!defined $quilt_mode) {
-    local $access_forpush;
-    $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
-       // access_cfg('quilt-mode', 'RETURN-UNDEF')
-       // 'linear';
-    $quilt_mode =~ m/^($quilt_modes_re)$/ 
-       or badcfg "unknown quilt-mode \`$quilt_mode'";
-    $quilt_mode = $1;
-}
-
-if (!defined $dodep14tag) {
-    local $access_forpush;
-    $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want';
-    $dodep14tag =~ m/^($dodep14tag_re)$/ 
-       or badcfg "unknown dep14tag setting \`$dodep14tag'";
-    $dodep14tag = $1;
-}
-
-$need_split_build_invocation ||= quiltmode_splitbrain();
-
-if (!defined $cleanmode) {
-    local $access_forpush;
-    $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF');
-    $cleanmode //= 'dpkg-source';
-
-    badcfg "unknown clean-mode \`$cleanmode'" unless
-       $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s;
-}
-

 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();
 my $fn = ${*::}{"cmd_$cmd"};
 $fn or badusage "unknown operation $cmd";
 $fn->();