tg-create.pl

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use Getopt::Long;
   7 use Topbloke;
   8
   9 Getopt::Long::Configure(qw(bundling));
  10
  11 die "bad usage\n" unless @ARGV==1;
  12
  13 our $spec = parse_branch_spec($ARGV[0]);
  14 our $current = current_tb_branch();
  15
  16 die "cannot make branch starting at base of another;".
  17     " check out a real branch\n" if $current->{Kind} eq 'base';
  18
  19 die "strange branch ref, making new branch with this as dep is unwise\n"
  20     if $current->{Kind} eq 'weird';
  21
  22 sub fillin ($$$) {
  23     my ($key, $newval, $what) = @_;
  24     return if defined $spec->{$key};
  25     $spec->{$key} = $newval;
  26 }
  27
  28 if (!defined $spec->{Email} || !defined $spec->{Domain}) {
  29     my $eaddr = run_git_1line(qw(config user.email));
  30     $eaddr =~ m/^(.*)\@/ or die "$eaddr ?";
  31     fillin('Email',$1,'email domain');
  32     fillin('Domain',$','email domain'); #');
  33 }
  34
  35 if (!defined $spec->{Date}) {
  36     $spec->{Date} = `LC_TIME=C date -u +%Y-%m-%dT%H%M%SZ`;
  37     chomp $spec->{Date} or die $!;
  38 }
  39
  40 length($spec->{Date})==18 or die "partial date specified, not supported\n";
  41
  42 my $newbranch = "$spec->{Email}\@$spec->{Domain}/$spec->{Date}/$spec->{Nick}";
  43
  44 $newbranch = run_git_1line(qw(check-ref-format --print), $newbranch);
  45
  46 printf "creating %s\n", $newbranch;