~drizzle-trunk/drizzle/development : contents of tests/randgen/lib/GenTest/Executor.pm at revision 2461.1.3

~drizzle-trunk/drizzle/development : (revision 2461.1.3)

# Copyright (C) 2008-2009 Sun Microsystems, Inc. All rights reserved.
# Use is subject to license terms.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
# USA

package GenTest::Executor;

require Exporter;
@ISA = qw(GenTest Exporter);

@EXPORT = qw(
	EXECUTOR_RETURNED_ROW_COUNTS
	EXECUTOR_AFFECTED_ROW_COUNTS
	EXECUTOR_EXPLAIN_COUNTS
	EXECUTOR_EXPLAIN_QUERIES
	EXECUTOR_ERROR_COUNTS
	EXECUTOR_STATUS_COUNTS
);

use strict;
use Carp;
use Data::Dumper;
use GenTest;
use GenTest::Constants;

use constant EXECUTOR_DSN			=> 0;
use constant EXECUTOR_DBH			=> 1;
use constant EXECUTOR_ID			=> 2;
use constant EXECUTOR_RETURNED_ROW_COUNTS	=> 3;
use constant EXECUTOR_AFFECTED_ROW_COUNTS	=> 4;
use constant EXECUTOR_EXPLAIN_COUNTS		=> 5;
use constant EXECUTOR_EXPLAIN_QUERIES		=> 6;
use constant EXECUTOR_ERROR_COUNTS		=> 7;
use constant EXECUTOR_STATUS_COUNTS		=> 8;
use constant EXECUTOR_DEFAULT_SCHEMA		=> 9;
use constant EXECUTOR_SCHEMA_METADATA		=> 10;
use constant EXECUTOR_COLLATION_METADATA	=> 11;
use constant EXECUTOR_META_CACHE		=> 12;
use constant EXECUTOR_CHANNEL			=> 13;
use constant EXECUTOR_SQLTRACE			=> 14;
use constant EXECUTOR_NO_ERR_FILTER             => 15;

my %global_schema_cache;

1;

sub new {
    my $class = shift;
	
	my $executor = $class->SUPER::new({
		'dsn'	=> EXECUTOR_DSN,
		'dbh'	=> EXECUTOR_DBH,
        'channel' => EXECUTOR_CHANNEL,
        'sqltrace' => EXECUTOR_SQLTRACE,
        'no-err-filter' => EXECUTOR_NO_ERR_FILTER
	}, @_);
    
    return $executor;
}

sub newFromDSN {
	my ($self,$dsn,$channel) = @_;
	
	if ($dsn =~ m/^dbi:mysql:/i) {
		require GenTest::Executor::MySQL;
		return GenTest::Executor::MySQL->new(dsn => $dsn, channel => $channel);
	} elsif ($dsn =~ m/^dbi:drizzle:/i) {
		require GenTest::Executor::Drizzle;
		return GenTest::Executor::Drizzle->new(dsn => $dsn);
	} elsif ($dsn =~ m/^dbi:JDBC:.*url=jdbc:derby:/i) {
		require GenTest::Executor::JavaDB;
		return GenTest::Executor::JavaDB->new(dsn => $dsn);
	} elsif ($dsn =~ m/^dbi:Pg:/i) {
		require GenTest::Executor::Postgres;
		return GenTest::Executor::Postgres->new(dsn => $dsn);
    } elsif ($dsn =~ m/^dummy/) {
		require GenTest::Executor::Dummy;
		return GenTest::Executor::Dummy->new(dsn => $dsn);
	} else {
		say("Unsupported dsn: $dsn");
		exit(STATUS_ENVIRONMENT_FAILURE);
	}
}

sub channel {
    return $_[0]->[EXECUTOR_CHANNEL];
}

sub sendError {
    my ($self, $msg) = @_;
    $self->channel->send($msg);
}


sub dbh {
	return $_[0]->[EXECUTOR_DBH];
}

sub setDbh {
	$_[0]->[EXECUTOR_DBH] = $_[1];
}

sub setDbh {
	$_[0]->[EXECUTOR_DBH] = $_[1];
}

sub sqltrace {
    my ($self, $sqltrace) = @_;
    $self->[EXECUTOR_SQLTRACE] = $sqltrace if defined $sqltrace;
    return $self->[EXECUTOR_SQLTRACE];
}

