|
1 #!perl |
|
2 # Copyright (c) 2005-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # # Script: uibench2db.pl |
|
16 # # Function: This script takes the performance log files created by |
|
17 # # the graphics uibench apps performace test and outputs data to the |
|
18 # # SymSym database |
|
19 # # call: uibench2db.pl --dir="\\loncoredev02.intra\graphics\9.2" --writedb --writecsv |
|
20 # # Design: This script looks at all the files under --dir |
|
21 # # seeking first build.html files then specific test reset logs. |
|
22 # # The test result contents are then extracted. |
|
23 # # Results for this build already in the database are deleted. |
|
24 # # The new results are added to the database. |
|
25 # # The raw results are available at |
|
26 # # http://smglinx.intra/SymSym/query/dbquery.pl?dbfilter=team+%3D+%27uibench%27&viewdata=other&dbview=table&dbschema=performance&p_reset=1&dbtable=performance_uibench_tests&Submit=%3E |
|
27 # # The results are graphed at |
|
28 # # http://smglinx.intra/twiki/bin/view/Perfresult/TestReportUibench |
|
29 # # uibench Location of script //EPOC/DV3/task/2005/November/UI-Perf/master-mnt/graphics/ui_bench/scripts/uibench2db.pl |
|
30 # # uibench contact David Kren |
|
31 # # SMG Location of script //EPOC/development/sag/performance/scripts/uibench2db.pl |
|
32 # # The SMG contact for the above is Patrick Diamond ext 1316 |
|
33 # # Instructions for adding new performance testcase results |
|
34 # # 1) If the result is in a new file then add its name to |
|
35 # # the global variable @testfiles_tef |
|
36 # # 2) amend the function process_build_tef_file to extract the performance data |
|
37 # # 3) run this script with the parms --dir & --writecsv but without --writedb |
|
38 # # check the contents of the csv file |
|
39 # # 4) To switch on debugging run on the cmd line "set DEBUG=2" |
|
40 # # If stuck after trying the above contact Patrick Diamond ext 1316 |
|
41 # # -- SQL Definitation |
|
42 # # CREATE TABLE performance.performance_uibench_tests ( |
|
43 # # team text, |
|
44 # # platform text, |
|
45 # # build text, |
|
46 # # testdate timestamp, |
|
47 # # testname text, |
|
48 # # resulttype text, |
|
49 # # result real); |
|
50 # # GRANT INSERT,DELETE,SELECT ON TABLE performance.performance_uibench_tests to performance_uibench; |
|
51 # # GRANT SELECT ON TABLE performance.performance_uibench_tests to public; |
|
52 # # GRANT USAGE ON SCHEMA performance to performance_uibench; |
|
53 # # CREATE INDEX performance_uibench_tests_platform ON performance.performance_uibench_tests(platform); |
|
54 # # CREATE INDEX performance_uibench_tests_testname ON performance.performance_uibench_tests(testname text_pattern_ops); |
|
55 # # COMMENT ON TABLE performance.performance_uibench_tests is 'Overnight performance test results for Graphics team, uibench results'; |
|
56 # ovgbenchmark.htm TESTEXECUTEfbstest_T_Performance.script.htm TESTEXECUTEscdvtest_t_performance.script.htm |
|
57 # |
|
58 # |
|
59 |
|
60 use Getopt::Long; |
|
61 use File::Basename; |
|
62 use File::Find; |
|
63 use strict; |
|
64 use warnings; |
|
65 |
|
66 my ($file,$help,$platform,$days,$writedb,$writecsv); |
|
67 $days=2; |
|
68 |
|
69 my @testfiles_tef = ('TESTEXECUTEte_uibench.Script.htm'); |
|
70 my @testfiles_rtest ; |
|
71 |
|
72 GetOptions ('dir=s' => \$file, |
|
73 'platform|p=s' => \$platform, |
|
74 'days|d=s' => \$days, |
|
75 'writecsv' => \$writecsv, |
|
76 'writedb' => \$writedb, |
|
77 'help|h|?' =>\$help) || usage(); |
|
78 |
|
79 usage(0) if $help; |
|
80 usage(1,'dir') if not defined $file; |
|
81 usage(1,'days') if not defined $days or $days !~ /^[0-9]+$/; |
|
82 $file =~ s/\\/\//g; # swap all \ for / in file/dir name |
|
83 my $DEBUG=0; |
|
84 $DEBUG=$ENV{DEBUG} if exists $ENV{DEBUG}; |
|
85 |
|
86 my @files; |
|
87 |
|
88 # if the path points to a file then use that |
|
89 if ( -f $file ) { |
|
90 push @files,$file; |
|
91 } else { |
|
92 # use the path as a dir path and search for build.html files |
|
93 print "Searching for build.html files\n" if $DEBUG; |
|
94 $file .= '/'; # ensure dir path ends in / |
|
95 $file =~ s/\/\/$/\//g; # ensure dir path doesn't end in // |
|
96 foreach my $f ("${file}build.html" , glob($file . '*/build.html')) { |
|
97 next if not defined $f; |
|
98 next if not -f $f; |
|
99 next if -M $f > $days; |
|
100 push @files,$f; |
|
101 } |
|
102 } |
|
103 |
|
104 |
|
105 # check that this machine has the perl drivers necessary to contact the database |
|
106 check_db_drivers(); |
|
107 |
|
108 # DB connect |
|
109 my $dbh; |
|
110 $dbh = connect_to_db() if defined $writedb; |
|
111 |
|
112 # Now extract test data from each build and call script to place data in database |
|
113 foreach my $f (@files) { |
|
114 my $testdata = process_test_build($f); |
|
115 |
|
116 my $team='uibench'; |
|
117 my $build = $testdata->{'build'}; |
|
118 my $date = $testdata->{'date'}; |
|
119 my $platform = $testdata->{'platform'}; |
|
120 |
|
121 $dbh->begin_work if defined $writedb; |
|
122 remove_duplicates ($dbh,$team,$build,$platform,$date) if defined $writedb; |
|
123 my $csv; |
|
124 open($csv,'>',dirname($f) . "/performance.csv") or die $! if defined $writecsv; |
|
125 |
|
126 # loop over each result and output it to db and csv |
|
127 foreach my $result (@{$testdata->{'results'}}) { |
|
128 next if not defined $result; |
|
129 next if not defined $result->{'value'} or $result->{'value'} eq ''; |
|
130 |
|
131 process_sql($dbh,$team,$platform,$build,$date,$result->{'testname'},$result->{'type'},$result->{'value'}) if defined $writedb; |
|
132 print $csv "$team,$platform,$build,$date,\"$result->{'testname'}\",\"$result->{'type'}\",$result->{'value'}\n" if defined $writecsv; |
|
133 |
|
134 print "." if not $DEBUG; |
|
135 } |
|
136 |
|
137 $dbh->commit or die ("DB error : $dbh->errorstr") if defined $writedb; |
|
138 close($csv) if defined $writecsv; |
|
139 |
|
140 print "\n" if not $DEBUG; |
|
141 } |
|
142 |
|
143 ######################### |
|
144 # Define subroutines |
|
145 |
|
146 # print out a usage message for this script and exit |
|
147 sub usage { |
|
148 my ($r,$p) = @_; |
|
149 $r = 0 if not defined $r; |
|
150 |
|
151 print "uibench2db.pl \n"; |
|
152 print "Error: Parameter \"--$p\" missing\n" if defined $p; |
|
153 |
|
154 print " --dir=<location of the build.html file with the test results>\n"; |
|
155 print " --days=<filter on number of days since data(zip) file was modified>\n"; |
|
156 print " --help : this text\n"; |
|
157 exit $r; |
|
158 } |
|
159 |
|
160 # Find and process each performance test case log |
|
161 sub process_test_build { |
|
162 my ($file) = @_; |
|
163 print "Function process_test_build: $file\n" if $DEBUG; |
|
164 |
|
165 my $testdata = {'date' => undef,'platform' => undef, 'build' => undef, 'results' => []}; |
|
166 my $dir = dirname($file); |
|
167 |
|
168 # find date,platform and build values for this set of test results |
|
169 process_build_log($testdata,$file); |
|
170 |
|
171 # find and process rtest logs |
|
172 foreach my $f (@testfiles_rtest) { |
|
173 print "\tLooking for $f\n" if $DEBUG > 1; |
|
174 my ($logfile) = glob("$dir/*/$f"); |
|
175 process_build_rtest_file($testdata,$logfile) if defined $logfile; |
|
176 } |
|
177 |
|
178 # find and process TEF logs |
|
179 foreach my $f (@testfiles_tef) { |
|
180 print "\tLooking for $f\n" if $DEBUG > 1; |
|
181 my ($logfile) = glob("$dir/*/$f"); |
|
182 process_build_tef_file($testdata,$logfile) if defined $logfile; |
|
183 } |
|
184 |
|
185 return $testdata; |
|
186 } |
|
187 |
|
188 # Extract the platform and date from the build.html file |
|
189 sub process_build_log { |
|
190 my ($test,$build_log) = @_; |
|
191 |
|
192 open (FH, "<", $build_log) or die "Error opening $file\n$!\n"; |
|
193 my @lines = <FH>; |
|
194 close(FH); |
|
195 |
|
196 # extract the build date and platform |
|
197 my ($date_line) = grep {/Build report for build /} @lines; |
|
198 my ($year,$month,$day,$hour,$minute,$platform) = |
|
199 ($date_line =~ /([0-9]{4})_([0-9][0-9])_([0-9][0-9])_([0-9][0-9])([0-9][0-9])_(.*?)\</); |
|
200 $test->{'date'} = "$year-$month-$day $hour:$minute"; |
|
201 |
|
202 # determine the platform name |
|
203 my @tags = split /_/,lc($platform); |
|
204 $test->{'platform'} = "$tags[1] $tags[0] $tags[2]"; |
|
205 |
|
206 # extract the name of the build |
|
207 my ($build_line) = grep {/Full OS Build Used:/} @lines; |
|
208 my ($build) = ($build_line =~ /Used:\s*(.*?)\.*\</); |
|
209 $test->{'build'} = $build; |
|
210 } |
|
211 |
|
212 |
|
213 # Extract the platform and date from the build.summary file |
|
214 sub process_build_rtest_file { |
|
215 my ($testdata,$file) = @_; |
|
216 |
|
217 print "Function process_build_rtest_file : $file\n" if $DEBUG; |
|
218 my $data = read_file($file); |
|
219 1 while $data =~ s/\<.*?\>//g; # strip all html tags |
|
220 |
|
221 my ($txt,$state) = ('',''); |
|
222 foreach my $line (split /\n/,$data) { |
|
223 chomp($line); |
|
224 $line =~ s/[[:cntrl:]]//g; # strip ctl chars |
|
225 if ($line =~ /^RTEST TITLE:\s*([a-z]+.*?)\s*$/i) { |
|
226 # start of new test case |
|
227 $state = $1; |
|
228 $state =~ s/\s*[0-9\.\(\)]+$//; # strip numeric suffix |
|
229 $txt = ''; |
|
230 } elsif ($state ne '' and $line =~ /^RTEST: SUCCESS\s*:/i) { |
|
231 # end of test case |
|
232 $txt .= "$line\n"; |
|
233 process_build_rtest_text($txt, $testdata->{'results'},$file,$state); |
|
234 $txt = ''; |
|
235 $state = ''; |
|
236 } elsif ($state eq '' and $line =~ /^\s*RTEST:\s+Level\s+[0-9]+\s+Next\s+test\s+.\s+(.*?)\s*$/i) { |
|
237 # start of new test case where the title hasn't been used |
|
238 # e.g. RTEST: Level 001 Next test - Defect tests |
|
239 $state = $1; |
|
240 $txt = ''; |
|
241 } |
|
242 $txt .= "$line\n" if $state ne ''; |
|
243 } |
|
244 } |
|
245 |
|
246 # Extract test performance data frome each TEF file |
|
247 sub process_build_tef_file { |
|
248 my ($testdata,$file) = @_; |
|
249 |
|
250 print "Function process_build_tef_file : $file\n" if $DEBUG; |
|
251 my $result = $testdata->{'results'}; |
|
252 my $data = read_file($file); |
|
253 1 while $data =~ s/\<.*?\>//g; # strip all html tags |
|
254 |
|
255 |
|
256 my ($txt,$state) = ('',''); |
|
257 foreach my $line (split /\n/,$data) { |
|
258 chomp($line); |
|
259 $line =~ s/[[:cntrl:]]/ /g; # strip ctl chars |
|
260 $txt .= $line; |
|
261 $txt .= "\n"; |
|
262 } |
|
263 |
|
264 # process results from TESTEXECUTEte_uibench.script.htm |
|
265 if ($file =~ /TESTEXECUTEte_uibench.Script.htm/i) { |
|
266 |
|
267 my %tests; |
|
268 |
|
269 # Format 1 : Result displayed in microseconds - Max and Min available |
|
270 while ($txt =~ /TID:\s+([^\s]+?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+us.*?\s+Max:\s+([0-9]+)\s+Min:\s+([0-9]+)\s+/gms) { |
|
271 my ($testname,$rot,$srcmode,$destmode,$iters,$microseconds,$max,$min) = ($1,$2,$3,$4,$5,$6,$7,$8); |
|
272 next if not defined $max or not defined $min; |
|
273 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
274 $tests{$testname} = 1; # record the fact that this test has been processed |
|
275 push @$result, {'testname' => "$testname,Mean", 'value' => $microseconds, 'type' => 'microseconds'}; |
|
276 #push @$result, {'testname' => "$testname,Max", 'value' => $max, 'type' => 'microseconds'}; |
|
277 #push @$result, {'testname' => "$testname,Min", 'value' => $min, 'type' => 'microseconds'}; |
|
278 print "\t$testname:Mean\t$microseconds\t$microseconds\n" if $DEBUG > 1; |
|
279 print "\t$testname:Max\t$max\t$max\n" if $DEBUG > 1; |
|
280 print "\t$testname:Min\t$min\t$min\n" if $DEBUG > 1; |
|
281 } |
|
282 |
|
283 # Format 2 : Result displayed in microseconds - Max and Min not available |
|
284 while ($txt =~ /TID:\s+(.*?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+us/g) { |
|
285 my ($testname,$rot,$srcmode,$destmode,$iters,$microseconds) = ($1,$2,$3,$4,$5,$6); |
|
286 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
287 next if exists $tests{$testname} ;# do not process this test again |
|
288 push @$result, {'testname' => "$testname,Mean", 'value' => $microseconds, 'type' => 'microseconds'}; |
|
289 print "\t$testname:Mean\t$microseconds\t$microseconds\n" if $DEBUG > 1; |
|
290 } |
|
291 |
|
292 # Format 3 : Result displayed in pixels/second - Max and Min available |
|
293 while ($txt =~ /TID:\s+([^\s]+?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+pixels\/second.*?\s+Max:\s+([0-9]+)\s+Min:\s+([0-9]+)\s+/gms) { |
|
294 my ($testname,$rot,$srcmode,$destmode,$iters,$pps,$max,$min) = ($1,$2,$3,$4,$5,$6,$7,$8); |
|
295 next if not defined $max or not defined $min; |
|
296 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
297 $tests{$testname} = 1; # record the fact that this test has been processed |
|
298 push @$result, {'testname' => "$testname,Mean", 'value' => $pps, 'type' => 'pixels/second'}; |
|
299 #push @$result, {'testname' => "$testname,Max", 'value' => $max, 'type' => 'microseconds'}; |
|
300 #push @$result, {'testname' => "$testname,Min", 'value' => $min, 'type' => 'microseconds'}; |
|
301 print "\t$testname:Mean\t$pps\t$pps\n" if $DEBUG > 1; |
|
302 print "\t$testname:Max\t$max\t$max\n" if $DEBUG > 1; |
|
303 print "\t$testname:Min\t$min\t$min\n" if $DEBUG > 1; |
|
304 } |
|
305 |
|
306 # Format 4 : Result displayed in pixels/second - Max and Min not available |
|
307 while ($txt =~ /TID:\s+(.*?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+pixels\/second/g) { |
|
308 my ($testname,$rot,$srcmode,$destmode,$iters,$pps) = ($1,$2,$3,$4,$5,$6); |
|
309 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
310 next if exists $tests{$testname} ;# do not process this test again |
|
311 push @$result, {'testname' => "$testname,Mean", 'value' => $pps, 'type' => 'pixels/second'}; |
|
312 print "\t$testname:Mean\t$pps\t$pps\n" if $DEBUG > 1; |
|
313 } |
|
314 |
|
315 # Format 5 : Result displayed in characters/second - Max and Min available |
|
316 while ($txt =~ /TID:\s+([^\s]+?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+characters\/second.*?\s+Max:\s+([0-9]+)\s+Min:\s+([0-9]+)\s+/gms) { |
|
317 my ($testname,$rot,$srcmode,$destmode,$iters,$cps,$max,$min) = ($1,$2,$3,$4,$5,$6,$7,$8); |
|
318 next if not defined $max or not defined $min; |
|
319 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
320 $tests{$testname} = 1; # record the fact that this test has been processed |
|
321 push @$result, {'testname' => "$testname,Mean", 'value' => $cps, 'type' => 'characters/second'}; |
|
322 #push @$result, {'testname' => "$testname,Max", 'value' => $max, 'type' => 'microseconds'}; |
|
323 #push @$result, {'testname' => "$testname,Min", 'value' => $min, 'type' => 'microseconds'}; |
|
324 print "\t$testname:Mean\t$cps\t$cps\n" if $DEBUG > 1; |
|
325 print "\t$testname:Max\t$max\t$max\n" if $DEBUG > 1; |
|
326 print "\t$testname:Min\t$min\t$min\n" if $DEBUG > 1; |
|
327 } |
|
328 |
|
329 # Format 6 : Result displayed in characters/second - Max and Min not available |
|
330 while ($txt =~ /TID:\s+(.*?)\s+Rot:\s+([0-9]+)\s+SrcMode:\s+([0-9]+)\s+DestMode:\s+([0-9]+)\s+Iters:\s+([0-9]+)\s+TrimmedMean:\s+([0-9]+)\s+characters\/second/g) { |
|
331 my ($testname,$rot,$srcmode,$destmode,$iters,$cps) = ($1,$2,$3,$4,$5,$6); |
|
332 $testname = sprintf('%s,Rot:%1d,SrcMode:%2d,DestMode:%2d',$testname,$rot,$srcmode,$destmode); |
|
333 next if exists $tests{$testname} ;# do not process this test again |
|
334 push @$result, {'testname' => "$testname,Mean", 'value' => $cps, 'type' => 'characters/second'}; |
|
335 print "\t$testname:Mean\t$cps\t$cps\n" if $DEBUG > 1; |
|
336 } |
|
337 } |
|
338 } |
|
339 |
|
340 |
|
341 # process the text associated with 1 testcase and extract performace results |
|
342 sub process_build_rtest_text { |
|
343 my ($txt, $result, $logfile, $testname) = @_; |
|
344 print "Function process_build_rtest_text: $logfile, $testname\n" if $DEBUG > 1; |
|
345 |
|
346 next if not defined $testname or $testname =~ /^\s*$/; |
|
347 $testname =~ s/[-]/:/g; # replace - with : as subtitle seperator |
|
348 $testname =~ s/\s*performance test\s*$//; # strip unnecessary suffix to test name |
|
349 print "$testname \n" if $DEBUG > 1; |
|
350 |
|
351 if ($testname eq 'T_BENCH') { |
|
352 while ($txt =~ /^\s*(.*?):\s*(.*?)\s+ms$/gim) { |
|
353 my ($subname,$num) = ($1,$2); |
|
354 push @$result, {'testname' => "$testname:$subname", 'value' => $num, 'type' => 'milliseconds'}; |
|
355 print "\t$testname:$subname\t$num\tmilliseconds\n" if $DEBUG > 1; |
|
356 } |
|
357 |
|
358 } |
|
359 return $result; |
|
360 } |
|
361 |
|
362 # return a connection to the databasse |
|
363 sub connect_to_db { |
|
364 print "Connecting to DB\n" if $DEBUG; |
|
365 my $dbh = DBI->connect('DBI:PgPP:dbname=metadata;host=smglinx.symbian.intra', 'performance_uibench', 'grui'); |
|
366 print "Connected to DB\n" if $DEBUG; |
|
367 return $dbh; |
|
368 } |
|
369 |
|
370 # save the result to the database |
|
371 sub process_sql { |
|
372 my ($dbh,$team,$platform,$build,$testdate,$testname,$resulttype,$result) = @_; |
|
373 |
|
374 print "Processing $testname result\n" if $DEBUG > 1; |
|
375 if ($DEBUG > 1) { |
|
376 shift; |
|
377 print 'Saving ' . join(',',@_) . "\n"; |
|
378 } |
|
379 my $sth = $dbh->prepare("INSERT INTO performance.performance_uibench_tests (team,platform,build,testdate,testname,resulttype,result) VALUES(?,?,?,?,?,?,?)") or die "Prepare Error $dbh->errorstr"; |
|
380 |
|
381 $sth->execute($team, |
|
382 $platform, |
|
383 $build, |
|
384 $testdate, |
|
385 $testname, |
|
386 $resulttype, |
|
387 $result) |
|
388 or die ("Error inserting values $team,$platform,$build,$testdate,$testname,$resulttype,$result\n $dbh->errorstr"); |
|
389 |
|
390 print "Saved result\n" if $DEBUG > 1; |
|
391 } |
|
392 |
|
393 # read in and return the contents of a file |
|
394 sub read_file { |
|
395 my ($file) = @_; |
|
396 |
|
397 open (FH,"<",$file) or die "Error reading from $file\n$!\n"; |
|
398 my $file_size = (stat ($file))[7]; # Size of file |
|
399 my $data; |
|
400 read(FH, $data, $file_size); |
|
401 close(FH); |
|
402 |
|
403 return $data; |
|
404 } |
|
405 |
|
406 # before saving to the database delete any duplicate data |
|
407 sub remove_duplicates { |
|
408 my ($dbh,$team,$build,$platform,$date) = @_; |
|
409 |
|
410 my $sth = $dbh->prepare("delete from performance.performance_uibench_tests where team = ? and build = ? and platform = ? and testdate = ?") or die "Prepare Error $dbh->errorstr"; |
|
411 |
|
412 $sth->execute($team, $build, $platform, $date) |
|
413 or die ("Error deleteing values $team,$build\n $dbh->errorstr"); |
|
414 |
|
415 } |
|
416 |
|
417 |
|
418 # ensure that the modules necessary to drive the database interactions are available and loaded |
|
419 sub check_db_drivers { |
|
420 |
|
421 print "Checking for DBI module\n" if $DEBUG; |
|
422 eval{require DBI}; |
|
423 if($@) { |
|
424 print "Failed to load DBI\n Now attempting to download and install\nppm install DBI\n"; |
|
425 system("ppm","install","DBI"); |
|
426 require DBI; |
|
427 } |
|
428 |
|
429 print "Checking for DBD::PgPP database driver module\n" if $DEBUG; |
|
430 eval{require DBD::PgPP}; |
|
431 if($@) { |
|
432 print "Failed to load DBD::PgPP\n Now attempting to download and install\nppm install DBD-PgPP\n"; |
|
433 system("ppm","install","DBD-PgPP"); |
|
434 require DBD::PgPP; |
|
435 } |
|
436 } |
|
437 |
|
438 sub find_performance_files { |
|
439 if ($File::Find::name |
|
440 =~ /\/t_performance.txt/i) { |
|
441 my $afile = lc($File::Find::name); |
|
442 $afile =~ s/\\/\//g; |
|
443 push @files, lc($afile); |
|
444 print "Found $afile\n" if $DEBUG; |
|
445 print "+" if not $DEBUG; |
|
446 } |
|
447 } |