Merge lp:~johnemb/randgen/xml-report into lp:randgen

Proposed by John H. Embretsen on 2010-04-07
Status: Merged
Merged at revision: not available
Proposed branch: lp:~johnemb/randgen/xml-report
Merge into: lp:randgen
Diff against target: 1405 lines (+861/-284)
9 files modified
gentest.pl (+14/-2)
lib/GenTest.pm (+10/-2)
lib/GenTest/App/GenTest.pm (+38/-2)
lib/GenTest/XML/BuildInfo.pm (+112/-96)
lib/GenTest/XML/Environment.pm (+331/-46)
lib/GenTest/XML/Report.pm (+66/-53)
lib/GenTest/XML/Test.pm (+85/-80)
lib/GenTest/XML/Transporter.pm (+189/-0)
runall.pl (+16/-3)
To merge this branch: bzr merge lp:~johnemb/randgen/xml-report
Reviewer Review Type Date Requested Status
Random Query Generator Team 2010-04-07 Pending
Review via email: mp+22942@code.launchpad.net

Description of the change

Basic support for automatic test reporting. Extends the existing XML reporting functionality (module) with various fixes, adaptations to new version of the specified schema, and adds functionality for sending XML report files via SCP to a remote destination.

The functionality is working, but expect to see further improvements in the near future.

New options (to runall and gentest) added (subject to change):

 --testname=<name_of_test>
 --report-xml-tt (enable reporting to the TestTool reporting framework)
 --report-xml-tt-type=<type> (report transport type, current default is "scp")
 --report-xml-tt-dest=<destination> (where to send XML report, current default is set to some non-public user@host:path, tested internally).

To enable XML report delivery both options --xml-output=<filename> and --report-xml-tt must be set.

See https://blueprints.launchpad.net/randgen/+spec/xml-report-delivery

To post a comment you must log in.

Preview Diff

