summaryrefslogtreecommitdiffstats
path: root/abs/core/tweaker/lib/Tweaker/Script.pm
blob: 7dd2c8ffd2bf24a8dc2720b5dabe1e0a7f1a27b2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
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;