sub noErrFilter {
    my ($self, $no_err_filter) = @_;
    $self->[EXECUTOR_NO_ERR_FILTER] = $no_err_filter if defined $no_err_filter;
    return $self->[EXECUTOR_NO_ERR_FILTER];
}

sub dsn {
	return $_[0]->[EXECUTOR_DSN];
}

sub setDsn {
	$_[0]->[EXECUTOR_DSN] = $_[1];
}

sub id {
	return $_[0]->[EXECUTOR_ID];
}

sub setId {
	$_[0]->[EXECUTOR_ID] = $_[1];
}

sub type {
	my ($self) = @_;
	
	if (ref($self) eq "GenTest::Executor::JavaDB") {
		return DB_JAVADB;
	} elsif (ref($self) eq "GenTest::Executor::MySQL") {
		return DB_MYSQL;
	} elsif (ref($self) eq "GenTest::Executor::Drizzle") {
		return DB_DRIZZLE;
	} elsif (ref($self) eq "GenTest::Executor::Postgres") {
		return DB_POSTGRES;
    } elsif (ref($self) eq "GenTest::Executor::Dummy") {
        if ($self->dsn =~ m/mysql/) {
            return DB_MYSQL;
        } elsif ($self->dsn =~ m/postgres/) {
            return DB_POSTGRES;
        } if ($self->dsn =~ m/javadb/) {
            return DB_JAVADB;
        } else {
            return DB_DUMMY;
        }
	} else {
		return DB_UNKNOWN;
	}
}

my @dbid = ("Unknown","Dummy", "MySQL","Postgres","JavaDB","Drizzle");

sub getName {
    my ($self) = @_;
    return $dbid[$self->type()];
}

sub preprocess {
    my ($self, $query) = @_;

    my $id = $dbid[$self->type()];
    
    # Keep if match (+)

    # print "... $id before: $query \n";
    
    $query =~ s/\/\*\+[a-z:]*$id[a-z:]*:([^*]*)\*\//$1/gi;

    # print "... after: $query \n";

    return $query;
}

## This array maps SQL State class (2 first letters) to a status. This
## list needs to be extended
my %class2status = (
    "07" => STATUS_SEMANTIC_ERROR, # dynamic SQL error
    "08" => STATUS_SEMANTIC_ERROR, # connection exception
    "22" => STATUS_SEMANTIC_ERROR, # data exception
    "23" => STATUS_SEMANTIC_ERROR, # integrity constraint violation
    "25" => STATUS_TRANSACTION_ERROR, # invalid transaction state
    "42" => STATUS_SYNTAX_ERROR    # syntax error or access rule
                                   # violation
    
    );

sub findStatus {
    my ($self, $state) = @_;

    my $class = substr($state, 0, 2);
    if (defined $class2status{$class}) {
        return $class2status{$class};
    } else {
        return STATUS_UNKNOWN_ERROR;
    }
}

sub defaultSchema {
    my ($self, $schema) = @_;
    if (defined $schema) {
        $self->[EXECUTOR_DEFAULT_SCHEMA] = $schema;
    }
    return $self->[EXECUTOR_DEFAULT_SCHEMA];
}

sub currentSchema {
    croak "currentSchema not defined for ". (ref $_[0]);
}

sub getSchemaMetaData {
    croak "getSchemaMetaData not defined for ". (ref $_[0]);
}

sub getCollationMetaData {
    carp "getCollationMetaData not defined for ". (ref $_[0]);
    return [[undef,undef]];
}


########### Metadata routines

sub cacheMetaData {
    my ($self) = @_;
    
    my $meta = {};

    if (not exists $global_schema_cache{$self->dsn()}) {
        say ("Caching schema metadata for ".$self->dsn());
        foreach my $row (@{$self->getSchemaMetaData()}) {
            my ($schema, $table, $type, $col, $key) = @$row;
            $meta->{$schema}={} if not exists $meta->{$schema};
            $meta->{$schema}->{$table}={} if not exists $meta->{$schema}->{$table};
            $meta->{$schema}->{$table}->{$col}=$key;
        }
	$global_schema_cache{$self->dsn()} = $meta;
    } else {
	$meta = $global_schema_cache{$self->dsn()};
    }

    $self->[EXECUTOR_SCHEMA_METADATA] = $meta;

    my $coll = {};
    foreach my $row (@{$self->getCollationMetaData()}) {
        my ($collation, $charset) = @$row;
        $coll->{$collation} = $charset;
    }
    $self->[EXECUTOR_COLLATION_METADATA] = $coll;

    $self->[EXECUTOR_META_CACHE] = {};
}

