X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=655f506f3aac024c40af6d3fed07cbfcb185576f;hb=6d766626a066b757058d023830f93cf39bb9c302;hp=e3d90e862bce9bac0746d518b49f81570148b738;hpb=0777ad33930b2c09258f9752e4e76c27ca75f347;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index e3d90e8..655f506 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -18,7 +18,8 @@ use Sub::Name (); __PACKAGE__->mk_group_accessors('simple' => qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts _conn_pid - _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints/ + _conn_tid transaction_depth _dbh_autocommit _driver_determined savepoints + _server_info_hash/ ); # the values for these accessors are picked out (and deleted) from @@ -33,13 +34,17 @@ __PACKAGE__->mk_group_accessors('simple' => @storage_options); # default cursor class, overridable in connect_info attributes __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor'); -__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class/); +__PACKAGE__->mk_group_accessors('inherited' => qw/ + sql_maker_class + _supports_insert_returning +/); __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks'); # Each of these methods need _determine_driver called before itself # in order to function reliably. This is a purely DRY optimization my @rdbms_specific_methods = qw/ + deployment_statements sqlt_type build_datetime_parser datetime_parser_type @@ -88,7 +93,7 @@ DBIx::Class::Storage::DBI - DBI storage handler ); $schema->resultset('Book')->search({ - written_on => $schema->storage->datetime_parser(DateTime->now) + written_on => $schema->storage->datetime_parser->format_datetime(DateTime->now) }); =head1 DESCRIPTION @@ -190,7 +195,7 @@ for most DBDs. See L for details. In addition to the standard L L attributes, DBIx::Class recognizes the following connection options. These options can be mixed in with your other -L connection attributes, or placed in a seperate hashref +L connection attributes, or placed in a separate hashref (C<\%extra_attributes>) as shown above. Every time C is invoked, any previous settings for @@ -342,7 +347,7 @@ SQL Server you should use C<< quote_char => [qw/[ ]/] >>. =item name_sep This only needs to be used in conjunction with C, and is used to -specify the charecter that seperates elements (schemas, tables, columns) from +specify the character that separates elements (schemas, tables, columns) from each other. In most cases this is simply a C<.>. The consequences of not supplying this value is that L @@ -741,6 +746,7 @@ sub disconnect { $self->_dbh_rollback unless $self->_dbh_autocommit; + %{ $self->_dbh->{CachedKids} } = (); $self->_dbh->disconnect; $self->_dbh(undef); $self->{_dbh_gen}++; @@ -778,8 +784,8 @@ sub with_deferred_fk_checks { =back -Verifies that the the current database handle is active and ready to execute -an SQL statement (i.e. the connection did not get stale, server is still +Verifies that the current database handle is active and ready to execute +an SQL statement (e.g. the connection did not get stale, server is still answering, etc.) This method is used internally by L. =cut @@ -848,7 +854,7 @@ sub ensure_connected { Returns a C<$dbh> - a data base handle of class L. The returned handle is guaranteed to be healthy by implicitly calling L, and if necessary performing a reconnection before returning. Keep in mind that this -is very B on some database engines. Consider using L +is very B on some database engines. Consider using L instead. =cut @@ -902,6 +908,7 @@ sub _populate_dbh { my @info = @{$self->_dbi_connect_info || []}; $self->_dbh(undef); # in case ->connected failed we might get sent here + $self->_server_info_hash (undef); $self->_dbh($self->_connect(@info)); $self->_conn_pid($$); @@ -926,6 +933,41 @@ sub _run_connection_actions { $self->_do_connection_actions(connect_call_ => $_) for @actions; } +sub _server_info { + my $self = shift; + + unless ($self->_server_info_hash) { + + my %info; + + my $server_version = $self->_get_server_version; + + if (defined $server_version) { + $info{dbms_version} = $server_version; + + my ($numeric_version) = $server_version =~ /^([\d\.]+)/; + my @verparts = split (/\./, $numeric_version); + if ( + @verparts + && + @verparts <= 3 + && + ! grep { $_ > 999 } (@verparts) + ) { + $info{normalized_dbms_version} = sprintf "%d.%03d%03d", @verparts; + } + } + + $self->_server_info_hash(\%info); + } + + return $self->_server_info_hash +} + +sub _get_server_version { + eval { shift->_get_dbh->get_info(18) }; +} + sub _determine_driver { my ($self) = @_; @@ -948,15 +990,19 @@ sub _determine_driver { else { # try to use dsn to not require being connected, the driver may still # force a connection in _rebless to determine version - ($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i; + # (dsn may not be supplied at all if all we do is make a mock-schema) + my $dsn = $self->_dbi_connect_info->[0] || ''; + ($driver) = $dsn =~ /dbi:([^:]+):/i; } } - my $storage_class = "DBIx::Class::Storage::DBI::${driver}"; - if ($self->load_optional_class($storage_class)) { - mro::set_mro($storage_class, 'c3'); - bless $self, $storage_class; - $self->_rebless(); + if ($driver) { + my $storage_class = "DBIx::Class::Storage::DBI::${driver}"; + if ($self->load_optional_class($storage_class)) { + mro::set_mro($storage_class, 'c3'); + bless $self, $storage_class; + $self->_rebless(); + } } } @@ -1357,29 +1403,56 @@ sub _execute { $self->dbh_do('_dbh_execute', @_); # retry over disconnects } -sub insert { +sub _prefetch_insert_auto_nextvals { my ($self, $source, $to_insert) = @_; - my $ident = $source->from; - my $bind_attributes = $self->source_bind_attributes($source); - - my $updated_cols = {}; + my $upd = {}; foreach my $col ( $source->columns ) { if ( !defined $to_insert->{$col} ) { my $col_info = $source->column_info($col); if ( $col_info->{auto_nextval} ) { - $updated_cols->{$col} = $to_insert->{$col} = $self->_sequence_fetch( + $upd->{$col} = $to_insert->{$col} = $self->_sequence_fetch( 'nextval', - $col_info->{sequence} || - $self->_dbh_get_autoinc_seq($self->_get_dbh, $source) + $col_info->{sequence} ||= + $self->_dbh_get_autoinc_seq($self->_get_dbh, $source, $col) ); } } } - $self->_execute('insert' => [], $source, $bind_attributes, $to_insert); + return $upd; +} + +sub insert { + my $self = shift; + my ($source, $to_insert, $opts) = @_; + + my $updated_cols = $self->_prefetch_insert_auto_nextvals (@_); + + my $bind_attributes = $self->source_bind_attributes($source); + + my ($rv, $sth) = $self->_execute('insert' => [], $source, $bind_attributes, $to_insert, $opts); + + if ($opts->{returning}) { + my @ret_cols = @{$opts->{returning}}; + + my @ret_vals = eval { + local $SIG{__WARN__} = sub {}; + my @r = $sth->fetchrow_array; + $sth->finish; + @r; + }; + + my %ret; + @ret{@ret_cols} = @ret_vals if (@ret_vals); + + $updated_cols = { + %$updated_cols, + %ret, + }; + } return $updated_cols; } @@ -1466,7 +1539,7 @@ sub insert_bulk { # neither _execute_array, nor _execute_inserts_with_no_binds are # atomic (even if _execute _array is a single call). Thus a safety # scope guard - my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0; + my $guard = $self->txn_scope_guard; $self->_query_start( $sql, ['__BULK__'] ); my $sth = $self->sth($sql); @@ -1483,8 +1556,7 @@ sub insert_bulk { $self->_query_end( $sql, ['__BULK__'] ); - - $guard->commit if $guard; + $guard->commit; return (wantarray ? ($rv, $sth, @bind) : $rv); } @@ -1513,7 +1585,11 @@ sub _execute_array { my @data = map { $_->[$data_index] } @$data; - $sth->bind_param_array( $placeholder_index, [@data], $attributes ); + $sth->bind_param_array( + $placeholder_index, + [@data], + (%$attributes ? $attributes : ()), + ); $placeholder_index++; } @@ -1888,7 +1964,33 @@ sub _count_select { # sub _subq_count_select { my ($self, $source, $rs_attrs) = @_; - return $rs_attrs->{group_by} if $rs_attrs->{group_by}; + + if (my $groupby = $rs_attrs->{group_by}) { + + my $avail_columns = $self->_resolve_column_info ($rs_attrs->{from}); + + my $sel_index; + for my $sel (@{$rs_attrs->{select}}) { + if (ref $sel eq 'HASH' and $sel->{-as}) { + $sel_index->{$sel->{-as}} = $sel; + } + } + + my @selection; + for my $g_part (@$groupby) { + if (ref $g_part or $avail_columns->{$g_part}) { + push @selection, $g_part; + } + elsif ($sel_index->{$g_part}) { + push @selection, $sel_index->{$g_part}; + } + else { + $self->throw_exception ("group_by criteria '$g_part' not contained within current resultset source(s)"); + } + } + + return \@selection; + } my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns); return @pcols ? \@pcols : [ 1 ]; @@ -2221,10 +2323,13 @@ them. sub create_ddl_dir { my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_; - if(!$dir || !-d $dir) { + unless ($dir) { carp "No directory given, using ./\n"; - $dir = "./"; + $dir = './'; } + + $self->throw_exception ("Directory '$dir' does not exist\n") unless(-d $dir); + $databases ||= ['MySQL', 'SQLite', 'PostgreSQL']; $databases = [ $databases ] if(ref($databases) ne 'ARRAY'); @@ -2434,7 +2539,7 @@ sub deploy { } $self->_query_end($line); }; - my @statements = $self->deployment_statements($schema, $type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } ); + my @statements = $schema->deployment_statements($type, undef, $dir, { %{ $sqltargs || {} }, no_comments => 1 } ); if (@statements > 1) { foreach my $statement (@statements) { $deploy->( $statement ); @@ -2522,8 +2627,8 @@ queries. This hook is to allow specific L drivers to change the way these aliases are named. -The default behavior is C<"$relname_$join_count" if $join_count > 1>, otherwise -C<"$relname">. +The default behavior is C<< "$relname_$join_count" if $join_count > 1 >>, +otherwise C<"$relname">. =cut