9 Getopt::Long::Configure(qw(bundling));
11 die "bad usage\n" unless @ARGV==1;
13 our $spec = parse_branch_spec($ARGV[0]);
14 our $current = current_tb_branch();
16 die "cannot make branch starting at base of another;".
17 " check out a real branch\n" if $current->{Kind} eq 'base';
19 die "strange branch ref $current->{Kind} $current->{Ref},\n".
20 " making new branch with this as dep is unwise\n"
21 unless ($current->{Kind} eq 'foreign' ||
22 $current->{Kind} eq 'tip');
25 my ($key, $newval, $what) = @_;
26 return if defined $spec->{$key};
27 $spec->{$key} = $newval;
30 if (!defined $spec->{Email} || !defined $spec->{Domain}) {
31 my $eaddr = run_git_1line(qw(config user.email));
32 $eaddr =~ m/^(.*)\@/ or die "$eaddr ?";
33 fillin('Email',$1,'email domain');
34 fillin('Domain',$','email domain'); #');
37 if (!defined $spec->{Date}) {
38 $spec->{Date} = `LC_TIME=C date -u +%Y-%m-%dT%H%M%SZ`;
39 chomp $spec->{Date} or die $!;
42 length($spec->{Date})==18 or die "partial date specified, not supported\n";
44 check_no_unwanted_metadata('HEAD')
45 if $current->{Kind} ne 'tip';
47 # For the metadata files in .topbloke, we hope that the user
48 # doesn't modify them. If they do then they get to keep all the pieces.
50 # For .topbloke/msg, if it's modified by the user (ie, if working
51 # version differs from HEAD) we keep that, and we stage it unless
52 # the cached version differs from the HEAD.
54 my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}";
56 $newbranch = run_git_1line(qw(check-ref-format --print), $newbranch);
58 printf "creating %s\n", $newbranch;
62 run_git__anyoutput(qw(diff --cached --name-only HEAD --
64 if (!run_git_test_anyoutput(qw(diff --name-only HEAD -- .topbloke/msg)) {
65 my $nm = wf_start('.topbloke/msg');
66 my $author = run_git_1line(qw(var GIT_AUTHOR_IDENT));
67 $author =~ s/ \d+ [-+]\d+$//;
68 wf($nm, "From: $author\n");
69 foreach my $h (qw(To CC BCC)) {
71 run_git(\$estatus, sub { wf($nm, "$h: $_") or die $!; },
72 qw(config), "topbloke.".lc $h);
73 die "$h $estatus" unless $estatus==0 || $estatus==256;
75 $subjprefix = git_config('topbloke.subjectprefix', '');
76 wf($n, <END) or die $!;
77 Subject: [${subprefix}PATCH] $spec->{Nick}
81 Signed-off-by: $author
84 run_git(qw(add .topbloke/msg));
85 print " created and staged new .topbloke/msg\n";
88 print " staged your modified .topbloke/msg\n";
89 run_git(qw(add .topbloke/msg));
91 print " left your (partially staged?) .topbloke/msg\n";
95 sub meta_and_stage ($$) {
96 my ($file, $contents) = @_;
97 wf_contents(".topbloke/$file", $contents);
98 run_git(qw(add), ".topbloke/$file");
101 meta_and_stage("deps", $current->{DepSpec}."\n");
102 meta_and_stage("flags", '');
104 if ($current->{Kind} eq 'foreign') {
105 meta_and_stage('included', $current->{DepSpec});