forked from epics_driver_modules/require
270 lines
8.2 KiB
Perl
Executable File
270 lines
8.2 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
|
|
use warnings;
|
|
use strict;
|
|
use 5.010;
|
|
|
|
use File::Glob qw/bsd_glob/;
|
|
use IPC::Open3 qw/open3/;
|
|
use Symbol qw/gensym/;
|
|
|
|
my $version;
|
|
my $tag;
|
|
my $remote;
|
|
my $branch;
|
|
my $commit;
|
|
my $remotetagcommit;
|
|
my $debug = 0;
|
|
|
|
# Check all files in top directory and all files specified explicitly in subdirectories
|
|
my @files = glob("GNUmakefile makefile Makefile *.c *.cc *.cpp *.h *.dbd *.st *.stt *.gt");
|
|
# perl glob keeps non-wildcard names even they don't match, which are removed manually.
|
|
@files = grep(-f, @files);
|
|
my @statusinfo;
|
|
|
|
while (@ARGV) {
|
|
my $arg = shift @ARGV;
|
|
if ($arg eq "-d") {
|
|
$debug = 1;
|
|
} else {
|
|
push @files, $arg;
|
|
}
|
|
}
|
|
# concatenate the files list to one space separatd string
|
|
my $files = join(' ', @files);
|
|
|
|
sub check_output {
|
|
my ($child_stdout, $child_stderr);
|
|
$child_stderr = gensym();
|
|
|
|
chomp(my $command = $_[0]);
|
|
if ($debug) {
|
|
say STDERR "\$ $command";
|
|
}
|
|
|
|
# start the child process capturing stdout and stderr
|
|
my $child_pid = open3(undef, $child_stdout, $child_stderr, $command);
|
|
|
|
# filehandles' bitmask for read
|
|
my $out_set = '';
|
|
vec($out_set, fileno($child_stdout), 1) = 1;
|
|
vec($out_set, fileno($child_stderr), 1) = 1;
|
|
my $num_bits = 2;
|
|
|
|
# output and error from the child process
|
|
my $output = '';
|
|
my $error = '';
|
|
|
|
while ($num_bits and select(my $rout=$out_set, undef, undef, 5)) {
|
|
for my $fh ($child_stdout, $child_stderr) {
|
|
next unless vec($rout, fileno($fh), 1);
|
|
|
|
my $bytes_read = sysread($fh, my $line, 4096);
|
|
if ($bytes_read) {
|
|
if ($fh == $child_stdout) {
|
|
$output .= $line;
|
|
}
|
|
else {
|
|
$error .= $line;
|
|
}
|
|
}
|
|
else {
|
|
|
|
vec($out_set, fileno($fh), 1) = 0;
|
|
$num_bits -= 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
waitpid($child_pid, 0);
|
|
die $error if $?;
|
|
if ($debug) {
|
|
say STDERR $output;
|
|
}
|
|
|
|
return split(/\n/, $output);
|
|
}
|
|
|
|
sub parse_git_output {
|
|
my @output = @{$_[0]};
|
|
|
|
foreach my $line (@output) {
|
|
chomp($line);
|
|
if ($line =~ /^fatal: Not a git repository/) {
|
|
return;
|
|
}
|
|
elsif ($line =~ /^\?\? (.*)/) {
|
|
say STDERR "$1: Not in git => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^ M (.*)/) {
|
|
say STDERR "$1: Locally modified => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^D (.*)/) {
|
|
say STDERR "$1: Deleted (or renamed) but not committed => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^ D (.*)/) {
|
|
say STDERR "$1: Locally deleted => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^A (.*)/) {
|
|
say STDERR "$1: Locally added => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^AM (.*)/) {
|
|
say STDERR "$1: Locally added and modified => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^([ MADRCU][ MADRCU]) (.*)/) {
|
|
say STDERR "$2: $1 (Whatever that means) => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^fatal: No names found/) {
|
|
say STDERR "No tag on this version => version test";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^On branch/) {
|
|
}
|
|
elsif ($line =~ /([0-9a-fA-F]+)[ \t]+refs\/tags\//) {
|
|
$remotetagcommit = $1;
|
|
if ($debug) {
|
|
say STDERR "Remote commit $remotetagcommit";
|
|
}
|
|
}
|
|
elsif ($line =~ /^([0-9]+)\.([0-9]+)(\.([0-9]+))?$/) {
|
|
$tag = $line;
|
|
my $major = $1;
|
|
my $minor = $2;
|
|
my $patch = $4 || "0";
|
|
$version = "$major.$minor.$patch";
|
|
say STDERR "Checking tag $line => version $version";
|
|
}
|
|
elsif ($line =~ /^[a-zA-Z0-9_]*[a-zA-Z]_([0-9]+)_([0-9]+)(_([0-9]+))?$/) {
|
|
$tag = $line;
|
|
my $major = $1;
|
|
my $minor = $2;
|
|
my $patch = $4 || "0";
|
|
$version = "$major.$minor.$patch";
|
|
say STDERR "Checking tag $line => version $version";
|
|
}
|
|
elsif ($line =~ /^(.*[0-9]+[_.][0-9]+([_.][0-9]+)?)-([0-9]+)-g[0-9a-fA-F]+$/) {
|
|
$version = "test";
|
|
my $s = $3 != 1 ? "s" : "";
|
|
say STDERR "Tag $1 is $3 commit$s old => version test";
|
|
}
|
|
elsif ($line =~ /^Your branch is ahead of '(.*)\/(.*)'/) {
|
|
say STDERR "Branch \"$2\" not yet pushed to remote \"$1\" => version test";
|
|
say STDERR "Try: git push --tags $1 $2";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^Your branch and '(.*)\/(.*)' have diverged/) {
|
|
say STDERR "Branch \"$2\" diverged from remote \"$1\" => version test";
|
|
say STDERR "Try to merge or rebase your changes.";
|
|
$version = "test";
|
|
}
|
|
elsif ($line =~ /^Your branch is up to date with '(.*)\/(.*)'/) {
|
|
$remote = $1;
|
|
$branch = $2;
|
|
}
|
|
elsif ($line =~ /^\* [^ ]+ +([0-9a-fA-F]+) \[(.*)\/([^:]*).*\]/) {
|
|
$commit = $1;
|
|
$remote = $2;
|
|
$branch = $3;
|
|
if ($debug) {
|
|
say STDERR "Commit $commit on branch $branch on remote $remote";
|
|
}
|
|
}
|
|
elsif ($debug) {
|
|
say STDERR "unparsed: $line";
|
|
}
|
|
}
|
|
}
|
|
|
|
if ($debug) {
|
|
say STDERR "checking $files";
|
|
}
|
|
|
|
eval {
|
|
# fails if git command exits with error
|
|
@statusinfo = check_output("git status --porcelain $files");
|
|
parse_git_output(\@statusinfo);
|
|
if ($version) {
|
|
say $version;
|
|
exit;
|
|
}
|
|
|
|
@statusinfo = check_output("git describe --tags");
|
|
parse_git_output(\@statusinfo);
|
|
if (!defined($version)) {
|
|
say STDERR "Could not find out version tag => version test";
|
|
$version = "test";
|
|
}
|
|
|
|
if ($version ne "test") {
|
|
@statusinfo = check_output("git branch -vv");
|
|
parse_git_output(\@statusinfo);
|
|
}
|
|
|
|
if ($version ne "test") {
|
|
@statusinfo = check_output("git status");
|
|
parse_git_output(\@statusinfo);
|
|
}
|
|
|
|
if ($debug) {
|
|
if (defined($remote)) {
|
|
say STDERR "remote = $remote";
|
|
} else {
|
|
say STDERR "remote undefined";
|
|
}
|
|
if (defined($tag)) {
|
|
say STDERR "tag = $tag";
|
|
} else {
|
|
say STDERR "tag undefined";
|
|
}
|
|
if (defined($commit)) {
|
|
say STDERR "commit = $commit";
|
|
} else {
|
|
say STDERR "commit undefined";
|
|
}
|
|
if (defined($branch)) {
|
|
say STDERR "branch = $branch";
|
|
} else {
|
|
say STDERR "branch undefined";
|
|
}
|
|
}
|
|
if (defined($remote) && defined($tag) && defined($commit)) {
|
|
my $err = eval {
|
|
@statusinfo = check_output("git ls-remote --tags '$remote' '$tag' '$tag^*'");
|
|
parse_git_output(\@statusinfo);
|
|
if (!$remotetagcommit) {
|
|
say STDERR "Tag $tag not yet pushed to remote \"$remote\" => version test";
|
|
say STDERR "Try: git push --tags $remote $branch";
|
|
$version = "test";
|
|
} else {
|
|
$remotetagcommit = substr($remotetagcommit,0,length($commit));
|
|
if ($remotetagcommit ne $commit) {
|
|
say STDERR "Tag $tag differs from the same tag on remote \"$remote\" => version test";
|
|
say STDERR "It is commit $commit locally but commit $remotetagcommit on $remote.";
|
|
say STDERR "Try a new tag after fixing your $tag tag: git tag --force $tag $remotetagcommit";
|
|
say STDERR "Or overwrite \"$remote\": git push --force --tags $remote $branch";
|
|
$version = "test";
|
|
}
|
|
}
|
|
};
|
|
if ($@) {
|
|
$@ =~ s/\n/\n| /g;
|
|
say STDERR "Cannot check tag $tag on remote \"$remote\":";
|
|
say STDERR "| $@";
|
|
say STDERR "I hope you know what you're doing.";
|
|
}
|
|
}
|
|
|
|
say $version;
|
|
exit;
|
|
};
|
|
|
|
say STDERR "No repository found => version test";
|
|
say "test";
|