fradrive/utils/version.pl

639 lines
17 KiB
Perl
Executable File

#!/usr/bin/env perl
use strict;
use warnings;
use Data::Dumper;
# Version changes:
# [x].[y].[z] -- Main version number
# XXX old
# [x].[y].[z]-test-[branchstring]-[num] -- test/branch/devel version number
# XXX new
# [x].[y].[z]-[num]+[branchname]
# on main/master: Biggest version so far, increment by occuring changes
# on other branches: find version; be it branch string, old format or main version number;
# increments from there. Increment version number, but on global conflict use new version number
# Actions and their results
# chore -> +patch
# feat -> +minor
# fix -> +patch
# [a-z]+! -> +major
# perf -> +patch
# refactor -> +patch
# test -> +patch
# style -> +patch
# revert -> =
# docs -> +patch
# build -> =
# ci -> =
# parameters with default values
my %par = ();
my %parKinds = (
vcslog=>{
arity=>1,
def=>'git log --pretty=tformat:"%H :::: %d :::: %s"',
help=>'set command which outputs the log information to be used; reads from STDIN if value is set to "-"',
},
vcstags=>{
arity=>1,
def=>'git tag',
help=>'set command which outputs the used tags',
},
vcsbranch=>{
arity=>1,
def=>'git rev-parse --abbrev-ref HEAD',
help=>'set command to find out the current branch name',
},
kind=>{
arity=>1,
def=>'v',
help=>'set tag kind of version numbers; this option resets autokind to "". Implemented kinds: v: main version; t: test version',
auto=>sub { $par{autokind}='' },
},
autokind=>{
arity=>1,
def=>'release/prod=v,release/*=t,*=t',
help=>'determine the tag kind from branch name instead of fixed value; use the first fitting glob',
},
change=>{
arity=>1,
def=>'chore=patch,feat=minor,feature=minor,fix=patch,BREAK=major,perf=patch,refactor=patch,test=patch,style=patch,revert=patch,docs=patch,build=patch,ci=patch',
help=>'how to react on which commit type; can be partially given. Actions are: "null", "major", "minor", "patch" or state "invalid" for removing this type',
},
changelog=>{
arity=>1,
def=>'',
help=>'File to add the changelog to; no changelog is written if this parameter is empty.'
},
changelogout=>{
arity=>1,
def=>'',
help=>'Use this file name to write the changelog to, but use "changelog" to read the old changelog. If not set for both versions the parameter changelog is used.',
},
autovcsurl=>{
arity=>1,
def=>q#git ls-remote --get-url origin | sed 's/[^@]*@\([^:]*\):\(.*\)\.git$/https:\/\/\1\/\2/'#,
help=>'Automated computation for vcsurl. If both values are set then vcsurl is used."',
},
vcsurl=>{
arity=>1,
def=>'',
help=>'Repository URL for changelog; for example "https://gitlab.example.doc/proj/proj/"',
},
v=>{def=>0,arity=>0,help=>'verbose'},
h=>{def=>0,arity=>0,help=>'help'},
);
for my $k(keys %parKinds) {
$par{$k} = $parKinds{$k}{def}
}
#for my $p(@ARGV) {
#
#}
{
my $i = 0;
while($i<@ARGV) {
if($ARGV[$i]=~m#^-(.*)#) {
my $key = $1;
if(not exists $parKinds{$key}) {
die "$0: Unknown parameter: -$key\n";
}
my $pk = $parKinds{$key};
die "$0: Too few parameters for '-$key'\n" if $i+$pk->{arity}>@ARGV;
my @par = @ARGV[$i+1..$i+$pk->{arity}];
#warn "<< @par >>";
$i++;
$i += $pk->{arity};
if($pk->{arity}) {
$par{$key} = $par[0]
} else {
$par{$key}=1
}
if(exists $pk->{auto}) {
$pk->{auto}->()
}
} else {
die "$0: Bad parameter: $ARGV[$i]\n"
}
}
}
if($par{'h'}) {
print "Usage: $0 [flags and options]\n\nAvailable options:\n";
for my $k(sort keys %parKinds) {
print " -$k\n $parKinds{$k}{help}\n";
if($parKinds{$k}{arity}) {
print " Default value: $parKinds{$k}{def}\n";
} else {
print " This is a flag and not an option\n";
}
print "\n";
}
exit 0
}
my $branchNameEscaped = `$par{vcsbranch}`;
chomp $branchNameEscaped;
if($par{autokind}) {
my $branch = $branchNameEscaped;
my @rules = split /,/, $par{autokind};
RULES: {
for my $r(@rules) {
warn "$0: Processing autokind rule '$r'\n" if $par{v};
if($r!~m#(.*)=(.*)#) {
die "$0: Bad rule in autokind: $r\n";
}
my ($glob, $kind) = ($1, $2);
if(globString($glob, $branch)) {
$par{'kind'} = $kind;
last RULES
}
}
warn "$0: No autokind rule matches; leaving the kind unchanged.\n"
}
}
$branchNameEscaped =~ s/[^0-9a-zA-Z]+/-/g;
if($par{'v'}) {
warn "VERBOSE: Parameters\n";
for my $k(sort keys %par) {
warn " $k: $par{$k}\n"
}
}
my %typeReact = ();
for my $as(split /,/, $par{change}) {
warn "$0: processing change parameter '$as'\n" if $par{v};
if($as=~m#(.*)=(.*)#) {
$typeReact{$1} = $2;
} else {
warn "$0: Unexpected change parameter: '$as'"
}
}
if($par{autovcsurl} and not $par{vcsurl}) {
$par{vcsurl} = qx($par{autovcsurl});
chomp $par{vcsurl};
$par{vcsurl}=~s#/*$#/#
}
if($par{changelog} and not $par{vcsurl}) {
die "Parameter 'changelog' given, but parameter 'vcsurl' is not. Please state the url of your repository for computation of a changelog.\n"
}
#my @have = split /\n/, `$par{vcstags}`;
#
#my @keep = grep { $_ } map { m#^($par{kind})([0-9].*)# ? [$1,$2] : undef } @have;
#
#my @oldVersions = ();
sub globString {
my ($glob, $string) = @_;
my @glob = map { m#\*# ? '*' : $_ } $glob=~m#(\?|\*+|[^\?\*]+)#g;
my %matchCache = ();
my $match = undef;
my $matchCore = sub {
my ($i, $j) = @_;
return 1 if $i==@glob and $j==length $string;
return 0 if $i>=@glob or $j>=length $string;
return $match->($i+1,$j+1) if '?' eq $glob[$i];
if('*' eq $glob[$i]) {
for my $jj($j..length($string)) {
return 1 if $match->($i+1, $jj);
}
return 0;
}
return $match->($i+1, $j+length($glob[$i])) if
$glob[$i] eq substr($string, $j, length($glob[$i]));
return 0
};
$match = sub {
my ($i, $j) = @_;
my $ij = "$i $j";
my $res = $matchCache{$ij};
if(not defined $res) {
$res = $matchCore->($i, $j);
$matchCache{$ij} = $res;
}
$res
};
$match->(0,0);
}
sub parseVersion {
my $v = shift;
if(not defined $v) {
my $c = join " ", caller;
warn "$0: internal error (parseVersion called on undef at $c)\n";
return undef
}
my %cap = ();
if(
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)$# ||
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)\.(?<mi>[0-9]+)$# ||
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)\.(?<mi>[0-9]+)\.(?<p>[0-9]+)$# ||
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)\.(?<mi>[0-9]+)\.(?<p>[0-9]+)-test-(?<sp>(?<brn>[a-z]+)-?(?<brv>[0-9\.]+))$# ||
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)\.(?<mi>[0-9]+)\.(?<p>[0-9]+)-(?<sp>(?<brv>[0-9\.]+)\+(?<brn>[0-9A-Za-z\-]+))$# || # [x].[y].[z]-[num]+[branchname]
$v=~m#^(?<pre>[a-z]*)(?<ma>[0-9]+)\.(?<mi>[0-9]+)\.(?<p>[0-9]+)-(?<sp>.*)$#
) {
%cap = %+
# my ($pre,$ma,$mi,$p,$sp,$brn,$brv) = ();
} else {
warn "$0: unexpected old version number: $v\n" if $par{v};
return undef
}
$cap{pre} = 'v' if '' eq $cap{pre};
my %ret = (
prefix=>$cap{pre},
major=>$cap{ma},
minor=>$cap{mi},
patch=>$cap{p},
subpatch=>$cap{sp},
branchname=>$cap{brn},
branchversion=>$cap{brv},
);
if($par{v}) {
my $parsed = join '; ', map { "$_=>".($ret{$_}//'') } sort keys %ret;
warn "Version '$v' was parsed to '$parsed'\n"
}
return \%ret
}
#@oldVersions = sort {
# ($a->{major} // 0) <=> ($b->{major} // 0) ||
# ($a->{minor} // 0) <=> ($b->{minor} // 0) ||
# ($a->{patch} // 0) <=> ($b->{patch} // 0) ||
# ($a->{subpatch} // '') <=> ($b->{subpatch} // '')
#} @oldVersions;
sub vsCompare {
my ($vp, $wp) = @_;
my ($v, $w) = ($vp, $wp);
my ($verr, $werr) = (0,0);
unless(ref $v) {
eval { $v = parseVersion($v) };
$verr = 1 if $@ or not defined $v;
}
unless(ref $w) {
eval { $w = parseVersion($w) };
$werr = 1 if $@ or not defined $w;
}
if($verr and $werr) {
return $vp cmp $wp;
}
if($verr) {
return -1
}
if($werr) {
return 1
}
#for($v, $w) {
# $_ = parseVersion($_) unless ref $_;
#}
if($v->{prefix}=~m/^v?$/ and $w->{prefix}=~m/^v?$/) {
return(
($v->{major} // 0) <=> ($w->{major} // 0) ||
($v->{minor} // 0) <=> ($w->{minor} // 0) ||
($v->{patch} // 0) <=> ($w->{patch} // 0) ||
($v->{branchname} // '') cmp ($w->{branchname} // '') ||
($v->{branchversion} // 0) <=> ($w->{branchversion} // 0) ||
($v->{subpatch} // '') cmp ($w->{subpatch} // '')
)
} elsif($v->{prefix}=~m/^v?$/ and !$w->{prefix}=~m/^v?$/) {
return 1;
} elsif(!$v->{prefix}=~m/^v?$/ and $w->{prefix}=~m/^v?$/) {
return -1;
} else {
return vsStringDebug($v) cmp vsStringDebug($w)
}
}
sub vsStringDebug {
my $v = shift;
my $ret =
("[" . ($v->{prefix} // 'undef') . "]") .
($v->{major} // 'undef') . "." .
($v->{minor} // 'undef') . "." .
($v->{patch} // 'undef');
$ret .= "-[$v->{subpatch}]" if defined $v->{subpatch};
$ret .= "-test-" . ($v->{branchname} // 'undef') . "-" . ($v->{branchversion} // 'undef');
return $ret
}
sub vsString {
my $v = shift;
my $ret =
($v->{major} // 0) . "." .
($v->{minor} // 0) . "." .
($v->{patch} // 0);
$ret .= "-$v->{subpatch}" if defined $v->{subpatch};
return $ret
}
sub vsJustVersion {
my $v = shift;
my $ret =
($v->{major} // 0) . "." .
($v->{minor} // 0) . "." .
($v->{patch} // 0);
return $ret
}
sub vsTestVersion {
my $v = shift;
# [x].[y].[z]-[num]+[branchname]
my $ret =
($v->{major} // 0) . "." .
($v->{minor} // 0) . "." .
($v->{patch} // 0) . "-" .
($v->{branchversion} // '0.0.0') . "+" .
$branchNameEscaped;
# old version format
#my $ret =
#'v' .
#($v->{major} // 0) . "." .
#($v->{minor} // 0) . "." .
#($v->{patch} // 0) . "-test-" .
#($v->{branchname} // 'a') .
#($v->{branchversion} // '0.0.0');
return $ret
}
#print vsStringDebug($_), "\n" for @oldVersions;
#print " << $_->[1] >>\n" for @keep;
my @versionsOrig = ();
if('-' eq $par{vcslog}) {
@versionsOrig = <STDIN>;
chomp for @versionsOrig
} else {
@versionsOrig = split /\n/, `$par{vcslog}`;
}
my @versions = ();
for my $v(@versionsOrig) {
warn "$0: Processing orig version (part 1): '$v'\n" if $par{v};
if($v=~m#^(.*?\S)\s*::::\s*(.*?)\s*::::\s*(.*)#) {
push @versions, {
hash => $1,
meta => $2,
subject => $3
}
}
}
#print Data::Dumper::Dumper(\@versions);
my @change = ();
my $tag = undef;
my @versionPast = ();
VERSION: for my $v(@versions) {
warn "$0: Processing version (part 2): $v\n" if $par{v};
#if($v->{meta}=~m#tag\s*:\s*\Q$par{kind}\E(.*)\)#) {
# $tag=$1;
# last VERSION
#}
if($v->{meta}=~m#tag\s*:\s*((?:[vtd]|db|)[0-9\.]+(?:[a-zA-Z\-\+0-9\.]*)?)[\),]#) {
$v->{version} = $1;
warn "$0: Found version number in log: '$v->{version}'\n" if $par{v};
push @versionPast, $v->{version}
}
next if $v->{subject}=~m#^\s*(?:Merge (?:branch|remote)|Revert )#;
if($v->{subject}=~m#^\s*([a-z]+)\s*(!?)\s*#) {
my ($type, $break) = ($1, $2);
if(exists $typeReact{$type}) {
my $react = $typeReact{$type};
next VERSION if 'null' eq $react;
my %h = %$v;
$h{react} = $react;
push @change, \%h
} else {
warn "$0: cannot react on commit message '$v->{subject}', type '$type' unknown\n" if $par{$v};
}
} else {
warn "$0: commit message not parseable: $v->{subject}\n" if $par{$v};
}
}
#$tag = parseVersion($tag);
for my $r(reverse @change) {
warn "$0: Processing change: $r\n" if $par{v};
if('major' eq $r->{react}) {
$tag->{major}++;
$tag->{minor}=0;
$tag->{patch}=0;
$tag->{subpatch}=undef;
} elsif('minor' eq $r->{react}) {
$tag->{minor}++;
$tag->{patch}=0;
$tag->{subpatch}=undef;
} elsif('patch' eq $r->{react}) {
$tag->{patch}++;
$tag->{subpatch}=undef;
} else {
die "$0: Cannot perform modification '$r->{react}' (probably internal error)"
}
}
#print Data::Dumper::Dumper(\@change, $tag);
#for my $c(@change) {
# print "==\n";
# for my $k(sort keys %$c) {
# print " $k: $c->{$k}\n"
# }
# print "\n"
#}
#
#print "\n";
#for my $v(@versionPast) {
# my $vv = vsStringDebug(parseVersion($v));
# print "VERSION $v --> $vv\n"
#}
my @allVersions = split /\n/, `$par{vcstags}`;
#my @sortAll = sort {vsCompare($b, $a)} @allVersions;
#my @sortSee = sort {vsCompare($b, $a)} @versionPast;
# we want the latest version and do not sort
my @sortAll = @allVersions;
my @sortSee = @versionPast;
#print "all: $sortAll[0] -- see: $sortSee[0]\n";
#
#print vsString($tag), "\n";
my $mainVersion = 'v' eq $par{kind};
my $highStart = $mainVersion ? $sortAll[0] : $sortSee[0];
my $highSee = $sortSee[0];
my %reactCollect = ();
SEARCHVERSION: for my $v(@versions) {
warn "$0: search for version: '$v'\n" if $par{v};
next unless $v->{version};
next unless $v->{react};
$reactCollect{$v->{react}} = 1;
if($highSee eq $v->{version}) {
last SEARCHVERSION;
}
}
sub justVersionInc {
my ($v, $react) = @_;
my $vv = parseVersion($v);
$vv->{patch}++; # if $react->{patch}; # in principal a good idea to increase only when a patch action happend, but we need a new version, even if nothing happend, so we always increase patch; if there are other changes as well, it is overwritten anyways
do {$vv->{minor}++; $vv->{patch}=0} if $react->{minor};
do {$vv->{major}++; $vv->{minor}=0; $vv->{patch}=0} if $react->{major};
my $ret = vsJustVersion($vv);
warn "$0: version inc from '$v' to $ret\n" if $par{v};
return $ret
}
my $newVersion = undef;
if($mainVersion) {
$newVersion = justVersionInc($highStart, \%reactCollect);
} else {
my $v = parseVersion($highStart);
if(exists $v->{branchname}) {
$v->{branchversion} = justVersionInc($v->{branchversion} // '0.0.0', \%reactCollect);
} else {
$v->{branchname} = 'a';
$v->{branchversion} = '0.0.0';
}
$newVersion = vsTestVersion($v);
}
my %allVersions = ();
for(@allVersions) {
$allVersions{$_} = 1
}
while(exists $allVersions{$newVersion}) {
warn "$0: Version conflict, so we try another version, '$newVersion' exists already\n" if $par{v};
if($mainVersion) {
die "$0: probably internal error (collision in main version)\n"
}
my $v = parseVersion($newVersion);
$v->{branchname} //= 'a';
$v->{branchname}++;
$newVersion = vsTestVersion($v);
}
print "$newVersion\n";
# If we want a changelog
if($par{changelog}) {
#print "Changelog file: '$par{changelog}'\n";
# TODO at the moment we only extend a changelog; starting with a fresh one is not supportet yet
my $fh = undef;
open($fh, '<', $par{changelog}) or die "Could not read changelog file '$par{changelog}', because: $!";
my @changelog = <$fh>;
close $fh;
my %seen = ();
my @sects = ([]);
for(@changelog) {
warn "$0: Changelog processing: '$_'\n" if $par{v};
push @sects, [] if m/^## /;
push @{$sects[-1]}, $_;
if(m#/commit/([a-f0-9]+)\s*\)\s*\)\s*$#) {
$seen{$1} = 1;
}
}
my $head = shift @sects;
#print Data::Dumper::Dumper($head);
#print " << $sects[0][0] >>\n";
if($sects[0][0]=~m/^##\s*\[([^\]\[]+)\]\(/ and $1 eq $newVersion) {
shift @sects;
}
for my $s(@sects) {
warn "$0: Changelog processing, section search: '$s'\n" if $par{v};
my $hh = $s->[0];
chomp $hh;
my $cnt = @$s;
#print " $hh\n $cnt lines\n\n"
}
#print Data::Dumper::Dumper($versions[0]);
for my $v(@versions) {
#print Data::Dumper::Dumper($v);
my $hash = $v->{hash};
my $see = 'new';
$see = 'old' if $seen{$hash};
#print "$hash -> $see ($v->{subject})\n";
}
my $changelogout = $par{changelogout} || $par{changelog};
my $changelogfh = undef;
open($changelogfh, '>', $changelogout) or die "$0: Could not write '$changelogout', because: $!\n";
my %extend = ();
my %when = (
'fix' => 'Bug Fixes',
'hotfix' => 'Bug Fixes',
'feat' => 'Features',
'feature' => 'Features',
);
SELECTCHANGELOG: for my $v(@versions) {
warn "$0: Changelog processing, version selection: '$v'\n" if $par{v};
last SELECTCHANGELOG if $seen{$v->{hash}};
next unless $v->{subject}=~m#^\s*([a-z]+)\s*(!?)\s*((?:\(.*?\))?)\s*:\s*(.*?)\s*$#i;
my ($kind, $break, $context, $msg) = ($1, $2, $3, $4);
my $where = $when{$kind};
$where = 'BREAKING CHANGES' if '!' eq $break;
next unless $where;
my $short = substr $v->{hash}, 0, 7;
my $contS = '';
if($context=~m#\((.*)\)#) {
$contS = "**$1:** ";
}
my $row = qq#* $contS$msg ([$short]($par{vcsurl}commit/$v->{hash}))#;
push @{$extend{$where}}, {
msg=>$msg,
context=>$context,
orig=>$v,
row=>$row,
};
}
#print Data::Dumper::Dumper(\%extend);
my $preVersion = '';
if(defined $sects[0] and defined $sects[0][0] and $sects[0][0]=~m/^##\s*\[([^\]\[]+)\]\(/) {
$preVersion = $1;
# $preVersion =~ s#^v?#v#;
}
my $today = do {
my @time = localtime;
my $year = $time[5]+1900;
my $month = $time[4]+1;
my $day = $time[3];
sprintf("%04i-%02i-%02i", $year, $month, $day)
};
print $changelogfh qq!# Changelog
All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines.
## [$newVersion]($par{vcsurl}/compare/$preVersion...$newVersion) ($today)
!;
for my $variant('BREAKING CHANGES', 'Features', 'Bug Fixes') {
my @all = map {$_->{row}} @{$extend{$variant}};
next unless @all;
my $msg = join "\n", @all;
print $changelogfh qq/### $variant\n\n$msg\n\n/
}
for(@sects) {
print $changelogfh $_ for @$_
}
}