← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/XML/BuildInfo.pm

  • Committer: Mark Atwood
  • Date: 2011-10-14 15:59:08 UTC
  • mfrom: (2430.1.12 refactor3a)
  • Revision ID: me@mark.atwood.name-20111014155908-whqmrmaf2grpsg5c
merge lp:~olafvdspek/drizzle/refactor3

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/randgen/lib/GenTest/XML/BuildInfo.pm
1
 
# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
2
 
# Use is subject to license terms.
3
 
#
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; version 2 of the License.
7
 
#
8
 
# This program is distributed in the hope that it will be useful, but
9
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11
 
# General Public License for more details.
12
 
#
13
 
# You should have received a copy of the GNU General Public License
14
 
# along with this program; if not, write to the Free Software
15
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
16
 
# USA
17
 
 
18
 
package GenTest::XML::BuildInfo;
19
 
 
20
 
require Exporter;
21
 
@ISA = qw(GenTest);
22
 
 
23
 
use strict;
24
 
use GenTest;
25
 
use GenTest::BzrInfo;
26
 
use DBI;
27
 
 
28
 
use constant BUILDINFO_DSNS     => 0;
29
 
use constant BUILDINFO_SERVERS  => 1;
30
 
 
31
 
use constant BUILDINFO_SERVER_VERSION   => 0;
32
 
use constant BUILDINFO_SERVER_PACKAGE   => 1;
33
 
use constant BUILDINFO_SERVER_BIT       => 2;
34
 
use constant BUILDINFO_SERVER_PATH      => 3;
35
 
use constant BUILDINFO_SERVER_VARIABLES => 4;
36
 
use constant BUILDINFO_SERVER_TREE      => 5;
37
 
use constant BUILDINFO_SERVER_REVISION  => 6;
38
 
 
39
 
