~ubuntu-branches/ubuntu/trusty/drizzle/trusty

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/Executor.pm

  • Committer: Package Import Robot
  • Author(s): Clint Byrum
  • Date: 2012-06-19 10:46:49 UTC
  • mfrom: (1.1.6)
  • mto: This revision was merged to the branch mainline in revision 29.
  • Revision ID: package-import@ubuntu.com-20120619104649-e2l0ggd4oz3um0f4
Tags: upstream-7.1.36-stable
ImportĀ upstreamĀ versionĀ 7.1.36-stable

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# Copyright (C) 2008-2009 Sun Microsystems, Inc. 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::Executor;
 
19
 
 
20
require Exporter;
 
21
@ISA = qw(GenTest Exporter);
 
22
 
 
23
@EXPORT = qw(
 
24
        EXECUTOR_RETURNED_ROW_COUNTS
 
25
        EXECUTOR_AFFECTED_ROW_COUNTS
 
26
        EXECUTOR_EXPLAIN_COUNTS
 
27
        EXECUTOR_EXPLAIN_QUERIES
 
28
        EXECUTOR_ERROR_COUNTS
 
29
        EXECUTOR_STATUS_COUNTS
 
30
);
 
31
 
 
32
use strict;
 
33
use Carp;
 
34
use Data::Dumper;
 
35
use GenTest;
 
36
use GenTest::Constants;
 
37
 
 
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;
 
54
 
 
55
my %global_schema_cache;
 
56
 
 
57
1;
 
58
 
 
59
sub new {
 
60
    my $class = shift;
 
61
        
 
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
 
68
        }, @_);
 
69
    
 
70
    return $executor;
 
71
}
 
72
 
 
73
sub newFromDSN {
 
74
        my ($self,$dsn,$channel) = @_;
 
75
        
 
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);
 
91
        } else {
 
92
                say("Unsupported dsn: $dsn");
 
93
                exit(STATUS_ENVIRONMENT_FAILURE);
 
94
        }
 
95
}
 
96
 
 
97
sub channel {
 
98
    return $_[0]->[EXECUTOR_CHANNEL];
 
99
}
 
100
 
 
101
sub sendError {
 
102
    my ($self, $msg) = @_;
 
103
    $self->channel->send($msg);
 
104
}
 
105
 
 
106
 
 
107
sub dbh {
 
108
        return $_[0]->[EXECUTOR_DBH];
 
109
}
 
110
 
 
111
sub setDbh {
 
112
        $_[0]->[EXECUTOR_DBH] = $_[1];
 
113
}
 
114
 
 
115
sub setDbh {
 
116
        $_[0]->[EXECUTOR_DBH] = $_[1];
 
117
}
 
118
 
 
119
sub sqltrace {
 
120
    my ($self, $sqltrace) = @_;
 
121
    $self->[EXECUTOR_SQLTRACE] = $sqltrace if defined $sqltrace;
 
122
    return $self->[EXECUTOR_SQLTRACE];
 
123
}
 
124
 
 
125
sub noErrFilter {
 
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];
 
129
}
 
130
 
 
131
sub dsn {
 
132
        return $_[0]->[EXECUTOR_DSN];
 
133
}
 
134
 
 
135
sub setDsn {
 
136
        $_[0]->[EXECUTOR_DSN] = $_[1];
 
137
}
 
138
 
 
139
sub id {
 
140
        return $_[0]->[EXECUTOR_ID];
 
141
}
 
142
 
 
143
sub setId {
 
144
        $_[0]->[EXECUTOR_ID] = $_[1];
 
145
}
 
146
 
 
147
sub type {
 
148
        my ($self) = @_;
 
149
        
 
150
        if (ref($self) eq "GenTest::Executor::JavaDB") {
 
151
                return DB_JAVADB;
 
152
        } elsif (ref($self) eq "GenTest::Executor::MySQL") {
 
153
                return DB_MYSQL;
 
154
        } elsif (ref($self) eq "GenTest::Executor::Drizzle") {
 
155
                return DB_DRIZZLE;
 
156
        } elsif (ref($self) eq "GenTest::Executor::Postgres") {
 
157
                return DB_POSTGRES;
 
158
    } elsif (ref($self) eq "GenTest::Executor::Dummy") {
 
159
        if ($self->dsn =~ m/mysql/) {
 
160
            return DB_MYSQL;
 
161
        } elsif ($self->dsn =~ m/postgres/) {
 
162
            return DB_POSTGRES;
 
163
        } if ($self->dsn =~ m/javadb/) {
 
164
            return DB_JAVADB;
 
165
        } else {
 
166
            return DB_DUMMY;
 
167
        }
 
168
        } else {
 
169
                return DB_UNKNOWN;
 
170
        }
 
171
}
 
172
 
 
173
my @dbid = ("Unknown","Dummy", "MySQL","Postgres","JavaDB","Drizzle");
 
174
 
 
175
sub getName {
 
176
    my ($self) = @_;
 
177
    return $dbid[$self->type()];
 
178
}
 
179
 
 
180
sub preprocess {
 
181
    my ($self, $query) = @_;
 
182
 
 
183
    my $id = $dbid[$self->type()];
 
184
    
 
185
    # Keep if match (+)
 
186
 
 
187
    # print "... $id before: $query \n";
 
188
    
 
189
    $query =~ s/\/\*\+[a-z:]*$id[a-z:]*:([^*]*)\*\//$1/gi;
 
190
 
 
191
    # print "... after: $query \n";
 
192
 
 
193
    return $query;
 
194
}
 
