1
# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
2
# Use is subject to license terms.
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.
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.
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
18
package GenTest::Executor;
21
@ISA = qw(GenTest Exporter);
24
EXECUTOR_RETURNED_ROW_COUNTS
25
EXECUTOR_AFFECTED_ROW_COUNTS
26
EXECUTOR_EXPLAIN_COUNTS
27
EXECUTOR_EXPLAIN_QUERIES
29
EXECUTOR_STATUS_COUNTS
36
use GenTest::Constants;
38
use constant EXECUTOR_DSN => 0;
39
use constant EXECUTOR_DBH => 1;
40
use constant EXECUTOR_ID => 2;
41
use constant EXECUTOR_RETURNED_ROW_COUNTS => 3;
42
use constant EXECUTOR_AFFECTED_ROW_COUNTS => 4;
43
use constant EXECUTOR_EXPLAIN_COUNTS => 5;
44
use constant EXECUTOR_EXPLAIN_QUERIES => 6;
45
use constant EXECUTOR_ERROR_COUNTS => 7;
46
use constant EXECUTOR_STATUS_COUNTS => 8;
47
use constant EXECUTOR_DEFAULT_SCHEMA => 9;
48
use constant EXECUTOR_SCHEMA_METADATA => 10;
49
use constant EXECUTOR_COLLATION_METADATA => 11;
50
use constant EXECUTOR_META_CACHE => 12;
51
use constant EXECUTOR_CHANNEL => 13;
52
use constant EXECUTOR_SQLTRACE => 14;
53
use constant EXECUTOR_NO_ERR_FILTER => 15;
55
my %global_schema_cache;
62
my $executor = $class->SUPER::new({
63
'dsn' => EXECUTOR_DSN,
64
'dbh' => EXECUTOR_DBH,
65
'channel' => EXECUTOR_CHANNEL,
66
'sqltrace' => EXECUTOR_SQLTRACE,
67
'no-err-filter' => EXECUTOR_NO_ERR_FILTER
74
my ($self,$dsn,$channel) = @_;
76
if ($dsn =~ m/^dbi:mysql:/i) {
77
require GenTest::Executor::MySQL;
78
return GenTest::Executor::MySQL->new(dsn => $dsn, channel => $channel);
79
} elsif ($dsn =~ m/^dbi:drizzle:/i) {
80
require GenTest::Executor::Drizzle;
81
return GenTest::Executor::Drizzle->new(dsn => $dsn);
82
} elsif ($dsn =~ m/^dbi:JDBC:.*url=jdbc:derby:/i) {
83
require GenTest::Executor::JavaDB;
84
return GenTest::Executor::JavaDB->new(dsn => $dsn);
85
} elsif ($dsn =~ m/^dbi:Pg:/i) {
86
require GenTest::Executor::Postgres;
87
return GenTest::Executor::Postgres->new(dsn => $dsn);
88
} elsif ($dsn =~ m/^dummy/) {
89
require GenTest::Executor::Dummy;
90
return GenTest::Executor::Dummy->new(dsn => $dsn);
92
say("Unsupported dsn: $dsn");
93
exit(STATUS_ENVIRONMENT_FAILURE);
98
return $_[0]->[EXECUTOR_CHANNEL];
102
my ($self, $msg) = @_;
103
$self->channel->send($msg);
108
return $_[0]->[EXECUTOR_DBH];
112
$_[0]->[EXECUTOR_DBH] = $_[1];
116
$_[0]->[EXECUTOR_DBH] = $_[1];
120
my ($self, $sqltrace) = @_;
121
$self->[EXECUTOR_SQLTRACE] = $sqltrace if defined $sqltrace;
122
return $self->[EXECUTOR_SQLTRACE];
126
my ($self, $no_err_filter) = @_;
127
$self->[EXECUTOR_NO_ERR_FILTER] = $no_err_filter if defined $no_err_filter;
128
return $self->[EXECUTOR_NO_ERR_FILTER];
132
return $_[0]->[EXECUTOR_DSN];
136
$_[0]->[EXECUTOR_DSN] = $_[1];
140
return $_[0]->[EXECUTOR_ID];
144
$_[0]->[EXECUTOR_ID] = $_[1];
150
if (ref($self) eq "GenTest::Executor::JavaDB") {
152
} elsif (ref($self) eq "GenTest::Executor::MySQL") {
154
} elsif (ref($self) eq "GenTest::Executor::Drizzle") {
156
} elsif (ref($self) eq "GenTest::Executor::Postgres") {
158
} elsif (ref($self) eq "GenTest::Executor::Dummy") {
159
if ($self->dsn =~ m/mysql/) {
161
} elsif ($self->dsn =~ m/postgres/) {
163
} if ($self->dsn =~ m/javadb/) {
173
my @dbid = ("Unknown","Dummy", "MySQL","Postgres","JavaDB","Drizzle");
177
return $dbid[$self->type()];
181
my ($self, $query) = @_;
183
my $id = $dbid[$self->type()];
187
# print "... $id before: $query \n";
189
$query =~ s/\/\*\+[a-z:]*$id[a-z:]*:([^*]*)\*\//$1/gi;
191
# print "... after: $query \n";
196
## This array maps SQL State class (2 first letters) to a status. This
197
## list needs to be extended
199
"07" => STATUS_SEMANTIC_ERROR, # dynamic SQL error
200
"08" => STATUS_SEMANTIC_ERROR, # connection exception
201
"22" => STATUS_SEMANTIC_ERROR, # data exception
202
"23" => STATUS_SEMANTIC_ERROR, # integrity constraint violation
203
"25" => STATUS_TRANSACTION_ERROR, # invalid transaction state
204
"42" => STATUS_SYNTAX_ERROR # syntax error or access rule
210
my ($self, $state) = @_;
212
my $class = substr($state, 0, 2);
213
if (defined $class2status{$class}) {
214
return $class2status{$class};
216
return STATUS_UNKNOWN_ERROR;
221
my ($self, $schema) = @_;
222
if (defined $schema) {
223
$self->[EXECUTOR_DEFAULT_SCHEMA] = $schema;
225
return $self->[EXECUTOR_DEFAULT_SCHEMA];
229
croak "currentSchema not defined for ". (ref $_[0]);
232
sub getSchemaMetaData {
233
croak "getSchemaMetaData not defined for ". (ref $_[0]);
236
sub getCollationMetaData {
237
carp "getCollationMetaData not defined for ". (ref $_[0]);
238
return [[undef,undef]];
242
########### Metadata routines
249
if (not exists $global_schema_cache{$self->dsn()}) {
250
say ("Caching schema metadata for ".$self->dsn());
251
foreach my $row (@{$self->getSchemaMetaData()}) {
252
my ($schema, $table, $type, $col, $key) = @$row;
253
$meta->{$schema}={} if not exists $meta->{$schema};
254
$meta->{$schema}->{$table}={} if not exists $meta->{$schema}->{$table};
255
$meta->{$schema}->{$table}->{$col}=$key;
257
$global_schema_cache{$self->dsn()} = $meta;
259
$meta = $global_schema_cache{$self->dsn()};
262
$self->[EXECUTOR_SCHEMA_METADATA] = $meta;
265
foreach my $row (@{$self->getCollationMetaData()}) {
266
my ($collation, $charset) = @$row;
267
$coll->{$collation} = $charset;
269
$self->[EXECUTOR_COLLATION_METADATA] = $coll;
271
$self->[EXECUTOR_META_CACHE] = {};
276
if (not defined $self->[EXECUTOR_META_CACHE]->{SCHEMAS}) {
277
my $schemas = [sort keys %{$self->[EXECUTOR_SCHEMA_METADATA]}];
278
croak "No schemas found"
279
if not defined $schemas or $#$schemas < 0;
280
$self->[EXECUTOR_META_CACHE]->{SCHEMAS} = $schemas;
282
return $self->[EXECUTOR_META_CACHE]->{SCHEMAS};
286
my ($self, $schema) = @_;
287
my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
289
$schema = $self->defaultSchema if not defined $schema;
291
my $cachekey = "TAB-$schema";
293
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
294
my $tables = [sort keys %{$meta->{$schema}}];
295
croak "Schema '$schema' has no tables"
296
if not defined $tables or $#$tables < 0;
297
$self->[EXECUTOR_META_CACHE]->{$cachekey} = $tables;
299
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
304
my ($self, $table, $schema) = @_;
305
my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
307
$schema = $self->defaultSchema if not defined $schema;
308
$table = $self->metaTables($schema)->[0] if not defined $table;
310
my $cachekey="COL-$schema-$table";
312
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
313
my $cols = [sort keys %{$meta->{$schema}->{$table}}];
314
croak "Table '$table' in schema '$schema' has no columns"
315
if not defined $cols or $#$cols < 0;
316
$self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
318
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
321
sub metaColumnsType {
322
my ($self, $type, $table, $schema) = @_;
323
my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
325
$schema = $self->defaultSchema if not defined $schema;
326
$table = $self->metaTables($schema)->[0] if not defined $table;
328
my $cachekey="COL-$type-$schema-$table";
330
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
331
my $colref = $meta->{$schema}->{$table};
332
my $cols = [sort grep {$colref->{$_} eq $type} keys %$colref];
333
croak "Table '$table' in schema '$schema' has no '$type' columns"
334
if not defined $cols or $#$cols < 0;
335
$self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
337
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
341
sub metaColumnsTypeNot {
342
my ($self, $type, $table, $schema) = @_;
343
my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
345
$schema = $self->defaultSchema if not defined $schema;
346
$table = $self->metaTables($schema)->[0] if not defined $table;
348
my $cachekey="COLNOT-$type-$schema-$table";
350
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
351
my $colref = $meta->{$schema}->{$table};
352
my $cols = [sort grep {$colref->{$_} ne $type} keys %$colref];
353
croak "Table '$table' in schema '$schema' has no columns which are not '$type'"
354
if not defined $cols or $#$cols < 0;
355
$self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
357
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
363
my $cachekey="COLLATIONS";
365
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
366
my $coll = [sort keys %{$self->[EXECUTOR_COLLATION_METADATA]}];
367
croak "No Collations defined" if not defined $coll or $#$coll < 0;
368
$self->[EXECUTOR_META_CACHE]->{$cachekey} = $coll;
370
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
373
sub metaCharactersets {
376
my $cachekey="CHARSETS";
378
if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
379
my $charsets = [values %{$self->[EXECUTOR_COLLATION_METADATA]}];
380
croak "No character sets defined" if not defined $charsets or $#$charsets < 0;
382
$self->[EXECUTOR_META_CACHE]->{$cachekey} = [sort grep { ! $seen{$_} ++ } @$charsets];
384
return $self->[EXECUTOR_META_CACHE]->{$cachekey};
387
################### Public interface to be used from grammars
391
my ($self, @args) = @_;
392
return $self->metaTables(@args);