Expanded Tweaker tar file into individual files, and adjusted installation process to reflect this. Further integration will be required before this is ready for R6.

2 files changed, 419 insertions, 0 deletions

diff --git a/abs/core-testing/tweaker/lib/Tweaker/Definitions.pm b/abs/core-testing/tweaker/lib/Tweaker/Definitions.pm
new file mode 100644
index 0000000..cbadf29
--- /dev/null
+++ b/abs/core-testing/tweaker/lib/Tweaker/Definitions.pm
@@ -0,0 +1,66 @@
+# Copyright 2007 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::Definitions;
+use List::Member;
+use Log::Log4perl qw(:easy);
+
+# To install the above modules:
+# --
+# sudo cpan install List::Member
+
+# Recommendation Levels
+my $bottom = -200; # a reserved value, under which no recommendationlevel can go
+my $not_available = -100;
+my $unsupported = -99;
+my $inadvisable = -50;
+my $optional = 0;
+my $recommended = 100;
+
+# Interactivity Levels
+my $guided = "guided";
+my $minimal = "minimal";
+
+# Special variables
+my $null = "null"; # reserved as the script name for special Tweaks that define Tweaker behavior
+
+my %global_variable_hash = (
+    "bottom" => $bottom,
+    "not available" => $not_available,
+    "unsupported" => $unsupported,
+    "inadvisable" => $inadvisable,
+    "optional" => $optional,
+    "recommended" => $recommended,
+    "guided" => $guided,
+    "minimal" => $minimal,
+    "null" => $null
+);
+
+sub get_global_variable_value {
+    my ($variable) = @_;
+
+    my @known_variables = keys %global_variable_hash;
+    if (member($variable, @known_variables) + 1) {
+	if ($global_variable_hash{$variable}) {
+	    return $global_variable_hash{$variable};
+	}
+    } else {
+	my $logger = get_logger();
+	$logger->error("No Tweaker Definition for variable named $variable");
+	return $bottom;
+    }
+}
+
+1;
diff --git a/abs/core-testing/tweaker/lib/Tweaker/Script.pm b/abs/core-testing/tweaker/lib/Tweaker/Script.pm
new file mode 100644
index 0000000..ec3a42a
--- /dev/null
+++ b/abs/core-testing/tweaker/lib/Tweaker/Script.pm
@@ -0,0 +1,353 @@
+# 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::Script;
+
+use strict;
+use DBI;
+use Switch;
+use Tweaker::Definitions;
+
+# To install the above modules:
+# --
+# sudo apt-get install libdbi-perl liblog-log4perl-perl
+# sudo cpan install Getopt::Lucid List::Member
+# choose the defaults for all options, agree to install all dependencies
+
+use Getopt::Lucid qw( :all );
+# see http://search.cpan.org/~dagolden/Getopt-Lucid-0.16/lib/Getopt/Lucid.pm 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 List::Member;
+
+my $dbh; # the database we connect to
+my $sth; # 
+my $TWEAKER_ROOT;
+my @known_options;
+
+# Print advice on usage and invocation.
+sub help () {
+    my $logger = get_logger('tweaker.script');
+    $logger->fatal("USAGE:\n$0 [--check Option] [--implement Option] [--poll Option] [--iterations] [--help]");
+    $logger->fatal("Valid values for Option are: ", join(" ",@known_options));
+    $logger->fatal("Only one of the above parameters may be passed.");
+    $logger->fatal("The --check and --iterations parameters are not yet supported.");
+    exit;
+}
+
+sub execute_shell_command {
+    my($command) = @_;
+    my $results="";
+    my $logger = get_logger('tweaker.script');
+
+    open(SHELL, "$command 2>&1 |");
+
+    while(<SHELL>) {
+	$results=$results."".$_;
+    }
+    close(SHELL);
+    chop($results);
+    $logger->debug("Command '$command' produced output '$results'");
+    return $results;
+}
+
+# Simple way to get the value of an environment variable from the executing shell.
+sub get_environment_variable {
+    my($envvar) = @_;
+    open(SHELL, "echo $envvar|");
+    while(<SHELL>) {
+	chop;
+	return $_;
+    }
+    close(SHELL);
+}
+
+sub get_mythtv_connection_string {
+    # we want something like mythconverg:localhost
+    my $dbname = "";
+    my $dbhostname = "";
+    open(MYSQLTXT, "< /home/mythtv/.mythtv/mysql.txt");
+    while(<MYSQLTXT>) {
+	if (/DBName=(.*)/) {
+	    $dbname=$1;
+	} elsif (/DBHostName=(.*)/) {
+	    $dbhostname=$1;
+	}
+    }
+    close(MYSQLTXT);
+    
+    return "$dbname:$dbhostname";
+}
+
+sub get_mythtv_authentication {
+    # we want something like ['root', '']
+    my $dbusername = "";
+    my $dbpassword = "";
+
+    open(MYSQLTXT, "< /home/mythtv/.mythtv/mysql.txt");
+    while(<MYSQLTXT>) {
+	if (/DBUserName=(.*)/) {
+	    $dbusername=$1;
+	} elsif (/DBPassword=(.*)/) {
+	    $dbpassword=$1;
+	}
+    }
+    close(MYSQLTXT);
+    
+    return ($dbusername, $dbpassword);
+}
+
+# Database routines.
+sub connect_to_db {
+    my ($db) = @_;
+    my $logger = get_logger('tweaker.script');
+    my ($dbusername, $dbpassword) = get_mythtv_authentication();
+    if (!($dbh = DBI->connect($db, $dbusername, $dbpassword))) {
+	$logger->error("Couldn't connect to database: ", DBI->errstr);
+	return -1;
+    }
+    return 1;
+}
+
+sub disconnect_from_db {
+    $dbh->disconnect;
+}
+
+sub do_query {
+    my ($query) =  @_;
+    my $logger = get_logger('tweaker.script');
+    my $rv="";
+    
+    $logger->debug("Processing statement: ", $query);
+    
+    if (!($sth = $dbh->prepare($query))) {
+	$logger->error("Couldn't prepare statement: ", $dbh->errstr);
+	return -1;
+    }
+    $rv = $sth->execute(); # Returns an integer when rows were affected; returns -1 when there's an
+    # error; returns 0E0 (true) when no error but no rows affected.
+
+    if (!$rv) {
+	$logger->error("Couldn't execute statement: ", $sth->errstr);
+	return -1;
+    }
+    return $rv;
+}
+
+# Make sure the option passed to this script is handled.
+sub validate_option {
+    my($option) = @_;
+
+    if (!(member($option, @known_options) + 1)) {
+	my $logger = get_logger('tweaker.script');
+	$logger->fatal("Option '$option' is not known to $0.");
+	$logger->fatal("Valid Options are: ", join(", ",@known_options));
+	exit -1;
+    }
+    return 1;
+}
+
+# Prints out each option that the script handles, separated by '|'.
+# This allows for a minimal .tcf entry.
+sub get_options {
+    print join("|",@known_options),"\n";
+}
+
+# Prints out the passed Recommendation Level first, followed by any other
+# strings, separated by '|'.  This allows the author of a Tweaker Script to
+# return explanatory information along with a Recommendation Level.
+sub recommendation_level {
+    print join("|",@_),"\n";
+}
+
+sub process_parameters () {
+    # Accept these parameters:
+    # --
+    my @parameters = (
+	Switch("help")->anycase,
+	Param("check")->anycase,  # Requirement 1.1
+	Param("implement")->anycase,  # Requirement 1.2
+	Param("poll")->anycase, # Requirement 1.3
+	Switch("iterations")->anycase, # Requirement 1.4
+	Switch("getoptions")->anycase # Requirement 1.5
+	);
+    my $opt = Getopt::Lucid->getopt( \@parameters );
+    
+    if (!(my $TWEAKER_ROOT = get_environment_variable("\$TWEAKER_ROOT"))) {
+	Log::Log4perl->easy_init();
+	my $logger = get_logger();
+	$logger->fatal("ERROR: \$TWEAKER_ROOT environment variable is not set.");
+	exit -1;
+    } else {
+	my $log4perl_conf = "$TWEAKER_ROOT/log4perl.conf";
+	Log::Log4perl::init_and_watch($log4perl_conf,10);
+	my $logger = get_logger('tweaker.script');
+	$logger->info("\$TWEAKER_ROOT is '$TWEAKER_ROOT'.");
+    }
+
+    if ($opt->get_help > 0) {
+	help;
+    }
+    
+    my $check = $opt->get_check;
+    my $implement = $opt->get_implement;
+    my $poll = $opt->get_poll;
+    my $iterations = $opt->get_iterations;
+    my $getoptions = $opt->get_getoptions;
+
+    # Requirement 1.6
+    if ($check) {
+	if ($implement || $poll || $iterations || $getoptions) {
+	    help;
+	}
+	validate_option($check); # exits with an error if option is invalid
+	check_option($check); # Requirement 1.1
+    } elsif ($implement) {
+	if ($poll || $iterations || $getoptions) {
+	    help;
+	}
+	validate_option($implement); # exits with an error if option is invalid
+	implement_option($implement); # Requirement 1.2
+    } elsif ($poll) {
+	if ($iterations || $getoptions) {
+	    help;
+	}
+	validate_option($poll); # exits with an error if option is invalid
+	poll_options($poll); # Requirement 1.3
+    } elsif ($iterations) {
+	if ($getoptions) {
+	    help;
+	}
+	#count_iterations; # Requirement 1.4
+    } elsif ($getoptions) {
+	get_options; # Requirement 1.5
+    } else {
+	help;
+    }
+}
+
+sub set_known_options {
+    my(@options) = @_;
+    @known_options = @_;
+}
+
+# These entries may or may not already exist.  First, try updating them, and if that fails, insert them.
+# Pass in array references for setfields and checkfields.  Each must
+# reference an array of lists, where each list is a key, value pair, e.g.
+# [["data", "somedata"], ["name", "skippy"]]
+sub change_or_make_entry {
+    my($table, $setfields, $checkfields) = @_;
+    my $query_string = "UPDATE $table SET ";
+
+    my $fields="";
+    foreach my $sets (@$setfields) {
+	if ($fields) {
+	    $fields = $fields . ", ";
+	}
+	$fields = $fields . "@$sets[0]='@$sets[1]' ";
+    }
+    $query_string = $query_string . $fields . "WHERE ";
+
+    my $checkstring="";
+    foreach my $checks (@$checkfields) {
+	if ($checkstring) {
+	    $checkstring = $checkstring . "AND ";
+	}
+	$checkstring = $checkstring . "@$checks[0]='@$checks[1]' ";
+    }
+    $query_string = $query_string . $checkstring;
+    
+    my $rv = do_query($query_string);
+    if (($rv == 0E0) || ($rv < 1)) { # UPDATE didn't apply; do an insert
+	my $fields="";
+	my $values="";
+	foreach my $sets (@$setfields) {
+	    if ($fields) {
+		$fields = $fields . ", ";
+		$values = $values . ", ";
+	    }
+	    $fields = $fields . "@$sets[0]";
+	    $values = $values . "'@$sets[1]'";
+	}
+	foreach my $sets (@$checkfields) {
+	    if ($fields) {
+		$fields = $fields . ", ";
+		$values = $values . ", ";
+	    }
+	    $fields = $fields . "@$sets[0]";
+	    $values = $values . "'@$sets[1]'";
+	}
+	
+	$query_string = "INSERT INTO $table (". $fields . ") VALUES (" . $values . ")";
+	
+	$rv = do_query($query_string);
+    }
+    return $rv;
+}
+
+# We update so many entries in the settings table that a subroutine makes coding and readability easier.
+sub change_or_make_setting {
+    my($value, $data) = @_;
+
+    return(change_or_make_entry("settings", [["data", $data]], [["value", $value]]));
+}
+
+# Benchmark-driven tests for low, medium, or high "performance" often look the same.
+# If your test falls into this pattern, you can use this subroutine to simplify your
+# Tweaker Script's poll_options subroutine.
+# NOTE: This only handles options for low, medium, or high right now.
+# NOTE: You don't have to use this!  Only use it if your poll_options subroutine
+# would look like this anyway.  Don't shoehorn it to fit!
+sub threshold_test {
+    my($option, $benchmark_number, $name_of_benchmarked_device, $low_threshold, $medium_threshold, $high_threshold) = @_;
+    # e.g. ("medium", 512, "video card", 350, 425, 500)
+
+    my $logger = get_logger('tweaker.script');
+    $logger->debug("Threshold test for option '$option' ($name_of_benchmarked_device) with benchmark of $benchmark_number, where: low = $low_threshold, medium = $medium_threshold, high = $high_threshold");
+    
+    switch ($option) {
+	case "low" {
+	    if ($benchmark_number <= $low_threshold) {
+		recommendation_level("recommended", "Your $name_of_benchmarked_device seems to be unable to handle higher usage than this.");
+	    } elsif ($benchmark_number <= $medium_threshold) {
+		recommendation_level("optional", "Your $name_of_benchmarked_device seems to be able to handle higher usage than this, but select this option if you want to reduce overall $name_of_benchmarked_device usage.");
+	    } elsif ($benchmark_number >= $high_threshold) {
+		recommendation_level("optional", "Your $name_of_benchmarked_device seems to be quite capable of this setting, but select this option if you want to reduce overall $name_of_benchmarked_device usage.");
+	    }
+	}
+	case "medium" {
+	    if ($benchmark_number <= $low_threshold) {
+		recommendation_level("inadvisable", "Your $name_of_benchmarked_device seems to be unable to handle this usage level, but you are free to try.");
+	    } elsif ($benchmark_number <= $medium_threshold) {
+		recommendation_level("recommended", "Your $name_of_benchmarked_device seems to be unable to handle higher usage than this.");
+	    } elsif ($benchmark_number >= $high_threshold) {
+		recommendation_level("optional", "Your $name_of_benchmarked_device seems to be able to handle higher usage than this, but select this option if you want to reduce overall $name_of_benchmarked_device usage.");
+	    }
+	}
+	case "high" {
+	    if ($benchmark_number <= $low_threshold) {
+		recommendation_level("inadvisable", "Your $name_of_benchmarked_device seems to be unable to handle this usage level, and it is not recommended that you try.");
+	    } elsif ($benchmark_number <= $medium_threshold) {
+		recommendation_level("inadvisable", "Your $name_of_benchmarked_device seems to be unable to handle this usage level, but you are free to try.");
+	    } elsif ($benchmark_number >= $high_threshold) {
+		recommendation_level("recommended", "Your $name_of_benchmarked_device seems to be quite capable of this setting.");
+	    }
+	}
+    }
+}
+
+1;