sub metaSchemas {
    my ($self) = @_;
    if (not defined $self->[EXECUTOR_META_CACHE]->{SCHEMAS}) {
        my $schemas = [sort keys %{$self->[EXECUTOR_SCHEMA_METADATA]}];
        croak "No schemas found" 
            if not defined $schemas or $#$schemas < 0;
        $self->[EXECUTOR_META_CACHE]->{SCHEMAS} = $schemas;
    }
    return $self->[EXECUTOR_META_CACHE]->{SCHEMAS};
}

sub metaTables {
    my ($self, $schema) = @_;
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];

    $schema = $self->defaultSchema if not defined $schema;

    my $cachekey = "TAB-$schema";

    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $tables = [sort keys %{$meta->{$schema}}];
        croak "Schema '$schema' has no tables"  
            if not defined $tables or $#$tables < 0;
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = $tables;
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
    
}

sub metaColumns {
    my ($self, $table, $schema) = @_;
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
    
    $schema = $self->defaultSchema if not defined $schema;
    $table = $self->metaTables($schema)->[0] if not defined $table;
    
    my $cachekey="COL-$schema-$table";
    
    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $cols = [sort keys %{$meta->{$schema}->{$table}}];
        croak "Table '$table' in schema '$schema' has no columns"  
            if not defined $cols or $#$cols < 0;
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
}

sub metaColumnsType {
    my ($self, $type, $table, $schema) = @_;
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
    
    $schema = $self->defaultSchema if not defined $schema;
    $table = $self->metaTables($schema)->[0] if not defined $table;
    
    my $cachekey="COL-$type-$schema-$table";
    
    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $colref = $meta->{$schema}->{$table};
        my $cols = [sort grep {$colref->{$_} eq $type} keys %$colref];
        croak "Table '$table' in schema '$schema' has no '$type' columns"  
            if not defined $cols or $#$cols < 0;
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
    
}

sub metaColumnsTypeNot {
    my ($self, $type, $table, $schema) = @_;
    my $meta = $self->[EXECUTOR_SCHEMA_METADATA];
    
    $schema = $self->defaultSchema if not defined $schema;
    $table = $self->metaTables($schema)->[0] if not defined $table;
    
    my $cachekey="COLNOT-$type-$schema-$table";

    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $colref = $meta->{$schema}->{$table};
        my $cols = [sort grep {$colref->{$_} ne $type} keys %$colref];
        croak "Table '$table' in schema '$schema' has no columns which are not '$type'"  
            if not defined $cols or $#$cols < 0;
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = $cols;
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
}

sub metaCollations {
    my ($self) = @_;
    
    my $cachekey="COLLATIONS";

    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $coll = [sort keys %{$self->[EXECUTOR_COLLATION_METADATA]}];
        croak "No Collations defined" if not defined $coll or $#$coll < 0;
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = $coll;
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
}

sub metaCharactersets {
    my ($self) = @_;
    
    my $cachekey="CHARSETS";
    
    if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
        my $charsets = [values %{$self->[EXECUTOR_COLLATION_METADATA]}];
        croak "No character sets defined" if not defined $charsets or $#$charsets < 0;
        my %seen = ();
        $self->[EXECUTOR_META_CACHE]->{$cachekey} = [sort grep { ! $seen{$_} ++ } @$charsets];
    }
    return $self->[EXECUTOR_META_CACHE]->{$cachekey};
}

################### Public interface to be used from grammars
##

sub tables {
    my ($self, @args) = @_;
    return $self->metaTables(@args);
}

1;

0.67.305 by Bernt M. Johnsen Copyright headres and license added	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
0.67.1 by Philip Stoev initial import from internal tree	18	package GenTest::Executor;
	19
	20	require Exporter;
	21	@ISA = qw(GenTest Exporter);
	22
	23	@EXPORT = qw(
0.67.435 by Philip Stoev count and report affected_rows and returned rows separately	24	EXECUTOR_RETURNED_ROW_COUNTS
	25	EXECUTOR_AFFECTED_ROW_COUNTS
0.67.3 by Philip Stoev allow working with tables and databases of varying structure	26	EXECUTOR_EXPLAIN_COUNTS
	27	EXECUTOR_EXPLAIN_QUERIES
	28	EXECUTOR_ERROR_COUNTS
0.67.521 by eve provide textual exit codes for various scripts and not jus numbers	29	EXECUTOR_STATUS_COUNTS
0.67.1 by Philip Stoev initial import from internal tree	30	);
	31
	32	use strict;
