X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=tb-create.pl;h=3a9afc311112826f9367c2c0e59358937702e995;hb=1a6262c839e4ed26b66cbbeb68910d89be52ac03;hp=591a72e0bb397b4264e073c1986b8c842a1a8a1a;hpb=98c96c9695b93d1ed7cf2ea81d1851364faad0ba;p=topbloke.git diff --git a/tb-create.pl b/tb-create.pl index 591a72e..3a9afc3 100755 --- a/tb-create.pl +++ b/tb-create.pl @@ -1,4 +1,5 @@ #!/usr/bin/perl +# usage: tb-create use warnings; use strict; @@ -10,14 +11,11 @@ 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 $spec = parse_patch_spec($ARGV[0]); +our $current = current_branch(); -die "cannot make branch starting at base of another;". - " check out a real branch\n" if $current->{Kind} eq 'base'; - -die "strange branch ref $current->{Kind} $current->{Ref},\n". - " making new branch with this as dep is unwise\n" +die "strange branch ref $current->{Ref} is of kind $current->{Kind},\n". + " making new patch with this as dep is not supported\n" unless ($current->{Kind} eq 'foreign' || $current->{Kind} eq 'tip'); @@ -39,54 +37,132 @@ if (!defined $spec->{Date}) { chomp $spec->{Date} or die $!; } +defined $spec->{Nick} or die "no patch nickname specified\n"; + length($spec->{Date})==18 or die "partial date specified, not supported\n"; -check_no_unwanted_metadata('HEAD') - if $current->{Kind} ne 'tip'; +chdir_toplevel(); + +run_git_check_nooutput("cannot create new patch with staged file(s)", + qw(diff --cached --name-only HEAD --)); + +run_git_check_nooutput("cannot create new patch 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 we stage it unless -# the cached version differs from the HEAD. +my $newpatch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}"; + +$newpatch = run_git_1line(qw(check-ref-format --print), $newpatch); -my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}"; +my $author = run_git_1line(qw(var GIT_AUTHOR_IDENT)); +$author =~ s/ \d+ [-+]\d+$// or die $!; -$newbranch = run_git_1line(qw(check-ref-format --print), $newbranch); +my $subjprefix = git_config('topbloke.subjectprefix', ''); -printf "creating %s\n", $newbranch; +printf "creating %s\n", $newpatch; setup_config(); -if (!run_git_test_anyoutput(qw(diff --name-only HEAD -- .topbloke/msg)) { - open NM, '>', ".topbloke/msg.tmp" or die $!; - my $author = run_git_1line(qw(var GIT_AUTHOR_IDENT)); - $author =~ s/ \d+ [-+]\d+$//; - print NM "From: $author\n" or die $!; - foreach my $h (qw(To CC BCC)) { - my $estatus; - run_git(\$estatus, sub { print NM "$h: $_" or die $!; }, - qw(config), "topbloke.".lc $h); - die "$h $estatus" unless $estatus==0 || $estatus==256; +#----- subroutines for setup + +sub create_and_switch ($$) { + my ($branchref, $what) = @_; + enable_reflog($branchref); + run_git(qw(update-ref -m), "tb-create $newpatch $what", $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); +} + +sub meta_rm_stage ($) { + my ($file) = @_; + run_git(qw(rm --ignore-unmatch -q --), ".topbloke/$file"); +} + +#----- create the base branch + +if (lstat '.topbloke') { + -d _ or die; +} else { + mkdir('.topbloke') or die "create .topbloke: $!\n"; +} + +my @meta_to_rm; + +if ($current->{Kind} eq 'foreign') { + check_no_metadata('HEAD'); +} else { + foreach_unknown_metadata('HEAD', + sub { push @meta_to_rm, $_ unless m/^\+/; }); +} + +my $baseref = "$baserefs/$newpatch"; +my $currentcommit = run_git_1line(qw(rev-parse), "HEAD"); +create_and_switch($baseref, 'base'); + +meta_rm_stage('msg'); +meta_and_stage('patch', "$newpatch\n"); +meta_rm_stage('base'); +meta_and_stage('deps', "$current->{DepSpec}\n"); +meta_rm_stage('deleted'); +meta_rm_stage($_) foreach @meta_to_rm; + +if ($current->{Kind} eq 'foreign') { + meta_and_stage('+included', ""); + meta_and_stage('+ends', ""); +} else { + # we inherit correct contents for +included + if ($current->{Kind} eq 'tip') { + metafile_process('+ends', undef, sub { + die if m/^\Q$current->{Fullname}\E /; + }, sub { + wf($_->[0], "$current->{Fullname} $currentcommit\n"); + }, undef); + stage_meta('+ends'); } - $subjprefix = git_config('topbloke.subjectprefix', ''); - print NM {Nick} +} + +run_git(qw(commit -q -m), "tb-create $newpatch base"); +my $basecommit = run_git_1line(qw(rev-parse), "$baseref~0"); + +#----- create the tip branch + +my $tipref = "$tiprefs/$newpatch"; +create_and_switch($tipref, 'tip'); + +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 - run_git(qw(add .topbloke/msg)); - print " created and staged new .topbloke/msg\n"; -} else { - if (!run_git_test_anyoutput(qw(diff --cached --name-only HEAD -- - .topblokemsg))) { - 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'); + +meta_and_stage('base', "$basecommit\n"); +meta_rm_stage('deps'); +depsfile_add_dep('+included',$newpatch); +stage_meta('+included'); +run_git(qw(commit -q -m), "tb-create $newpatch tip");