summaryrefslogtreecommitdiffstats
path: root/abs/core/tweaker/lib/Tweaker/Script.pm
diff options
context:
space:
mode:
Diffstat (limited to 'abs/core/tweaker/lib/Tweaker/Script.pm')
-rw-r--r--abs/core/tweaker/lib/Tweaker/Script.pm353
1 files changed, 353 insertions, 0 deletions
diff --git a/abs/core/tweaker/lib/Tweaker/Script.pm b/abs/core/tweaker/lib/Tweaker/Script.pm
new file mode 100644
index 0000000..7dd2c8f
--- /dev/null
+++ b/abs/core/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, "< /usr/share/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, "< /usr/share/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;
generated by cgit v0.12 at 2024-05-02 17:01:58 (GMT)