Ticket #1757: changestats.pl

#!/usr/bin/perl

use strict;
use warnings;
use feature 'unicode_strings';
use utf8;

use Getopt::Long;
use XML::DOM;

my $mod_root = '../../../binaries/data/mods';

my $mod = 'public';
my $key;
my $change;
my $only_print;

GetOptions('mod|m=s' => \$mod, 'key|k=s' => \$key, 'change|c=i' => \$change, 'print|p' => \$only_print);

my @classes = @ARGV;


sub get_filename
{
    my ($mod, $template_name) = @_;
    $template_name =~ s|^/||;  # Remove a leading /
    return "$mod_root/$mod/simulation/templates/$template_name";
}

sub array_contains_array
{
    # Check if the first array argument contains all the elements of the second one.
    # There's probably a more efficient way to do this.
    my ($array1, $array2) = @_;
    my @array1 = @$array1;
    my @array2 = @$array2;

    foreach my $element (@array2) {
        if (!grep(/^$element$/, @array1)) {
            return 0;
        }
    }
    return 1;
}

sub minimum_one_decimal
{
    # Ensure $num has at least one decimal place.
    # This is because values in templates always have a decimal place.
    my ($num) = @_;
    if ($num == int($num)) {
        return sprintf('%.01f', $num);
    }
    return sprintf('%g\n', $num);
}

sub get_templates
{
    my ($mod, $subdir) = @_;
    $subdir = $subdir || '';
    opendir my $template_dir, "$mod_root/$mod/simulation/templates/$subdir";
    my @templates = readdir $template_dir;
    closedir $template_dir;
    return map { "$subdir/$_"; } grep(/^[^.]/, @templates);  # Remove directories that start with a dot.
}

sub get_template_classes
{
    my ($parser, $template_file) = @_;
    my @classes = ();
    my $template = $parser->parsefile($template_file);
    my $entity = $template->getDocumentElement;

    # Merge this template's classes with all its inherited classes.
    my $parent = $entity->getAttributeNode('parent');
    if ($parent) {
        @classes = get_template_classes($parser, get_filename($mod, $parent->getNodeValue) . '.xml');
    }

    my $identity = $entity->getElementsByTagName('Identity')->item(0);
    if ($identity) {
        my $class_tokens = $identity->getElementsByTagName('Classes')->item(0);
        if ($class_tokens) {
            push @classes, split(' ', $class_tokens->getFirstChild->getNodeValue);  # The firstChild is the text node.
        }
    }

    $template->dispose;
    return @classes;
}

sub matching_templates
{
    my ($mod, $templates, $desired_classes) = @_;
    my @templates = @$templates;
    my @desired_classes = @$desired_classes;
    my @matching;
    my $parser = new XML::DOM::Parser;

    foreach my $template_name (@templates) {
        my $template_file = get_filename($mod, $template_name);
        if (-d $template_file) {
            my @more_templates = get_templates($mod, $template_name);
            push @matching, matching_templates($mod, \@more_templates, \@desired_classes);
        }
        else {
            my @classes = get_template_classes($parser, $template_file);
            if (array_contains_array(\@classes, \@desired_classes)) {
                push @matching, $template_file;
            }
        }
    }
    return @matching;
}

my @all_templates = get_templates($mod);
my @matching_files = matching_templates($mod, \@all_templates, \@classes);

print join("\n", map { substr $_, 56; } @matching_files), "\n";  # 56 is the length of $mod_root/simulation/templates/
exit if $only_print;

my $parser = new XML::DOM::Parser;
foreach my $template_file (@matching_files) {
    my $template = $parser->parsefile($template_file);
    my @query = split '/', $key;
    my @elements = $template->getElementsByTagName(shift @query);
    foreach my $element_name (@query) {
        @elements = map { $_->getElementsByTagName($element_name); } @elements;
    }

    foreach my $element (@elements) {
        my $value = $element->getFirstChild->getNodeValue;
        $element->getFirstChild->setNodeValue(minimum_one_decimal $value + $change);
        my $nv = $element->getFirstChild->getNodeValue;
    }

    # Can't use printToFile because it messes up Unicode characters.
    open(my $output_file, '>:utf8', $template_file);
    print $output_file $template->toString;
    $template->dispose;
}

print scalar(@matching_files), " files matched (fewer were actually modified).\n";