sub new {
40
 
    my $class = shift;
41
 
 
42
 
    my $buildinfo = $class->SUPER::new({
43
 
        dsns    => BUILDINFO_DSNS
44
 
    }, @_);
45
 
 
46
 
    $buildinfo->[BUILDINFO_SERVERS] = [];
47
 
 
48
 
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
49
 
    {
50
 
        my $dsn = $buildinfo->[BUILDINFO_DSNS]->[$id];
51
 
        next if $dsn eq '';
52
 
        my $dbh = DBI->connect($dsn);
53
 
 
54
 
        my $server;
55
 
 
56
 
        # TODO: Add support for non-MySQL dsns.
57
 
        
58
 
        # set this first because it may be used below
59
 
        $server->[BUILDINFO_SERVER_PATH] = $dbh->selectrow_array('SELECT @@basedir');
60
 
        
61
 
        # Server Version: 
62
 
        #   To align with other test drivers reporting to the same place we 
63
 
        #   report only the three x.y.z version numbers as "version".
64
 
        #   Expecting e.g "5.5.4-m3-log-debug", using only "5.5.4".
65
 
        #   The rest (e.g. "log-debug" as well as the version will be prepended
66
 
        #   to the value of the "package" tag instead.
67
 
        my $long_version = $dbh->selectrow_array('SELECT @@version');
68
 
        if ($long_version =~ /^(\d+\.\d+\.\d+)/ )
69
 
        {
70
 
            # grab version number only to use for version tag.
71
 
            $server->[BUILDINFO_SERVER_VERSION] = $1;
72
 
        } else {
73
 
            # version not of the expected format, so use the whole thing.
74
 
            $server->[BUILDINFO_SERVER_VERSION] = $long_version;
75
 
        }
76
 
        
77
 
        $server->[BUILDINFO_SERVER_PACKAGE] = $long_version . ' ' .
78
 
            $dbh->selectrow_array('SELECT @@version_comment');
79
 
 
80
 
        # Source code version-control information (tree, revision):
81
 
        #   First we check some environment variables for information: 
82
 
        #     BRANCH_SOURCE - source URL as understood by the underlying version
83
 
        #                     control system.
84
 
        #     BRANCH_NAME   - possibly non-unique name of the branch.
85
 
        #     PUSH_REVISION - unique ID for the current revision of the branch, 
86
 
        #                     as provided by the underlying version control system.
87
 
        #
88
 
        # If those are not present, we try to query bzr itself.
89
 
 
90
 
        # This may take a few seconds due to bzr slowness.
91
 
        my $bzrinfo_server = GenTest::BzrInfo->new(
92
 
            dir => $server->[BUILDINFO_SERVER_PATH]
93
 
        );
94
 
        
95
 
        # revision
96
 
        if (defined $ENV{'PUSH_REVISION'}) {
97
 
            $server->[BUILDINFO_SERVER_REVISION] = $ENV{'PUSH_REVISION'};
98
 
        } else {
99
 
            # If this fails, it remains undefined and will not be reported.
100
 
            $server->[BUILDINFO_SERVER_REVISION] = $bzrinfo_server->bzrRevisionId();
101
 
        }
102
 
        
103
 
        # tree:
104
 
        #   Since BRANCH_NAME may not be uniquely identifying a branch, we
105
 
        #   instead use the final part of the source URL as tree (branch) name.
106
 
        #   E.g. in PB2, we may have both daily-trunk and mysql-trunk referring
107
 
        #   to the same branch.
108
 
        if (defined $ENV{'BRANCH_SOURCE'}) {
109
 
            # extract last part of source URL and use as tree name.
110
 
            # Example: 
111
 
            #   http://host.com/bzr/server/mysql-next-mr
112
 
            #   becomes "mysql-next-mr".
113
 
            # Need to account for possible ending '/'.
114
 
            if ($ENV{BRANCH_SOURCE} =~ m{([^\\\/]+)[\\\/]?$}) {
115
 
                $server->[BUILDINFO_SERVER_TREE] = $1;
116
 
            }
117
 
        } else {
118
 
            if (defined $ENV{'BRANCH_NAME'}) {
119
 
                $server->[BUILDINFO_SERVER_TREE] = $ENV{'BRANCH_NAME'};
120
 
            } else {
121
 
                # Get branch nick from bzr
122
 
                # If this fails, it remains undefined and will not be reported.
123
 
                $server->[BUILDINFO_SERVER_TREE] = $bzrinfo_server->bzrBranchNick();
124
 
            }
125
 
        }
126
 
        
127
 
        # According to the schema, bit must be "32" or "64".
128
 
        # There is no reliable way to get this on all supported platforms using MySQL queries.
129
 
        #$server->[BUILDINFO_SERVER_BIT] = $dbh->selectrow_array('SELECT @@version_compile_machine');
130
 
        
131
 
        $server->[BUILDINFO_SERVER_VARIABLES] = [];
132
 
        my $sth = $dbh->prepare("SHOW VARIABLES");
133
 
        $sth->execute();
134
 
        while (my ($name, $value) = $sth->fetchrow_array()) {
135
 
            push @{$server->[BUILDINFO_SERVER_VARIABLES]}, [ $name , $value ];
136
 
        }
137
 
        $sth->finish();
138
 
 
139
 
        $dbh->disconnect();
140
 
 
141
 
        $buildinfo->[BUILDINFO_SERVERS]->[$id] = $server;
142
 
    }
143
 
 
144
 
    return $buildinfo;
145
 
}
146
 
 
147
 
