Porting/GitUtils.pm

   1 #!/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;