#!/usr/bin/perl -w
#
# <@LICENSE>
# Copyright 2004 Apache Software Foundation
# 
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

use strict;

my $NUM_SCORESETS = 4;

my ($scoreset,$oldscores,$newscores) = @ARGV;

$scoreset = int($scoreset) if defined $scoreset;
if (!defined $newscores || $scoreset < 0 || $scoreset >= $NUM_SCORESETS ) {
  die "usage: rewrite-cf-with-new-scores scoreset oldscores.cf newscores.cf\n";
}

system ("./parse-rules-for-masses -s $scoreset") and die;
our %rules;
if (-e "tmp/rules.pl") {
  # Note, the spaces need to stay in front of the require to work around a RPM 4.1 problem
  require "./tmp/rules.pl";
}
else {
  die "parse-rules-for-masses had no error but no tmp/rules.pl!?!";
}

# now read the generated scores
my @gascoreorder = ();
my %gascorelines = ();
open (STDIN, "<$newscores") or die "cannot open $newscores";
while (<STDIN>) {
  /^score\s+(\S+)\s+(-?\d+(?:\.\d+)?)/ or next;
  my $name = $1;  my $score = $2;
  next unless (exists ($rules{$name}) && $rules{$name}->{issubrule} == 0);
  next if ($name =~ /^__/);
  next if ($name eq '(null)');	# er, oops ;)

  $gascorelines{$name} = $score;
  push (@gascoreorder, $name);
}

open (IN, "<$oldscores") or die "cannot open $oldscores";
my $out = '';
my $pre = '';
my %seenscoreforrule = (
    'AWL' => 1,                 # dynamic rule, skip it
);

# read until '# Start of generated scores', removing scores from our
# new list if we come across them.
while (<IN>) {
  if (/^\s*score\s+(\S+)\s/) {
    my $name = $1;
    $seenscoreforrule{$name} = 1;
    delete $gascorelines{$name};
    next unless (exists ($rules{$name}) && $rules{$name}->{issubrule} == 0);
  }
  $pre .= $_;
  /^# Start of generated scores/ and last;
}

# now skip until '# End of generated scores'
my %oldscores = ();
while (<IN>) {
  if (/^\s*score\s+\S+/) {
    my($score,$name,@scores) = split;
    @{$oldscores{$name}} = @scores;
    $seenscoreforrule{$name} = 1;
  }

  /^# End of generated scores/ and last;
}
if (defined $_) {
  $out .= $_;
}

# and read until EOF, again removing scores from our list as we find 'em.
while (<IN>) {
  if (/^\s*score\s+\S+/) {
    my($score,$name,@scores) = split;

    next unless (exists ($rules{$name}) && $rules{$name}->{issubrule} == 0);
    if (defined $gascorelines{$name}) {
      # Set appropriate scoreset value
      $scores[$scoreset] = $gascorelines{$name};

      # Create new score line
      $_ = join(" ","score",$name,generate_scores($name, @scores))."\n";
    }
    delete $gascorelines{$name};
    $seenscoreforrule{$name} = 1;
  }
  $out .= $_;
}
close IN;

# and output the lot
print $pre, "\n";
foreach my $name (@gascoreorder) {
  $_ = $gascorelines{$name};
  next unless (defined ($_));

  next if ($rules{$name}->{lang});          # "lang es" rules etc.
  next if ($name eq 'AWL');                 # dynamic score

  # Use the old scores if they existed
  my @scores = ();
  @scores = @{$oldscores{$name}} if ( exists $oldscores{$name} );

  # Set appropriate scoreset value
  $scores[$scoreset] = $_;
  delete $oldscores{$name};
  $seenscoreforrule{$name} = 1;

  # Create new score line
  print join(" ","score",$name,generate_scores($name, @scores)),"\n";
}

# output any tests that were in the old scores file, but not in
# the GA output
# TODO: currently, I'm assuming that if the GA didn't use it,
# we must not assign the rule a score.
foreach my $name (sort keys %oldscores) {
  delete $oldscores{$name};
  $seenscoreforrule{$name} = 1;
  next if ($rules{$name}->{lang});          # "lang es" rules etc.

  # my @scores = @{$oldscores{$name}} if ( exists $oldscores{$name} );
  my @scores = (0, 0, 0, 0);
  print join(" ","score",$name,generate_scores($name, @scores)),"\n";
}

# now do the same for what's in tmp/rules.pl
foreach my $name (sort keys %rules) {
  next if ($seenscoreforrule{$name});
  next if ($rules{$name}->{issubrule});
  next if ($rules{$name}->{lang});          # "lang es" rules etc.
  delete $oldscores{$name};

  # my @scores = @{$oldscores{$name}} if ( exists $oldscores{$name} );
  my @scores = (0, 0, 0, 0);
  print join(" ","score",$name,generate_scores($name, @scores)),"\n";
}

print "\n", $out;

sub generate_scores {
  my ($name, @scores) = @_;

  my $isnet = ($rules{$name}->{tflags} =~ /\bnet\b/);
  my $islearn = ($rules{$name}->{tflags} =~ /\blearn\b/);

  # Set defaults if not already set
  $scores[0] ||= 0;

  my $flag = 1;
  for(my $i=1;$i<$NUM_SCORESETS;$i++) {
    $scores[$i] = $scores[0] unless defined $scores[$i];
    $flag = 0 if ( $scores[$i] != $scores[$i-1] );
  };

  # enforce rule/scoreset rules.
  # net rules never have a non-zero score in sets 0 and 2
  for(my $i=0;$i<$NUM_SCORESETS;$i++) {
    if ($isnet && ($i & 1) == 0) {
      $scores[$i] = 0;
      $flag = 0 if ( $i > 0 && $scores[$i] != $scores[$i-1] );
    }
    if ($islearn && ($i & 2) == 0) {
      $scores[$i] = 0;
      $flag = 0 if ( $i > 0 && $scores[$i] != $scores[$i-1] );
    }
  }

  if ($flag) {
    splice @scores, 1;
  }

  return @scores;
}