195
 
 
196
## This array maps SQL State class (2 first letters) to a status. This
 
197
## list needs to be extended
 
198
my %class2status = (
 
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
 
205
                                   # violation
 
206
    
 
207
    );
 
208
 
 
209
sub findStatus {
 
210
    my ($self, $state) = @_;
 
211
 
 
212
    my $class = substr($state, 0, 2);
 
213
    if (defined $class2status{$class}) {
 
214
        return $class2status{$class};
 
215
    } else {
 
216
        return STATUS_UNKNOWN_ERROR;
 
217
    }
 
218
}
 
219
 
 
220
sub defaultSchema {
 
221
    my ($self, $schema) = @_;
 
222
    if (defined $schema) {
 
223
        $self->[EXECUTOR_DEFAULT_SCHEMA] = $schema;
 
224
    }
 
225
    return $self->[EXECUTOR_DEFAULT_SCHEMA];
 
226
}
 
227
 
 
228
sub currentSchema {
 
229
    croak "currentSchema not defined for ". (ref $_[0]);
 
230
}
 
231
 
 
232
sub getSchemaMetaData {
 
233
    croak "getSchemaMetaData not defined for ". (ref $_[0]);
 
234
}
 
235
 
 
236
sub getCollationMetaData {
 
237
    carp "getCollationMetaData not defined for ". (ref $_[0]);
 
238
    return [[undef,undef]];
 
239
}
 
240
 
 
241
 
 
242
########### Metadata routines
 
243
 
 
244
sub cacheMetaData {
 
245
    my ($self) = @_;
 
246
    
 
247
    my $meta = {};
 
248
 
 
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;
 
256
        }
 
257
        $global_schema_cache{$self->dsn()} = $meta;
 
258
    } else {
 
259
        $meta = $global_schema_cache{$self->dsn()};
 
260
    }
 
261
 
 
262
    $self->[EXECUTOR_SCHEMA_METADATA] = $meta;
 
263
 
 
264
    my $coll = {};
 
265
    foreach my $row (@{$self->getCollationMetaData()}) {
 
266
        my ($collation, $charset) = @$row;
 
267
        $coll->{$collation} = $charset;
 
268
    }
 
269
    $self->[EXECUTOR_COLLATION_METADATA] = $coll;
 
270
 
 
271
    $self->[EXECUTOR_META_CACHE] = {};
 
272
}
 
273
 
 
274
sub metaSchemas {
 
275
    my ($self) = @_;
 
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;
 
281
    }
 
282
    return $self->[EXECUTOR_META_CACHE]->{SCHEMAS};
 
283
}
 
284
 
 
285
sub metaTables {
 
286
    my ($self, $schema) = @_;
 
287
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
 
288
 
 
289
    $schema = $self->defaultSchema if not defined $schema;
 
290
 
 
291
    my $cachekey = "TAB-$schema";
 
292
 
 
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;
 
298
    }
 
299
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
300
    
 
301
}
 
302
 
 
303
sub metaColumns {
 
304
    my ($self, $table, $schema) = @_;
 
305
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
 
306
    
 
307
    $schema = $self->defaultSchema if not defined $schema;
 
308
    $table = $self->metaTables($schema)->[0] if not defined $table;
 
309
    
 
310
    my $cachekey="COL-$schema-$table";
 
311
    
 
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;
 
317
    }
 
318
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
319
}
 
320
 
 
321
sub metaColumnsType {
 
322
    my ($self, $type, $table, $schema) = @_;
 
323
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
 
324
    
 
325
    $schema = $self->defaultSchema if not defined $schema;
 
326
    $table = $self->metaTables($schema)->[0] if not defined $table;
 
327
    
 
328
    my $cachekey="COL-$type-$schema-$table";
 
329
    
 
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;
 
336
    }
 
337
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
338
    
 
339
}
 
340
 
 
341
sub metaColumnsTypeNot {
 
342
    my ($self, $type, $table, $schema) = @_;
 
343
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
 
344
    
 
345
    $schema = $self->defaultSchema if not defined $schema;
 
346
    $table = $self->metaTables($schema)->[0] if not defined $table;
 
347
    
 
348
    my $cachekey="COLNOT-$type-$schema-$table";
 
349
 
 
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;
 
356
    }
 
357
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
358
}
 
359
 
 
360
sub metaCollations {
 
361
    my ($self) = @_;
 
362
    
 
363
    my $cachekey="COLLATIONS";
 
364
 
 
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;
 
369
    }
 
370
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
371
}
 
372
 
 
373
sub metaCharactersets {
 
374
    my ($self) = @_;
 
375
    
 
376
    my $cachekey="CHARSETS";
 
377
    
 
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;
 
381
        my %seen = ();
 
382
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = [sort grep { ! $seen{$_} ++ } @$charsets];
 
383
    }
 
384
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
 
385
}
 
386
 
 
387
################### Public interface to be used from grammars
 
388
##
 
389
 
 
390
sub tables {
 
391
    my ($self, @args) = @_;
 
392
    return $self->metaTables(@args);
 
393
}
 
394
 
 
395
1;