X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=topbloke.git;a=blobdiff_plain;f=tb-create.pl;fp=tb-create.pl;h=831fa101b94eed1e46143135d1cc3122c70217a4;hp=9f883f3b32da2bb0443dee28aab9a3a869a4340d;hb=c0f7fab5983a34c10790e39e7f48b546ca4011f7;hpb=fbdf67103c969969b564342bb7aed61c8c7ed36b diff --git a/tb-create.pl b/tb-create.pl index 9f883f3..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,18 @@ if (!defined $spec->{Date}) { length($spec->{Date})==18 or die "partial date specified, not supported\n"; +chdir_toplevel(); + check_no_unwanted_metadata('HEAD') if $current->{Kind} ne 'tip'; -run_git_check_nooutput('cannot create new topbloke branch with staged files', +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. # @@ -57,62 +63,91 @@ 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(); -my $user_edited_msg = - run_git_test_anyoutput(qw(diff --name-only HEAD -- .topbloke/msg)); +#----- 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', ''); -open GIT, "|-", 'git', qw(update-index --index-info) or die $!; -foreach my $file (qw(msg deps)) { - run_git(qw(update-index --cacheinfo 0644), $notapplicable_sha1, - ".topbloke/$file"); +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 $nm = wf_start('.topbloke/msg'); - my $author = run_git_1line(qw(var GIT_AUTHOR_IDENT)); - $author =~ s/ \d+ [-+]\d+$//; - 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; - } - $subjprefix = git_config('topbloke.subjectprefix', ''); - wf($n, {Nick} +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); - run_git(qw(add .topbloke/msg)); - print " created and staged new .topbloke/msg\n"; -} else { - if (! - print " staged your modified .topbloke/msg\n"; - run_git(qw(add .topbloke/msg)); - } else { - print " left your (partially staged?) .topbloke/msg\n"; - } -} +wf_done($nm); +stage_meta('msg'); -sub meta_and_stage ($$) { - my ($file, $contents) = @_; - wf_contents(".topbloke/$file", $contents); - run_git(qw(add), ".topbloke/$file"); -} +meta_and_stage('deps', "$current->{DepSpec}\n"); +# we inherit empty flags from the base branch -meta_and_stage("deps", $current->{DepSpec}."\n"); -meta_and_stage("flags", ''); +open I, '>>', ".topbloke/included" or die $!; +print I "$newbranch\n"; +close I or die $!; +stage_meta('included'); -if ($current->{Kind} eq 'foreign') { - meta_and_stage('included', $current->{DepSpec}); - +run_git(qw(commit -q -m), "create branch $spec->{Nick}\n$newbranch\n"); + + +INCLUDED IS WRONG MISSING NEWLINE