directory refactoring: dgit clone: call record_maintree

[dgit.git] / dgit

diff --git a/dgit b/dgit
index c344d31ea2dba92e699fb9006ae39f0781c6f842..a67c12cb09ceac540f5d4f359987cbe68abcbd5c 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -19,7 +19,7 @@
 
 use strict;
 
 
 use strict;
 

-use Debian::Dgit;
+use Debian::Dgit qw(:DEFAULT :playground);

 setup_sigwarn();
 
 use IO::Handle;
 setup_sigwarn();
 
 use IO::Handle;


@@ -557,7 +557,7 @@ sub nextarg {
 }
 
 sub pre_help () {
 }
 
 sub pre_help () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_help () {
     print $helpmsg or die $!;
 }
 sub cmd_help () {
     print $helpmsg or die $!;


@@ -635,6 +635,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 
 our %gitcfgs;
 our @gitcfgsources = qw(cmdline local global system);
 
 our %gitcfgs;
 our @gitcfgsources = qw(cmdline local global system);

+our $invoked_in_git_tree = 1;

 
 sub git_slurp_config () {
     # This algoritm is a bit subtle, but this is needed so that for
 
 sub git_slurp_config () {
     # This algoritm is a bit subtle, but this is needed so that for


@@ -681,9 +682,10 @@ sub cfg {
        "$us: distro or suite appears not to be (properly) supported";
 }
 
        "$us: distro or suite appears not to be (properly) supported";
 }
 

-sub no_local_git_cfg () {
+sub not_necessarily_a_tree () {

     # needs to be called from pre_*
     @gitcfgsources = grep { $_ ne 'local' } @gitcfgsources;
     # needs to be called from pre_*
     @gitcfgsources = grep { $_ ne 'local' } @gitcfgsources;

+    $invoked_in_git_tree = 0;

 }
 
 sub access_basedistro__noalias () {
 }
 
 sub access_basedistro__noalias () {


@@ -985,12 +987,6 @@ sub commit_getclogp ($) {
     $commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
 }
 
     $commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
 }
 

-sub must_getcwd () {
-    my $d = getcwd();
-    defined $d or fail "getcwd failed: $!";
-    return $d;
-}
-

 sub parse_dscdata () {
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
     printdebug Dumper($dscdata) if $debuglevel>1;
 sub parse_dscdata () {
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
     printdebug Dumper($dscdata) if $debuglevel>1;


@@ -1674,18 +1670,13 @@ sub create_remote_git_repo () {
 our ($dsc_hash,$lastpush_mergeinput);
 our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
 
 our ($dsc_hash,$lastpush_mergeinput);
 our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url);
 

-our $ud = '.git/dgit/unpack';

 
 

-sub prep_ud (;$) {
-    my ($d) = @_;
-    $d //= $ud;
-    rmtree($d);
-    mkpath '.git/dgit';
-    mkdir $d or die $!;
+sub prep_ud () {
+    fresh_playground 'dgit/unpack';

 }
 
 sub mktree_in_ud_here () {
 }
 
 sub mktree_in_ud_here () {

-    workarea_setup $gitcfgs{local};
+    playtree_setup $gitcfgs{local};

 }
 
 sub git_write_tree () {
 }
 
 sub git_write_tree () {


@@ -2060,7 +2051,7 @@ sub generate_commits_from_dsc () {
     # See big comment in fetch_from_archive, below.
     # See also README.dsc-import.
     prep_ud();
     # See big comment in fetch_from_archive, below.
     # See also README.dsc-import.
     prep_ud();

-    changedir $ud;
+    changedir $playground;

 
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {
 
     my @dfi = dsc_files_info();
     foreach my $fi (@dfi) {


@@ -2470,8 +2461,8 @@ END
            @output = $lastpush_mergeinput;
        }
     }
            @output = $lastpush_mergeinput;
        }
     }

-    changedir '../../../..';
-    rmtree($ud);
+    changedir $maindir;
+    rmtree $playground;

     return @output;
 }
 
     return @output;
 }
 


@@ -3599,6 +3590,7 @@ sub clone ($) {
     mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
     mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);

+    record_maindir();

     setup_new_tree();
     clone_set_head();
     my $giturl = access_giturl(1);
     setup_new_tree();
     clone_set_head();
     my $giturl = access_giturl(1);


@@ -4177,7 +4169,7 @@ END
     if (madformat_wantfixup($format)) {
        # user might have not used dgit build, so maybe do this now:
        if (quiltmode_splitbrain()) {
     if (madformat_wantfixup($format)) {
        # user might have not used dgit build, so maybe do this now:
        if (quiltmode_splitbrain()) {

-           changedir $ud;
+           changedir $playground;

            quilt_make_fake_dsc($upstreamversion);
            my $cachekey;
            ($dgithead, $cachekey) =
            quilt_make_fake_dsc($upstreamversion);
            my $cachekey;
            ($dgithead, $cachekey) =


@@ -4190,7 +4182,7 @@ END
                                               $actualhead, $dgithead,
                                               $archive_hash);
            $maintviewhead = $actualhead;
                                               $actualhead, $dgithead,
                                               $archive_hash);
            $maintviewhead = $actualhead;

-           changedir '../../../..';
+           changedir $maindir;

            prep_ud(); # so _only_subdir() works, below
        } else {
            commit_quilty_patch();
            prep_ud(); # so _only_subdir() works, below
        } else {
            commit_quilty_patch();


@@ -4221,13 +4213,13 @@ END
        }
     }
 
        }
     }
 

-    changedir $ud;
+    changedir $playground;

     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");
     check_for_vendor_patches() if madformat($dsc->{format});
     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --),
         $dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir("source package");
     check_for_vendor_patches() if madformat($dsc->{format});

-    changedir '../../../..';
+    changedir $maindir;

     my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
     debugcmd "+",@diffcmd;
     $!=0; $?=-1;
     my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
     debugcmd "+",@diffcmd;
     $!=0; $?=-1;


@@ -4389,7 +4381,7 @@ END
 }
 
 sub pre_clone () {
 }
 
 sub pre_clone () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_clone {
     parseopts();
 }
 sub cmd_clone {
     parseopts();


@@ -4492,21 +4484,18 @@ END
     pull();
 }
 
     pull();
 }
 

