From 209ac67a45cd2a16b115f27ace04355ae2376104 Mon Sep 17 00:00:00 2001 From: Jason Etheridge Date: Mon, 22 Jul 2013 19:03:24 -0400 Subject: [PATCH] first attempt at making a test maker for seeding a baseline set of pgTAP tests for Evergreen TODO: put SELECT todo()'s in front of the tests that are currently failing but shouldn't be (quirk with pgTAP and PostgreSQL 9.1?) TODO: test for presence and attributes of stored procedures Signed-off-by: Jason Etheridge --- Open-ILS/src/sql/Pg/make-pgtap-tests.pl | 224 ++++++++++++++++++++++++++++++++ 1 file changed, 224 insertions(+) create mode 100755 Open-ILS/src/sql/Pg/make-pgtap-tests.pl diff --git a/Open-ILS/src/sql/Pg/make-pgtap-tests.pl b/Open-ILS/src/sql/Pg/make-pgtap-tests.pl new file mode 100755 index 0000000000..7241818918 --- /dev/null +++ b/Open-ILS/src/sql/Pg/make-pgtap-tests.pl @@ -0,0 +1,224 @@ +#!/usr/bin/perl +# vim:et:ts=4: +use strict; +use warnings; +use Getopt::Long; +use Data::Dumper; + +my ($db_name, $db_host, $db_port, $db_user, $db_pw) = + ( 'evergreen2', 'localhost', '5432', 'evergreen', 'evergreen' ); + +GetOptions( + 'db_name=s' => \$db_name, + 'db_host=s' => \$db_host, + 'db_port=s' => \$db_port, + 'db_user=s' => \$db_user, + 'db_pw=s' => \$db_pw, +); + +use DBI; + +my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port"; +my $dbh = DBI->connect($dsn, $db_user, $db_pw); + +# Short-circuit if we didn't connect successfully +unless($dbh) { + warn "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n"; + exit 1; +} + +print q^ +\set ECHO +\set QUIET 1 +-- Turn off echo and keep things quiet. + +-- Format the output for nice TAP. +\pset format unaligned +\pset tuples_only true +\pset pager + +-- Revert all changes on failure. +\set ON_ERROR_ROLLBACK 1 +\set ON_ERROR_STOP true +\set QUIET 1 + +-- Load the TAP functions. +BEGIN; + +-- Plan the tests. +SELECT no_plan(); + +-- Run the tests. +^; + +my @schemas = fetch_schemas(); +foreach my $schema ( @schemas ) { + print "\n-- schema " . $dbh->quote($schema) . "\n\n"; + print "SELECT has_schema(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote("Has schema $schema") . "\n);\n"; + + sub handle_columns { + my ($schema,$table) = (shift,shift); + my @columns = fetch_columns($schema,$table); + foreach my $column_array ( @columns ) { + my $column = $column_array->[0]; + my $col_type = $column_array->[1]; + my $col_nullable = $column_array->[2]; + my $col_default = $column_array->[3]; + print "\n-- -- -- column " . $dbh->quote("$schema.$table.$column") . "\n\n"; + print "SELECT has_column(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote($column) . ",\n"; + print "\t" . $dbh->quote("Has column $schema.$table.$column") . "\n);\n"; + print "SELECT col_type_is(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote($column) . ",\n"; + print "\t" . $dbh->quote($col_type) . ",\n"; + print "\t" . $dbh->quote("Column $schema.$table.$column is type $col_type"); + print "\n);\n"; + if ($col_nullable eq 'YES') { + print "SELECT col_is_null(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote($column) . ",\n"; + print "\t" . $dbh->quote("Column $schema.$table.$column is nullable"); + print "\n);\n"; + } else { + print "SELECT col_not_null(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote($column) . ",\n"; + print "\t" . $dbh->quote("Column $schema.$table.$column is not nullable"); + print "\n);\n"; + } + if (defined $col_default) { + my $fixme = ''; + if ($col_type eq 'interval') { + # FIXME - ERROR: invalid input syntax for type interval: "'1 day'::interval" + $fixme = '-- FIXME type 1 -- '; + } elsif ($col_type eq 'time without time zone') { + # FIXME - ERROR: invalid input syntax for type time: "'17:00:00'::time without time zone" + $fixme = '-- FIXME type 2 -- '; + } elsif ($col_default =~ 'org_unit_custom_tree_purpose') { + # FIXME - ERROR: invalid input value for enum actor.org_unit_custom_tree_purpose: "'opac'::actor.org_unit_custom_tree_purpose" + $fixme = '-- FIXME type 3 -- '; + } elsif ($col_type eq 'integer' && $col_default =~ '\(-?\d+\)') { + # FIXME - ERROR: invalid input syntax for integer: "(-1)" + $fixme = '-- FIXME type 4 -- '; + } elsif ($col_type eq 'USER-DEFINED') { + # FIXME - ERROR: Unexpected end of string + $fixme = '-- FIXME type 5 -- '; + } + # I would love to SELECT todo past these, but they cause hard failures + print $fixme . "SELECT col_default_is(\n"; + print $fixme . "\t" . $dbh->quote($schema) . ",\n"; + print $fixme . "\t" . $dbh->quote($table) . ",\n"; + print $fixme . "\t" . $dbh->quote($column) . ",\n"; + print $fixme . "\t" . $dbh->quote($col_default) . ",\n"; + print $fixme . "\t" . $dbh->quote("Column $schema.$table.$column has default value: $col_default"); + print "\n$fixme);\n"; + } else { + print "SELECT col_hasnt_default(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote($column) . ",\n"; + print "\t" . $dbh->quote("Column $schema.$table.$column has no default value"); + print "\n);\n"; + } + } + } + + my @tables = fetch_tables($schema); + foreach my $table ( @tables ) { + print "\n-- -- table " . $dbh->quote("$schema.$table") . "\n\n"; + print "SELECT has_table(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($table) . ",\n"; + print "\t" . $dbh->quote("Has table $schema.$table") . "\n);\n"; + handle_columns($schema,$table); + } + + my @views = fetch_views($schema); + foreach my $view ( @views ) { + print "\n-- -- view " . $dbh->quote("$schema.$view") . "\n\n"; + print "SELECT has_view(\n"; + print "\t" . $dbh->quote($schema) . ",\n"; + print "\t" . $dbh->quote($view) . ",\n"; + print "\t" . $dbh->quote("Has view $schema.$view") . "\n);\n"; + + handle_columns($schema,$view); + } + +} + +print q^ +-- Finish the tests and clean up. +SELECT * FROM finish(); +ROLLBACK; +^; + +sub fetch_schemas { + my $sth = $dbh->prepare(" + SELECT schema_name FROM information_schema.schemata + WHERE catalog_name = ? + AND schema_name NOT IN ('information_schema','migration_tools','public') + AND schema_name !~ '^pg_'; + "); + $sth->execute(($db_name)); + my $schemas = $sth->fetchall_arrayref([0]); + $sth->finish; + return sort map { $_->[0] } @{ $schemas }; +} + +sub fetch_tables { + my $schema = shift; + my $sth = $dbh->prepare(" + SELECT table_name FROM information_schema.tables + WHERE table_catalog = ? + AND table_schema = ? + AND table_type = 'BASE TABLE' + "); + $sth->execute(($db_name,$schema)); + my $tables = $sth->fetchall_arrayref([0]); + $sth->finish; + return sort map { $_->[0] } @{ $tables }; +} + +sub fetch_views { + my $schema = shift; + my $sth = $dbh->prepare(" + SELECT table_name FROM information_schema.tables + WHERE table_catalog = ? + AND table_schema = ? + AND table_type = 'VIEW' + "); + $sth->execute(($db_name,$schema)); + my $tables = $sth->fetchall_arrayref([0]); + $sth->finish; + return sort map { $_->[0] } @{ $tables }; +} + +sub fetch_columns { + my ($schema,$table) = (shift,shift); + my $sth = $dbh->prepare(" + SELECT + column_name, + data_type, + is_nullable, + column_default + FROM information_schema.columns + WHERE table_catalog = ? + AND table_schema = ? + AND table_name = ? + "); + $sth->execute(($db_name,$schema,$table)); + my $columns = $sth->fetchall_arrayref(); + $sth->finish; + return sort { $a->[0] cmp $b->[0] } (map { $_ } @{ $columns }); +} + +$dbh->disconnect; + -- 2.11.0