0.67.189 by Bernt M. Johnsen current/default Schema cleanup	33	use Carp;
0.67.195 by Bernt M. Johnsen New metadata implmentation	34	use Data::Dumper;
0.67.1 by Philip Stoev initial import from internal tree	35	use GenTest;
0.67.9 by Philip Stoev merge from internal tree	36	use GenTest::Constants;
0.67.1 by Philip Stoev initial import from internal tree	37
0.67.435 by Philip Stoev count and report affected_rows and returned rows separately	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;
0.67.521 by eve provide textual exit codes for various scripts and not jus numbers	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;
0.67.629 by Patrick Crews Added no-err-filter option to turn off randgen suppression of error messages. There are cases where we want to see all error output from the randgen. Code only added to Drizzle Executor, but can be added to other Executors if desired	53	use constant EXECUTOR_NO_ERR_FILTER => 15;
0.67.1 by Philip Stoev initial import from internal tree	54
0.67.561 by eve cache MySQL metadata	55	my %global_schema_cache;
0.67.561 by eve cache MySQL metadata	56
0.67.1 by Philip Stoev initial import from internal tree	57	1;
	58
	59	sub new {
0.67.9 by Philip Stoev merge from internal tree	60	my $class = shift;
0.67.1 by Philip Stoev initial import from internal tree	61
	62	my $executor = $class->SUPER::new({
	63	'dsn' => EXECUTOR_DSN,
	64	'dbh' => EXECUTOR_DBH,
0.96.1 by Bernt M. Johnsen Centralized handling of error message supression in separate process	65	'channel' => EXECUTOR_CHANNEL,
0.67.629 by Patrick Crews Added no-err-filter option to turn off randgen suppression of error messages. There are cases where we want to see all error output from the randgen. Code only added to Drizzle Executor, but can be added to other Executors if desired	66	'sqltrace' => EXECUTOR_SQLTRACE,
	67	'no-err-filter' => EXECUTOR_NO_ERR_FILTER
0.67.1 by Philip Stoev initial import from internal tree	68	}, @_);
0.67.9 by Philip Stoev merge from internal tree	69
0.67.9 by Philip Stoev merge from internal tree	70	return $executor;
0.67.1 by Philip Stoev initial import from internal tree	71	}
0.67.1 by Philip Stoev initial import from internal tree	72
0.67.10 by Philip Stoev initial fixes for drizzle	73	sub newFromDSN {
0.96.1 by Bernt M. Johnsen Centralized handling of error message supression in separate process	74	my ($self,$dsn,$channel) = @_;
0.67.10 by Philip Stoev initial fixes for drizzle	75
	76	if ($dsn =~ m/^dbi:mysql:/i) {
	77	require GenTest::Executor::MySQL;
0.96.1 by Bernt M. Johnsen Centralized handling of error message supression in separate process	78	return GenTest::Executor::MySQL->new(dsn => $dsn, channel => $channel);
0.67.10 by Philip Stoev initial fixes for drizzle	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);
0.81.9 by Bernt M. Johnsen Added print mode for Dummy executor	88	} elsif ($dsn =~ m/^dummy/) {
0.67.49 by Bernt M. Johnsen Refactored gendata.pl and gendata-old.pl to modules. The scripts are kept as wrappers	89	require GenTest::Executor::Dummy;
	90	return GenTest::Executor::Dummy->new(dsn => $dsn);
0.67.10 by Philip Stoev initial fixes for drizzle	91	} else {
	92	say("Unsupported dsn: $dsn");
	93	exit(STATUS_ENVIRONMENT_FAILURE);
	94	}
	95	}
	96
0.96.1 by Bernt M. Johnsen Centralized handling of error message supression in separate process	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
0.67.1 by Philip Stoev initial import from internal tree	107	sub dbh {
	108	return $_[0]->[EXECUTOR_DBH];
	109	}
	110
	111	sub setDbh {
	112	$_[0]->[EXECUTOR_DBH] = $_[1];
	113	}
	114
