Author: timbo
Date: Tue Dec 21 15:08:28 2010
New Revision: 14600
Added:
dbi/trunk/t/48dbi_dbd_sqlengine.t
- copied unchanged from r14599,
/dbi/branches/sqlengine/t/48dbi_dbd_sqlengine.t
Modified:
dbi/trunk/ (props changed)
dbi/trunk/.gitignore
dbi/trunk/Changes
dbi/trunk/dbixs_rev.h
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/File.pm
dbi/trunk/lib/DBI/DBD.pm
dbi/trunk/lib/DBI/DBD/SqlEngine.pm
dbi/trunk/lib/DBI/SQL/Nano.pm
dbi/trunk/t/51dbm_file.t
dbi/trunk/t/52dbm_complex.t
Log:
svn merge --reintegrate https://svn.perl.org/modules/dbi/branches/sqlengine
Plus resolution of the natural merge conflicts in Changes.
Modified: dbi/trunk/.gitignore
==============================================================================
--- dbi/trunk/.gitignore (original)
+++ dbi/trunk/.gitignore Tue Dec 21 15:08:28 2010
@@ -26,3 +26,4 @@
xx*
ModList
git-svn-modlist
+git-dpull
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Tue Dec 21 15:08:28 2010
@@ -8,19 +8,27 @@
=head2 Changes in DBI 1.617 (svn rXXX) XXX
- Fixed typo in InactiveDestroy thanks to Emmanuel Rodriguez.
- Fixed compiler warnings RT#62640
- Added additional notes on DBDs which avoid creating a statement in
- the do method and the effects on error handlers (Martin J. Evans)
-
-=head2 Changes in DBI 1.616 (svn r14486) 15th October 2010
-
- Documented dbd_st_execute return (Martin J. Evans)
Fixed spurious dbi_profile lines written to the log when
profiling is enabled and a trace flag, like SQL, is used.
Fixed to recognize SQL::Statement errors even if instantiated
with RaiseError=0 (Jens Rehsack)
+ Fixed RT#61513 by catching attribute assignment to tied table access
+ interface (Jens Rehsack)
+ Fixing some misbehavior of DBD::File when running within the Gofer
+ server.
+ Fixed compiler warnings RT#62640
+
Optimized connect() to remove redundant FETCH of \%attrib values.
+ Improved initialization phases in DBI::DBD::SqlEngine (Jens Rehsack)
+
+ Added additional notes on DBDs which avoid creating a statement in
+ the do() method and the effects on error handlers (Martin J. Evans)
+ Adding new attribute "sql_dialect" to DBI::DBD::SqlEngine to allow
+ users control used SQL dialect (ANSI, CSV or AnyData), defaults to
+ CSV (Jens Rehsack)
+ Add documentation for DBI::DBD::SqlEngine attributes (Jens Rehsack)
+ Documented dbd_st_execute return (Martin J. Evans)
+ Fixed typo in InactiveDestroy thanks to Emmanuel Rodriguez.
=head2 Changes in DBI 1.615 (svn r14438) 21st September 2010
Modified: dbi/trunk/dbixs_rev.h
==============================================================================
--- dbi/trunk/dbixs_rev.h (original)
+++ dbi/trunk/dbixs_rev.h Tue Dec 21 15:08:28 2010
@@ -1,2 +1,4 @@
-/* Mon Aug 30 20:49:00 2010 */
-#define DBIXS_REVISION 14354
+/* Tue Dec 14 22:26:28 2010 */
+/* Mixed revision working copy (14564M:14571) */
+/* Code modified since last checkin */
+#define DBIXS_REVISION 14564
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Tue Dec 21 15:08:28 2010
@@ -254,6 +254,8 @@
@DBD::DBM::Table::ISA = qw(DBD::File::Table);
+my $dirfext = $^O eq 'VMS' ? '.sdbm_dir' : '.dir';
+
sub file2table
{
my ( $self, $meta, $file, $file_is_table, $quoted ) = @_;
@@ -272,7 +274,7 @@
__PACKAGE__->register_reset_on_modify( \%reset_on_modify );
my %compat_map = (
- map { $_ => "dbm_$_" } qw(type mldbm store_metadata),
+ ( map { $_ => "dbm_$_" } qw(type mldbm store_metadata) ),
dbm_ext => 'f_ext',
dbm_file => 'f_file',
dbm_lockfile => ' f_lockfile',
@@ -444,9 +446,9 @@
$meta->{hash} and untie %{ $meta->{hash} };
$self->SUPER::drop($data);
# XXX extra_files
- -f $meta->{f_fqbn} . '.dir'
+ -f $meta->{f_fqbn} . $dirfext
and $meta->{f_ext} eq '.pag/r'
- and unlink( $meta->{f_fqbn} . '.dir' );
+ and unlink( $meta->{f_fqbn} . $dirfext );
return 1;
}
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Tue Dec 21 15:08:28 2010
@@ -218,9 +218,16 @@
# DBI::BD::SqlEngine::dr::connect will detect old-style drivers and
# don't call twice
- defined $phase or $phase = 0;
+ unless (defined $phase) {
+ # we have an "old" driver here
+ $phase = defined $dbh->{sql_init_phase};
+ $phase and $phase = $dbh->{sql_init_phase};
+ }
if (0 == $phase) {
+ # check whether we're running in a Gofer server or not (see
+ # validate_FETCH_attr for details)
+ $dbh->{f_in_gofer} = (defined $INC{"DBD/Gofer.pm"} && (caller(5))[0] eq
"DBI::Gofer::Execute");
# f_ext should not be initialized
# f_map is deprecated (but might return)
$dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ());
@@ -234,7 +241,7 @@
my $ro_attrs = $drv_prefix . "readonly_attrs";
my @comp_attrs = ();
- if (exists $dbh->{$drv_prefix . "meta"}) {
+ if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{f_in_gofer}) {
my $attr = $dbh->{$drv_prefix . "meta"};
defined $attr and defined $dbh->{$valid_attrs} and
!defined $dbh->{$valid_attrs}{$attr} and
@@ -265,6 +272,27 @@
return $_[0]->SUPER::disconnect ();
} # disconnect
+sub validate_FETCH_attr
+{
+ my ($dbh, $attrib) = @_;
+
+ # If running in a Gofer server, access to our tied compatibility hash
+ # would force Gofer to serialize the tieing object including it's
+ # private $dbh reference used to do the driver function calls.
+ # This will result in nasty exceptions. So return a copy of the
+ # f_meta structure instead, which is the source of for the compatibility
+ # tie-hash. It's not as good as liked, but the best we can do in this
+ # situation.
+ if ($dbh->{f_in_gofer}) {
+ (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
+ my $drv_prefix = DBI->driver_prefix ($drv_class);
+ exists $dbh->{$drv_prefix . "meta"} && $attrib eq $dbh->{$drv_prefix .
"meta"} and
+ $attrib = "f_meta";
+ }
+
+ return $attrib;
+ } # validate_FETCH_attr
+
sub validate_STORE_attr
{
my ($dbh, $attrib, $value) = @_;
@@ -281,6 +309,18 @@
carp "'$value' doesn't look like a valid file extension
attribute\n";
}
+ (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
+ my $drv_prefix = DBI->driver_prefix ($drv_class);
+
+ if (exists $dbh->{$drv_prefix . "meta"}) {
+ my $attr = $dbh->{$drv_prefix . "meta"};
+ if ($attrib eq $attr) {
+ while (my ($k, $v) = each %$value) {
+ $dbh->{$attrib}{$k} = $v;
+ }
+ }
+ }
+
return $dbh->SUPER::validate_STORE_attr ($attrib, $value);
} # validate_STORE_attr
@@ -1145,9 +1185,9 @@
=head4 NULLABLE
-Not really working, always returns an array ref of ones, as DBD::CSV
-does not verify input data. Valid after C<< $sth->execute >>; undef for
-non-select statements.
+Not really working, always returns an array ref of ones, except the
+affected table has been created in this session. Valid after
+C<< $sth->execute >>; undef for non-select statements.
=head3 The following DBI attributes and methods are not supported:
Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm (original)
+++ dbi/trunk/lib/DBI/DBD.pm Tue Dec 21 15:08:28 2010
@@ -3337,7 +3337,7 @@
q|END { delete $ENV{DBI_AUTOPROXY}; }| ],
},
n => { name => "DBI::SQL::Nano",
- match => qr/^(?:49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
+ match =>
qr/^(?:48dbi_dbd_sqlengine|49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
add => [ q{$ENV{DBI_SQL_NANO} = 1},
q|END { delete $ENV{DBI_SQL_NANO}; }| ],
},
Modified: dbi/trunk/lib/DBI/DBD/SqlEngine.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD/SqlEngine.pm (original)
+++ dbi/trunk/lib/DBI/DBD/SqlEngine.pm Tue Dec 21 15:08:28 2010
@@ -133,7 +133,8 @@
{
# must be done first, because setting flags implicitly calls
$dbdname::db->STORE
$dbh->func( 0, "init_default_attributes" );
- my $two_phased_init = defined $dbh->{sql_init_phase};
+ my $two_phased_init;
+ defined $dbh->{sql_init_phase} and $two_phased_init =
++$dbh->{sql_init_phase};
my %second_phase_attrs;
my ( $var, $val );
@@ -191,10 +192,8 @@
$dbh->func( 1, "init_default_attributes" );
%$attr = %second_phase_attrs;
}
- else
- {
- $dbh->func("init_done");
- }
+
+ $dbh->func("init_done");
$dbh->STORE( Active => 1 );
}
@@ -317,12 +316,14 @@
sql_nano_version => 1, # Nano
version
sql_statement_version => 1, # S:S
version
sql_flags => 1, # flags for
SQL::Parser
+ sql_dialect => 1, # dialect
for SQL::Parser
sql_quoted_identifier_case => 1, # case for
quoted identifiers
sql_identifier_case => 1, # case for
non-quoted identifiers
sql_parser_object => 1, #
SQL::Parser instance
sql_sponge_driver => 1, # Sponge
driver for table_info ()
sql_valid_attrs => 1, # SQL valid
attributes
sql_readonly_attrs => 1, # SQL
readonly attributes
+ sql_init_phase => 1, # Only
during initialization
};
$dbh->{sql_readonly_attrs} = {
sql_engine_version => 1, #
DBI::DBD::SqlEngine version
@@ -348,6 +349,7 @@
{
# we have an "old" driver here
$phase = defined $dbh->{sql_init_phase};
+ $phase and $phase = $dbh->{sql_init_phase};
}
if ( 0 == $phase )
@@ -360,6 +362,8 @@
$dbh->{sql_identifier_case} = 2; # SQL_IC_LOWER
$dbh->{sql_quoted_identifier_case} = 3; # SQL_IC_SENSITIVE
+ $dbh->{sql_dialect} = "CSV";
+
$dbh->{sql_init_phase} = $given_phase;
# complete derived attributes, if required
@@ -381,34 +385,31 @@
and $dbh->{$ro_attrs}{$attr} = 1;
}
}
- else
- {
- delete $dbh->{sql_init_phase};
- }
return $dbh;
} # init_default_attributes
sub init_done
{
- delete $_[0]->{sql_init_phase};
+ defined $_[0]->{sql_init_phase} and delete $_[0]->{sql_init_phase};
+ delete $_[0]->{sql_valid_attrs}->{sql_init_phase};
return;
}
sub sql_parser_object
{
my $dbh = $_[0];
+ my $dialect = $dbh->{sql_dialect} || "CSV";
my $parser = {
- dialect => "CSV",
RaiseError => $dbh->FETCH("RaiseError"),
PrintError => $dbh->FETCH("PrintError"),
};
my $sql_flags = $dbh->FETCH("sql_flags") || {};
%$parser = ( %$parser, %$sql_flags );
- $parser = SQL::Parser->new( $parser->{dialect}, $parser );
+ $parser = SQL::Parser->new( $dialect, $parser );
$dbh->{sql_parser_object} = $parser;
return $parser;
-} # cache_sql_parser_object
+} # sql_parser_object
sub sql_sponge_driver
{
@@ -444,9 +445,12 @@
$attrib eq "AutoCommit"
and return 1;
+ # Driver private attributes are lower cased
if ( $attrib eq ( lc $attrib ) )
{
- # Driver private attributes are lower cased
+ # first let the implementation deliver an alias for the attribute to
fetch
+ # after it validates the legitimation of the fetch request
+ $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
my $attr_prefix;
$attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
@@ -459,8 +463,6 @@
my $valid_attrs = $attr_prefix . "valid_attrs";
my $ro_attrs = $attr_prefix . "readonly_attrs";
- $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
-
exists $dbh->{$valid_attrs}
and ( $dbh->{$valid_attrs}{$attrib}
or return $dbh->set_err( $DBI::stderr, "Invalid attribute
'$attrib'" ) );
@@ -1005,6 +1007,148 @@
likely change in the near future to provide the table meta data basics
like DBD::File.
+=head2 Metadata
+
+The following attributes are handled by DBI itself and not by
+DBI::DBD::SqlEngine, thus they all work as expected:
+
+ Active
+ ActiveKids
+ CachedKids
+ CompatMode (Not used)
+ InactiveDestroy
+ AutoInactiveDestroy
+ Kids
+ PrintError
+ RaiseError
+ Warn (Not used)
+
+=head3 The following DBI attributes are handled by DBI::DBD::SqlEngine:
+
+=head4 AutoCommit
+
+Always on.
+
+=head4 ChopBlanks
+
+Works.
+
+=head4 NUM_OF_FIELDS
+
+Valid after C<< $sth->execute >>.
+
+=head4 NUM_OF_PARAMS
+
+Valid after C<< $sth->prepare >>.
+
+=head4 NAME
+
+Valid after C<< $sth->execute >>; probably undef for Non-Select statements.
+
+=head4 NULLABLE
+
+Not really working, always returns an array ref of ones, as DBD::CSV
+does not verify input data. Valid after C<< $sth->execute >>; undef for
+non-select statements.
+
+=head3 The following DBI attributes and methods are not supported:
+
+=over 4
+
+=item bind_param_inout
+
+=item CursorName
+
+=item LongReadLen
+
+=item LongTruncOk
+
+=back
+
+=head3 DBI::DBD::SqlEngine specific attributes
+
+In addition to the DBI attributes, you can use the following dbh
+attributes:
+
+=head4 sql_engine_version
+
+Contains the module version of this driver (B<readonly>)
+
+=head4 sql_nano_version
+
+Contains the module version of DBI::SQL::Nano (B<readonly>)
+
+=head4 sql_statement_version
+
+Contains the module version of SQL::Statement, if available (B<readonly>)
+
+=head4 sql_handler
+
+Contains the SQL Statement engine, either DBI::SQL::Nano or SQL::Statement
+(B<readonly>).
+
+=head4 sql_parser_object
+
+Contains an instantiated instance of SQL::Parser (B<readonly>).
+This is filled when used first time (only when used with SQL::Statement).
+
+=head4 sql_sponge_driver
+
+Contains an internally used DBD::Sponge handle (B<readonly>).
+
+=head4 sql_valid_attrs
+
+Contains the list of valid attributes for each DBI::DBD::SqlEngine based
+driver (B<readonly>).
+
+=head4 sql_readonly_attrs
+
+Contains the list of those attributes which are readonly (B<readonly>).
+
+=head4 sql_identifier_case
+
+Contains how DBI::DBD::SqlEngine deals with non-quoted SQL identifiers:
+
+ * SQL_IC_UPPER (1) means all identifiers are internally converted
+ into upper-cased pendants
+ * SQL_IC_LOWER (2) means all identifiers are internally converted
+ into lower-cased pendants
+ * SQL_IC_MIXED (4) means all identifiers are taken as they are
+
+These conversions happen if (and only if) no existing identifier matches.
+Once existing identifier is used as known.
+
+The SQL statement execution classes doesn't have to care, so don't expect
+C<sql_identifier_case> affects column names in statements like
+
+ SELECT * FROM foo
+
+=head4 sql_quoted_identifier_case
+
+Contains how DBI::DBD::SqlEngine deals with quoted SQL identifiers
+(B<readonly>). It's fixated to SQL_IC_SENSITIVE (3), which is interpreted
+as SQL_IC_MIXED.
+
+=head4 sql_flags
+
+Contains additional flags to instantiate an SQL::Parser. Because an
+SQL::Parser is instantiated only once, it's recommended to set this flag
+before any statement is executed.
+
+=head4 sql_dialect
+
+Controls the dialect understood by SQL::Parser. Possible values (delivery
+state of SQL::Statement):
+
+ * ANSI
+ * CSV
+ * AnyData
+
+Defaults to "CSV". Because an SQL::Parser is instantiated only once and
+SQL::Parser doesn't allow to modify the dialect once instantiated,
+it's strongly recommended to set this flag before any statement is
+executed (best place is connect attribute hash).
+
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
Modified: dbi/trunk/lib/DBI/SQL/Nano.pm
==============================================================================
--- dbi/trunk/lib/DBI/SQL/Nano.pm (original)
+++ dbi/trunk/lib/DBI/SQL/Nano.pm Tue Dec 21 15:08:28 2010
@@ -110,7 +110,7 @@
$self->{where_clause} = $self->parse_where_clause($clauses) if
($clauses);
}
};
- /^\s*INSERT\s+INTO\s+(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
+ /^\s*INSERT\s+(?:INTO\s+)?(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
&& do
{
$self->{command} = 'INSERT';
Modified: dbi/trunk/t/51dbm_file.t
==============================================================================
--- dbi/trunk/t/51dbm_file.t (original)
+++ dbi/trunk/t/51dbm_file.t Tue Dec 21 15:08:28 2010
@@ -52,6 +52,14 @@
$dbh->do(q/create table FRED (a integer, b integer)/);
ok( -f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext exists" );
+my $tblfext;
+unless( $using_dbd_gofer )
+{
+ $tblfext = $dbh->{dbm_tables}->{fred}->{f_ext} || '';
+ $tblfext =~ s{/r$}{};
+ ok( -f File::Spec->catfile( $dir, "fred$tblfext" ), "fred$tblfext exists"
);
+}
+
ok( $dbh->do(q/insert into fRED (a,b) values(1,2)/), 'insert into mixed case
table' );
# but change fRED to FRED and it works.
@@ -94,6 +102,29 @@
ok( @$r == 2, 'rows found via select via fully qualified path' );
}
-ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );
+if( $using_dbd_gofer )
+{
+ ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );
+ ok( !-f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext
removed" );
+}
+else
+{
+ my $tbl_info = { file => "fred$tblfext" };
+
+ ok( $dbh->disconnect(), "disconnect" );
+ $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
+ f_dir => $dir,
+ sql_identifier_case => 2, # SQL_IC_LOWER
+ dbm_tables => { fred => $tbl_info },
+ }
+ );
+
+ $r = $dbh->selectall_arrayref(q/select * from Fred/);
+ ok( @$r == 2, 'rows found after reconnect using "dbm_tables"' );
+
+ ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );
+ ok( !-f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext
removed" );
+ ok( !-f File::Spec->catfile( $dir, "fred$tblfext" ), "fred$tblfext
removed" );
+}
done_testing();
Modified: dbi/trunk/t/52dbm_complex.t
==============================================================================
--- dbi/trunk/t/52dbm_complex.t (original)
+++ dbi/trunk/t/52dbm_complex.t Tue Dec 21 15:08:28 2010
@@ -92,7 +92,6 @@
plan skip_all => "Not running with SQL::Statement" unless ( $haveSS );
plan skip_all => "Not running with MLDBM" unless ( @mldbm_types );
-plan skip_all => "Needs more love to run with Gofer, too" if( $using_dbd_gofer
);
do "t/lib.pl";
@@ -103,22 +102,30 @@
my $suffix;
my $tbl_meta;
+sub break_at_warn
+{
+ note "break here";
+}
+$SIG{__WARN__} = \&break_at_warn;
+$SIG{__DIE__} = \&break_at_warn;
+
sub load_tables
{
my ( $dbmtype, $dbmmldbm ) = @_;
+ my $last_suffix;
if ($using_dbd_gofer)
{
$dbh->disconnect();
- $dbh = DBI->connect( "dbi:DBM:", undef, undef, { f_dir => $dir, f_meta
=> $tbl_meta, dbm_type => $dbmtype, dbm_mldbm => $dbmmldbm } );
+ $dbh = DBI->connect( "dbi:DBM:", undef, undef, { f_dir => $dir,
dbm_type => $dbmtype, dbm_mldbm => $dbmmldbm } );
}
else
{
+ $last_suffix = $suffix;
$dbh->{dbm_type} = $dbmtype;
$dbh->{dbm_mldbm} = $dbmmldbm;
}
- my $last_suffix = $suffix;
(my $serializer = $dbmmldbm ) =~ s/::/_/g;
$suffix = join( "_", $$, $dbmtype, $serializer );
@@ -131,7 +138,7 @@
my ($readsth);
ok( $readsth = $dbh->prepare($readsql), "prepare: $readsql" );
ok( $readsth->execute(), "execute: $readsql" );
- ok( $dbh->do( $impsql, {}, $readsth ), $impsql );
+ ok( $dbh->do( $impsql, {}, $readsth ), $impsql ) or warn
$dbh->errstr();
}
}
else
