#!/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 @$_
  }
}