X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=tb-create.pl;h=831fa101b94eed1e46143135d1cc3122c70217a4;hp=15b22086c5d7bd9f55e06c74da5590183786e74b;hb=c0f7fab5983a34c10790e39e7f48b546ca4011f7;hpb=3f2fe818215b4c83293645aea47ed879c5ae1f08 diff --git a/tb-create.pl b/tb-create.pl index 15b2208..831fa10 100755 --- a/tb-create.pl +++ b/tb-create.pl @@ -11,7 +11,7 @@ Getopt::Long::Configure(qw(bundling)); die "bad usage\n" unless @ARGV==1; our $spec = parse_branch_spec($ARGV[0]); -our $current = current_tb_branch(); +our $current = current_branch(); die "cannot make branch starting at base of another;". " check out a real branch\n" if $current->{Kind} eq 'base'; @@ -41,12 +41,113 @@ if (!defined $spec->{Date}) { length($spec->{Date})==18 or die "partial date specified, not supported\n"; -fixme check foreign base branch for unwanted topbloke files +chdir_toplevel(); + +check_no_unwanted_metadata('HEAD') + if $current->{Kind} ne 'tip'; + +run_git_check_nooutput("cannot create new topbloke branch with staged file(s)", + qw(diff --cached --name-only HEAD --)); + +run_git_check_nooutput("cannot create new topbloke branch with". + " modified metadata file(s)", + qw(diff --name-only HEAD -- .topbloke)); + +# For the metadata files in .topbloke, we hope that the user +# doesn't modify them. If they do then they get to keep all the pieces. +# +# For .topbloke/msg, if it's modified by the user (ie, if working +# version differs from HEAD) we keep that and stage it. my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}"; $newbranch = run_git_1line(qw(check-ref-format --print), $newbranch); +my $author = run_git_1line(qw(var GIT_AUTHOR_IDENT)); +$author =~ s/ \d+ [-+]\d+$// or die $!; + +my $subjprefix = git_config('topbloke.subjectprefix', ''); + printf "creating %s\n", $newbranch; setup_config(); + +#----- subroutines for setup + +sub create_and_switch ($) { + my ($branchref) = @_; + run_git(qw(update-ref -m), "tb-create base", $branchref, 'HEAD'); + run_git(qw(symbolic-ref HEAD), $branchref); +} + +sub stage_meta ($) { + my ($file) = @_; + run_git(qw(add), ".topbloke/$file"); +} + +sub meta_and_stage ($$) { + my ($file, $contents) = @_; + wf_contents(".topbloke/$file", $contents); + stage_meta($file); +} + +#----- create the base branch + +if (lstat '.topbloke') { + -d _ or die; +} else { + mkdir('.topbloke') or die "create .topbloke: $!\n"; +} + +my $baseref = "refs/topbloke-bases/$newbranch"; +create_and_switch($baseref); + +run_git(qw(update-ref -m), "tb-create base", $baseref, 'HEAD'); +run_git(qw(symbolic-ref HEAD), $baseref); + +meta_and_stage('msg', "# not applicable\n"); +meta_and_stage('deps', "# not applicable\n"); +meta_and_stage('flags', ''); + +if ($current->{Kind} eq 'foreign') { + meta_and_stage('included', $current->{DepSpec}); + meta_and_stage('pflags', ''); +} + +run_git(qw(commit -q -m), "create base branch $spec->{Nick}\n$newbranch\n"); + +#----- create the tip branch + +my $tipref = "refs/topbloke-tips/$newbranch"; +create_and_switch($tipref); + +my $nm = wf_start('.topbloke/msg'); +wf($nm, "From: $author\n"); +foreach my $h (qw(To CC BCC)) { + my $estatus; + run_git(\$estatus, sub { wf($nm, "$h: $_") or die $!; }, + qw(config), "topbloke.".lc $h); + die "$h $estatus" unless $estatus==0 || $estatus==256; +} +wf($nm, <{Nick} + + + +Signed-off-by: $author +END +wf_done($nm); +stage_meta('msg'); + +meta_and_stage('deps', "$current->{DepSpec}\n"); +# we inherit empty flags from the base branch + +open I, '>>', ".topbloke/included" or die $!; +print I "$newbranch\n"; +close I or die $!; +stage_meta('included'); + +run_git(qw(commit -q -m), "create branch $spec->{Nick}\n$newbranch\n"); + + +INCLUDED IS WRONG MISSING NEWLINE