diff options
Diffstat (limited to 'abs/core/tweaker/bin/tweaker.pl')
-rwxr-xr-x | abs/core/tweaker/bin/tweaker.pl | 333 |
1 files changed, 0 insertions, 333 deletions
diff --git a/abs/core/tweaker/bin/tweaker.pl b/abs/core/tweaker/bin/tweaker.pl deleted file mode 100755 index 28519df..0000000 --- a/abs/core/tweaker/bin/tweaker.pl +++ /dev/null @@ -1,333 +0,0 @@ -#!/usr/bin/perl -w - -# Copyright 2007, 2008 Robert ("Bob") Igo of StormLogic, LLC and mythic.tv. -# -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see <http://www.gnu.org/licenses/>. - -package Tweaker; - -use strict; -use Getopt::Lucid qw( :all ); -# see http://search.cpan.org/~dagolden/Getopt-Lucid-0.16/lib/Getopt/Lucid.pm for usage details -use XML::Twig; -# see http://xmltwig.com for usage details -use Log::Log4perl qw(get_logger); - -# see http://search.cpan.org/~mschilli/Log-Log4perl-1.14/lib/Log/Log4perl.pm for usage details -# http://www.perl.com/pub/a/2002/09/11/log4perl.html is highly recommended as well - -use Tweaker::Script; -use Tweaker::Definitions; - -# To install the above modules: -# -- -# sudo cpan install Getopt::Lucid XML::Twig Log::Log4perl List::Member -# choose the defaults for all options, agree to install all dependencies -# Copy TweakerDefinitions.pm to /etc/perl - -use vars qw($debug); -use vars qw($interactivity); -use vars qw($logfile); -use vars qw($twig); - -my $bottom = Tweaker::Definitions::get_global_variable_value("bottom"); -my $optional = Tweaker::Definitions::get_global_variable_value("optional"); -my $minimal = Tweaker::Definitions::get_global_variable_value("minimal"); -my $null = Tweaker::Definitions::get_global_variable_value("null"); - -# As each tweak tag is processed, this subroutine is called. Here we will -# see if any previous tweak tag had the same name attribute. If so, we will -# replace the previous tweak tag with this new tweak tag's contents. -sub uniquify_tweaks { - my ($twig, $this_tweak) = @_; - my $tweak_name = $this_tweak->att('name'); - my $previous_tweak = $this_tweak->prev_sibling( qq{tweak[\@name="$tweak_name"]}); - my $logger = get_logger('tweaker'); - - # If the tweak's name is found elsewhere, replace the first - # instance with the latest one, then delete the latest one. - if ($previous_tweak) { - my $log_entry; - # Requirement 6.3.1 - $log_entry = sprintf("\tReplacing\n\t\t%s\n\twith\n\t\t%s\n", $previous_tweak->sprint, $this_tweak->sprint); - $logger->info($log_entry); - $this_tweak->cut; - $this_tweak->replace($previous_tweak); - } -} - -$twig = XML::Twig->new(load_DTD => 1, - expand_external_ents => 1, - twig_handlers => { 'tweak' => \&uniquify_tweaks } - ); - -# Requirement 4.2 -# Print advice on usage and invocation. -sub help () { - my $logger = get_logger('tweaker'); - $logger->fatal("USAGE:\n$0 --tcf file1.tcf [--tcf file2.tcf ...] [--help]"); - exit; -} - -sub print_tcf { - my(@tweaks) = @_; - my $logger = get_logger('tweaker'); - - $logger->debug('<?xml version="1.0"?>'); # print the XML declaration - $logger->debug('<!DOCTYPE stats SYSTEM "tcf.dtd">'); - $logger->debug('<tcf>'); # then the root element start tag - - foreach my $tweak (@tweaks) { # the list of tweaks - $logger->debug($tweak->sprint); # print the xml content of the element - } - - $logger->debug("</tcf>\n"); # close the document -} - -# For each tweak, invoke the option that was selected. -# Requirement 9.1.5 -# Requirement 13 -sub invoke_selected_options { - my @tweaks= $twig->root->children; # get the tweak list - my $logger = get_logger('tweaker'); - my $has_selected_option; - my $recommendationlevel = $bottom; - - foreach my $tweak (@tweaks) { # the list of tweaks - if ($tweak->att('name')) { - $has_selected_option=0; - $logger->debug("TWEAK ", $tweak->att('name')); - my @options = $tweak->descendants('option'); - foreach my $option (@options) { - if ($option->first_child('selected')) { - $has_selected_option++; - $recommendationlevel = $option->first_child('selected')->text; - $logger->info("\t", $tweak->att('name'), " : ", $option->att('name'), " is selected (recommendationlevel is ", $recommendationlevel, ")"); - # If the selected option is merely $optional, and we are in $minimal interactivity mode, we - # really don't know if this option is useful for the user. Just skip it. - if (($recommendationlevel == $optional) && ($interactivity eq $minimal)) { # UI Requirement 9.1.4 - $logger->debug("\tSKIPPING"); - next; - } elsif (($tweak->first_child('script')->text) && - ($tweak->first_child('script')->text) ne $null) { - $logger->debug("\tRUNNING"); - my $command = sprintf("%s --implement %s", $tweak->first_child('script')->text, $option->att('name')); - $logger->info("\t\tRunning '$command' to run a tweak."); - - open(COMMAND, "$command|"); - while(<COMMAND>) { # should only be one line of results - if ($_) { - $logger->debug("script returned text: ", $_); - } else { - $logger->debug("no return value from script"); - } - } - close(COMMAND); - } else { - $logger->debug("\tNO SCRIPT TO RUN"); - } - } - } - if ($has_selected_option == 0) { - $logger->debug("\tNO OPTION SELECTED"); - } - } - } -} - - -# Parses an XML file in TCF format, loading its information into memory. -# Rely on the DTD to mandate required tags. -sub parse_tcf { - my $this_tcf = shift(@_); - my $logger = get_logger('tweaker'); - - $logger->info("Parsing $this_tcf..."); - $twig->safe_parsefile($this_tcf) || $logger->fatal("Bad TCF $this_tcf: $@"); - if ($@) { - return 0; - } - # ??? For Requirement 5.1, we need to catch parse errors here - # $twig now has the parsed $this_tcf - $logger->info("DONE parsing $this_tcf"); - - my $root= $twig->root; # get the root of the twig (tcf) - my @tweaks= $root->children; # get the tweak list - - print_tcf(@tweaks) if $debug; - - return 1; # successfully parsed $this_tcf -} - -sub parse_core_tcf { - my ($core_tcf_pathname) = @_; - my $logger = get_logger('tweaker'); - - $logger->debug("core TCF pathname: $core_tcf_pathname"); - - # Requirement 5.1 - if (!(parse_tcf($core_tcf_pathname))) { - # Part of Requirement 6.4.1 - $logger->fatal("$0 requires at least one valid .tcf file."); - $logger->fatal("$core_tcf_pathname, or a .tcf that it includes, did not parse."); - exit; - } - # $twig->root->print; -} - -sub process_parameters () { - # Accept these parameters: - # -- - my @parameters = ( - Switch("help")->anycase, # Requirement 4.2 - Switch("debug")->anycase, - # part of Requirement 8 - Param("interactivity")->default($minimal), # side-effect of UI Requirement 9 for v0.7 - ); - - my $opt = Getopt::Lucid->getopt( \@parameters ); - my $help = $opt->get_help; - $debug = $opt->get_debug; - $interactivity = $opt->get_interactivity; - - if ($interactivity ne $minimal) { # side-effect of UI Requirement 9 for v0.7 - my $logger = get_logger('tweaker'); - $logger->warn("This version of Tweaker ignores requests for $interactivity interactivity and defaults to $minimal."); - $interactivity = $minimal; - } - - if ( $help > 0 ) { - help; - } -} - -# Requirement 6.6: Tweaker shall determine Recommendation Levels and default Options -# Requirements 6.6.1 and 6.6.2 -sub post_process_tweaks { - my $logger = get_logger('tweaker'); - - # Requirement 6.6.1 - - my $root= $twig->root; # get the root of the twig (tcf) - my @tweaks= $root->children; # get the tweak list - - foreach my $tweak (@tweaks) { - $logger->debug("#######"); - my @options = $tweak->descendants('option'); - - my $name_of_most_recommended_option=""; - my $most_recommended_option; - my $highest_recommendationlevel=$bottom; - - foreach my $option (@options) { - $logger->debug("===== OPTION"); - $logger->debug($option->sprint); - - my $recommendationlevel = $option->first_child('recommendationlevel'); - if ($recommendationlevel) { - # Requirement 6.6.1.1 - $logger->debug("\t+++"); - $logger->debug("\tUsing predefined recommendation level:", $recommendationlevel->text); - } else { - # Requirement 6.6.1.4 - my $result="optional"; - my $explanation=""; - - if (($tweak->first_child('script')->text) && - ($tweak->first_child('script')->text) ne $null) { - # Requirement 6.6.1.2 - $logger->debug("\t---"); - $logger->debug("\tThis has no defined recommendation level."); - - # Get the name of the script for this tweak and invoke it with the name of the option. - my $command = sprintf("%s --poll %s", $tweak->first_child('script')->text, $option->att('name')); - $logger->debug("\t\tRunning '$command' to see what it should be."); - # Create a recommendationlevel element and populate it with the script's return value. - - open(COMMAND, "$command|"); - while(<COMMAND>) { # should only be one line of results - $logger->debug("Got this: ", $_); - if ($_) { - chop; - my @text = split(/\|/); - $result = $text[0]; - if ($text[1]) { - $explanation = $text[1]; - } - } - } - close(COMMAND); - } - # Requirement 6.6.1.3 - $option->set_field ( 'recommendationlevel', $result ); - if ($explanation) { - $option->set_field ( 'explanation', $explanation ); - } - #$logger->debug("*** Paste results: ", $option->sprint); - } - # Requirement 6.6.2 : Auto-select the Option with the highest non-negative Recommendation Level. - # Requirement 6.6.2.1 : If there is a tie, Tweaker shall auto-select the first Option with the highest Recommendation Level. - $recommendationlevel = $option->first_child('recommendationlevel'); - if ($recommendationlevel) { - if ($name_of_most_recommended_option) { - $logger->debug("comparing ", $name_of_most_recommended_option, "'s recommendationlevel ($highest_recommendationlevel) to ", $recommendationlevel->text, " (",Tweaker::Definitions::get_global_variable_value($recommendationlevel->text),")"); - } else { - $logger->debug("considering recommendationlevel ", $recommendationlevel->text, " (",Tweaker::Definitions::get_global_variable_value($recommendationlevel->text),")"); - } - if (($highest_recommendationlevel < Tweaker::Definitions::get_global_variable_value($recommendationlevel->text)) - && (Tweaker::Definitions::get_global_variable_value($recommendationlevel->text) >= 0)) { - $highest_recommendationlevel = Tweaker::Definitions::get_global_variable_value($recommendationlevel->text); - $name_of_most_recommended_option = $option->att('name'); - $most_recommended_option = $option; - $logger->debug("now recommending: ", $name_of_most_recommended_option, " at level ", $highest_recommendationlevel); - } - } else { - $logger->error("No recommendationlevel defined for ", $option->att('name')); - } - # Select the best option, based on recommendation level - } - if ($most_recommended_option) { - $logger->debug("(1) BEST OPTION: ", $most_recommended_option->sprint); - $most_recommended_option->set_field ( 'selected', $highest_recommendationlevel ); - } - } -} - -sub main () { - my $tweaker_root; - - if (!($tweaker_root = Tweaker::Script::get_environment_variable("\$TWEAKER_ROOT"))) { - Log::Log4perl->easy_init(); - my $logger = get_logger(); - $logger->fatal("\$TWEAKER_ROOT not defined. Exiting."); - exit -1; - } - my $core_tcf_path = "$tweaker_root/tcf"; - my $core_tcf = "tweaker-core.tcf"; - my $core_tcf_pathname = "$core_tcf_path/$core_tcf"; - my $log4perl_conf = "$tweaker_root/log4perl.conf"; - - Log::Log4perl::init_and_watch($log4perl_conf,10); - - process_parameters; - parse_core_tcf($core_tcf_pathname); - post_process_tweaks; - # ??? need to add Requirement 11 here - invoke_selected_options; -} - -main; - -#my @tweaks= $twig->root->children; # get the tweak list -#print_tcf(@tweaks) if $debug; |