use warnings;
use Carp::Clan qw/^DBIx::Class/;
use DBI;
-use DBIx::Class::SQLAHacks;
use DBIx::Class::Storage::DBI::Cursor;
use DBIx::Class::Storage::Statistics;
use Scalar::Util();
__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 savepoints/
+ _conn_pid _conn_tid transaction_depth _dbh_autocommit _on_connect_do
+ _on_disconnect_do savepoints/
);
# the values for these accessors are picked out (and deleted) from
# the attribute hashref passed to connect_info
my @storage_options = qw/
- on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint
+ on_connect_call on_disconnect_call disable_sth_caching unsafe auto_savepoint
/;
__PACKAGE__->mk_group_accessors('simple' => @storage_options);
Note, this only runs if you explicitly call L</disconnect> on the
storage object.
+=item on_connect_call
+
+A more generalized form of L</on_connect_do> that calls the specified
+C<connect_call_METHOD> methods in your storage driver.
+
+ on_connect_do => 'select 1'
+
+is equivalent to:
+
+ on_connect_call => [ [ do_sql => 'select 1' ] ]
+
+Its values may contain:
+
+=over
+
+=item a scalar
+
+Will call the C<connect_call_METHOD> method.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >>
+
+=item an array reference
+
+Each value can be a method name or code reference.
+
+=item an array of arrays
+
+For each array, the first item is taken to be the C<connect_call_> method name
+or code reference, and the rest are parameters to it.
+
+=back
+
+Some predefined storage methods you may use:
+
+=over
+
+=item do_sql
+
+Executes a SQL string or a code reference that returns a SQL string. This is
+what L</on_connect_do> and L</on_disconnect_do> use.
+
+It can take:
+
+=over
+
+=item a scalar
+
+Will execute the scalar as SQL.
+
+=item an arrayref
+
+Taken to be arguments to L<DBI/do>, the SQL string optionally followed by the
+attributes hashref and bind values.
+
+=item a code reference
+
+Will execute C<< $code->($storage) >> and execute the return array refs as
+above.
+
+=back
+
+=item set_datetime_format
+
+Execute any statements necessary to initialize the database session to return
+and accept datetime/timestamp values used with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+=back
+
+=item on_disconnect_call
+
+Takes arguments in the same form as L</on_connect_call> and executes them
+immediately before disconnecting from the database.
+
+Calls the C<disconnect_call_METHOD> methods as opposed to the
+C<connect_call_METHOD> methods called by L</on_connect_call>.
+
+Note, this only runs if you explicitly call L</disconnect> on the
+storage object.
+
=item disable_sth_caching
If set to a true value, this option will disable the caching of
$self->_sql_maker_opts->{$sql_maker_opt} = $opt_val;
}
}
+ for my $connect_do_opt (qw/on_connect_do on_disconnect_do/) {
+ if(my $opt_val = delete $attrs{$connect_do_opt}) {
+ $self->$connect_do_opt($opt_val);
+ }
+ }
}
%attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case
This method is deprecated in favour of setting via L</connect_info>.
+=cut
+
+sub on_connect_do {
+ my $self = shift;
+ $self->_setup_connect_do(on_connect_do => @_);
+}
+
+=head2 on_disconnect_do
+
+This method is deprecated in favour of setting via L</connect_info>.
+
+=cut
+
+sub on_disconnect_do {
+ my $self = shift;
+ $self->_setup_connect_do(on_disconnect_do => @_);
+}
+
+sub _setup_connect_do {
+ my ($self, $opt) = (shift, shift);
+
+ my $accessor = "_$opt";
+
+ return $self->$accessor if not @_;
+
+ my $val = shift;
+
+ (my $call = $opt) =~ s/_do\z/_call/;
+
+ if (ref($self->$call) ne 'ARRAY') {
+ $self->$call([
+ defined $self->$call ? $self->$call : ()
+ ]);
+ }
+
+ if (not ref($val)) {
+ push @{ $self->$call }, [ 'do_sql', $val ];
+ } elsif (ref($val) eq 'CODE') {
+ push @{ $self->$call }, $val;
+ } elsif (ref($val) eq 'ARRAY') {
+ push @{ $self->$call },
+ map [ 'do_sql', $_ ], @$val;
+ } else {
+ $self->throw_exception("Invalid type for $opt ".ref($val));
+ }
+
+ $self->$accessor($val);
+}
=head2 dbh_do
my ($self) = @_;
if( $self->connected ) {
- my $connection_do = $self->on_disconnect_do;
- $self->_do_connection_actions($connection_do) if ref($connection_do);
+ my $connection_call = $self->on_disconnect_call;
+ $self->_do_connection_actions(disconnect_call_ => $connection_call)
+ if $connection_call;
$self->_dbh->rollback unless $self->_dbh_autocommit;
$self->_dbh->disconnect;
my ($self) = @_;
unless ($self->_sql_maker) {
my $sql_maker_class = $self->sql_maker_class;
+ $self->ensure_class_loaded ($sql_maker_class);
$self->_sql_maker($sql_maker_class->new( $self->_sql_maker_args ));
}
return $self->_sql_maker;
# there is no transaction in progress by definition
$self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1;
- my $connection_do = $self->on_connect_do;
- $self->_do_connection_actions($connection_do) if $connection_do;
+ my $connection_call = $self->on_connect_call;
+ $self->_do_connection_actions(connect_call_ => $connection_call)
+ if $connection_call;
}
sub _determine_driver {
}
sub _do_connection_actions {
- my $self = shift;
- my $connection_do = shift;
-
- if (!ref $connection_do) {
- $self->_do_query($connection_do);
- }
- elsif (ref $connection_do eq 'ARRAY') {
- $self->_do_query($_) foreach @$connection_do;
- }
- elsif (ref $connection_do eq 'CODE') {
- $connection_do->($self);
- }
- else {
- $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) );
+ my $self = shift;
+ my $method_prefix = shift;
+ my $call = shift;
+
+ if (not ref($call)) {
+ my $method = $method_prefix . $call;
+ $self->$method(@_);
+ } elsif (ref($call) eq 'CODE') {
+ $self->$call(@_);
+ } elsif (ref($call) eq 'ARRAY') {
+ if (ref($call->[0]) ne 'ARRAY') {
+ $self->_do_connection_actions($method_prefix, $_) for @$call;
+ } else {
+ $self->_do_connection_actions($method_prefix, @$_) for @$call;
+ }
+ } else {
+ $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) );
}
return $self;
}
+sub connect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+sub disconnect_call_do_sql {
+ my $self = shift;
+ $self->_do_query(@_);
+}
+
+# override in db-specific backend when necessary
+sub connect_call_set_datetime_format { 1 }
+
sub _do_query {
my ($self, $action) = @_;
return ($sql, \@bind);
}
+
sub _fix_bind_params {
my ($self, @bind) = @_;
if ( $self->debug ) {
@bind = $self->_fix_bind_params(@bind);
-
+
$self->debugobj->query_start( $sql, @bind );
}
}
sub insert {
my ($self, $source, $to_insert) = @_;
- my $ident = $source->from;
+ my $ident = $source->from;
my $bind_attributes = $self->source_bind_attributes($source);
my $updated_cols = {};
# Genarating a single PK column subquery is trivial and supported
# by all RDBMS. However if we have a multicolumn PK, things get ugly.
# Look at _multipk_update_delete()
-sub subq_update_delete {
+sub _subq_update_delete {
my $self = shift;
my ($rs, $op, $values) = @_;
return $self->_execute($self->_select_args(@_));
}
+sub _select_args_to_query {
+ my $self = shift;
+
+ my $sql_maker = $self->sql_maker;
+ local $sql_maker->{for};
+
+ # my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset)
+ # = $self->_select_args($ident, $select, $cond, $attrs);
+ my ($op, $bind, $ident, $bind_attrs, @args) =
+ $self->_select_args(@_);
+
+ # my ($sql, $bind) = $self->_prep_for_execute($op, $bind, $ident, [ $select, $cond, $order, $rows, $offset ]);
+ my ($sql, $prepared_bind) = $self->_prep_for_execute($op, $bind, $ident, \@args);
+
+ return \[ "($sql)", @{ $prepared_bind || [] }];
+}
+
sub _select_args {
my ($self, $ident, $select, $condition, $attrs) = @_;
- my $order = $attrs->{order_by};
my $for = delete $attrs->{for};
my $sql_maker = $self->sql_maker;
$sql_maker->{for} = $for;
- my @in_order_attrs = qw/group_by having _virtual_order_by/;
- if (List::Util::first { exists $attrs->{$_} } (@in_order_attrs) ) {
- $order = {
- ($order
- ? (order_by => $order)
- : ()
- ),
- ( map { $_ => $attrs->{$_} } (@in_order_attrs) )
- };
- }
+ my $order = { map
+ { $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () }
+ (qw/order_by group_by having _virtual_order_by/ )
+ };
- # the reason this is so contrived is because we have several tables in
- # from, each with its own set of bindattrs
- my $alias2source;
- if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
- $alias2source->{$ident->alias} = $ident;
- }
- elsif (ref $ident eq 'ARRAY') {
- for (@$ident) {
- my $tabinfo;
- if (ref $_ eq 'HASH') {
- $tabinfo = $_;
- }
- if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
- $tabinfo = $_->[0];
- }
+ my $bind_attrs = {};
- $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-result_source}
- if ($tabinfo->{-result_source});
- }
- }
+ my $alias2source = $self->_resolve_ident_sources ($ident);
- my $bind_attrs = {};
for my $alias (keys %$alias2source) {
my $bindtypes = $self->source_bind_attributes ($alias2source->{$alias}) || {};
for my $col (keys %$bindtypes) {
return @args;
}
+sub _resolve_ident_sources {
+ my ($self, $ident) = @_;
+
+ my $alias2source = {};
+
+ # the reason this is so contrived is that $ident may be a {from}
+ # structure, specifying multiple tables to join
+ if ( Scalar::Util::blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+ # this is compat mode for insert/update/delete which do not deal with aliases
+ $alias2source->{me} = $ident;
+ }
+ elsif (ref $ident eq 'ARRAY') {
+
+ for (@$ident) {
+ my $tabinfo;
+ if (ref $_ eq 'HASH') {
+ $tabinfo = $_;
+ }
+ if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
+ $tabinfo = $_->[0];
+ }
+
+ $alias2source->{$tabinfo->{-alias}} = $tabinfo->{-result_source}
+ if ($tabinfo->{-result_source});
+ }
+ }
+
+ return $alias2source;
+}
+
sub count {
my ($self, $source, $attrs) = @_;
my $tmp_attrs = { %$attrs };
- # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count
- delete $tmp_attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/);
+ # take off any pagers, record_filter is cdbi, and no point of ordering a count
+ delete $tmp_attrs->{$_} for (qw/select as rows offset page order_by record_filter/);
+ # overwrite the selector
$tmp_attrs->{select} = { count => '*' };
- $tmp_attrs->{as} = [qw/count/];
my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs);
my ($count) = $tmp_rs->cursor->next;
my $sub_attrs = { %$attrs };
# these can not go in the subquery, and there is no point of ordering it
- delete $sub_attrs->{$_} for qw/prefetch collapse select +select as +as columns +columns order_by/;
+ delete $sub_attrs->{$_} for qw/prefetch collapse select as order_by/;
# if we prefetch, we group_by primary keys only as this is what we would get out of the rs via ->next/->all
# simply deleting group_by suffices, as the code below will re-fill it
delete $sub_attrs->{group_by};
}
- $sub_attrs->{columns} = $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ];
+ $sub_attrs->{group_by} ||= [ map { "$attrs->{alias}.$_" } ($source->primary_columns) ];
+ $sub_attrs->{select} = $self->_grouped_count_select ($source, $sub_attrs);
$attrs->{from} = [{
count_subq => $source->resultset_class->new ($source, $sub_attrs )->as_query
}];
# the subquery replaces this
- delete $attrs->{$_} for qw/where bind prefetch collapse distinct group_by having having_bind rows offset page pager/;
+ delete $attrs->{$_} for qw/where bind prefetch collapse group_by having having_bind rows offset page pager/;
return $self->count ($source, $attrs);
}
+#
+# Returns a SELECT to go with a supplied GROUP BY
+# (caled by count_grouped so a group_by is present)
+# Most databases expect them to match, but some
+# choke in various ways.
+#
+sub _grouped_count_select {
+ my ($self, $source, $rs_args) = @_;
+ return $rs_args->{group_by};
+}
+
sub source_bind_attributes {
my ($self, $source) = @_;
return;
}
+=head2 is_datatype_numeric
+
+Given a datatype from column_info, returns a boolean value indicating if
+the current RDBMS considers it a numeric value. This controls how
+L<DBIx::Class::Row/set_column> decides whether to mark the column as
+dirty - when the datatype is deemed numeric a C<< != >> comparison will
+be performed instead of the usual C<eq>.
+
+=cut
+
+sub is_datatype_numeric {
+ my ($self, $dt) = @_;
+
+ return 0 unless $dt;
+
+ return $dt =~ /^ (?:
+ numeric | int(?:eger)? | (?:tiny|small|medium|big)int | dec(?:imal)? | real | float | double (?: \s+ precision)? | (?:big)?serial
+ ) $/ix;
+}
+
+
=head2 create_ddl_dir (EXPERIMENTAL)
=over 4
projects / dbsrgits/DBIx-Class.git / blobdiff