#!/usr/bin/env perl
# Purpose: retrieve a new revision id, which is higher than any revision
# number used globally already inside cfg-schema, and install the template
# script using that id.

use strict;
use warnings;

use Getopt::Long qw(:config posix_default no_ignorecase);
use File::Copy qw(cp);
use File::Find;
use Dpkg::Changelog::Parse;

sub error
{
    my (@args) = @_;

    print { \*STDERR } "error: @args\n";
    exit 1;
}

sub usage
{
  print <<HELP;
Usage: $0 [<option>...] <script-name>

Options:
  -r  --renumber <file>  Take <file> and assign to it a new ID.
  -h, --help             Print this help message.
  -t, --type <type>      Apply the revision script to the YAML <type>, valid
                           types: config (default), constants, network, maintenance.
  -T, --template <file>  Use <file> as the template.
  -n, --dry-run          Do nothing, just print what would happen.

Example:
  ./new-script fix_wrong_setting
  ./new-script --type constants add_new_values
  ./new-script --renumber cfg_scripts/network/1234_test.up
HELP
}

sub get_up_name {
    my $filename = shift;

    if ($filename =~ m{/\d+_([^/]+)\.up$}) {
        return $1;
    } else {
        error "cannot extract up script name from '$filename'";
    }
}

my $type = 'config';
my $tmpl = 'cfg_scripts/template_script.up';
my $script_old;
my $name;
my $dryrun = 0;

my @options_spec = (
    'help|h|?' => sub { usage(); exit 0; },
    'type|t=s' => \$type,
    'template|T=s' => \$tmpl,
    'renumber|r=s' => \$script_old,
    'dry-run|n' => \$dryrun,
);

{
    local $SIG{__WARN__} = sub { my $arg = shift; chomp $arg; error($arg) };
    GetOptions(@options_spec);
}

error "missing required arguments for --type" unless length $type;
error "unknown revision script type: $type"
    if $type !~ m/^config|constants|network|maintenance$/;
error "missing required arguments for --template" unless length $tmpl;
if (length $script_old) {
    $name = get_up_name($script_old);
} else {
    error "expected exactly one script-name argument" if @ARGV != 1;
    $name = shift =~ tr/-/_/r;
}
error "missing required argument <script-name>" unless length $name;

my $project_dir = qx(git rev-parse --show-toplevel);
chdir $project_dir;

my %pathnames;
sub wanted {
    return unless /^\d+_.*\.up$/;

    my $id = s{^(\d+)_.*$}{$1}r;
    $pathnames{$id} = $File::Find::name;
}
find({ wanted => \&wanted }, 'cfg_scripts/');

use constant ID_NEW_STYLE_LOW => 703000000;

my $id_last = (sort { $a <=> $b } keys %pathnames)[-1];
my @id_last;

if ($id_last >= ID_NEW_STYLE_LOW) {
    @id_last = $id_last =~ m/^(\d{5,})(\d{4})$/;
}

print "Latest revision script in use:\n";
print "  revision = $id_last\n";
print "  filename = $pathnames{$id_last}\n";

my $changelog = changelog_parse(count => 1);
my $id_version = $changelog->{Version} =~ s/^.*~mr//r;
my @id_version = split /\./, $id_version;
my $id_new;
my @id_new;

# Starting with mr7.3.0 we use the new id allocation schema:
#
#   XXYYZZIIII
#
# where XXYYZZ are the mrXX.YY.XX version components prefixed with 0 if needed,
# and IIII is an integer from 0 to 9999. Sipwise will only allocate IIII within
# the 0 to 4999 range, and will reserve the 5000 to 9999 range for the
# customers.
$id_new[0] = join '', map { sprintf "%02d", $_ } @id_version[0..2];
if ($id_last < ID_NEW_STYLE_LOW) {
    $id_new[1] = 0;
} elsif ($id_last[0] != $id_new[0]) {
    $id_new[1]= 0;
} else {
    $id_new[1] = $id_last[1] + 10;
}
$id_new = sprintf '%d%04d', $id_new[0], $id_new[1] + int rand 10;

my $script_new = "cfg_scripts/$type/${id_new}_${name}.up";

print "Adding new revision script:\n";
print "  revision = $id_new\n";
print "  renumber = $script_old\n" if length $script_old;
print "  filename = $script_new\n";

exit 0 if $dryrun;

if (length $script_old) {
    system 'git', 'mv', $script_old, $script_new;
} else {
    cp($tmpl, $script_new);
}