sub xml {
148
 
    require XML::Writer;
149
 
 
150
 
    my $buildinfo = shift;
151
 
    my $buildinfo_xml;
152
 
 
153
 
    my $writer = XML::Writer->new(
154
 
        OUTPUT      => \$buildinfo_xml,
155
 
        DATA_MODE   => 1,   # this and DATA_INDENT to have line breaks and indentation after each element
156
 
        DATA_INDENT => 2,   # number of spaces used for indentation
157
 
    );
158
 
 
159
 
    $writer->startTag('product');
160
 
    $writer->dataElement('name','MySQL');
161
 
    $writer->startTag('builds');
162
 
 
163
 
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
164
 
    {
165
 
        my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
166
 
        next if not defined $server;
167
 
 
168
 
        # Note that the order of these tags (sequence) is significant.
169
 
        # Commented tags are part of XML spec but not implemented here yet.
170
 
 
171
 
        $writer->startTag('build', id => $id);
172
 
        $writer->dataElement('version', $server->[BUILDINFO_SERVER_VERSION]);
173
 
        $writer->dataElement('tree', $server->[BUILDINFO_SERVER_TREE]) if defined $server->[BUILDINFO_SERVER_TREE];
174
 
        $writer->dataElement('revision', $server->[BUILDINFO_SERVER_REVISION]) if defined $server->[BUILDINFO_SERVER_REVISION];
175
 
        #<xsd:element name="tag" type="xsd:string" minOccurs="0" form="qualified"/>
176
 
        $writer->dataElement('package', $server->[BUILDINFO_SERVER_PACKAGE]);
177
 
        #$writer->dataElement('bit', $server->[BUILDINFO_SERVER_BIT]); # Must be 32 or 64
178
 
        $writer->dataElement('path', $server->[BUILDINFO_SERVER_PATH]);
179
 
        #<xsd:element name="compile_options" type="cassiopeia:Options" minOccurs="0" form="qualified"/>
180
 
        #<xsd:element name="commandline" type="xsd:string" minOccurs="0" form="qualified" />
181
 
        #<xsd:element name="buildscript" minOccurs="0" type="xsd:string" form="qualified" />
182
 
        $writer->endTag('build');
183
 
    }
184
 
 
185
 
 
186
 
    $writer->endTag('builds');
187
 
 
188
 
    $writer->startTag('binaries'); # --> <software> = <program>
189
 
 
190
 
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
191
 
    {
192
 
        my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
193
 
        next if not defined $server;
194
 
 
195
 
        $writer->startTag('program');
196
 
        $writer->dataElement('name', 'mysqld');
197
 
        $writer->dataElement('type', 'database');
198
 
        $writer->startTag('commandline_options');
199
 
 
200
 
    # TODO: List actual commmand-line options (and config file options /
201
 
    #       RQG-defaults?), not all server variables?
202
 
        foreach my $option (@{$server->[BUILDINFO_SERVER_VARIABLES]})
203
 
        {
204
 
            $writer->startTag('option');
205
 
            $writer->dataElement('name', $option->[0]);
206
 
            $writer->dataElement('value', $option->[1]);
207
 
            $writer->endTag('option');
208
 
        }
209
 
 
210
 
        $writer->endTag('commandline_options');
211
 
        $writer->endTag('program');
212
 
    }
213
 
 
214
 
    $writer->endTag('binaries');
215
 
    $writer->endTag('product');
216
 
    $writer->end();
217
 
 
218
 
    return $buildinfo_xml;
219
 
}
220
 
 
221
 
1;
 
1
# Copyright (c) 2008, 2010 Oracle and/or its affiliates. All rights reserved.
 
2
# Use is subject to license terms.
 
3
#
 
4
# This program is free software; you can redistribute it and/or modify
 
5
# it under the terms of the GNU General Public License as published by
 
6
# the Free Software Foundation; version 2 of the License.
 
7
#
 
8
# This program is distributed in the hope that it will be useful, but
 
9
# WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 
11
# General Public License for more details.
 
12
#
 
13
# You should have received a copy of the GNU General Public License
 
14
# along with this program; if not, write to the Free Software
 
15
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
 
16
# USA
 
17
 
 
18
package GenTest::XML::BuildInfo;
 
19
 
 
20
require Exporter;
 
21
@ISA = qw(GenTest);
 
22
 
 
23
use strict;
 
24
use GenTest;
 
25
use GenTest::BzrInfo;
 
26
use DBI;
 
27
 
 
28
use constant BUILDINFO_DSNS     => 0;
 
29
use constant BUILDINFO_SERVERS  => 1;
 
30
 
 
31
use constant BUILDINFO_SERVER_VERSION   => 0;
 
32
use constant BUILDINFO_SERVER_PACKAGE   => 1;
 
33
use constant BUILDINFO_SERVER_BIT       => 2;
 
34
use constant BUILDINFO_SERVER_PATH      => 3;
 
35
use constant BUILDINFO_SERVER_VARIABLES => 4;
 
36
use constant BUILDINFO_SERVER_TREE      => 5;
 
37
use constant BUILDINFO_SERVER_REVISION  => 6;
 
