dgit: Dgit parsing: Refactor into parse_dsc_field

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 7c282532b044daaf9afd64337c5fcb0418af2499..54b0e6fc7719237d1d357459edfb6e2a3d360c62 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -142,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;
 


@@ -791,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 ($) {


@@ -2700,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();
 


@@ -2711,17 +2723,12 @@ 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;
-       }
-       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";
-       } else {
-           progress "last upload to archive has NO git hash";
+           $f = $dsc->{$field};
+           last if defined $f;

        }
        }

+       parse_dsc_field($f, 'last upload to archive');

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


@@ -3723,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);


@@ -3740,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) = @_;


@@ -4076,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;


@@ -4091,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";
     }


@@ -4131,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';


@@ -4147,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 {


@@ -5637,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) {


@@ -5729,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


@@ -5789,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();


@@ -5817,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();
 }


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

-    my $dgit_commit = $dsc->{$ourdscfield[0]};
-    if (defined $dgit_commit
+    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)]) {
        && !forceing [qw(import-dsc-with-dgit-field)]) {

-       $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc";
-       $dgit_commit = $&;

        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;


@@ -6264,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};
 


@@ -6291,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}) {


@@ -6315,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->();