| 1 |
laffer1 |
3783 |
#!/usr/bin/perl |
| 2 |
|
|
use strict; |
| 3 |
|
|
use warnings; |
| 4 |
|
|
use POSIX qw(strftime); |
| 5 |
|
|
|
| 6 |
|
|
use base qw/Exporter/; |
| 7 |
|
|
our @EXPORT_OK=qw(iso_time_with_dot gen_dot_patch); |
| 8 |
|
|
|
| 9 |
|
|
sub iso_time_with_dot { |
| 10 |
|
|
strftime "%Y-%m-%d.%H:%M:%S",gmtime(shift||time) |
| 11 |
|
|
} |
| 12 |
|
|
|
| 13 |
|
|
# generate the contents of a .patch file for an arbitrary commitish, or for HEAD if none is supplied |
| 14 |
|
|
# assumes the CWD is inside of a perl git repository. If the repository is bare then refs/heads/* |
| 15 |
|
|
# is used to determine the branch. If the repository is not bare then refs/remotes/origin/* is used |
| 16 |
|
|
# to determine the branch. (The assumption being that if its bare then this is running inside of |
| 17 |
|
|
# the master git repo - if its not bare then it is a checkout which may not have all the branches) |
| 18 |
|
|
sub gen_dot_patch { |
| 19 |
|
|
my $target= shift || 'HEAD'; |
| 20 |
|
|
chomp(my ($git_dir, $is_bare, $sha1)=`git rev-parse --git-dir --is-bare-repository $target`); |
| 21 |
|
|
die "Not in a git repository!" if !$git_dir; |
| 22 |
|
|
$is_bare= "" if $is_bare and $is_bare eq 'false'; |
| 23 |
|
|
|
| 24 |
|
|
# which branches to scan - the order here is important, the first hit we find we use |
| 25 |
|
|
# so if two branches can both reach a ref we want the right one first. |
| 26 |
|
|
my @branches=( |
| 27 |
|
|
'blead', |
| 28 |
|
|
'maint-5.10', |
| 29 |
|
|
'maint-5.8', |
| 30 |
|
|
'maint-5.8-dor', |
| 31 |
|
|
'maint-5.6', |
| 32 |
|
|
'maint-5.005', |
| 33 |
|
|
'maint-5.004', |
| 34 |
|
|
# and more generalized searches... |
| 35 |
|
|
'refs/heads/*', |
| 36 |
|
|
'refs/remotes/*', |
| 37 |
|
|
'refs/*', |
| 38 |
|
|
); |
| 39 |
|
|
my $reftype= $is_bare ? "heads" : "remotes/origin"; |
| 40 |
|
|
my $branch; |
| 41 |
|
|
foreach my $name (@branches) { |
| 42 |
|
|
my $refs= $name=~m!^refs/! ? $name : "refs/$reftype/$name"; |
| 43 |
|
|
my $cmd= "git name-rev --name-only --refs=$refs $sha1"; |
| 44 |
|
|
chomp($branch= `$cmd`); |
| 45 |
|
|
last if $branch ne 'undefined'; |
| 46 |
|
|
} |
| 47 |
|
|
for ($branch) { |
| 48 |
|
|
$_ ||= "error"; # hmm, we didnt get /anything/ from name-rev? |
| 49 |
|
|
s!^\Q$reftype\E/!! || # strip off the reftype |
| 50 |
|
|
s!^refs/heads/!! || # possible other places it was found |
| 51 |
|
|
s!^refs/remotes/!! || # ... |
| 52 |
|
|
s!^refs/!!; # might even be a tag or something weirdo... |
| 53 |
|
|
s![~^].*\z!!; # strip off how far we are from the item |
| 54 |
|
|
} |
| 55 |
|
|
my $tstamp= iso_time_with_dot(`git log -1 --pretty="format:%ct" $sha1`); |
| 56 |
|
|
chomp(my $describe= `git describe $sha1`); |
| 57 |
|
|
join(" ", $branch, $tstamp, $sha1, $describe); |
| 58 |
|
|
} |
| 59 |
|
|
|
| 60 |
|
|
1; |