[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1=== modified file 'gentest.pl'
2--- gentest.pl 2010-03-13 15:32:59 +0000
3+++ gentest.pl 2010-04-07 14:30:43 +0000
4@@ -46,6 +46,7 @@
5 'gendata:s',
6 'grammar=s',
7 'redefine=s',
8+ 'testname=s',
9 'threads=i',
10 'queries=s',
11 'duration=s',
12@@ -54,12 +55,15 @@
13 'rpl_mode=s',
14 'validators:s@',
15 'reporters:s@',
16+ 'report-xml-tt',
17+ 'report-xml-tt-type=s',
18+ 'report-xml-tt-dest=s',
19 'seed=s',
20 'mask=i',
21 'mask-level=i',
22 'rows=i',
23 'varchar-length=i',
24- 'xml_output=s',
25+ 'xml-output=s',
26 'views',
27 'start-dirty',
28 'filter=s',
29@@ -77,6 +81,7 @@
30 'engine',
31 'gendata',
32 'redefine',
33+ 'testname',
34 'threads',
35 'queries',
36 'duration',
37@@ -85,6 +90,9 @@
38 'rpl_mode',
39 'validators',
40 'reporters',
41+ 'report-xml-tt',
42+ 'report-xml-tt-type',
43+ 'report-xml-tt-dest',
44 'seed',
45 'mask',
46 'mask-level',
47@@ -138,7 +146,11 @@
48 --views : Pass --views to gendata-old.pl or gendata.pl
49 --filter : ......
50 --start-dirty: Do not generate data (use existing database(s))
51- --xml-output: ......
52+ --xml-output: Name of a file to which an XML report will be written if this option is set.
53+ --report-xml-tt: Report test results in XML-format to the Test Tool (TT) reporting framework.
54+ --report-xml-tt-type: Type of TT XML transport to use (e.g. scp)
55+ --report-xml-tt-dest: Destination of TT XML report (e.g. user\@host:/path/to/location (for type scp))
56+ --testname : Name of test, used for reporting purposes.
57 --valgrind : ......
58 --filter : ......
59 --help : This help message
60
61=== modified file 'lib/GenTest.pm'
62--- lib/GenTest.pm 2010-03-04 13:51:59 +0000
63+++ lib/GenTest.pm 2010-04-07 14:30:43 +0000
64@@ -18,7 +18,7 @@
65 package GenTest;
66 use base 'Exporter';
67
68-@EXPORT = ('say', 'sayFile', 'tmpdir', 'safe_exit', 'windows',
69+@EXPORT = ('say', 'sayFile', 'tmpdir', 'safe_exit', 'windows', 'linux',
70 'solaris', 'isoTimestamp', 'isoUTCTimestamp', 'rqg_debug');
71
72 use strict;
73@@ -123,6 +123,14 @@
74 }
75 }
76
77+sub linux {
78+ if ($^O eq 'linux') {
79+ return 1;
80+ } else {
81+ return 0;
82+ }
83+}
84+
85 sub solaris {
86 if ($^O eq 'solaris') {
87 return 1;
88@@ -136,7 +144,7 @@
89
90 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = defined $datetime ? localtime($datetime) : localtime();
91 return sprintf("%04d-%02d-%02dT%02d:%02d:%02d", $year+1900, $mon+1 ,$mday ,$hour, $min, $sec);
92-
93+
94 }
95
96 sub isoUTCTimestamp {
97
98=== modified file 'lib/GenTest/App/GenTest.pm'
99--- lib/GenTest/App/GenTest.pm 2010-04-06 13:29:11 +0000
100+++ lib/GenTest/App/GenTest.pm 2010-04-07 14:30:43 +0000
101@@ -24,6 +24,7 @@
102 use strict;
103 use Carp;
104 use Data::Dumper;
105+use File::Basename;
106
107 use GenTest;
108 use GenTest::Properties;
109@@ -40,6 +41,7 @@
110 use GenTest::XML::Report;
111 use GenTest::XML::Test;
112 use GenTest::XML::BuildInfo;
113+use GenTest::XML::Transporter;
114 use GenTest::Constants;
115 use GenTest::Result;
116 use GenTest::Validator;
117@@ -234,8 +236,24 @@
118 );
119 }
120
121+ # XML:
122+ # Define test suite name for reporting purposes.
123+ # Until we support test suites and/or reports with multiple suites/tests,
124+ # we use the test name as test suite name, from config option "testname".
125+ # Default test name is the basename portion of the grammar file name.
126+ # If a grammar file is not given, the default is "rqg_no_name".
127+ my $test_suite_name = $self->config->testname;
128+ if (not defined $test_suite_name) {
129+ if (defined $self->config->grammar) {
130+ $test_suite_name = basename($self->config->grammar, '.yy');
131+ } else {
132+ $test_suite_name = "rqg_no_name";
133+ }
134+ }
135+
136 my $test = GenTest::XML::Test->new(
137- id => Time::HiRes::time(),
138+ id => time(),
139+ name => $test_suite_name, # NOTE: Consider changing to test (or test case) name when suites are supported.
140 attributes => {
141 engine => $self->config->engine,
142 gendata => $self->config->gendata,
143@@ -254,6 +272,7 @@
144
145 my $report = GenTest::XML::Report->new(
146 buildinfo => $buildinfo,
147+ name => $test_suite_name, # NOTE: name here refers to the name of the test suite or "test".
148 tests => [ $test ]
149 );
150
151@@ -393,9 +412,26 @@
152 $test->end($total_status == STATUS_OK ? "pass" : "fail");
153
154 if (defined $self->config->property('xml-output')) {
155- open (XML , ">$self->config->property('xml-output')") or say("Unable to open $self->config->property('xml-output'): $!");
156+ open (XML , '>'.$self->config->property('xml-output')) or carp("Unable to open ".$self->config->property('xml-output').": $!");
157 print XML $report->xml();
158 close XML;
159+ say("XML report written to ". $self->config->property('xml-output'));
160+ }
161+
162+ # XML Result reporting to Test Tool (TT).
163+ # Currently both --xml-output=<filename> and --report-xml-tt must be
164+ # set to trigger this.
165+ if (defined $self->config->property('report-xml-tt')) {
166+ my $xml_transporter = GenTest::XML::Transporter->new(
167+ type => $self->config->property('report-xml-tt-type')
168+ );
169+ my $result = $xml_transporter->sendXML(
170+ $self->config->property('xml-output'),
171+ $self->config->property('report-xml-tt-dest')
172+ );
173+ if ($result != STATUS_OK) {
174+ croak("Error from XML Transporter: $result");
175+ }
176 }
177
178 if ($total_status == STATUS_OK) {
179
180=== modified file 'lib/GenTest/XML/BuildInfo.pm'
181--- lib/GenTest/XML/BuildInfo.pm 2010-02-10 12:47:45 +0000
182+++ lib/GenTest/XML/BuildInfo.pm 2010-04-07 14:30:43 +0000
183@@ -1,4 +1,4 @@
184-# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
185+# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
186 # Use is subject to license terms.
187 #
188 # This program is free software; you can redistribute it and/or modify
189@@ -24,107 +24,123 @@
190 use GenTest;
191 use DBI;
192
193-use constant BUILDINFO_DSNS => 0;
194-use constant BUILDINFO_SERVERS => 1;
195+use constant BUILDINFO_DSNS => 0;
196+use constant BUILDINFO_SERVERS => 1;
197
198-use constant BUILDINFO_SERVER_VERSION => 0;
199-use constant BUILDINFO_SERVER_PACKAGE => 1;
200-use constant BUILDINFO_SERVER_BIT => 2;
201-use constant BUILDINFO_SERVER_PATH => 3;
202-use constant BUILDINFO_SERVER_VARIABLES => 4;
203+use constant BUILDINFO_SERVER_VERSION => 0;
204+use constant BUILDINFO_SERVER_PACKAGE => 1;
205+use constant BUILDINFO_SERVER_BIT => 2;
206+use constant BUILDINFO_SERVER_PATH => 3;
207+use constant BUILDINFO_SERVER_VARIABLES => 4;
208
209 sub new {
210- my $class = shift;
211-
212- my $buildinfo = $class->SUPER::new({
213- dsns => BUILDINFO_DSNS
214- }, @_);
215-
216- $buildinfo->[BUILDINFO_SERVERS] = [];
217-
218- foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]}) {
219- my $dsn = $buildinfo->[BUILDINFO_DSNS]->[$id];
220- next if $dsn eq '';
221- my $dbh = DBI->connect($dsn);
222-
223- my $server;
224-
225- $server->[BUILDINFO_SERVER_VERSION] = $dbh->selectrow_array('SELECT @@version');
226- $server->[BUILDINFO_SERVER_PACKAGE] = $dbh->selectrow_array('SELECT @@version_comment');
227- $server->[BUILDINFO_SERVER_BIT] = $dbh->selectrow_array('SELECT @@version_compile_machine');
228- $server->[BUILDINFO_SERVER_PATH] = $dbh->selectrow_array('SELECT @@basedir');
229- $server->[BUILDINFO_SERVER_VARIABLES] = [];
230-
231- my $sth = $dbh->prepare("SHOW VARIABLES");
232- $sth->execute();
233- while (my ($name, $value) = $sth->fetchrow_array()) {
234- push @{$server->[BUILDINFO_SERVER_VARIABLES]}, [ $name , $value ];
235- }
236- $sth->finish();
237-
238- $dbh->disconnect();
239-
240- $buildinfo->[BUILDINFO_SERVERS]->[$id] = $server;
241- }
242-
243- return $buildinfo;
244+ my $class = shift;
245+
246+ my $buildinfo = $class->SUPER::new({
247+ dsns => BUILDINFO_DSNS
248+ }, @_);
249+
250+ $buildinfo->[BUILDINFO_SERVERS] = [];
251+
252+ foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
253+ {
254+ my $dsn = $buildinfo->[BUILDINFO_DSNS]->[$id];
255+ next if $dsn eq '';
256+ my $dbh = DBI->connect($dsn);
257+
258+ my $server;
259+
260+ # TODO: Add support for non-MySQL dsns.
261+ $server->[BUILDINFO_SERVER_VERSION] = $dbh->selectrow_array('SELECT @@version');
262+ $server->[BUILDINFO_SERVER_PACKAGE] = $dbh->selectrow_array('SELECT @@version_comment');
263+ # According to the schema, bit must be "32" or "64".
264+ #$server->[BUILDINFO_SERVER_BIT] = $dbh->selectrow_array('SELECT @@version_compile_machine');
265+ $server->[BUILDINFO_SERVER_PATH] = $dbh->selectrow_array('SELECT @@basedir');
266+ $server->[BUILDINFO_SERVER_VARIABLES] = [];
267+
268+ my $sth = $dbh->prepare("SHOW VARIABLES");
269+ $sth->execute();
270+ while (my ($name, $value) = $sth->fetchrow_array()) {
271+ push @{$server->[BUILDINFO_SERVER_VARIABLES]}, [ $name , $value ];
272+ }
273+ $sth->finish();
274+
275+ $dbh->disconnect();
276+
277+ $buildinfo->[BUILDINFO_SERVERS]->[$id] = $server;
278+ }
279+
280+ return $buildinfo;
281 }
282
283 sub xml {
284- require XML::Writer;
285-
286- my $buildinfo = shift;
287- my $buildinfo_xml;
288-
289- my $writer = XML::Writer->new(
290- OUTPUT => \$buildinfo_xml,
291- );
292-
293- $writer->startTag('product');
294- $writer->dataElement('name','mysql');
295- $writer->startTag('builds');
296-
297- foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]}) {
298- my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
299- next if not defined $server;
300-
301- $writer->startTag('build', id => $id);
302- $writer->dataElement('version', $server->[BUILDINFO_SERVER_VERSION]);
303- $writer->dataElement('package', $server->[BUILDINFO_SERVER_PACKAGE]);
304- $writer->dataElement('bit', $server->[BUILDINFO_SERVER_BIT]);
305- $writer->dataElement('path', $server->[BUILDINFO_SERVER_PATH]);
306- # <compile_options>
307- $writer->endTag('build');
308- }
309-
310- $writer->endTag('builds');
311-
312- $writer->startTag('binaries');
313-
314- foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]}) {
315- my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
316- next if not defined $server;
317-
318- $writer->startTag('binary');
319- $writer->dataElement('name', 'mysqld');
320- $writer->startTag('commandline_options');
321-
322- foreach my $option (@{$server->[BUILDINFO_SERVER_VARIABLES]}) {
323- $writer->startTag('option');
324- $writer->dataElement('name', $option->[0]);
325- $writer->dataElement('value', $option->[1]);
326- $writer->endTag('option');
327- }
328-
329- $writer->endTag('commandline_options');
330- $writer->endTag('binary');
331- }
332-
333- $writer->endTag('binaries');
334- $writer->endTag('product');
335- $writer->end();
336-
337- return $buildinfo_xml;
338+ require XML::Writer;
339+
340+ my $buildinfo = shift;
341+ my $buildinfo_xml;
342+
343+ my $writer = XML::Writer->new(
344+ OUTPUT => \$buildinfo_xml,
345+ );
346+
347+ $writer->startTag('product');
348+ $writer->dataElement('name','MySQL');
349+ $writer->startTag('builds');
350+
351+ foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
352+ {
353+ my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
354+ next if not defined $server;
355+
356+ $writer->startTag('build', id => $id);
357+ $writer->dataElement('version', $server->[BUILDINFO_SERVER_VERSION]);
358+ $writer->dataElement('package', $server->[BUILDINFO_SERVER_PACKAGE]);
359+ #$writer->dataElement('bit', $server->[BUILDINFO_SERVER_BIT]); # Must be 32 or 64
360+ $writer->dataElement('path', $server->[BUILDINFO_SERVER_PATH]);
361+ ## TODO (if applicable):
362+ #<xsd:element name="tree" type="xsd:string" minOccurs="0" form="qualified"/>
363+ #<xsd:element name="revision" type="xsd:string" minOccurs="0" form="qualified"/>
364+ #<xsd:element name="tag" type="xsd:string" minOccurs="0" form="qualified"/>
365+ #<xsd:element name="compile_options" type="cassiopeia:Options" minOccurs="0" form="qualified"/>
366+ #<xsd:element name="commandline" type="xsd:string" minOccurs="0" form="qualified" />
367+ #<xsd:element name="buildscript" minOccurs="0" type="xsd:string" form="qualified" />
368+ $writer->endTag('build');
369+ }
370+
371+
372+ $writer->endTag('builds');
373+
374+ $writer->startTag('binaries'); # --> <software> = <program>
375+
376+ foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
377+ {
378+ my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
379+ next if not defined $server;
380+
381+ $writer->startTag('program');
382+ $writer->dataElement('name', 'mysqld');
383+ $writer->dataElement('type', 'database');
384+ $writer->startTag('commandline_options');
385+
386+ # TODO: List actual commmand-line options (and config file options /
387+ # RQG-defaults?), not all server variables?
388+ foreach my $option (@{$server->[BUILDINFO_SERVER_VARIABLES]})
389+ {
390+ $writer->startTag('option');
391+ $writer->dataElement('name', $option->[0]);
392+ $writer->dataElement('value', $option->[1]);
393+ $writer->endTag('option');
394+ }
395+
396+ $writer->endTag('commandline_options');
397+ $writer->endTag('program');
398+ }
399+
400+ $writer->endTag('binaries');
401+ $writer->endTag('product');
402+ $writer->end();
403+
404+ return $buildinfo_xml;
405 }
406
407 1;
408
409=== modified file 'lib/GenTest/XML/Environment.pm'
410--- lib/GenTest/XML/Environment.pm 2010-02-10 12:47:45 +0000
411+++ lib/GenTest/XML/Environment.pm 2010-04-07 14:30:43 +0000
412@@ -1,4 +1,4 @@
413-# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
414+# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
415 # Use is subject to license terms.
416 #
417 # This program is free software; you can redistribute it and/or modify
418@@ -21,57 +21,342 @@
419 @ISA = qw(GenTest);
420
421 use strict;
422+use Carp;
423+use File::Spec;
424 use GenTest;
425-
426+use Net::Domain qw(hostfqdn);
427+
428+# Global variables keeping environment info
429+our $hostname = Net::Domain->hostfqdn();
430+our $arch;
431+our $kernel;
432+our $bit;
433+our $cpu;
434+our $memory;
435+#our $disk;
436+our $role = 'server';
437+our $locale;
438+our $encoding;
439+our $timezone;
440+our $osType;
441+our $osVer;
442+our $osRev;
443+our $osPatch;
444+our $osBit;
445+
446+
447+our $DEBUG=0;
448
449 sub new {
450- my $class = shift;
451-
452- my $environment = $class->SUPER::new({
453- }, @_);
454-
455- return $environment;
456+ my $class = shift;
457+
458+ my $environment = $class->SUPER::new({
459+ }, @_);
460+
461+ return $environment;
462 }
463
464 sub xml {
465- require XML::Writer;
466-
467- my $environment = shift;
468- my $environment_xml;
469-
470- my $writer = XML::Writer->new(
471- OUTPUT => \$environment_xml,
472- );
473-
474- $writer->startTag('environments');
475- $writer->startTag('environment', 'id' => 0);
476- $writer->startTag('hosts');
477- $writer->startTag('host');
478-
479- $writer->dataElement('name', `hostname`);
480- $writer->dataElement('arch', $^O);
481- $writer->dataElement('role', 'server');
482-
483- # <os>
484-
485- # <software>
486-
487- $writer->startTag('software');
488- $writer->startTag('program');
489- $writer->dataElement('name', 'perl');
490- $writer->dataElement('version', $^V);
491- $writer->dataElement('path', $^X);
492- $writer->endTag('program');
493- $writer->endTag('software');
494-
495- $writer->endTag('host');
496- $writer->endTag('hosts');
497- $writer->endTag('environment');
498- $writer->endTag('environments');
499-
500- $writer->end();
501-
502- return $environment_xml;
503+ require XML::Writer;
504+
505+ # Obtain environmental info from host.
506+ # In separate function because lots of logic is needed to parse various
507+ # information based on the OS.
508+ getInfo();
509+
510+ my $environment = shift;
511+ my $environment_xml;
512+
513+ my $writer = XML::Writer->new(
514+ OUTPUT => \$environment_xml,
515+ );
516+
517+ $writer->startTag('environments');
518+ $writer->startTag('environment', 'id' => 0);
519+ $writer->startTag('hosts');
520+ $writer->startTag('host');
521+
522+ # Some elements may be empty either because
523+ # a) we don't know that piece of information
524+ # b) values are fetched from a database of test hosts
525+ $writer->dataElement('name', $hostname);
526+ $writer->dataElement('arch', $arch);
527+ $writer->dataElement('kernel', $kernel);
528+ $writer->dataElement('bit', $bit) if defined $bit;
529+ $writer->dataElement('cpu', $cpu);
530+ $writer->dataElement('memory', $memory);
531+ $writer->dataElement('disk', '');
532+ $writer->dataElement('role', $role);
533+ $writer->dataElement('locale', $locale);
534+ $writer->dataElement('encoding', $encoding);
535+ $writer->dataElement('timezone', $timezone);
536+
537+ #
538+ # <software> ...
539+ #
540+ $writer->startTag('software');
541+
542+ # <os>
543+ $writer->startTag('program');
544+ $writer->dataElement('name', $osType);
545+ $writer->dataElement('type', 'os');
546+ $writer->dataElement('version', $osVer);
547+ #$writer->dataElement('patch', $osPatch); # not in XML schema
548+ $writer->dataElement('bit', $osBit) if defined $osBit;
549+ $writer->endTag('program');
550+
551+ # <program> perl
552+ $writer->startTag('program');
553+ $writer->dataElement('name', 'perl');
554+ $writer->dataElement('type', 'perl');
555+ #$writer->dataElement('version', $^V); # Solaris yields: Code point \u0005 is not a valid character in XML at lib/GenTest/XML/Environment.pm line 45
556+ $writer->dataElement('version', $]);
557+ $writer->dataElement('path', $^X);
558+ $writer->endTag('program');
559+
560+ # <program> harness
561+ $writer->startTag('program');
562+ $writer->dataElement('name', 'Random Query Generator');
563+ $writer->dataElement('type', 'harness');
564+ my $rqg_path = File::Spec->rel2abs(); # assuming cwd is the randgen dir
565+ $writer->dataElement('path', $rqg_path);
566+ ## TODO (if applicable):
567+ #<xsd:element name="version" type="xsd:string" minOccurs="0" maxOccurs="1" form="qualified"/>
568+ #<xsd:element name="revision" type="xsd:int" minOccurs="0" form="qualified"/>
569+ #<xsd:element name="commandline_options" type="cassiopeia:Options" minOccurs="0" form="qualified"/>
570+ #<xsd:element name="commandline" minOccurs="0" type="xsd:string" form="qualified" /> # alternative to the above
571+ $writer->endTag('program');
572+
573+ $writer->endTag('software');
574+
575+ $writer->endTag('host');
576+ $writer->endTag('hosts');
577+ $writer->endTag('environment');
578+ $writer->endTag('environments');
579+
580+ $writer->end();
581+
582+ return $environment_xml;
583+}
584+
585+sub getInfo()
586+{
587+
588+ # lets see what OS type we have
589+ if (linux())
590+ {
591+
592+ # Get the CPU info
593+ $cpu = trim(`cat /proc/cpuinfo | grep -i "model name" | head -n 1 | cut -b 14-`);
594+ my $numOfP = trim(`cat /proc/cpuinfo | grep processor |wc -l`);
595+ $cpu ="$numOfP"."x"."$cpu";
596+
597+ #try to get OS Information
598+ if (-e "/etc/SuSE-release"){$osVer=`cat /etc/SuSE-release |head -n 1`;}
599+ elsif (-e "/etc/redhat-release"){$osVer=`cat /etc/redhat-release |head -n 1`;}
600+ elsif (-e "/etc/debian_version"){$osVer=`cat /etc/debian_version |head -n 1`;}
601+ else {$osVer="linux-unknown";}
602+ $osVer=trim($osVer);
603+ if (-e "/etc/SuSE-release"){$osPatch=`cat /etc/SuSE-release |tail -n 1`;}
604+ elsif (-e "/etc/redhat-release"){$osPatch=`cat /etc/redhat-release |tail -n 1`;}
605+ elsif (-e "/etc/debian_version"){$osPatch=`cat /etc/debian_version |tail -n 1`;}
606+ else {$osPatch="unknown";}
607+ (my $trash, $osPatch) = split(/=/,$osPatch);
608+ $osType="Linux";
609+ $arch=trim(`uname -m`);
610+ # We assume something like "x86_64" from 'uname -m'. Get bit info from that.
611+ ($trash, $bit) = split(/_/,$arch);
612+ # If nothing after '_' (or no '_' at all), assume 32-bit.
613+ $bit = "32" if length($bit) < 1;
614+ #$bit = undef if length($bit) < 1;
615+ $osBit = $bit; # treat $osBit as $bit for now...
616+
617+ $kernel=trim(`uname -r`);
618+
619+ #Memory
620+ $memory = trim(`cat /proc/meminfo | grep -i memtotal`);
621+ $memory =~ s/MemTotal: //;
622+ ($memory, $trash) = split(/k/,$memory);
623+ $memory = trim(`cat /proc/meminfo |grep -i memtotal`);
624+ $memory =~ /MemTotal:\s*(\d+)/;
625+ $memory = sprintf("%.2f",($1/1024000))."GB";
626+
627+ #locale
628+ if (defined ($locale=`locale |grep LC_CTYPE| cut -b 10-`))
629+ {
630+ ($locale,$encoding) = split(/\./,$locale);
631+ }
632+ else
633+ {
634+ $locale = "UNKNOWN";
635+ $encoding = "UNKNOWN";
636+ }
637+
638+ #TimeZone
639+ $timezone = trim(`date +%Z`);
640+ }
641+ elsif(solaris())
642+ {
643+
644+ # Get the CPU info
645+ my $tmpVar = `/usr/sbin/psrinfo -v | grep -i "operates" | head -1`;
646+ ($cpu, my $speed) = split(/processor operates at/,$tmpVar);
647+ $cpu =~ s/The//;
648+ $speed =~ s/MHz//;
649+ $cpu = trim($cpu);
650+ $speed = trim($speed);
651+ if ($speed => 1000)
652+ {
653+ $speed = $speed/1000;
654+ $speed = "$speed"."GHz";
655+ }
656+ else
657+ {
658+ $speed = "$speed"."MHz";
659+ }
660+
661+ my $numOfP = `/usr/sbin/psrinfo -v | grep -i "operates" |wc -l`;
662+ $numOfP = trim($numOfP);
663+ $cpu ="$numOfP"."x"."$cpu"."$speed";
664+
665+ #try to get OS Information
666+ ($osType,$osVer,$arch) = split (/ /, trim(`uname -srp`));
667+ # use of uname -m is discouraged (man pages), so use isainfo instead
668+ $kernel = `isainfo -k`;
669+ $osBit = `isainfo -b`;
670+ my $trash; # variable functioning as /dev/null
671+ ($trash, $trash, my $osPatch1, my $osPatch2, $trash) = split(/ /, trim(`cat /etc/release | head -1`));
672+ my $osPatch3 = `uname -v`;
673+ $osPatch = $osPatch1.' '.$osPatch2.' '.$osPatch3;
674+ $osPatch = trim($osPatch);
675+
676+ #Memory
677+ $memory = `/usr/sbin/prtconf | grep Memory`;
678+ $memory =~ s/Memory size://;
679+ $memory =~ s/Megabytes//;
680+ $memory = trim($memory);
681+ $memory = $memory/1024;
682+ ($memory, my $trash) = split(/\./,$memory);
683+ $memory = "$memory"."GB";
684+
685+ #locale
686+ if (defined ($locale=`locale |grep LC_CTYPE| cut -b 10-`))
687+ {
688+ ($locale,$encoding) = split(/\./,$locale);
689+ }
690+ else
691+ {
692+ $locale = "UNKNOWN";
693+ $encoding = "UNKNOWN";
694+ }
695+
696+ #TimeZone
697+ $timezone = trim(`date +%Z`);
698+ }
699+ elsif(windows())
700+ {
701+ #$hostName = `hostname`;
702+ my @tmpData;
703+ if ($^O eq 'cygwin')
704+ {
705+ # Assuming cygwin on Windows at this point
706+ @tmpData = `cmd /c systeminfo 2>&1`;
707+ }
708+ else
709+ {
710+ # Assuming Windows at this point
711+ @tmpData = `systeminfo 2>&1`;
712+ }
713+
714+ if ($? != 0)
715+ {
716+ carp "systeminfo command failed with: $?";
717+ $cpu = "UNKNOWN";
718+ $osType = "UNKNOWN";
719+ $osVer = "UNKNOWN";
720+ $arch = "UNKNOWN";
721+ $kernel = "UNKNOWN";
722+ $memory = "UNKNOWN";
723+ $locale = "UNKNOWN";
724+ $timezone = "UNKNOWN";
725+ }
726+ else
727+ {
728+ $kernel = "UNKOWN";
729+ my $cpuFlag = 0;
730+ # Time to get busy and grab what we need.
731+ foreach my $line (@tmpData)
732+ {
733+ if ($cpuFlag == 1)
734+ {
735+ (my $numP, $cpu) = split(/\:/,$line);
736+ $numP = trim($numP);
737+ (my $trash, $numP) = split(/\[/,$numP);
738+ ($numP, $trash) = split(/\]/,$numP);
739+ $cpu = "$numP"."$cpu";
740+ $cpu = trim($cpu);
741+ $cpuFlag=0;
742+ }
743+ elsif ($line =~ /OS Name:\s+(.*?)\s*$/)
744+ {
745+ $osType = $1;
746+ }
747+ elsif ($line =~ /^OS Version:\s+(.*?)\s*$/)
748+ {
749+ $osVer = $1;
750+ }
751+ elsif ($line =~ /System type:\s/i)
752+ {
753+ (my $trash, $arch) = split(/\:/,$line);
754+ ($arch,$trash) = split(/\-/,$arch);
755+ $arch = trim($arch);
756+ }
757+ elsif ($line =~ /^Processor/)
758+ {
759+ $cpuFlag = 1;
760+ next;
761+ }
762+ elsif ($line =~ /^Total Physical Memory:\s+(.*?)\s*$/)
763+ {
764+ $memory = $1;
765+ }
766+ elsif ($line =~ /Locale:/)
767+ {
768+ (my $trash, $locale) = split(/\:/,$line);
769+ ($locale, $trash) = split(/\;/,$locale);
770+ $locale = trim($locale);
771+ }
772+ elsif ($line =~ /Time Zone:\s+(.*?)\s*$/)
773+ {
774+ $timezone = $1;
775+ }
776+ }
777+ }
778+ }
779+ else
780+ {
781+ confess "\n\nUnable to figure out OS!!\n\n";
782+ }
783+
784+ if ($DEBUG)
785+ {
786+ print "cpu = $cpu\n";
787+ print "os = $osType\n";
788+ print "OS ver = $osVer\n";
789+ print "Arch = $arch\n";
790+ print "Kernel = $kernel\n";
791+ print "memory = $memory\n";
792+ print "locale = $locale\n";
793+ print "Timezone = $timezone\n";
794+ }
795+}
796+
797+sub trim($)
798+{
799+ my $string = shift;
800+ $string =~ s/^\s+//;
801+ $string =~ s/\s+$//;
802+ return $string;
803 }
804
805 1;
806
807=== modified file 'lib/GenTest/XML/Report.pm'
808--- lib/GenTest/XML/Report.pm 2010-03-04 13:51:59 +0000
809+++ lib/GenTest/XML/Report.pm 2010-04-07 14:30:43 +0000
810@@ -1,4 +1,4 @@
811-# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
812+# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
813 # Use is subject to license terms.
814 #
815 # This program is free software; you can redistribute it and/or modify
816@@ -30,10 +30,11 @@
817 # test result XML report. Not all of them will be used
818 #
819
820-use constant XMLREPORT_DATE => 0;
821-use constant XMLREPORT_BUILDINFO => 1;
822-use constant XMLREPORT_TESTS => 2;
823-use constant XMLREPORT_ENVIRONMENT => 3;
824+use constant XMLREPORT_DATE => 0;
825+use constant XMLREPORT_BUILDINFO => 1;
826+use constant XMLREPORT_TESTS => 2;
827+use constant XMLREPORT_ENVIRONMENT => 3;
828+use constant XMLREPORT_NAME => 4;
829
830 1;
831
832@@ -44,62 +45,74 @@
833 environment => XMLREPORT_ENVIRONMENT,
834 date => XMLREPORT_DATE,
835 buildinfo => XMLREPORT_BUILDINFO,
836- tests => XMLREPORT_TESTS
837+ tests => XMLREPORT_TESTS,
838+ name => XMLREPORT_NAME
839 }, @_);
840
841- $report->[XMLREPORT_DATE] = isoUTCTimestamp() if not defined $report->[XMLREPORT_DATE];
842+ $report->[XMLREPORT_DATE] = isoTimestamp() if not defined $report->[XMLREPORT_DATE];
843 $report->[XMLREPORT_ENVIRONMENT] = GenTest::XML::Environment->new() if not defined $report->[XMLREPORT_ENVIRONMENT];
844
845 return $report;
846 }
847
848 sub xml {
849- my $report = shift;
850-
851- require XML::Writer;
852-
853- my $report_xml;
854-
855- my $writer = XML::Writer->new(
856- OUTPUT => \$report_xml,
857- UNSAFE => 1
858- );
859-
860- $writer->xmlDecl('ISO-8859-1');
861- $writer->startTag('report',
862- 'xmlns' => "http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia",
863- 'xmlns:xsi' => "http://www.w3.org/2001/XMLSchema-instance",
864- 'xsi:schemaLocation' => "http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia/cassiopeia-testresult.xsd"
865- );
866-
867- $writer->dataElement('date', $report->[XMLREPORT_DATE]);
868- $writer->dataElement('version', 1);
869- $writer->dataElement('operator', $<);
870-
871- $writer->raw($report->[XMLREPORT_BUILDINFO]->xml()) if defined $report->[XMLREPORT_BUILDINFO];
872- $writer->raw($report->[XMLREPORT_ENVIRONMENT]->xml()) if defined $report->[XMLREPORT_BUILDINFO];
873-
874- $writer->startTag('testsuites');
875- $writer->startTag('testsuite', id => 0);
876- $writer->dataElement('name', 'Random Query Generator');
877- $writer->dataElement('environment_id', 0);
878- $writer->dataElement('starttime', $report->[XMLREPORT_DATE]);
879- $writer->dataElement('endtime', isoUTCTimestamp());
880- $writer->dataElement('description', 'http://forge.mysql.com/wiki/RQG');
881- $writer->startTag('tests');
882-
883- foreach my $test (@{$report->[XMLREPORT_TESTS]}) {
884- $writer->raw($test->xml());
885- }
886-
887- $writer->endTag('tests');
888- $writer->endTag('testsuite');
889- $writer->endTag('testsuites');
890- $writer->endTag('report');
891-
892- $writer->end();
893-
894- return $report_xml;
895+ my $report = shift;
896+
897+ require XML::Writer;
898+
899+ my $report_xml;
900+
901+ my $writer = XML::Writer->new(
902+ OUTPUT => \$report_xml,
903+ UNSAFE => 1 # required for use of 'raw()'
904+ );
905+
906+ $writer->xmlDecl('ISO-8859-1');
907+ $writer->startTag('report',
908+ 'xmlns' => "http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia",
909+ 'xmlns:xsi' => "http://www.w3.org/2001/XMLSchema-instance",
910+ 'xsi:schemaLocation' => "http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia http://clustra.norway.sun.com/intraweb/organization/qa/cassiopeia/testresult-schema-1-2.xsd",
911+ 'version' => "1.2"
912+ );
913+
914+ $writer->dataElement('date', $report->[XMLREPORT_DATE]);
915+ if (linux() || solaris())
916+ {
917+ $writer->dataElement('operator', $ENV{'LOGNAME'});
918+ }
919+ else
920+ {
921+ $writer->dataElement('operator', $ENV{'USERNAME'});
922+ }
923+
924+ $writer->raw($report->[XMLREPORT_ENVIRONMENT]->xml()) if defined $report->[XMLREPORT_BUILDINFO];
925+ $writer->raw($report->[XMLREPORT_BUILDINFO]->xml()) if defined $report->[XMLREPORT_BUILDINFO];
926+
927+ $writer->startTag('testsuites');
928+ $writer->startTag('testsuite', id => 0);
929+ $writer->dataElement('name', $report->[XMLREPORT_NAME]);
930+ $writer->dataElement('environment_id', 0);
931+ $writer->dataElement('starttime', $report->[XMLREPORT_DATE]);
932+ $writer->dataElement('endtime', isoTimestamp());
933+ $writer->dataElement('description', 'http://forge.mysql.com/wiki/RQG');
934+ # TODO (if applicable):
935+ # test-suite specific descriptions (once we have defined testsuites)?
936+ #<xsd:element name="logdir" type="xsd:string" minOccurs="0" form="qualified"/>
937+ #<xsd:element name="attributes" type="cassiopeia:Attributes" minOccurs="0" form="qualified"/> # pairs of (name, value)
938+ $writer->startTag('tests');
939+
940+ foreach my $test (@{$report->[XMLREPORT_TESTS]}) {
941+ $writer->raw($test->xml());
942+ }
943+
944+ $writer->endTag('tests');
945+ $writer->endTag('testsuite');
946+ $writer->endTag('testsuites');
947+ $writer->endTag('report');
948+
949+ $writer->end();
950+
951+ return $report_xml;
952 }
953
954 1;
955
956=== modified file 'lib/GenTest/XML/Test.pm'
957--- lib/GenTest/XML/Test.pm 2010-03-04 13:51:59 +0000
958+++ lib/GenTest/XML/Test.pm 2010-04-07 14:30:43 +0000
959@@ -1,4 +1,4 @@
960-# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
961+# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
962 # Use is subject to license terms.
963 #
964 # This program is free software; you can redistribute it and/or modify
965@@ -28,101 +28,106 @@
966 # test result XML report. Not all of them will be used
967 #
968
969-use constant TEST_ID => 0;
970-use constant TEST_NAME => 1;
971-use constant TEST_ENVIRONMENT_ID => 2;
972-use constant TEST_STARTTIME => 3;
973-use constant TEST_ENDTIME => 4;
974-use constant TEST_LOGDIR => 5;
975-use constant TEST_RESULT => 6;
976-use constant TEST_DESCRIPTION => 7;
977-use constant TEST_ATTRIBUTES => 8;
978-use constant TEST_INCIDENTS => 9;
979+use constant TEST_ID => 0;
980+use constant TEST_NAME => 1;
981+use constant TEST_ENVIRONMENT_ID => 2;
982+use constant TEST_STARTTIME => 3;
983+use constant TEST_ENDTIME => 4;
984+use constant TEST_LOGDIR => 5;
985+use constant TEST_RESULT => 6;
986+use constant TEST_DESCRIPTION => 7;
987+use constant TEST_ATTRIBUTES => 8;
988+use constant TEST_INCIDENTS => 9;
989
990 1;
991
992 sub new {
993- my $class = shift;
994-
995- my $test = $class->SUPER::new({
996- id => TEST_ID,
997- name => TEST_NAME,
998- environment_id => TEST_ENVIRONMENT_ID,
999- starttime => TEST_STARTTIME,
1000- endtime => TEST_ENDTIME,
1001- logdir => TEST_LOGDIR,
1002- result => TEST_RESULT,
1003- description => TEST_DESCRIPTION,
1004- attributes => TEST_ATTRIBUTES,
1005- incidents => TEST_INCIDENTS
1006- }, @_);
1007-
1008- $test->[TEST_STARTTIME] = isoUTCTimestamp() if not defined $test->[TEST_STARTTIME];
1009- $test->[TEST_ENVIRONMENT_ID] = 0 if not defined $test->[TEST_ENVIRONMENT_ID];
1010-
1011- return $test;
1012+ my $class = shift;
1013+
1014+ my $test = $class->SUPER::new({
1015+ id => TEST_ID,
1016+ name => TEST_NAME,
1017+ environment_id => TEST_ENVIRONMENT_ID,
1018+ starttime => TEST_STARTTIME,
1019+ endtime => TEST_ENDTIME,
1020+ logdir => TEST_LOGDIR,
1021+ result => TEST_RESULT,
1022+ description => TEST_DESCRIPTION,
1023+ attributes => TEST_ATTRIBUTES,
1024+ incidents => TEST_INCIDENTS
1025+ }, @_);
1026+
1027+ $test->[TEST_STARTTIME] = isoTimestamp() if not defined $test->[TEST_STARTTIME];
1028+ $test->[TEST_ENVIRONMENT_ID] = 0 if not defined $test->[TEST_ENVIRONMENT_ID];
1029+
1030+ return $test;
1031 }
1032
1033 sub end {
1034- my ($test, $result) = @_;
1035- $test->[TEST_ENDTIME] = isoUTCTimestamp();
1036- $test->[TEST_RESULT] = $result;
1037+ my ($test, $result) = @_;
1038+ $test->[TEST_ENDTIME] = isoTimestamp();
1039+ $test->[TEST_RESULT] = $result;
1040 }
1041
1042 sub xml {
1043- require XML::Writer;
1044-
1045- my $test = shift;
1046-
1047- $test->end() if not defined $test->[TEST_ENDTIME];
1048-
1049- my $test_xml;
1050- my $writer = XML::Writer->new(
1051- OUTPUT => \$test_xml,
1052- UNSAFE => 1
1053- );
1054-
1055- $writer->startTag('test', id => $test->[TEST_ID]);
1056-
1057- $writer->dataElement('name', $test->[TEST_NAME]);
1058- $writer->dataElement('environment_id', $test->[TEST_ENVIRONMENT_ID]);
1059- $writer->dataElement('starttime', $test->[TEST_STARTTIME]);
1060- $writer->dataElement('endtime', $test->[TEST_ENDTIME]);
1061- $writer->dataElement('logdir', $test->[TEST_LOGDIR]);
1062- $writer->dataElement('result', $test->[TEST_RESULT]);
1063- $writer->dataElement('description', $test->[TEST_DESCRIPTION]);
1064-
1065- if (defined $test->[TEST_ATTRIBUTES]) {
1066- $writer->startTag('attributes');
1067- while (my ($name, $value) = each %{$test->[TEST_ATTRIBUTES]}) {
1068- $writer->emptyTag('attribute', 'name' => $name, 'value' => $value);
1069- }
1070- $writer->endTag('attributes');
1071- }
1072-
1073- if (defined $test->[TEST_INCIDENTS]) {
1074- $writer->startTag('incidents');
1075- foreach my $incident (@{$test->[TEST_INCIDENTS]}) {
1076- $writer->raw($incident->xml());
1077- }
1078- $writer->endTag('incidents');
1079- }
1080-
1081- $writer->endTag('test');
1082-
1083- $writer->end();
1084-
1085- return $test_xml;
1086+ require XML::Writer;
1087+
1088+ my $test = shift;
1089+
1090+ $test->end() if not defined $test->[TEST_ENDTIME];
1091+
1092+ my $test_xml;
1093+ my $writer = XML::Writer->new(
1094+ OUTPUT => \$test_xml,
1095+ UNSAFE => 1
1096+ );
1097+
1098+ $writer->startTag('test', id => $test->[TEST_ID]);
1099+
1100+ $writer->dataElement('name', $test->[TEST_NAME] ? $test->[TEST_NAME] : "NO_NAME");
1101+ $writer->dataElement('environment_id', $test->[TEST_ENVIRONMENT_ID]);
1102+ $writer->dataElement('starttime', $test->[TEST_STARTTIME]);
1103+ $writer->dataElement('endtime', $test->[TEST_ENDTIME]);
1104+ $writer->dataElement('logdir', $test->[TEST_LOGDIR]);
1105+ $writer->dataElement('result', $test->[TEST_RESULT]);
1106+ $writer->dataElement('description', $test->[TEST_DESCRIPTION]);
1107+
1108+ if (defined $test->[TEST_ATTRIBUTES]) {
1109+ $writer->startTag('attributes');
1110+ while (my ($name, $value) = each %{$test->[TEST_ATTRIBUTES]}) {
1111+ $writer->startTag('attribute');
1112+ $writer->dataElement('name', $name);
1113+ $writer->dataElement('value', $value);
1114+ $writer->endTag('attribute');
1115+ }
1116+ $writer->endTag('attributes');
1117+ }
1118+
1119+ if (defined $test->[TEST_INCIDENTS]) {
1120+ $writer->startTag('incidents');
1121+ foreach my $incident (@{$test->[TEST_INCIDENTS]}) {
1122+ $writer->raw($incident->xml());
1123+ }
1124+ $writer->endTag('incidents');
1125+ }
1126+
1127+ # TODO: <metrics> (name, value, unit, attributes, timestamp)
1128+
1129+ $writer->endTag('test');
1130+
1131+ $writer->end();
1132+
1133+ return $test_xml;
1134 }
1135
1136 sub setId {
1137- $_[0]->[TEST_ID] = $_[1];
1138+ $_[0]->[TEST_ID] = $_[1];
1139 }
1140
1141 sub addIncident {
1142- my ($test, $incident) = @_;
1143- $test->[TEST_INCIDENTS] = [] if not defined $test->[TEST_INCIDENTS];
1144- push @{$test->[TEST_INCIDENTS]}, $incident;
1145+ my ($test, $incident) = @_;
1146+ $test->[TEST_INCIDENTS] = [] if not defined $test->[TEST_INCIDENTS];
1147+ push @{$test->[TEST_INCIDENTS]}, $incident;
1148 }
1149
1150 1;
1151
1152=== added file 'lib/GenTest/XML/Transporter.pm'
1153--- lib/GenTest/XML/Transporter.pm 1970-01-01 00:00:00 +0000
1154+++ lib/GenTest/XML/Transporter.pm 2010-04-07 14:30:43 +0000
1155@@ -0,0 +1,189 @@
1156+# Copyright (c) 2010 Oracle and/or its affiliates. All rights reserved.
1157+# Use is subject to license terms.
1158+#
1159+# This program is free software; you can redistribute it and/or modify
1160+# it under the terms of the GNU General Public License as published by
1161+# the Free Software Foundation; version 2 of the License.
1162+#
1163+# This program is distributed in the hope that it will be useful, but
1164+# WITHOUT ANY WARRANTY; without even the implied warranty of
1165+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
1166+# General Public License for more details.
1167+#
1168+# You should have received a copy of the GNU General Public License
1169+# along with this program; if not, write to the Free Software
1170+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
1171+# USA
1172+
1173+package GenTest::XML::Transporter;
1174+
1175+require Exporter;
1176+@ISA = qw(GenTest);
1177+
1178+#@EXPORT = ('XMLTRANSPORT_TYPE_SCP', 'XMLTRANSPORT_TYPE_MYSQL');
1179+
1180+use strict;
1181+use GenTest;
1182+use GenTest::Constants;
1183+use GenTest::Properties;
1184+
1185+
1186+use constant XMLTRANSPORT_TYPE => 0; # which transport type to use
1187+use constant XMLTRANSPORT_TYPE_MYSQL => 1; # db connections
1188+use constant XMLTRANSPORT_TYPE_SCP => 2; # secure copy
1189+use constant XMLTRANSPORT_TYPES => 3; # collection of types
1190+
1191+# Defaults:
1192+use constant XML_DEFAULT_TRANSPORT_TYPE => XMLTRANSPORT_TYPE_SCP;
1193+use constant XML_MYSQL_DEFAULT_DSN =>
1194+ 'dbi:mysql:host=myhost:port=3306:user=xmldrop:password=test;database=test';
1195+use constant XML_SCP_DEFAULT_USER => 'qauser';
1196+use constant XML_SCP_DEFAULT_HOST => 'regin.norway.sun.com';
1197+use constant XML_SCP_DEFAULT_DEST_PATH => '/raid/xml_results/TestTool/xml/';
1198+
1199+1; # so the require or use succeeds
1200+
1201+#
1202+# Use this class for transporting XML reports to a given destination.
1203+#
1204+# Usage example (using default settings):
1205+#
1206+# use GenTest::XML::Transporter;
1207+# my $xml_transporter = GenTest::XML::Transporter->new(
1208+# type => undef)
1209+# );
1210+# my $result = $xml_transporter->sendXML($xmlFileName);
1211+# if ($result != STATUS_OK) {
1212+# croak("Error from XML Transporter: $result");
1213+# }
1214+#
1215+#
1216+sub new {
1217+ my $class = shift;
1218+
1219+ my $self = $class->SUPER::new({
1220+ type => XMLTRANSPORT_TYPE
1221+ }, @_);
1222+
1223+ # Figure out transport type, which may be set as string value on
1224+ # command-line, or elsewhere. Use default if not set.
1225+ if (not defined $self->[XMLTRANSPORT_TYPE]) {
1226+ $self->[XMLTRANSPORT_TYPE] = XML_DEFAULT_TRANSPORT_TYPE;
1227+ say('XML Transport: Using default settings');
1228+ } elsif ($self->[XMLTRANSPORT_TYPE] =~ m{scp}io) {
1229+ # string match for "scp" (case insensitive)
1230+ $self->[XMLTRANSPORT_TYPE] = XMLTRANSPORT_TYPE_SCP;
1231+ } elsif ($self->[XMLTRANSPORT_TYPE] =~ m{mysql}io) {
1232+ # string match for "mysql" (case insensitive)
1233+ $self->[XMLTRANSPORT_TYPE] = XMLTRANSPORT_TYPE_MYSQL;
1234+ }
1235+
1236+ #${$self}[XMLTRANSPORT_TYPES] = ();
1237+
1238+ return $self;
1239+}
1240+
1241+
1242+#
1243+# Returns the type of transport mechanism this object represents.
1244+#
1245+sub type {
1246+ my $self = shift;
1247+ if (defined $self->[XMLTRANSPORT_TYPE]) {
1248+ return $self->[XMLTRANSPORT_TYPE];
1249+ } else {
1250+ return XML_DEFAULT_TRANSPORT_TYPE;
1251+ }
1252+}
1253+
1254+#
1255+# Constructs a default destination for the SCP transport type.
1256+# Suitable for use in an scp command-line such as:
1257+# scp myfile <defaultScpDestination>
1258+# where <defaultScpDestination> is <user>@<host>:<path>.
1259+#
1260+sub defaultScpDestination {
1261+ my $self = shift;
1262+ return XML_SCP_DEFAULT_USER.'@'.XML_SCP_DEFAULT_HOST.
1263+ ':'.XML_SCP_DEFAULT_DEST_PATH;
1264+}
1265+
1266+
1267+#
1268+# Sends XML data to a destination.
1269+# The transport mechanism to use (e.g. file copy, database insert, ftp, etc.)
1270+# and destination is determined by the "type" argument to the object's
1271+# constructor.
1272+#
1273+# Arguments:
1274+# arg1: xml - The xml data file name. TODO: Support XML as string?
1275+# arg2: dest - Destination for xml report. Defaults are used if omitted.
1276+#
1277+sub sendXML {
1278+ my ($self, $xml, $dest) = @_;
1279+
1280+ if ($self->type == XMLTRANSPORT_TYPE_MYSQL) {
1281+ say("XML Transport type: MySQL database connection");
1282+ $dest = XML_MYSQL_DEFAULT_DSN if not defined $dest;
1283+ return $self->mysql($xml, $dest);
1284+ } elsif ($self->type == XMLTRANSPORT_TYPE_SCP) {
1285+ say("XML Transport type: SCP");
1286+ $dest = $self->defaultScpDestination if not defined $dest;
1287+ return $self->scp($xml, $dest);
1288+ } else {
1289+ say("[ERROR] XML transport type '".$self->type."' not supported.");
1290+ return STATUS_ENVIRONMENT_FAILURE;
1291+ }
1292+
1293+
1294+
1295+}
1296+
1297+#
1298+# Sends the XML contents of file $xml to $dest.
1299+# If $dest is not defined, a default MySQL dsn will be used.
1300+#
1301+# TODO: - Support argument as string (real XML contents) instead of file name.
1302+# - Support non-default destination.
1303+#
1304+sub mysql() {
1305+ my ($self, $xml, $dest) = @_;
1306+
1307+ # TODO:
1308+ # 1. Establish dbh / connect
1309+ # 2. Execute query
1310+ # 3. Check for errors
1311+ # 4. Return appropriate status.
1312+ say("MySQL XML transport not implemented yet");
1313+ return STATUS_WONT_HANDLE;
1314+}
1315+
1316+#
1317+# Sends the file $xml by SCP (secure file copy) to $dest.
1318+#
1319+sub scp {
1320+ my ($self, $xml, $dest) = @_;
1321+
1322+ # For now, we assume $xml is a file name
1323+ # TODO: Support XML as string as well? Create temporary file?
1324+ my $xmlfile = $xml;
1325+
1326+ my $cmd;
1327+ if (windows()) {
1328+ $cmd = 'pscp.exe -q '.$xmlfile.' '.$dest;
1329+ } else {
1330+ $cmd = 'scp '.$xmlfile.' '.$dest;
1331+ }
1332+
1333+ say("SCP command is: ".$cmd);
1334+
1335+ # TODO: The scp command is interactive if keys and hosts are not set up.
1336+ # This may cause hangs in automated environments. Find a way to
1337+ # always run non-interactively, or kill the command after a timeout.
1338+ my $result == system($cmd);
1339+ if ($result != STATUS_OK) {
1340+ warn('XML Transport: scp failed. Command was: '.$cmd);
1341+ }
1342+
1343+ return $result >> 8;
1344+}
1345
1346=== modified file 'runall.pl'
1347--- runall.pl 2010-03-19 12:25:07 +0000
1348+++ runall.pl 2010-04-07 14:30:43 +0000
1349@@ -56,7 +56,8 @@
1350 $engine, $help, $debug, $validators, $reporters, $grammar_file,
1351 $redefine_file, $seed, $mask, $mask_level, $mem, $rows,
1352 $varchar_len, $xml_output, $valgrind, $views, $start_dirty,
1353- $filter, $build_thread);
1354+ $filter, $build_thread, $testname, $report_xml_tt, $report_xml_tt_type,
1355+ $report_xml_tt_dest);
1356
1357 my $threads = my $default_threads = 10;
1358 my $queries = my $default_queries = 1000;
1359@@ -85,6 +86,9 @@
1360 'debug' => \$debug,
1361 'validators:s' => \$validators,
1362 'reporters:s' => \$reporters,
1363+ 'report-xml-tt' => \$report_xml_tt,
1364+ 'report-xml-tt-type=s' => \$report_xml_tt_type,
1365+ 'report-xml-tt-dest=s' => \$report_xml_tt_dest,
1366 'gendata:s' => \$gendata,
1367 'seed=s' => \$seed,
1368 'mask=i' => \$mask,
1369@@ -97,7 +101,8 @@
1370 'views' => \$views,
1371 'start-dirty' => \$start_dirty,
1372 'filter=s' => \$filter,
1373- 'mtr-build-thread=i' => \$build_thread
1374+ 'mtr-build-thread=i' => \$build_thread,
1375+ 'testname=s' => \$testname
1376 );
1377
1378 if (!$opt_result || $help || $basedirs[0] eq '' || not defined $grammar_file) {
1379@@ -333,9 +338,13 @@
1380 push @gentest_options, "--views" if defined $views;
1381 push @gentest_options, "--varchar-length=$varchar_len" if defined $varchar_len;
1382 push @gentest_options, "--xml-output=$xml_output" if defined $xml_output;
1383+push @gentest_options, "--report-xml-tt" if defined $report_xml_tt;
1384+push @gentest_options, "--report-xml-tt-type=$report_xml_tt_type" if defined $report_xml_tt_type;
1385+push @gentest_options, "--report-xml-tt-dest=$report_xml_tt_dest" if defined $report_xml_tt_dest;
1386 push @gentest_options, "--debug" if defined $debug;
1387 push @gentest_options, "--filter=$filter" if defined $filter;
1388 push @gentest_options, "--valgrind" if defined $valgrind;
1389+push @gentest_options, "--testname=$testname" if defined $testname;
1390
1391 # Push the number of "worker" threads into the environment.
1392 # lib/GenTest/Generator/FromGrammar.pm will generate a corresponding grammar element.
1393@@ -443,7 +452,11 @@
1394 --mask-level: Grammar mask level. Passed to gentest.pl
1395 --rows : No of rows. Passed to gentest.pl
1396 --varchar-length: length of strings. passed to gentest.pl
1397- --xml-outputs: Passed to gentest.pl
1398+ --xml-output: Passed to gentest.pl
1399+ --report-xml-tt: Passed to gentest.pl
1400+ --report-xml-tt-type: Passed to gentest.pl
1401+ --report-xml-tt-dest: Passed to gentest.pl
1402+ --testname : Name of test, used for reporting purposes.
1403 --views : Generate views. Passed to gentest.pl
1404 --valgrind : Passed to gentest.pl
1405 --filter : Passed to gentest.pl