38
 
 
39
sub new {
 
40
    my $class = shift;
 
41
 
 
42
    my $buildinfo = $class->SUPER::new({
 
43
        dsns    => BUILDINFO_DSNS
 
44
    }, @_);
 
45
 
 
46
    $buildinfo->[BUILDINFO_SERVERS] = [];
 
47
 
 
48
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
 
49
    {
 
50
        my $dsn = $buildinfo->[BUILDINFO_DSNS]->[$id];
 
51
        next if $dsn eq '';
 
52
        my $dbh = DBI->connect($dsn);
 
53
 
 
54
        my $server;
 
55
 
 
56
        # TODO: Add support for non-MySQL dsns.
 
57
        
 
58
        # set this first because it may be used below
 
59
        $server->[BUILDINFO_SERVER_PATH] = $dbh->selectrow_array('SELECT @@basedir');
 
60
        
 
61
        # Server Version: 
 
62
        #   To align with other test drivers reporting to the same place we 
 
63
        #   report only the three x.y.z version numbers as "version".
 
64
        #   Expecting e.g "5.5.4-m3-log-debug", using only "5.5.4".
 
65
        #   The rest (e.g. "log-debug" as well as the version will be prepended
 
66
        #   to the value of the "package" tag instead.
 
67
        my $long_version = $dbh->selectrow_array('SELECT @@version');
 
68
        if ($long_version =~ /^(\d+\.\d+\.\d+)/ )
 
69
        {
 
70
            # grab version number only to use for version tag.
 
71
            $server->[BUILDINFO_SERVER_VERSION] = $1;
 
72
        } else {
 
73
            # version not of the expected format, so use the whole thing.
 
74
            $server->[BUILDINFO_SERVER_VERSION] = $long_version;
 
75
        }
 
76
        
 
77
        $server->[BUILDINFO_SERVER_PACKAGE] = $long_version . ' ' .
 
78
            $dbh->selectrow_array('SELECT @@version_comment');
 
79
 
 
80
        # Source code version-control information (tree, revision):
 
81
        #   First we check some environment variables for information: 
 
82
        #     BRANCH_SOURCE - source URL as understood by the underlying version
 
83
        #                     control system.
 
84
        #     BRANCH_NAME   - possibly non-unique name of the branch.
 
85
        #     PUSH_REVISION - unique ID for the current revision of the branch, 
 
86
        #                     as provided by the underlying version control system.
 
87
        #
 
88
        # If those are not present, we try to query bzr itself.
 
89
 
 
90
        # This may take a few seconds due to bzr slowness.
 
91
        my $bzrinfo_server = GenTest::BzrInfo->new(
 
92
            dir => $server->[BUILDINFO_SERVER_PATH]
 
93
        );
 
94
        
 
95
        # revision
 
96
        if (defined $ENV{'PUSH_REVISION'}) {
 
97
            $server->[BUILDINFO_SERVER_REVISION] = $ENV{'PUSH_REVISION'};
 
98
        } else {
 
99
            # If this fails, it remains undefined and will not be reported.
 
100
            $server->[BUILDINFO_SERVER_REVISION] = $bzrinfo_server->bzrRevisionId();
 
101
        }
 
102
        
 
103
        # tree:
 
104
        #   Since BRANCH_NAME may not be uniquely identifying a branch, we
 
105
        #   instead use the final part of the source URL as tree (branch) name.
 
106
        #   E.g. in PB2, we may have both daily-trunk and mysql-trunk referring
 
107
        #   to the same branch.
 
108
        if (defined $ENV{'BRANCH_SOURCE'}) {
 
109
            # extract last part of source URL and use as tree name.
 
110
            # Example: 
 
111
            #   http://host.com/bzr/server/mysql-next-mr
 
112
            #   becomes "mysql-next-mr".
 
113
            # Need to account for possible ending '/'.
 
114
            if ($ENV{BRANCH_SOURCE} =~ m{([^\\\/]+)[\\\/]?$}) {
 
115
                $server->[BUILDINFO_SERVER_TREE] = $1;
 
116
            }
 
117
        } else {
 
118
            if (defined $ENV{'BRANCH_NAME'}) {
 
119
                $server->[BUILDINFO_SERVER_TREE] = $ENV{'BRANCH_NAME'};
 
120
            } else {
 
121
                # Get branch nick from bzr
 
122
                # If this fails, it remains undefined and will not be reported.
 
123
                $server->[BUILDINFO_SERVER_TREE] = $bzrinfo_server->bzrBranchNick();
 
124
            }
 
125
        }
 
126
        
 
127
        # According to the schema, bit must be "32" or "64".
 
128
        # There is no reliable way to get this on all supported platforms using MySQL queries.
 
129
        #$server->[BUILDINFO_SERVER_BIT] = $dbh->selectrow_array('SELECT @@version_compile_machine');
 
130
        
 
131
        $server->[BUILDINFO_SERVER_VARIABLES] = [];
 
132
        my $sth = $dbh->prepare("SHOW VARIABLES");
 
133
        $sth->execute();
 
134
        while (my ($name, $value) = $sth->fetchrow_array()) {
 
135
            push @{$server->[BUILDINFO_SERVER_VARIABLES]}, [ $name , $value ];
 
136
        }
 
137
        $sth->finish();
 
138
 
 
139
        $dbh->disconnect();
 
140
 
 
141
        $buildinfo->[BUILDINFO_SERVERS]->[$id] = $server;
 
142
    }
 
143
 
 
144
    return $buildinfo;
 
145
}
 
