[DBD::Pg 13/14] Add back in MATERIALIZED VIEWS work - too hard to do so inside the previous merger. Also changed tabs to spaces, minor POD tweaks.
[email protected] Sun, 27 Jul 2014 05:14:14 +0000
| Newsgroups | perl.dbd.pg.changes |
|---|---|
| Message-ID | <[email protected]> |
Committed by Greg Sabino Mullane <[email protected]> Subject: [DBD::Pg 13/14] Add back in MATERIALIZED VIEWS work - too hard to do so inside the previous merger. Also changed tabs to spaces, minor POD tweaks. --- Pg.pm | 586 +++++++++++++++++++++++++++++---------------------------- t/03dbmethod.t | 2 + 2 files changed, 302 insertions(+), 286 deletions(-) diff --git a/Pg.pm b/Pg.pm index ed261c5..3a9379d 100644 --- a/Pg.pm +++ b/Pg.pm @@ -1067,35 +1067,41 @@ use 5.008001; SELECT 'SYSTEM VIEW' , 'relkind: v; nspname ~ ^pg_(catalog|toast)$' UNION + SELECT 'MATERIALIZED VIEW' + , 'relkind: m' + UNION + SELECT 'SYSTEM MATERIALIZED VIEW' + , 'relkind: m; nspname ~ ^pg_(catalog|toast)$' + UNION SELECT 'LOCAL TEMPORARY' , 'relkind: r; nspname ~ ^pg_(toast_)?temp') type_info ORDER BY "TABLE_TYPE" ASC }; - } - else { - # Default SQL - $extracols = q{,n.nspname AS pg_schema, c.relname AS pg_table}; - my @search = (q|c.relkind IN ('r', 'v')|, # No sequences, etc. for now - q|NOT (quote_ident(n.nspname) ~ '^pg_(toast_)?temp_' AND NOT has_schema_privilege(n.nspname, 'USAGE'))|); # No others' temp objects - my $showtablespace = ', quote_ident(t.spcname) AS "pg_tablespace_name", quote_ident(t.spclocation) AS "pg_tablespace_location"'; - if ($dbh->{private_dbdpg}{version} >= 90200) { - $showtablespace = ', quote_ident(t.spcname) AS "pg_tablespace_name", quote_ident(pg_tablespace_location(t.oid)) AS "pg_tablespace_location"'; - } - - ## If the schema or table has an underscore or a %, use a LIKE comparison - if (defined $schema and length $schema) { - push @search, 'n.nspname ' . ($schema =~ /[_%]/ ? 'LIKE ' : '= ') . $dbh->quote($schema); - } - if (defined $table and length $table) { - push @search, 'c.relname ' . ($table =~ /[_%]/ ? 'LIKE ' : '= ') . $dbh->quote($table); - } - - my $TSJOIN = 'pg_catalog.pg_tablespace t ON (t.oid = c.reltablespace)'; - if ($dbh->{private_dbdpg}{version} < 80000) { - $TSJOIN = '(SELECT 0 AS oid, 0 AS spcname, 0 AS spclocation LIMIT 0) AS t ON (t.oid=1)'; - } - my $whereclause = join "\n\t\t\t\t\t AND " => @search; - $tbl_sql = qq{ + } + else { + # Default SQL + $extracols = q{,n.nspname AS pg_schema, c.relname AS pg_table}; + my @search = (q|c.relkind IN ('r', 'v', 'm')|, # No sequences, etc. for now + q|NOT (quote_ident(n.nspname) ~ '^pg_(toast_)?temp_' AND NOT has_schema_privilege(n.nspname, 'USAGE'))|); # No others' temp objects + my $showtablespace = ', quote_ident(t.spcname) AS "pg_tablespace_name", quote_ident(t.spclocation) AS "pg_tablespace_location"'; + if ($dbh->{private_dbdpg}{version} >= 90200) { + $showtablespace = ', quote_ident(t.spcname) AS "pg_tablespace_name", quote_ident(pg_tablespace_location(t.oid)) AS "pg_tablespace_location"'; + } + + ## If the schema or table has an underscore or a %, use a LIKE comparison + if (defined $schema and length $schema) { + push @search, 'n.nspname ' . ($schema =~ /[_%]/ ? 'LIKE ' : '= ') . $dbh->quote($schema); + } + if (defined $table and length $table) { + push @search, 'c.relname ' . ($table =~ /[_%]/ ? 'LIKE ' : '= ') . $dbh->quote($table); + } + + my $TSJOIN = 'pg_catalog.pg_tablespace t ON (t.oid = c.reltablespace)'; + if ($dbh->{private_dbdpg}{version} < 80000) { + $TSJOIN = '(SELECT 0 AS oid, 0 AS spcname, 0 AS spclocation LIMIT 0) AS t ON (t.oid=1)'; + } + my $whereclause = join "\n\t\t\t\t\t AND " => @search; + $tbl_sql = qq{ SELECT NULL::text AS "TABLE_CAT" , quote_ident(n.nspname) AS "TABLE_SCHEM" , quote_ident(c.relname) AS "TABLE_NAME" @@ -1107,10 +1113,17 @@ use 5.008001; 'SYSTEM TABLE' ELSE 'TABLE' END - ELSE CASE WHEN quote_ident(n.nspname) ~ '^pg_' THEN + WHEN c.relkind = 'v' THEN + CASE WHEN quote_ident(n.nspname) ~ '^pg_' THEN 'SYSTEM VIEW' ELSE 'VIEW' END + WHEN c.relkind = 'm' THEN + CASE WHEN quote_ident(n.nspname) ~ '^pg_' THEN + 'SYSTEM MATERIALIZED VIEW' + ELSE 'MATERIALIZED VIEW' + END + ELSE 'UNKNOWN' END AS "TABLE_TYPE" , d.description AS "REMARKS" $showtablespace $extracols FROM pg_catalog.pg_class AS c @@ -1122,129 +1135,129 @@ use 5.008001; ORDER BY "TABLE_TYPE", "TABLE_CAT", "TABLE_SCHEM", "TABLE_NAME" }; - if (defined($type) and length($type)) { - my $type_restrict = join ', ' => - map { $dbh->quote($_) unless /^'/ } - grep {length} - split(',', $type); - $tbl_sql = qq{SELECT * FROM ($tbl_sql) ti WHERE "TABLE_TYPE" IN ($type_restrict)}; - } - } - my $sth = $dbh->prepare( $tbl_sql ) or return undef; - $sth->execute(); - - return $sth; - } + if (defined($type) and length($type)) { + my $type_restrict = join ', ' => + map { $dbh->quote($_) unless /^'/ } + grep {length} + split(',', $type); + $tbl_sql = qq{SELECT * FROM ($tbl_sql) ti WHERE "TABLE_TYPE" IN ($type_restrict)}; + } + } + my $sth = $dbh->prepare( $tbl_sql ) or return undef; + $sth->execute(); + + return $sth; + } - sub tables { - my ($dbh, @args) = @_; - my $attr = $args[4]; - my $sth = $dbh->table_info(@args) or return; - my $tables = $sth->fetchall_arrayref() or return; - my @tables = map { (! (ref $attr eq 'HASH' and $attr->{pg_noprefix})) ? - "$_->[1].$_->[2]" : $_->[2] } @$tables; - return @tables; - } + sub tables { + my ($dbh, @args) = @_; + my $attr = $args[4]; + my $sth = $dbh->table_info(@args) or return; + my $tables = $sth->fetchall_arrayref() or return; + my @tables = map { (! (ref $attr eq 'HASH' and $attr->{pg_noprefix})) ? + "$_->[1].$_->[2]" : $_->[2] } @$tables; + return @tables; + } - sub table_attributes { - my ($dbh, $table) = @_; + sub table_attributes { + my ($dbh, $table) = @_; - my $sth = $dbh->column_info(undef,undef,$table,undef); + my $sth = $dbh->column_info(undef,undef,$table,undef); - my %convert = ( - COLUMN_NAME => 'NAME', - DATA_TYPE => 'TYPE', - COLUMN_SIZE => 'SIZE', - NULLABLE => 'NOTNULL', - REMARKS => 'REMARKS', - COLUMN_DEF => 'DEFAULT', - pg_constraint => 'CONSTRAINT', - ); + my %convert = ( + COLUMN_NAME => 'NAME', + DATA_TYPE => 'TYPE', + COLUMN_SIZE => 'SIZE', + NULLABLE => 'NOTNULL', + REMARKS => 'REMARKS', + COLUMN_DEF => 'DEFAULT', + pg_constraint => 'CONSTRAINT', + ); - my $attrs = $sth->fetchall_arrayref(\%convert); + my $attrs = $sth->fetchall_arrayref(\%convert); - for my $row (@$attrs) { - # switch the column names - for my $name (keys %$row) { - $row->{ $convert{$name} } = $row->{$name}; + for my $row (@$attrs) { + # switch the column names + for my $name (keys %$row) { + $row->{ $convert{$name} } = $row->{$name}; - ## Keep some original columns - delete $row->{$name} unless ($name eq 'REMARKS' or $name eq 'NULLABLE'); + ## Keep some original columns + delete $row->{$name} unless ($name eq 'REMARKS' or $name eq 'NULLABLE'); - } - # Moved check outside of loop as it was inverting the NOTNULL value for - # attribute. - # NOTNULL inverts the sense of NULLABLE - $row->{NOTNULL} = ($row->{NOTNULL} ? 0 : 1); + } + # Moved check outside of loop as it was inverting the NOTNULL value for + # attribute. + # NOTNULL inverts the sense of NULLABLE + $row->{NOTNULL} = ($row->{NOTNULL} ? 0 : 1); - my @pri_keys = $dbh->primary_key( undef, undef, $table ); - $row->{PRIMARY_KEY} = scalar(grep { /^$row->{NAME}$/i } @pri_keys) ? 1 : 0; - } + my @pri_keys = $dbh->primary_key( undef, undef, $table ); + $row->{PRIMARY_KEY} = scalar(grep { /^$row->{NAME}$/i } @pri_keys) ? 1 : 0; + } - return $attrs; + return $attrs; - } + } - sub _calc_col_size { + sub _calc_col_size { - my $mod = shift; - my $size = shift; + my $mod = shift; + my $size = shift; - if ((defined $size) and ($size > 0)) { - return $size; - } elsif ($mod > 0xffff) { - my $prec = ($mod & 0xffff) - 4; - $mod >>= 16; - my $dig = $mod; - return "$prec,$dig"; - } elsif ($mod >= 4) { - return $mod - 4; - } # else { - # $rtn = $mod; - # $rtn = undef; - # } + if ((defined $size) and ($size > 0)) { + return $size; + } elsif ($mod > 0xffff) { + my $prec = ($mod & 0xffff) - 4; + $mod >>= 16; + my $dig = $mod; + return "$prec,$dig"; + } elsif ($mod >= 4) { + return $mod - 4; + } # else { + # $rtn = $mod; + # $rtn = undef; + # } - return; - } + return; + } - sub type_info_all { - my ($dbh) = @_; - - my $names = - { - TYPE_NAME => 0, - DATA_TYPE => 1, - COLUMN_SIZE => 2, - LITERAL_PREFIX => 3, - LITERAL_SUFFIX => 4, - CREATE_PARAMS => 5, - NULLABLE => 6, - CASE_SENSITIVE => 7, - SEARCHABLE => 8, - UNSIGNED_ATTRIBUTE => 9, - FIXED_PREC_SCALE => 10, - AUTO_UNIQUE_VALUE => 11, - LOCAL_TYPE_NAME => 12, - MINIMUM_SCALE => 13, - MAXIMUM_SCALE => 14, - SQL_DATA_TYPE => 15, - SQL_DATETIME_SUB => 16, - NUM_PREC_RADIX => 17, - INTERVAL_PRECISION => 18, - }; - - ## This list is derived from dbi_sql.h in DBI, from types.c and types.h, and from the PG docs - - ## Aids to make the list more readable: - my $GIG = 1073741824; - my $PS = 'precision/scale'; - my $LEN = 'length'; - my $UN; - my $ti = - [ - $names, + sub type_info_all { + my ($dbh) = @_; + + my $names = + { + TYPE_NAME => 0, + DATA_TYPE => 1, + COLUMN_SIZE => 2, + LITERAL_PREFIX => 3, + LITERAL_SUFFIX => 4, + CREATE_PARAMS => 5, + NULLABLE => 6, + CASE_SENSITIVE => 7, + SEARCHABLE => 8, + UNSIGNED_ATTRIBUTE => 9, + FIXED_PREC_SCALE => 10, + AUTO_UNIQUE_VALUE => 11, + LOCAL_TYPE_NAME => 12, + MINIMUM_SCALE => 13, + MAXIMUM_SCALE => 14, + SQL_DATA_TYPE => 15, + SQL_DATETIME_SUB => 16, + NUM_PREC_RADIX => 17, + INTERVAL_PRECISION => 18, + }; + + ## This list is derived from dbi_sql.h in DBI, from types.c and types.h, and from the PG docs + + ## Aids to make the list more readable: + my $GIG = 1073741824; + my $PS = 'precision/scale'; + my $LEN = 'length'; + my $UN; + my $ti = + [ + $names, # name sql_type size pfx/sfx crt n/c/s +-/P/I local min max sub rdx itvl ['unknown', SQL_UNKNOWN_TYPE, 0, $UN,$UN, $UN, 1,0,0, $UN,0,0, 'UNKNOWN', $UN,$UN, @@ -1291,31 +1304,31 @@ use 5.008001; ['timestamptz',SQL_TYPE_TIMESTAMP_WITH_TIMEZONE, 29, q{'},q{'}, $UN, 1,0,2, $UN,0,0, 'TIMESTAMPTZ',0,6, SQL_TYPE_TIMESTAMP_WITH_TIMEZONE, $UN, $UN, $UN ], - # - # intentionally omitted: char, all geometric types, internal types - ]; - return $ti; - } + # + # intentionally omitted: char, all geometric types, internal types + ]; + return $ti; + } - # Characters that need to be escaped by quote(). - my %esc = ( - q{'} => '\\047', # '\\' . sprintf("%03o", ord("'")), # ISO SQL 2 - '\\' => '\\134', # '\\' . sprintf("%03o", ord("\\")), - ); + # Characters that need to be escaped by quote(). + my %esc = ( + q{'} => '\\047', # '\\' . sprintf("%03o", ord("'")), # ISO SQL 2 + '\\' => '\\134', # '\\' . sprintf("%03o", ord("\\")), + ); - # Set up lookup for SQL types we don't want to escape. - my %no_escape = map { $_ => 1 } - DBI::SQL_INTEGER, DBI::SQL_SMALLINT, DBI::SQL_BIGINT, DBI::SQL_DECIMAL, - DBI::SQL_FLOAT, DBI::SQL_REAL, DBI::SQL_DOUBLE, DBI::SQL_NUMERIC; + # Set up lookup for SQL types we don't want to escape. + my %no_escape = map { $_ => 1 } + DBI::SQL_INTEGER, DBI::SQL_SMALLINT, DBI::SQL_BIGINT, DBI::SQL_DECIMAL, + DBI::SQL_FLOAT, DBI::SQL_REAL, DBI::SQL_DOUBLE, DBI::SQL_NUMERIC; - sub get_info { + sub get_info { - my ($dbh,$type) = @_; + my ($dbh,$type) = @_; - return undef unless defined $type and length $type; + return undef unless defined $type and length $type; - my %type = ( + my %type = ( ## Driver information: @@ -1329,7 +1342,7 @@ use 5.008001; 4 => ['SQL_DRIVER_HENV', 0 ], ## not applicable 76 => ['SQL_DRIVER_HLIB', 0 ], ## not applicable 5 => ['SQL_DRIVER_HSTMT', 0 ], ## not applicable - ## Not clear what should go here. Some things suggest 'Pg', others 'Pg.pm'. We'll use DBD::Pg for now + ## Not clear what should go here. Some things suggest 'Pg', others 'Pg.pm'. We'll use DBD::Pg for now 6 => ['SQL_DRIVER_NAME', 'DBD::Pg' ], 77 => ['SQL_DRIVER_ODBC_VERSION', '03.00' ], 7 => ['SQL_DRIVER_VER', 'DBDVERSION' ], ## magic word @@ -1497,146 +1510,146 @@ use 5.008001; 125 => ['SQL_CONVERT_WLONGVARCHAR', 0 ], 126 => ['SQL_CONVERT_WVARCHAR', 0 ], - ); ## end of %type - - ## Put both numbers and names into a hash - my %t; - for (keys %type) { - $t{$_} = $type{$_}->[1]; - $t{$type{$_}->[0]} = $type{$_}->[1]; - } - - return undef unless exists $t{$type}; - - my $ans = $t{$type}; - - if ($ans eq 'NAMEDATALEN') { - return $dbh->selectall_arrayref('SHOW max_identifier_length')->[0][0]; - } - elsif ($ans eq 'ODBCVERSION') { - my $version = $dbh->{private_dbdpg}{version}; - return '00.00.0000' unless $version =~ /^(\d\d?)(\d\d)(\d\d)$/o; - return sprintf '%02d.%02d.%.2d00', $1,$2,$3; - } - elsif ($ans eq 'DBDVERSION') { - my $simpleversion = $DBD::Pg::VERSION; - $simpleversion =~ s/_/./g; - return sprintf '%02d.%02d.%1d%1d%1d%1d', split (/\./, "$simpleversion.0.0.0.0.0.0"); - } - elsif ($ans eq 'MAXCONNECTIONS') { - return $dbh->selectall_arrayref('SHOW max_connections')->[0][0]; - } - elsif ($ans eq 'ENCODING') { - return $dbh->selectall_arrayref('SHOW server_encoding')->[0][0]; - } - elsif ($ans eq 'KEYWORDS') { - ## http://www.postgresql.org/docs/current/static/sql-keywords-appendix.html - ## Basically, we want ones that are 'reserved' for PostgreSQL but not 'reserved' in SQL:2003 - ## - return join ',' => (qw(ANALYSE ANALYZE ASC DEFERRABLE DESC DO FREEZE ILIKE INITIALLY ISNULL LIMIT NOTNULL OFF OFFSET PLACING RETURNING VERBOSE)); - } - elsif ($ans eq 'CURRENTDB') { - return $dbh->selectall_arrayref('SELECT pg_catalog.current_database()')->[0][0]; - } - elsif ($ans eq 'READONLY') { - my $SQL = q{SELECT CASE WHEN setting = 'on' THEN 'Y' ELSE 'N' END FROM pg_settings WHERE name = 'transaction_read_only'}; - my $info = $dbh->selectall_arrayref($SQL); - return defined $info->[0] ? $info->[0][0] : 'N'; - } - elsif ($ans eq 'DEFAULTTXN') { - my $SQL = q{SELECT CASE WHEN setting = 'read committed' THEN 2 ELSE 8 END FROM pg_settings WHERE name = 'default_transaction_isolation'}; - my $info = $dbh->selectall_arrayref($SQL); - return defined $info->[0] ? $info->[0][0] : 2; - } - - return $ans; - } # end of get_info - - sub private_attribute_info { - return { - pg_async_status => undef, - pg_bool_tf => undef, - pg_db => undef, - pg_default_port => undef, - pg_enable_utf8 => undef, - pg_utf8_flag => undef, - pg_errorlevel => undef, - pg_expand_array => undef, - pg_host => undef, - pg_INV_READ => undef, - pg_INV_WRITE => undef, - pg_lib_version => undef, - pg_options => undef, - pg_pass => undef, - pg_pid => undef, - pg_placeholder_dollaronly => undef, - pg_placeholder_nocolons => undef, - pg_port => undef, - pg_prepare_now => undef, - pg_protocol => undef, - pg_server_prepare => undef, - pg_server_version => undef, - pg_socket => undef, - pg_standard_conforming_strings => undef, - pg_switch_prepared => undef, - pg_user => undef, - }; - } + ); ## end of %type + + ## Put both numbers and names into a hash + my %t; + for (keys %type) { + $t{$_} = $type{$_}->[1]; + $t{$type{$_}->[0]} = $type{$_}->[1]; + } + + return undef unless exists $t{$type}; + + my $ans = $t{$type}; + + if ($ans eq 'NAMEDATALEN') { + return $dbh->selectall_arrayref('SHOW max_identifier_length')->[0][0]; + } + elsif ($ans eq 'ODBCVERSION') { + my $version = $dbh->{private_dbdpg}{version}; + return '00.00.0000' unless $version =~ /^(\d\d?)(\d\d)(\d\d)$/o; + return sprintf '%02d.%02d.%.2d00', $1,$2,$3; + } + elsif ($ans eq 'DBDVERSION') { + my $simpleversion = $DBD::Pg::VERSION; + $simpleversion =~ s/_/./g; + return sprintf '%02d.%02d.%1d%1d%1d%1d', split (/\./, "$simpleversion.0.0.0.0.0.0"); + } + elsif ($ans eq 'MAXCONNECTIONS') { + return $dbh->selectall_arrayref('SHOW max_connections')->[0][0]; + } + elsif ($ans eq 'ENCODING') { + return $dbh->selectall_arrayref('SHOW server_encoding')->[0][0]; + } + elsif ($ans eq 'KEYWORDS') { + ## http://www.postgresql.org/docs/current/static/sql-keywords-appendix.html + ## Basically, we want ones that are 'reserved' for PostgreSQL but not 'reserved' in SQL:2003 + ## + return join ',' => (qw(ANALYSE ANALYZE ASC DEFERRABLE DESC DO FREEZE ILIKE INITIALLY ISNULL LIMIT NOTNULL OFF OFFSET PLACING RETURNING VERBOSE)); + } + elsif ($ans eq 'CURRENTDB') { + return $dbh->selectall_arrayref('SELECT pg_catalog.current_database()')->[0][0]; + } + elsif ($ans eq 'READONLY') { + my $SQL = q{SELECT CASE WHEN setting = 'on' THEN 'Y' ELSE 'N' END FROM pg_settings WHERE name = 'transaction_read_only'}; + my $info = $dbh->selectall_arrayref($SQL); + return defined $info->[0] ? $info->[0][0] : 'N'; + } + elsif ($ans eq 'DEFAULTTXN') { + my $SQL = q{SELECT CASE WHEN setting = 'read committed' THEN 2 ELSE 8 END FROM pg_settings WHERE name = 'default_transaction_isolation'}; + my $info = $dbh->selectall_arrayref($SQL); + return defined $info->[0] ? $info->[0][0] : 2; + } + + return $ans; + } # end of get_info + + sub private_attribute_info { + return { + pg_async_status => undef, + pg_bool_tf => undef, + pg_db => undef, + pg_default_port => undef, + pg_enable_utf8 => undef, + pg_utf8_flag => undef, + pg_errorlevel => undef, + pg_expand_array => undef, + pg_host => undef, + pg_INV_READ => undef, + pg_INV_WRITE => undef, + pg_lib_version => undef, + pg_options => undef, + pg_pass => undef, + pg_pid => undef, + pg_placeholder_dollaronly => undef, + pg_placeholder_nocolons => undef, + pg_port => undef, + pg_prepare_now => undef, + pg_protocol => undef, + pg_server_prepare => undef, + pg_server_version => undef, + pg_socket => undef, + pg_standard_conforming_strings => undef, + pg_switch_prepared => undef, + pg_user => undef, + }; + } } { - package DBD::Pg::st; + package DBD::Pg::st; - sub parse_trace_flag { - my ($h, $flag) = @_; - return DBD::Pg->parse_trace_flag($flag); - } - - sub bind_param_array { - - ## Binds an array of data to a specific placeholder in a statement - ## The DBI version is broken, so we implement a near-copy here - - my $sth = shift; - my ($p_id, $value_array, $attr) = @_; - - ## Bail if the second arg is not undef or an arrayref - return $sth->set_err(1, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array)) - if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY'; - - ## Bail if the first arg is not a number - return $sth->set_err(1, q{Can't use named placeholders for non-driver supported bind_param_array}) - unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here - - ## Store the list of items in the hash (will be undef or an arrayref) - $sth->{ParamArrays}{$p_id} = $value_array; - - ## If any attribs were passed in, we need to call bind_param - return $sth->bind_param($p_id, '', $attr) if $attr; ## This is the big change so -w does not complain - - return 1; - } ## end bind_param_array + sub parse_trace_flag { + my ($h, $flag) = @_; + return DBD::Pg->parse_trace_flag($flag); + } - sub private_attribute_info { - return { - pg_async => undef, - pg_bound => undef, - pg_current_row => undef, - pg_direct => undef, - pg_numbound => undef, - pg_cmd_status => undef, - pg_oid_status => undef, - pg_placeholder_dollaronly => undef, - pg_placeholder_nocolons => undef, - pg_prepare_name => undef, - pg_prepare_now => undef, - pg_segments => undef, - pg_server_prepare => undef, - pg_size => undef, - pg_switch_prepared => undef, - pg_type => undef, - }; + sub bind_param_array { + + ## Binds an array of data to a specific placeholder in a statement + ## The DBI version is broken, so we implement a near-copy here + + my $sth = shift; + my ($p_id, $value_array, $attr) = @_; + + ## Bail if the second arg is not undef or an arrayref + return $sth->set_err(1, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array)) + if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY'; + + ## Bail if the first arg is not a number + return $sth->set_err(1, q{Can't use named placeholders for non-driver supported bind_param_array}) + unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here + + ## Store the list of items in the hash (will be undef or an arrayref) + $sth->{ParamArrays}{$p_id} = $value_array; + + ## If any attribs were passed in, we need to call bind_param + return $sth->bind_param($p_id, '', $attr) if $attr; ## This is the big change so -w does not complain + + return 1; + } ## end bind_param_array + + sub private_attribute_info { + return { + pg_async => undef, + pg_bound => undef, + pg_current_row => undef, + pg_direct => undef, + pg_numbound => undef, + pg_cmd_status => undef, + pg_oid_status => undef, + pg_placeholder_dollaronly => undef, + pg_placeholder_nocolons => undef, + pg_prepare_name => undef, + pg_prepare_now => undef, + pg_segments => undef, + pg_server_prepare => undef, + pg_size => undef, + pg_switch_prepared => undef, + pg_type => undef, + }; } } ## end st section @@ -2772,7 +2785,7 @@ Returns all tables and views visible to the current user. The schema and table arguments will do a C<LIKE> search if a percent sign (C<%>) or an underscore (C<_>) is detected in the argument. The C<$type> argument accepts any comma-separated combination of "TABLE", "VIEW", "SYSTEM TABLE", "SYSTEM VIEW", -or "LOCAL TEMPORARY". (Using all is the default action.) +"MATERIALIZED VIEW", "SYSTEM MATERIALIZED VIEW", or "LOCAL TEMPORARY". (Using all is the default action.) Note that a statement handle is returned, and not a direct list of tables. See the examples below for ways to handle this. @@ -2786,7 +2799,8 @@ B<TABLE_SCHEM>: The name of the schema that the table or view is in. B<TABLE_NAME>: The name of the table or view. B<TABLE_TYPE>: The type of object returned. Will be one of "TABLE", "VIEW", -"MATERIALIZED VIEW", "SYSTEM VIEW", "SYSTEM MATERIALIZED VIEW", or "SYSTEM TABLE". +"MATERIALIZED VIEW", "SYSTEM VIEW", "SYSTEM MATERIALIZED VIEW", "SYSTEM TABLE", +or "LOCAL TEMPORARY". The TABLE_SCHEM and TABLE_NAME will be quoted via C<quote_ident()>. diff --git a/t/03dbmethod.t b/t/03dbmethod.t index 2eb536f..108e0c5 100644 --- a/t/03dbmethod.t +++ b/t/03dbmethod.t @@ -554,6 +554,8 @@ ok ($sth, $t); my @expected = ('LOCAL TEMPORARY', 'SYSTEM TABLE', 'SYSTEM VIEW', + 'MATERIALIZED VIEW', + 'SYSTEM MATERIALIZED VIEW', 'TABLE', 'VIEW',); -- 1.8.4