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