This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Create inversion list for Assigned code points
[perl5.git] / Porting / GitUtils.pm
CommitLineData
ed34cb0d
YO
1#!/usr/bin/perl
2use strict;
3use warnings;
4use POSIX qw(strftime);
5
6use base qw/Exporter/;
7our @EXPORT_OK=qw(iso_time_with_dot gen_dot_patch);
8
9sub 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)
18sub 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) {
67a05ee1 48 $_ ||= "error"; # hmm, we did not get /anything/ from name-rev?
ed34cb0d
YO
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`);
11a59587 56 chomp(my $describe= `git describe $sha1`);
ed34cb0d
YO
57 join(" ", $branch, $tstamp, $sha1, $describe);
58}
59
601;