Minor improvement in gitinfo.h production

* Makefile.am: Minor change. * include/mailutils/Makefile.am (gitinfo.h): Build only if $(srcdir) and $(builddir) are the same. * mu-aux/gitinfo.pl: Rename to mu-aux/gitinfo * configure.ac (GITINFO): Reflect this change * mu-aux/Makefile.am: Likewise.
author: Sergey Poznyakoff <gray@gnu.org> 2017-04-05 21:09:55 +0300
committer: Sergey Poznyakoff <gray@gnu.org> 2017-04-06 07:33:36 +0300
commit: 9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f (patch)
tree: 2f5a4080e156c4080497ed01774398f3a6989188 /mu-aux/gitinfo
parent: 612f9a557fc97f23711e3c6c55f3e601ac4ac32d (diff)
download: mailutils-9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f.tar.gz
mailutils-9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f.tar.bz2
1 files changed, 524 insertions, 0 deletions
diff --git a/mu-aux/gitinfo b/mu-aux/gitinfo
new file mode 100755
index 000000000..a932f2a66
--- /dev/null
+++ b/mu-aux/gitinfo
@@ -0,0 +1,524 @@
+eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"'
+  & eval 'exec perl -wS "$0" $argv:q'
+    if 0;
+
+# This file is part of GNU Mailutils.
+# Copyright (C) 2017 Free Software Foundation, Inc.
+#
+# GNU Mailutils is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 3, or (at
+# your option) any later version.
+#
+# GNU Mailutils is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Mailutils.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use Getopt::Long qw(:config gnu_getopt no_ignore_case);
+use Pod::Usage;
+use Pod::Man;
+use Pod::Find qw(pod_where);
+
+=head1 NAME
+
+gitinfo.pl - build version tag for mailutils
+
+=head1 SYNOPSIS
+
+B<perl gitinfo.pl>
+[B<-C> I<DIR>]
+[B<-H> I<FORMAT>]    
+[B<-o> I<FILE>]
+[B<-r> B<recent> | B<released> | B<stable>]    
+[B<--directory=>I<DIR>]
+[B<--format=>I<FORMAT>]    
+[B<--output=>I<FILE>]
+[B<--reference=>B<recent> | B<released> | B<stable>]    
+
+B<perl gitinfo.pl> B<-h> | B<--help> | B<--usage>
+
+=head1 DESCRIPTION
+
+Outputs Git information for the version of GNU mailutils in
+the local source tree.  The information is printed according to
+the supplied I<FORMAT>.  The format is an arbitrary string, containing
+variable references in the form B<$I<VARIABLE>> or B<${I<VARIABLE>}>.
+If the variable reference occurs within a quoted string, any occurrences
+of double quotes and backslashes in the expansion will be escaped by
+backslashes.
+    
+The following variables are defined:
+
+=over 4
+
+=item B<package_name>
+
+Package name, obtained from the B<AC_INIT> line in F<configure.ac>.
+    
+=item B<package_version>
+
+Package version, from the same source.    
+
+=item B<recent_version>
+
+Most recent version as listed in the B<NEWS> file.
+    
+=item B<recent_date>
+
+Date when the most recent version was released (if it was).
+
+=item B<recent_commit>
+
+Hash of the commit corresponding to the resent version.    
+    
+=item B<recent_distance>
+
+Distance (number of commits) between B<recent_commit> and B<HEAD>.    
+    
+=item B<released_version>
+
+The most recent released version as per B<NEWS> file.
+
+=item B<released_date>
+
+Date when it was released.    
+
+=item B<released_commit>
+
+Hash of the commit corresponding to B<released_version>.    
+    
+=item B<released_distance>
+
+Distance (number of commits) between B<released_commit> and B<HEAD>.    
+    
+=item B<stable_version>
+
+The most recent stable version, i.e. most recently released version
+which number doesn't have patchlevel part.  Most often is the same
+as B<released_version>.    
+    
+=item B<stable_date>
+
+Date of the stable release.    
+
+=item B<stable_commit>
+    
+Hash of the commit corresponding to B<stable_version>.
+    
+=item B<stable_distance>
+
+Distance between B<stable_commit> and B<HEAD>.
+    
+=item B<refversion>
+
+Reference version, selected by the B<--reference> command line option.
+By default, it is the same as B<recent_version> above. 
+
+=item B<refdate>
+
+Date when B<refversion> was released.  May be absent, if the reference
+version was never released.    
+    
+=item B<refcommit>
+
+Hash of the commit corresponding to the B<refversion>.
+    
+=item B<refdist>
+
+Number of commits between B<refcommit> and B<HEAD>.    
+
+=item B<describe>
+
+Result of the B<git describe> command.
+
+=item B<dirty>
+
+If the source tree has uncommitted modifications, this variable is set
+to 1.  Otherwise, it is undefined.
+
+=item B<commit_hash>
+
+The hash of the topmost commit.    
+
+=item B<commit_time>
+
+Time of the topmost commit (UNIX timestamp).    
+
+=item B<commit_subject>    
+
+Subject of the topmost commit.
+    
+=back    
+
+The construct
+
+B<{?I<EXPR>??I<REPL-IF-TRUE>>[B<?|I<REPL-IF-FALSE>>]B<?}>
+
+within a format string provides a rudimental control flow facility.  The
+I<EXPR> is evaluated as a Perl expression in an environment when the variales
+disucussed above are defined.  If the result is true (in Perl sense), the     
+construct expands to I<REPL-IF-TRUE>.  Othervise, it expands to
+I<REPL-IF-FALSE> or, if it is not defined, to the empty string.
+
+Notice, that conditional expressions cannot be nested.
+    
+In addition to the format strings, the argument to the B<--format> option
+can be any of the following predefined format names:
+
+=over 4
+
+=item B<h>
+
+=item B<c>
+
+Produces a set of B<C> defines.  It is equivalent to the following multi-line
+format:
+
+    #define MU_GIT_COMMIT_HASH "$commit_hash"
+    #define MU_GIT_COMMIT_TIME "$commit_time"
+    #define MU_GIT_COMMIT_SUBJECT "$commit_subject"
+    {?$refdist>0??#define MU_GIT_COMMIT_DISTANCE $refdist
+    ?}#define MU_GIT_DESCRIBE_STRING "$describe{?$dirty??-dirty?}"
+
+=item B<all>
+
+This is the default format.  It outputs all variables as B<I<NAME>="I<VALUE>">
+pairs, each pair on a separate line.  Occurrences of B<"> and B<\> within
+values are escaped by additional backslashes.
+    
+=back    
+    
+=head1 OPTIONS
+
+=over 4
+
+=item B<-C>, B<--directory=>I<DIR>
+
+Use I<DIR> as the top-level source directory.  By default it is determined
+automatically, which works for as long as B<gitinfo.pl> is run from a
+subdirectory of the git-controlled working tree.
+
+=item B<-H>, B<--format>=I<FORMAT>
+
+Select output format.  See B<DESCRIPTION> for the details.    
+
+=item B<-o>, B<--output=>I<FILE>
+
+Output results to the I<FILE>, instead of the standard output.    
+    
+=item B<-r>, B<--reference=>I<VERSION>
+
+Select the reference version.  Argument is one of: B<recent> (the default),
+B<released>, or B<stable>.
+    
+=item B<-h>
+
+Display short help summary.
+
+=item B<--help>
+
+Display the manpage.
+
+=item B<--usage>
+
+Display command line usage summary.
+
+=back
+
+=cut
+
+# find_commit(VERSION)
+# Finds commit corresponding to the version number VERSION.
+sub find_commit($) {
+    my $v = quotemeta(shift);
+    my $cmd = q{git log -S'^AC_INIT\(\[[^]]+\][[:space:]]*,[[:space:]]*\[}
+	      . $v
+	      . q{\]' --pickaxe-regex --reverse --pretty=format:%H -- configure.ac};
+    open(my $fd, '-|', $cmd)
+	or die "$cmd: $!";
+    my $s = <$fd>;
+    close $fd;
+    chomp $s;
+    return $s;
+}
+
+# find_count(VERSION)
+# Returns number of commits between VERSION and the current commit.
+sub find_count($) {
+    my $v = shift;
+    my $cmd = "git rev-list --count $v..HEAD";
+    open(my $fd, '-|', $cmd) or die "$cmd: $!";
+    my $s = <$fd>;
+    close $fd;
+    chomp $s;
+    return $s;
+}
+
+sub scan_news($) {
+    my ($hashref) = @_;
+    my $file = 'NEWS';
+    open(my $fd, '<', $file) or die "can't open $file: $!";
+    while (<$fd>) {
+	chomp;
+	if (/^(?:\*[[:space:]]+)?
+	      [vV]ersion [[:space:]]+
+	      ([[:digit:]](?:[.,][[:digit:]]+){1,2}(?:[[:digit:]._-])*)
+	      (?:(?:.*)[[:punct:]][[:space:]]*
+	      ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}))?/x) {
+	    my ($ver, $date) = ($1, $2);
+	    unless (exists($hashref->{recent_version})) {
+		$hashref->{recent_version} = $ver;
+		$hashref->{recent_date} = $date if $date;
+	    }
+	    if ($date) {
+		if (!exists($hashref->{released_version})) {
+		    $hashref->{released_version} = $ver;
+		    $hashref->{released_date} = $date;
+		}
+		if ($ver =~ /^\d+\.\d+$/) {
+		    $hashref->{stable_version} = $ver;
+		    $hashref->{stable_date} = $date;
+		    last;
+		}
+	    }
+	}
+    }
+    close $fd;
+}
+
+# this_version()
+# Returns a list (package, version).
+sub this_version() {
+    my $file = 'configure.ac';
+    open(my $fd, '<', $file) or die "can't open $file: $!";
+    while (<$fd>) {
+	chomp;
+	return ($1, $2) if (/^AC_INIT\(\[(.+?)\]\s*,\s*\[(.+?)\].*/);
+    }
+}
+
+# git_describe($HASHREF)
+# Define 'describe' and 'dirty' keys in $HASHREF
+sub git_describe($) {
+    my ($href) = @_;
+    my $descr = `git describe`;
+    chomp $descr;
+    $href->{describe} = $descr;
+    if (`git diff-index --name-only HEAD 2>/dev/null`) {
+	$href->{dirty} = 1;
+    }
+    return $descr;
+}
+
+# last_commit_info($HASHREF)
+# Populates %$HASHREF with entries describing the current commit.
+sub last_commit_info {
+    my ($hashref) = @_;
+    my @names = qw(commit_hash commit_time commit_subject);
+    open(my $fd,'-|',
+	 "git log --max-count=1 --pretty=format:'%H%n%ai%n%s' HEAD")
+	or die;
+    while (<$fd>) {
+	chomp;
+	my $name = shift @names;
+	last unless $name;
+	$hashref->{$name} = $_;
+    }
+    close $fd;
+}
+
+# Convert POD markup to the usage message suitable for --help and --usage
+# output.
+sub pod_usage_msg() {
+    my %args;
+    open my $fd, '>', \my $msg;
+
+    $args{-input} = pod_where({-inc => 1}, __PACKAGE__);
+    pod2usage(-verbose => 99,
+	      -sections => 'NAME',
+	      -output => $fd,
+	      -exitval => 'NOEXIT',
+	      %args);
+    my @a = split /\n/, $msg;
+    $msg = $a[1];
+    $msg =~ s/^\s+//;
+    $msg =~ s/ - /: /;
+    return $msg;
+}
+
+my %gitinfo;
+
+sub eval_format {
+    my ($format) = @_;
+    my @res;
+    while ($format) {
+	if ($format =~ /^(?<pfx>.*?)"(?<sfx>.*)$/s) {
+	    push @res, eval_format($+{pfx});
+	    my $acc;
+	    $format = $+{sfx};
+	    my $s = $format;
+	    while ($s) {
+		if ($s =~ /^([^\\"]*?)\\"(.*)$/s) {
+		    $acc .= $1 . '"';
+		    $s = $2;
+		} elsif ($s =~ /^(.*?)"(.*)$/s) {
+		    $acc .= $1;
+		    $format = $2;
+		    last;
+		} else {
+		    $acc = undef;
+		    last;
+		}
+	    }
+	    if (defined($acc)) {
+		my $x = eval_format($acc);
+		$x =~ s/(["\\])/\\$1/g;
+		push @res, '"', $x, '"';
+	    }
+	} elsif ($format =~ /^(?<pfx>.*?)
+                             \{\?
+                             (?<cond>.+?)
+                             \?\?
+                             (?<iftrue>.+?)
+                             (?:\?\|(?<iffalse>.*?))?
+                             \?\}(?<sfx>.*)$/sx) {
+	    
+	    my ($pfx, $cond, $iftrue, $iffalse, $sfx) =
+		($+{pfx}, $+{cond}, $+{iftrue}, $+{iffalse}, $+{sfx});
+
+	    use Safe;
+	    my $s = new Safe;
+	    while (my ($k,$v) = each %gitinfo) {
+		${$s->varglob($k)} = $v;
+	    }
+	    my $x = $s->reval($cond);
+	    push @res, eval_format($pfx);
+	    if ($x) {
+		push @res, eval_format($iftrue);
+	    } else {
+		push @res, eval_format($iffalse);
+	    }
+	    $format = $sfx;
+	} elsif ($format =~ /^(?<pfx>.*?)
+                        \$(?<ocb>{?)
+                        (?<var>[a-zA-Z_][a-zA-Z_0-9]*)
+                        (?<ccb>}?)
+                        (?<sfx>.*)$/sx) {
+	    my ($pfx, $ocb, $var, $ccb, $sfx) =
+		($+{pfx}, $+{ocb}, $+{var}, $+{ccb}, $+{sfx});
+	    if ("$ocb$ccb" =~ /^(?:{})?$/) {
+		push @res, $pfx;
+		my $val = $gitinfo{$var} if defined $gitinfo{$var};
+		#$val =~ s/(["\\])/\\$1/g if $odq;
+		push @res, $val;
+		$format = $sfx;
+	    } else {
+		last;
+	    }
+	} else {
+	    last;
+	}
+    }
+
+    push @res, $format if $format;
+
+    return join('', @res);
+}
+
+my $refpoint = 'recent';
+my $output;
+my $format = 'all';
+
+my %fmtab = (
+    c => <<'EOT'
+#define MU_GIT_COMMIT_HASH "$commit_hash"
+#define MU_GIT_COMMIT_TIME "$commit_time"
+#define MU_GIT_COMMIT_SUBJECT "$commit_subject"
+{?$refdist>0??#define MU_GIT_COMMIT_DISTANCE $refdist
+?}#define MU_GIT_DESCRIBE_STRING "$describe{?$dirty??-dirty?}"
+EOT
+    ,
+    'h' => 'c',
+    'all' => sub {
+	foreach my $name (sort keys %gitinfo) {
+	    my $val = $gitinfo{$name};
+	    next unless defined $val;
+	    $val =~ s/(["\\])/\\$1/g;
+	    print "$name=\"$val\"\n";
+	}
+    }
+);
+
+my $dir;
+
+GetOptions("help" => sub {
+	      pod2usage(-exitstatus => 0, -verbose => 2);
+	   },
+	   "h" => sub {
+	      pod2usage(-message => pod_usage_msg(),
+			-exitstatus => 0);
+	   },
+	   "usage" => sub {
+	      pod2usage(-exitstatus => 0, -verbose => 0);
+	   },
+	   "directory|C=s" => \$dir,
+	   "reference|r=s" => \$refpoint,
+	   "format|H=s" => \$format,
+	   "output|o=s" => \$output
+    ) or exit(1);
+
+if ($output) {
+    open(STDOUT, '>', $output) or die "can't open $output: $!"
+}
+
+if ($dir) {
+    chdir($dir) or die "can't change to $dir: $!";
+} elsif (! -d '.git') {
+    $dir = `git rev-parse --show-toplevel 2>/dev/null`;
+    chomp $dir;
+    chdir($dir) or die "can't change to $dir: $!";
+}
+
+if (-d '.git') {
+    scan_news(\%gitinfo);
+    foreach my $pfx (qw(ref recent_ stable_ released_)) {
+	my $name = $pfx . 'version';
+	if (exists($gitinfo{$name})) {
+	    my $com = $gitinfo{$pfx . 'commit'} = find_commit($gitinfo{$name});
+	    my $n = find_count($com);
+	    if ($n =~ /^\d+$/) {
+		$gitinfo{$pfx . 'dist'} = $n;
+	    }
+	}
+    }
+
+    unless (exists($gitinfo{$refpoint . '_version'})) {
+	die "reference point '$refpoint' doesn't exist";
+    }
+
+    @gitinfo{qw(refversion refdate refcommit refdist)} =
+        @gitinfo{map { "${refpoint}_$_" } qw(version date commit dist)};
+
+    last_commit_info(\%gitinfo);
+    git_describe(\%gitinfo);
+    ($gitinfo{package_name}, $gitinfo{package_version}) = this_version;
+    if ($gitinfo{recent_version} =~ /^\d+\.\d+$/) {
+	$gitinfo{upload_dest} = 'ftp';
+    } else {
+	$gitinfo{upload_dest} = 'alpha';
+    }
+}
+
+$format = $fmtab{$format} while exists $fmtab{$format};
+if (ref($format) eq 'CODE') {
+    &{$format}
+} else {
+    $format = "$format\n" unless $format =~ /\n$/s;
+    print eval_format($format);
+}
+
author	Sergey Poznyakoff <gray@gnu.org>	2017-04-05 21:09:55 +0300
committer	Sergey Poznyakoff <gray@gnu.org>	2017-04-06 07:33:36 +0300
commit	9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f (patch)
tree	2f5a4080e156c4080497ed01774398f3a6989188 /mu-aux/gitinfo
parent	612f9a557fc97f23711e3c6c55f3e601ac4ac32d (diff)
download	mailutils-9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f.tar.gz mailutils-9c6c1cd005bb037c40f3e1a2f0ce1492a70ec33f.tar.bz2