0.103.2 by Bernt M. Johnsen Sqltrace option for re-runs	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
0.67.629 by Patrick Crews Added no-err-filter option to turn off randgen suppression of error messages. There are cases where we want to see all error output from the randgen. Code only added to Drizzle Executor, but can be added to other Executors if desired	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
0.67.1 by Philip Stoev initial import from internal tree	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
0.67.9 by Philip Stoev merge from internal tree	147	sub type {
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	148	my ($self) = @_;
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	149
0.74.1 by Bernt M. Johnsen Smal fixxes, more testing	150	if (ref($self) eq "GenTest::Executor::JavaDB") {
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	151	return DB_JAVADB;
0.74.1 by Bernt M. Johnsen Smal fixxes, more testing	152	} elsif (ref($self) eq "GenTest::Executor::MySQL") {
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	153	return DB_MYSQL;
0.74.1 by Bernt M. Johnsen Smal fixxes, more testing	154	} elsif (ref($self) eq "GenTest::Executor::Drizzle") {
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	155	return DB_DRIZZLE;
0.74.1 by Bernt M. Johnsen Smal fixxes, more testing	156	} elsif (ref($self) eq "GenTest::Executor::Postgres") {
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	157	return DB_POSTGRES;
0.74.1 by Bernt M. Johnsen Smal fixxes, more testing	158	} elsif (ref($self) eq "GenTest::Executor::Dummy") {
0.67.176 by Bernt M. Johnsen Improved Dummy executor for debugging purposes	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	}
0.67.11 by Philip Stoev Drizzle Executor and conf/ files	168	} else {
	169	return DB_UNKNOWN;
	170	}
0.67.9 by Philip Stoev merge from internal tree	171	}
0.67.9 by Philip Stoev merge from internal tree	172
0.67.49 by Bernt M. Johnsen Refactored gendata.pl and gendata-old.pl to modules. The scripts are kept as wrappers	173	my @dbid = ("Unknown","Dummy", "MySQL","Postgres","JavaDB","Drizzle");
0.67.9 by Philip Stoev merge from internal tree	174
	175	sub getName {
	176	my ($self) = @_;
	177	return $dbid[$self->type()];
	178	}
	179
	180	sub preprocess {
	181	my ($self, $query) = @_;
	182
0.67.176 by Bernt M. Johnsen Improved Dummy executor for debugging purposes	183	my $id = $dbid[$self->type()];
0.67.9 by Philip Stoev merge from internal tree	184
	185	# Keep if match (+)
	186
	187	# print "... $id before: $query \n";
	188
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	189	$query =~ s/\/\\+[a-z:]$id[a-z:]:([^])\\//$1/gi;
0.67.9 by Philip Stoev merge from internal tree	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
0.67.188 by Bernt M. Johnsen Implemented in gendata, added defaultSchema in executors	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 {
0.67.189 by Bernt M. Johnsen current/default Schema cleanup	229	croak "currentSchema not defined for ". (ref $_[0]);
0.67.188 by Bernt M. Johnsen Implemented in gendata, added defaultSchema in executors	230	}
	231
0.67.195 by Bernt M. Johnsen New metadata implmentation	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 = {};
0.67.561 by eve cache MySQL metadata	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()};
0.67.195 by Bernt M. Johnsen New metadata implmentation	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}) {
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	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;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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}}];
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	295	croak "Schema '$schema' has no tables"
	296	if not defined $tables or $#$tables < 0;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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}) {
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	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;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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";
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	329
0.67.195 by Bernt M. Johnsen New metadata implmentation	330	if (not defined $self->[EXECUTOR_META_CACHE]->{$cachekey}) {
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	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;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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}) {
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	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;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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}) {
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	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;
0.67.195 by Bernt M. Johnsen New metadata implmentation	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]}];
0.67.232 by Bernt M. Johnsen Implemented: Bug #49565 _field and the rest should assert instead of returning an empty string	380	croak "No character sets defined" if not defined $charsets or $#$charsets < 0;
0.67.195 by Bernt M. Johnsen New metadata implmentation	381	my %seen = ();
	382	$self->[EXECUTOR_META_CACHE]->{$cachekey} = [sort grep { ! $seen{$_} ++ } @$charsets];
	383	}
	384	return $self->[EXECUTOR_META_CACHE]->{$cachekey};
	385	}
	386
0.67.201 by Bernt M. Johnsen Small fix in tables()	387	################### Public interface to be used from grammars
	388	##
	389
	390	sub tables {
	391	my ($self, @args) = @_;
	392	return $self->metaTables(@args);
	393	}
	394
0.67.1 by Philip Stoev initial import from internal tree	395	1;