# implicitly uses $main::us
%EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)],
playground => [qw(record_maindir $maindir $local_git_cfg
- fresh_playground $playground)]);
+ $maindir_gitdir $maindir_gitcommon
+ fresh_playground $playground
+ ensure_a_playground)]);
@EXPORT_OK = ( @{ $EXPORT_TAGS{policyflags} },
@{ $EXPORT_TAGS{playground} } );
}
# createing different playgrounds; but $playground global can
# refer only to one, obv.
#
+# ensure_a_playground SUBDIR_PATH_COMPONENTS
+# like fresh_playground except:
+# merely ensures the directory exists; does not delete an existing one
+# never sets global $playground
+#
# then can use
#
# changedir $playground
# ----- maindir -----
+# these three all go together
our $maindir;
+our $maindir_gitdir;
+our $maindir_gitcommon;
+
our $local_git_cfg;
sub record_maindir () {
- $maindir //= must_getcwd();
+ if (!defined $maindir) {
+ $maindir = must_getcwd();
+ if (!stat "$maindir/.git") {
+ fail "cannot stat $maindir/.git: $!";
+ }
+ if (-d _) {
+ # we fall back to this in case we have a pre-worktree
+ # git, which may not know git rev-parse --git-common-dir
+ $maindir_gitdir = "$maindir/.git";
+ $maindir_gitcommon = "$maindir/.git";
+ } else {
+ $maindir_gitdir = cmdoutput qw(git rev-parse --git-dir);
+ $maindir_gitcommon = cmdoutput qw(git rev-parse --git-common-dir);
+ }
+ }
$local_git_cfg //= git_slurp_config_src 'local';
}
our $playground;
-sub fresh_playground ($) {
+sub ensure_a_playground_parent ($) {
my ($spc) = @_;
record_maindir();
- $spc = ".git/$spc";
+ $spc = "$maindir_gitdir/$spc";
my $parent = dirname $spc;
- mkdir $parent or $!==EEXIST or fail "failed to mkdir $parent: $!";
+ mkdir $parent or $!==EEXIST
+ or fail "failed to mkdir playground parent $parent: $!";
+ return $spc;
+}
+
+sub ensure_a_playground ($) {
+ my ($spc) = @_;
+ $spc = ensure_a_playground_parent $spc;
+ mkdir $spc or $!==EEXIST or fail "failed to mkdir a playground $spc: $!";
+ return $spc;
+}
+
+sub fresh_playground ($) {
+ my ($spc) = @_;
+ $spc = ensure_a_playground_parent $spc;
rmtree $spc;
- mkdir $spc or die "$spc $!";
- return $playground = "$maindir/$spc";
+ mkdir $spc or fail "failed to mkdir the playground $spc: $!";
+ return $playground = $spc;
}
# ----- playtrees -----
sub playtree_setup (;$) {
my ($t_local_git_cfg) = @_;
$t_local_git_cfg //= $local_git_cfg;
- # should be run in a directory .git/FOO/BAR of a working tree
+ # for use in the playtree
+ # $maindir must be set, eg by calling record_maindir or fresh_playground
runcmd qw(git init -q);
runcmd qw(git config gc.auto 0);
foreach my $copy (qw(user.email user.name user.useConfigOnly
next unless $v;
runcmd qw(git config), $copy, $_ foreach @$v;
}
+ # this is confusing: we have
+ # . playtree, not a worktree, has .git/, our cwd
+ # $maindir might be a worktree so
+ # $maindir_gitdir contains our main working "dgit", HEAD, etc.
+ # $maindir_gitcommon the shared stuff, including .objects
rmtree('.git/objects');
- symlink '../../../../objects','.git/objects' or die $!;
+ symlink "$maindir_gitcommon/objects",'.git/objects' or die $!;
ensuredir '.git/info';
open GA, "> .git/info/attributes" or die $!;
print GA "* $negate_harmful_gitattrs\n" or die $!;