server_branch server_ref
stat_exists link_ltarget
hashfile
- fail ensuredir executable_on_path
+ fail ensuredir must_getcwd executable_on_path
waitstatusmsg failedcmd_waitstatus
failedcmd_report_cmd failedcmd
runcmd cmdoutput cmdoutput_errok
shellquote printcmd messagequote
$negate_harmful_gitattrs
changedir git_slurp_config_src
- workarea_setup
- fresh_workarea in_workarea);
+ playtree_setup);
# implicitly uses $main::us
- %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)] );
- @EXPORT_OK = ( qw($wa), @{ $EXPORT_TAGS{policyflags} } );
+ %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)],
+ playground => [qw(record_maindir $maindir $local_git_cfg
+ fresh_playground $playground)]);
+ @EXPORT_OK = ( @{ $EXPORT_TAGS{policyflags} },
+ @{ $EXPORT_TAGS{playground} } );
}
our @EXPORT_OK;
die "mkdir $dir: $!";
}
+sub must_getcwd () {
+ my $d = getcwd();
+ defined $d or fail "getcwd failed: $!";
+ return $d;
+}
+
sub executable_on_path ($) {
my ($program) = @_;
return 1 if $program =~ m{/};
return $r;
}
-sub workarea_setup ($) {
- # for use in the workarea
+# ========== playground handling ==========
+
+# terminology:
+#
+# $maindir user's git working tree
+# $playground area in .git/ where we can make files, unpack, etc. etc.
+# playtree git working tree sharing object store with the user's
+# inside playground, or identical to it
+#
+# other globals
+#
+# $local_git_cfg hash of arrays of values: git config from $maindir
+#
+# expected calling pattern
+#
+# firstly
+#
+# [record_maindir]
+# must be run in directory containing .git
+# assigns to $maindir if not already set
+# also calls git_slurp_config_src to record git config
+# in $local_git_cfg, unless it's already set
+#
+# fresh_playground SUBDIR_PATH_COMPONENTS
+# e.g fresh_playground 'dgit/unpack' ('.git/' is implied)
+# default SUBDIR_PATH_COMPONENTS is $playground_subdir
+# calls record_maindir
+# sets up a new playground (destroying any old one)
+# assigns to $playground and returns the same pathname
+# caller may call multiple times with different subdir paths
+# createing different playgrounds; but $playground global can
+# refer only to one, obv.
+#
+# then can use
+#
+# changedir $playground
+# changedir $maindir
+#
+# playtree_setup $local_git_cfg
+# # ^ call in some (perhaps trivial) subdir of $playground
+#
+# rmtree $playground
+
+# ----- maindir -----
+
+our $maindir;
+our $local_git_cfg;
+
+sub record_maindir () {
+ $maindir //= must_getcwd();
+ $local_git_cfg //= git_slurp_config_src 'local';
+}
+
+# ----- playgrounds -----
+
+our $playground;
+
+sub fresh_playground ($) {
+ my ($spc) = @_;
+ record_maindir();
+ $spc = ".git/$spc";
+ my $parent = dirname $spc;
+ mkdir $parent or $!==EEXIST or fail "failed to mkdir $parent: $!";
+ rmtree $spc;
+ mkdir $spc or die "$spc $!";
+ return $playground = "$maindir/$spc";
+}
+
+# ----- playtrees -----
+
+sub playtree_setup (;$) {
my ($t_local_git_cfg) = @_;
- # should be run in a directory .git/FOO/BAR of a working tree
+ $t_local_git_cfg //= $local_git_cfg;
+ # 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
runcmd qw(git config), $copy, $_ foreach @$v;
}
rmtree('.git/objects');
- symlink '../../../../objects','.git/objects' or die $!;
+ symlink "$maindir/.git/objects",'.git/objects' or die $!;
ensuredir '.git/info';
open GA, "> .git/info/attributes" or die $!;
print GA "* $negate_harmful_gitattrs\n" or die $!;
close GA or die $!;
}
-our $wa;
-our $local_git_cfg;
-
-sub in_workarea ($;$) {
- my $sub = pop @_; # in_workarea [$twa, sub { ... };]
- # default $twa is global $wa (which caller must, in that case, set)
- # $twa should be relative paths of the form .git/FOO/BAR
- my ($twa) = @_;
- $twa //= $wa;
- changedir $twa or die "$twa $!";
- my $r = eval { $sub->($twa); };
- changedir '../../..' or die "$@; $!";
- die $@ if length $@;
- return $r;
-}
-
-sub fresh_workarea (;$) {
- my ($twa) = @_;
- $twa //= $wa;
- $local_git_cfg //= git_slurp_config_src 'local';
- my $parent = dirname $twa;
- mkdir $parent or $!==EEXIST or fail "failed to mkdir $parent: $!";
- rmtree $twa;
- mkdir $twa or die "$twa $!";
- in_workarea sub { workarea_setup $local_git_cfg; };
-}
-
1;