146
 
 
147
sub xml {
 
148
    require XML::Writer;
 
149
 
 
150
    my $buildinfo = shift;
 
151
    my $buildinfo_xml;
 
152
 
 
153
    my $writer = XML::Writer->new(
 
154
        OUTPUT      => \$buildinfo_xml,
 
155
        DATA_MODE   => 1,   # this and DATA_INDENT to have line breaks and indentation after each element
 
156
        DATA_INDENT => 2,   # number of spaces used for indentation
 
157
    );
 
158
 
 
159
    $writer->startTag('product');
 
160
    $writer->dataElement('name','MySQL');
 
161
    $writer->startTag('builds');
 
162
 
 
163
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
 
164
    {
 
165
        my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
 
166
        next if not defined $server;
 
167
 
 
168
        # Note that the order of these tags (sequence) is significant.
 
169
        # Commented tags are part of XML spec but not implemented here yet.
 
170
 
 
171
        $writer->startTag('build', id => $id);
 
172
        $writer->dataElement('version', $server->[BUILDINFO_SERVER_VERSION]);
 
173
        $writer->dataElement('tree', $server->[BUILDINFO_SERVER_TREE]) if defined $server->[BUILDINFO_SERVER_TREE];
 
174
        $writer->dataElement('revision', $server->[BUILDINFO_SERVER_REVISION]) if defined $server->[BUILDINFO_SERVER_REVISION];
 
175
        #<xsd:element name="tag" type="xsd:string" minOccurs="0" form="qualified"/>
 
176
        $writer->dataElement('package', $server->[BUILDINFO_SERVER_PACKAGE]);
 
177
        #$writer->dataElement('bit', $server->[BUILDINFO_SERVER_BIT]); # Must be 32 or 64
 
178
        $writer->dataElement('path', $server->[BUILDINFO_SERVER_PATH]);
 
179
        #<xsd:element name="compile_options" type="cassiopeia:Options" minOccurs="0" form="qualified"/>
 
180
        #<xsd:element name="commandline" type="xsd:string" minOccurs="0" form="qualified" />
 
181
        #<xsd:element name="buildscript" minOccurs="0" type="xsd:string" form="qualified" />
 
182
        $writer->endTag('build');
 
183
    }
 
184
 
 
185
 
 
186
    $writer->endTag('builds');
 
187
 
 
188
    $writer->startTag('binaries'); # --> <software> = <program>
 
189
 
 
190
    foreach my $id (0..$#{$buildinfo->[BUILDINFO_DSNS]})
 
191
    {
 
192
        my $server = $buildinfo->[BUILDINFO_SERVERS]->[$id];
 
193
        next if not defined $server;
 
194
 
 
195
        $writer->startTag('program');
 
196
        $writer->dataElement('name', 'mysqld');
 
197
        $writer->dataElement('type', 'database');
 
198
        $writer->startTag('commandline_options');
 
199
 
 
200
    # TODO: List actual commmand-line options (and config file options /
 
201
    #       RQG-defaults?), not all server variables?
 
202
        foreach my $option (@{$server->[BUILDINFO_SERVER_VARIABLES]})
 
203
        {
 
204
            $writer->startTag('option');
 
205
            $writer->dataElement('name', $option->[0]);
 
206
            $writer->dataElement('value', $option->[1]);
 
207
            $writer->endTag('option');
 
208
        }
 
209
 
 
210
        $writer->endTag('commandline_options');
 
211
        $writer->endTag('program');
 
212
    }
 
213
 
 
214
    $writer->endTag('binaries');
 
215
    $writer->endTag('product');
 
216
    $writer->end();
 
217
 
 
218
    return $buildinfo_xml;
 
219
}
 
220
 
 
221
1;