#!/usr/bin/perl # NOTE: this script is used by generate-new-scores; it is meant to be copied # to and called from the masses/ directory of the checkout being used # for the score generation run for the particular scoreset; you # shouldn't need to call this script manually # # <@LICENSE> # Licensed to the Apache Software Foundation (ASF) under one or more # contributor license agreements. See the NOTICE file distributed with # this work for additional information regarding copyright ownership. # The ASF licenses this file to you 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. # use strict; use warnings; my %active_rules; my %original_rules; open(ACTIVE, "../rules/active.list") or die "Cannot open active.list: $!"; while() { $active_rules{$1} = undef if (/^(?!__)(\S+)$/); } close ACTIVE; open(ORIG, "../rules/50_scores.cf") or die "Cannot open original score file: $!"; while() { if (/^score\s+(\S+)/) { $original_rules{$1} = undef; } } close ORIG; open(FREQS, "freqs") or die "Cannot open freqs: $!"; readline(FREQS); readline(FREQS); readline(FREQS); while () { if (/(\S+)$/) { delete $active_rules{$1}; } } close FREQS; open(SCORES, ">scores-active-zeroed") or die "Cannot open scores-active-zeroed: $!"; if (scalar keys %active_rules) { open(FREQS, ">>freqs") or die "Cannot open freqs: $!"; foreach my $rule (sort(keys %active_rules)) { # no need to get the real scores for the base rules since there's no hits # on them their score doesn't matter print FREQS " 0.000 0.0000 0.0000 0.500 0.00 0.00 $rule\n"; # generate zero score lines for active.list non-base ruleset rules that are hitless # skip the AWL rule, it doesn't have a static score TODO: detect this automatically?! unless (exists $original_rules{$rule} || $rule =~ /^AWL$/) { my $line = "score $rule "; for (my $i = 0; $i < 30 - length $rule; $i++) { $line .= ' '; } $line .= "0.000\n"; print SCORES $line; } } close FREQS; } close SCORES;