-sub cmd_push {
+sub prep_push () {

     parseopts();
     parseopts();

-    badusage "-p is not allowed with dgit push" if defined $package;
+    build_or_push_prep_early();
+    pushing();

     check_not_dirty();
     check_not_dirty();

-    my $clogp = parsechangelog();
-    $package = getfield $clogp, 'Source';

     my $specsuite;
     if (@ARGV==0) {
     } elsif (@ARGV==1) {
        ($specsuite) = (@ARGV);
     } else {
     my $specsuite;
     if (@ARGV==0) {
     } elsif (@ARGV==1) {
        ($specsuite) = (@ARGV);
     } else {

-       badusage "incorrect arguments to dgit push";
+       badusage "incorrect arguments to dgit $subcommand";

     }
     }

-    $isuite = getfield $clogp, 'Distribution';
-    pushing();

     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();
     if ($new_package) {
        local ($package) = $existing_package; # this is a hack
        canonicalise_suite();


@@ -4516,9 +4505,13 @@ sub cmd_push {
     if (defined $specsuite &&
        $specsuite ne $isuite &&
        $specsuite ne $csuite) {
     if (defined $specsuite &&
        $specsuite ne $isuite &&
        $specsuite ne $csuite) {

-           fail "dgit push: changelog specifies $isuite ($csuite)".
+           fail "dgit $subcommand: changelog specifies $isuite ($csuite)".

                " but command line specifies $specsuite";
     }
                " but command line specifies $specsuite";
     }

+}
+
+sub cmd_push {
+    prep_push();

     dopush();
 }
 
     dopush();
 }
 


@@ -4602,7 +4595,7 @@ sub i_method {
 }
 
 sub pre_rpush () {
 }
 
 sub pre_rpush () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_rpush {
     my $host = nextarg;
 }
 sub cmd_rpush {
     my $host = nextarg;


@@ -5015,7 +5008,7 @@ END
 
     my $dgitview = git_rev_parse 'HEAD';
 
 
     my $dgitview = git_rev_parse 'HEAD';
 

-    changedir '../../../..';
+    changedir $maindir;

     # When we no longer need to support squeeze, use --create-reflog
     # instead of this:
     ensuredir ".git/logs/refs/dgit-intern";
     # When we no longer need to support squeeze, use --create-reflog
     # instead of this:
     ensuredir ".git/logs/refs/dgit-intern";


@@ -5040,7 +5033,7 @@ END
     runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
        $dgitview;
 
     runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
        $dgitview;
 

-    changedir '.git/dgit/unpack/work';
+    changedir "$playground/work";

 
     my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
     progress "dgit view: created ($saved)";
 
     my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
     progress "dgit view: created ($saved)";


@@ -5339,7 +5332,7 @@ END
     my $headref = git_rev_parse('HEAD');
 
     prep_ud();
     my $headref = git_rev_parse('HEAD');
 
     prep_ud();

-    changedir $ud;
+    changedir $playground;

 
     my $upstreamversion = upstreamversion $version;
 
 
     my $upstreamversion = upstreamversion $version;
 


@@ -5351,7 +5344,7 @@ END
 
     die 'bug' if $split_brain && !$need_split_build_invocation;
 
 
     die 'bug' if $split_brain && !$need_split_build_invocation;
 

-    changedir '../../../..';
+    changedir $maindir;

     runcmd_ordryrun_local
         @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
 }
     runcmd_ordryrun_local
         @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
 }


@@ -5462,7 +5455,7 @@ END
 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.
 sub quilt_check_splitbrain_cache ($$) {
     my ($headref, $upstreamversion) = @_;
     # Called only if we are in (potentially) split brain mode.

-    # Called in $ud.
+    # Called in playground.

     # Computes the cache key and looks in the cache.
     # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
 
     # Computes the cache key and looks in the cache.
     # Returns ($dgit_view_commitid, $cachekey) or (undef, $cachekey)
 


@@ -5818,14 +5811,18 @@ sub cmd_clean () {
     maybe_unapply_patches_again();
 }
 
     maybe_unapply_patches_again();
 }
 

-sub build_prep_early () {
-    our $build_prep_early_done //= 0;
-    return if $build_prep_early_done++;
-    badusage "-p is not allowed when building" if defined $package;
+sub build_or_push_prep_early () {
+    our $build_or_push_prep_early_done //= 0;
+    return if $build_or_push_prep_early_done++;
+    badusage "-p is not allowed with dgit $subcommand" if defined $package;

     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';

+}
+
+sub build_prep_early () {
+    build_or_push_prep_early();

     notpushing();
     check_not_dirty();
 }
     notpushing();
     check_not_dirty();
 }


@@ -6134,10 +6131,10 @@ sub build_source {
     } else {
        my @cmd = (@dpkgsource, qw(-b --));
        if ($split_brain) {
     } else {
        my @cmd = (@dpkgsource, qw(-b --));
        if ($split_brain) {

-           changedir $ud;
+           changedir $playground;

            runcmd_ordryrun_local @cmd, "work";
            my @udfiles = <${package}_*>;
            runcmd_ordryrun_local @cmd, "work";
            my @udfiles = <${package}_*>;

-           changedir "../../..";
+           changedir $maindir;

            foreach my $f (@udfiles) {
                printdebug "source copy, found $f\n";
                next unless
            foreach my $f (@udfiles) {
                printdebug "source copy, found $f\n";
                next unless


@@ -6145,7 +6142,7 @@ sub build_source {
                    ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                     $f eq srcfn($version, $&));
                printdebug "source copy, found $f - renaming\n";
                    ($f =~ m/\.debian\.tar(?:\.\w+)$/ &&
                     $f eq srcfn($version, $&));
                printdebug "source copy, found $f - renaming\n";

-               rename "$ud/$f", "../$f" or $!==ENOENT
+               rename "$playground/$f", "../$f" or $!==ENOENT

                    or fail "put in place new source file ($f): $!";
            }
        } else {
                    or fail "put in place new source file ($f): $!";
            }
        } else {


@@ -6375,7 +6372,7 @@ END
 }
 
 sub pre_archive_api_query () {
 }
 
 sub pre_archive_api_query () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
 }
 sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;


@@ -6394,7 +6391,7 @@ sub repos_server_url () {
 }    
 
 sub pre_clone_dgit_repos_server () {
 }    
 
 sub pre_clone_dgit_repos_server () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_clone_dgit_repos_server {
     badusage "need destination argument" unless @ARGV==1;
 }
 sub cmd_clone_dgit_repos_server {
     badusage "need destination argument" unless @ARGV==1;


@@ -6406,7 +6403,7 @@ sub cmd_clone_dgit_repos_server {
 }
 
 sub pre_print_dgit_repos_server_source_url () {
 }
 
 sub pre_print_dgit_repos_server_source_url () {

-    no_local_git_cfg();
+    not_necessarily_a_tree();

 }
 sub cmd_print_dgit_repos_server_source_url {
     badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
 }
 sub cmd_print_dgit_repos_server_source_url {
     badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"


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

+record_maindir if $invoked_in_git_tree;

 git_slurp_config();
 
 my $fn = ${*::}{"cmd_$cmd"};
 git_slurp_config();
 
 my $fn = ${*::}{"cmd_$cmd"};