From c0f7fab5983a34c10790e39e7f48b546ca4011f7 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 22 Jan 2012 17:32:06 +0000 Subject: [PATCH] wip tb-create --- FORMAT | 7 ++- Topbloke.pm | 44 +++++++++++++------ tb-create.pl | 119 +++++++++++++++++++++++++++++++++------------------ 3 files changed, 112 insertions(+), 58 deletions(-) diff --git a/FORMAT b/FORMAT index 447a3fb..ece1976 100644 --- a/FORMAT +++ b/FORMAT @@ -8,20 +8,23 @@ Topbloke branch is: In-tree, there are metadata files in .topbloke Files which are per-branch and do not inherit any contents - or changes from dependencies: + or changes from bases or dependencies: msg brach "commit message" + ("# not applicable" in bases) deps direct dependencies, one per line as either: topbloke branch name /refs/heads/ + ("# not applicable" in bases) flags flags that apply to this branch, one per line + base has its own, perhaps different, set of flags; Unknown flags starting with [a-z] are ok; otherwise fatal. Currently defined flags: Deleted branch is deleted - + (valid on branch only) Files which not inherit contents and changes from dependencies: diff --git a/Topbloke.pm b/Topbloke.pm index 4815b55..b1303e1 100644 --- a/Topbloke.pm +++ b/Topbloke.pm @@ -14,8 +14,13 @@ BEGIN { $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(parse_branch_spec current_tb_branch run_git_1line - setup_config check_no_unwanted_metadata); + @EXPORT = qw(debug + run_git run_git_1line run_git_check_nooutput + run_git_test_anyoutput + git_config git_dir chdir_toplevel + current_branch parse_branch_spec + setup_config check_no_unwanted_metadata + wf_start wf wf_abort wf_done wf_contents); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); } @@ -103,7 +108,15 @@ sub git_dir () { return $git_dir; } -sub current_tb_branch () { +sub chdir_toplevel () { + my $toplevel; + run_git(sub { $toplevel = $_; }, + qw(rev-parse --show-toplevel)); + die "not in working tree?\n" unless defined $toplevel; + chdir $toplevel or die "chdir toplevel $toplevel: $!\n"; +} + +sub current_branch () { open R, git_dir().'/HEAD' or die "open HEAD $!"; my $ref = ; defined $ref or die $!; close R; @@ -176,7 +189,7 @@ sub parse_branch_spec ($) { } } if (defined $rel_levels) { - my $branch = current_tb_branch(); + my $branch = current_branch(); if (!defined $branch->{Nick}) { die "relative branch spec \`$orig',". " but current branch not a topbloke branch\n"; @@ -196,9 +209,10 @@ sub setup_config () { foreach my $iteration (qw(0 1)) { foreach my $file (@files) { my $cfgname = "merge.topbloke-$file"; - my $current_estatus; - my $current = run_git_1line(\$current_estatus, - qw(config), "$cfgname.driver"); + my ($current, $current_estatus); + run_git(\$current_estatus, + sub { $current = $_; }, + qw(config), "$cfgname.driver"); $current = "## failed $current_estatus" if $current_estatus; next if $current =~ m/^topbloke-merge-driver --v$version /o; die "$file $current ?" if $iteration; @@ -252,26 +266,28 @@ sub check_no_unwanted_metadata ($) { sub wf_start ($) { my ($path) = @_; - my $fh = new IO::File '>', "$path.tmp" or die "$path.tmp: $!"; - $writing{$fh} = $path; + my $fh = new IO::File "$path.tmp", '>' or die "create $path.tmp: $!\n"; return [ $fh, $path ]; } sub wf ($$) { my ($wf, $data) = @_; - print $wf->[0] $data or die "$wf->[1]: $!"; + my ($fh, $path) = @$wf; + print $fh $data or die "write $path.tmp: $!\n"; } sub wf_abort ($) { my ($wf) = @_; - close $wf->[0]; - unlink $wf->[1] or die "$wf->[1]: $!"; + my ($fh, $path) = @$wf; + close $fh; + unlink "$path.tmp" or die "remove $path.tmp: $!\n"; } sub wf_done ($) { my ($wf) = @_; - close $wf->[0] or die "$wf->[1]: $!"; - rename $wf->[1].'.tmp', $wf->[1] or die "$wf->[1]: $!"; + my ($fh, $path) = @$wf; + close $fh or die "finish writing $path.tmp: $!\n"; + rename "$path.tmp", $path or die "install new $path: $!\n"; } sub wf_contents ($$) { 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 -- 2.30.2