package DBIx::Class::Storage::DBI;
# -*- mode: cperl; cperl-indent-level: 2 -*-
+use strict;
+use warnings;
+
use base 'DBIx::Class::Storage';
+use mro 'c3';
-use strict;
-use warnings;
use Carp::Clan qw/^DBIx::Class/;
use DBI;
use DBIx::Class::Storage::DBI::Cursor;
use List::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/
+ qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts
+ _conn_pid _conn_tid transaction_depth _dbh_autocommit 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 on_connect_do on_disconnect_do
+ disable_sth_caching unsafe auto_savepoint
/;
__PACKAGE__->mk_group_accessors('simple' => @storage_options);
=item *
-A single code reference which returns a connected
-L<DBI database handle|DBI/connect> optionally followed by
+A single code reference which returns a connected
+L<DBI database handle|DBI/connect> optionally followed by
L<extra attributes|/DBIx::Class specific connection attributes> recognized
by DBIx::Class:
%extra_attributes,
}];
-This is particularly useful for L<Catalyst> based applications, allowing the
+This is particularly useful for L<Catalyst> based applications, allowing the
following config (L<Config::General> style):
<Model::DB>
set C<AutoCommit> to either I<0> or I<1>. L<DBIx::Class> further
recommends that it be set to I<1>, and that you perform transactions
via our L<DBIx::Class::Schema/txn_do> method. L<DBIx::Class> will set it
-to I<1> if you do not do explicitly set it to zero. This is the default
+to I<1> if you do not do explicitly set it to zero. This is the default
for most DBDs. See L</DBIx::Class and AutoCommit> for details.
=head3 DBIx::Class specific connection attributes
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 datetime_setup
+
+Execute any statements necessary to initialize the database session to return
+and accept datetime/timestamp values used with
+L<DBIx::Class::InflateColumn::DateTime>.
+
+Only necessary for some databases, see your specific storage driver for
+implementation details.
+
+=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
statement handles via L<DBI/prepare_cached>.
-=item limit_dialect
+=item limit_dialect
Sets the limit dialect. This is useful for JDBC-bridge among others
where the remote SQL-dialect cannot be determined by the name of the
=item quote_char
-Specifies what characters to use to quote table and column names. If
+Specifies what characters to use to quote table and column names. If
you use this you will want to specify L</name_sep> as well.
C<quote_char> expects either a single character, in which case is it
=item name_sep
-This only needs to be used in conjunction with C<quote_char>, and is used to
-specify the charecter that seperates elements (schemas, tables, columns) from
+This only needs to be used in conjunction with C<quote_char>, and is used to
+specify the charecter that seperates 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<SQL::Abstract>
This method is deprecated in favour of setting via L</connect_info>.
+=cut
+
+=head2 on_disconnect_do
+
+This method is deprecated in favour of setting via L</connect_info>.
+
+=cut
+
+sub _parse_connect_do {
+ my ($self, $type) = @_;
+
+ my $val = $self->$type;
+ return () if not defined $val;
+
+ my @res;
+
+ if (not ref($val)) {
+ push @res, [ 'do_sql', $val ];
+ } elsif (ref($val) eq 'CODE') {
+ push @res, $val;
+ } elsif (ref($val) eq 'ARRAY') {
+ push @res, map { [ 'do_sql', $_ ] } @$val;
+ } else {
+ $self->throw_exception("Invalid type for $type: ".ref($val));
+ }
+
+ return \@res;
+}
=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 @actions;
+
+ push @actions, ( $self->on_disconnect_call || () );
+ push @actions, $self->_parse_connect_do ('on_disconnect_do');
+
+ $self->_do_connection_actions(disconnect_call_ => $_) for @actions;
$self->_dbh->rollback unless $self->_dbh_autocommit;
$self->_dbh->disconnect;
$self->_verify_pid;
return 0 if !$self->_dbh;
}
- return ($dbh->FETCH('Active') && $dbh->ping);
+ return ($dbh->FETCH('Active') && $self->_ping);
}
return 0;
}
+sub _ping {
+ my $self = shift;
+
+ my $dbh = $self->_dbh or return 0;
+
+ return $dbh->ping;
+}
+
# handle pid changes correctly
# NOTE: assumes $self->_dbh is a valid $dbh
sub _verify_pid {
sub _sql_maker_args {
my ($self) = @_;
-
+
return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
}
# 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 @actions;
+
+ push @actions, ( $self->on_connect_call || () );
+ push @actions, $self->_parse_connect_do ('on_connect_do');
+
+ $self->_do_connection_actions(connect_call_ => $_) for @actions;
}
sub _determine_driver {
($driver) = $self->_dbi_connect_info->[0] =~ /dbi:([^:]+):/i;
}
- if ($self->load_optional_class("DBIx::Class::Storage::DBI::${driver}")) {
- bless $self, "DBIx::Class::Storage::DBI::${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();
}
}
}
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_datetime_setup { 1 }
+
sub _do_query {
my ($self, $action) = @_;
$self->throw_exception ("Your Storage implementation doesn't support savepoints")
unless $self->can('_svp_begin');
-
+
push @{ $self->{savepoints} }, $name;
$self->debugobj->svp_begin($name) if $self->debug;
-
+
return $self->_svp_begin($name);
}
}
$self->debugobj->svp_rollback($name) if $self->debug;
-
+
return $self->_svp_rollback($name);
}
my $sth = $self->sth($sql,$op);
- my $placeholder_index = 1;
+ my $placeholder_index = 1;
foreach my $bound (@$bind) {
my $attributes = {};
}
## Still not quite perfect, and EXPERIMENTAL
-## Currently it is assumed that all values passed will be "normal", i.e. not
+## Currently it is assumed that all values passed will be "normal", i.e. not
## scalar refs, or at least, all the same type as the first set, the statement is
## only prepped once.
sub insert_bulk {
my $table = $source->from;
@colvalues{@$cols} = (0..$#$cols);
my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
-
+
$self->_query_start( $sql, @bind );
my $sth = $self->sth($sql);
my $bind_attributes = $self->source_bind_attributes($source);
## Bind the values and execute
- my $placeholder_index = 1;
+ my $placeholder_index = 1;
foreach my $bound (@bind) {
my $self = shift @_;
my $source = shift @_;
my $bind_attributes = $self->source_bind_attributes($source);
-
+
return $self->_execute('update' => [], $source, $bind_attributes, @_);
}
sub delete {
my $self = shift @_;
my $source = shift @_;
-
+
my $bind_attrs = $self->source_bind_attributes($source);
-
+
return $self->_execute('delete' => [], $source, $bind_attrs, @_);
}
my $self = shift;
# localization is neccessary as
- # 1) there is no infrastructure to pass this around (easy to do, but will wait)
+ # 1) there is no infrastructure to pass this around before SQLA2
# 2) _select_args sets it and _prep_for_execute consumes it
my $sql_maker = $self->sql_maker;
- local $sql_maker->{for};
+ local $sql_maker->{_dbic_rs_attrs};
return $self->_execute($self->_select_args(@_));
}
my $self = shift;
# localization is neccessary as
- # 1) there is no infrastructure to pass this around (easy to do, but will wait)
+ # 1) there is no infrastructure to pass this around before SQLA2
# 2) _select_args sets it and _prep_for_execute consumes it
my $sql_maker = $self->sql_maker;
- local $sql_maker->{for};
+ local $sql_maker->{_dbic_rs_attrs};
# my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset)
# = $self->_select_args($ident, $select, $cond, $attrs);
sub _select_args {
my ($self, $ident, $select, $where, $attrs) = @_;
+ my ($alias2source, $rs_alias) = $self->_resolve_ident_sources ($ident);
+
my $sql_maker = $self->sql_maker;
- my $alias2source = $self->_resolve_ident_sources ($ident);
+ $sql_maker->{_dbic_rs_attrs} = {
+ %$attrs,
+ select => $select,
+ from => $ident,
+ where => $where,
+ $rs_alias
+ ? ( _source_handle => $alias2source->{$rs_alias}->handle )
+ : ()
+ ,
+ };
# calculate bind_attrs before possible $ident mangling
my $bind_attrs = {};
my $fqcn = join ('.', $alias, $col);
$bind_attrs->{$fqcn} = $bindtypes->{$col} if $bindtypes->{$col};
- # so that unqualified searches can be bound too
- $bind_attrs->{$col} = $bind_attrs->{$fqcn} if $alias eq 'me';
+ # Unqialified column names are nice, but at the same time can be
+ # rather ambiguous. What we do here is basically go along with
+ # the loop, adding an unqualified column slot to $bind_attrs,
+ # alongside the fully qualified name. As soon as we encounter
+ # another column by that name (which would imply another table)
+ # we unset the unqualified slot and never add any info to it
+ # to avoid erroneous type binding. If this happens the users
+ # only choice will be to fully qualify his column name
+
+ if (exists $bind_attrs->{$col}) {
+ $bind_attrs->{$col} = {};
+ }
+ else {
+ $bind_attrs->{$col} = $bind_attrs->{$fqcn};
+ }
}
}
- my @limit;
- if ($attrs->{software_limit} ||
- $sql_maker->_default_limit_syntax eq "GenericSubQ") {
- $attrs->{software_limit} = 1;
- } else {
+ # adjust limits
+ if (
+ $attrs->{software_limit}
+ ||
+ $sql_maker->_default_limit_syntax eq "GenericSubQ"
+ ) {
+ $attrs->{software_limit} = 1;
+ }
+ else {
$self->throw_exception("rows attribute must be positive if present")
if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
# MySQL actually recommends this approach. I cringe.
$attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
+ }
- if ($attrs->{rows} && keys %{$attrs->{collapse}}) {
- ($ident, $select, $where, $attrs)
- = $self->_adjust_select_args_for_limited_prefetch ($ident, $select, $where, $attrs);
- }
- else {
- push @limit, $attrs->{rows}, $attrs->{offset};
- }
+ my @limit;
+
+ # see if we need to tear the prefetch apart (either limited has_many or grouped prefetch)
+ # otherwise delegate the limiting to the storage, unless software limit was requested
+ if (
+ ( $attrs->{rows} && keys %{$attrs->{collapse}} )
+ ||
+ ( $attrs->{group_by} && @{$attrs->{group_by}} &&
+ $attrs->{prefetch_select} && @{$attrs->{prefetch_select}} )
+ ) {
+ ($ident, $select, $where, $attrs)
+ = $self->_adjust_select_args_for_complex_prefetch ($ident, $select, $where, $attrs);
+ }
+ elsif (! $attrs->{software_limit} ) {
+ push @limit, $attrs->{rows}, $attrs->{offset};
}
###
my $order = { map
{ $attrs->{$_} ? ( $_ => $attrs->{$_} ) : () }
- (qw/order_by group_by having _virtual_order_by/ )
+ (qw/order_by group_by having/ )
};
-
- $sql_maker->{for} = delete $attrs->{for};
-
return ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $where, $order, @limit);
}
-sub _adjust_select_args_for_limited_prefetch {
+#
+# This is the code producing joined subqueries like:
+# SELECT me.*, other.* FROM ( SELECT me.* FROM ... ) JOIN other ON ...
+#
+sub _adjust_select_args_for_complex_prefetch {
my ($self, $from, $select, $where, $attrs) = @_;
- if ($attrs->{group_by} and @{$attrs->{group_by}}) {
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a group_by attribute');
- }
-
- $self->throw_exception ('Prefetch with limit (rows/offset) is not supported on resultsets with a custom from attribute')
+ $self->throw_exception ('Complex prefetches are not supported on resultsets with a custom from attribute')
if (ref $from ne 'ARRAY');
+ # copies for mangling
+ $from = [ @$from ];
+ $select = [ @$select ];
+ $attrs = { %$attrs };
+
# separate attributes
my $sub_attrs = { %$attrs };
- delete $attrs->{$_} for qw/where bind rows offset/;
- delete $sub_attrs->{$_} for qw/for collapse select order_by/;
+ delete $attrs->{$_} for qw/where bind rows offset group_by having/;
+ delete $sub_attrs->{$_} for qw/for collapse prefetch_select _collapse_order_by select as/;
my $alias = $attrs->{alias};
+ my $sql_maker = $self->sql_maker;
+
+ # create subquery select list - consider only stuff *not* brought in by the prefetch
+ my $sub_select = [];
+ for my $i (0 .. @{$attrs->{select}} - @{$attrs->{prefetch_select}} - 1) {
+ my $sel = $attrs->{select}[$i];
+
+ # alias any functions to the dbic-side 'as' label
+ # adjust the outer select accordingly
+ if (ref $sel eq 'HASH' && !$sel->{-select}) {
+ $sel = { -select => $sel, -as => $attrs->{as}[$i] };
+ $select->[$i] = join ('.', $attrs->{alias}, ($attrs->{as}[$i] || "select_$i") );
+ }
- # create subquery select list
- my $sub_select = [ grep { $_ =~ /^$alias\./ } @{$attrs->{select}} ];
+ push @$sub_select, $sel;
+ }
# bring over all non-collapse-induced order_by into the inner query (if any)
# the outer one will have to keep them all
+ delete $sub_attrs->{order_by};
if (my $ord_cnt = @{$attrs->{order_by}} - @{$attrs->{_collapse_order_by}} ) {
$sub_attrs->{order_by} = [
- @{$attrs->{order_by}}[ 0 .. ($#{$attrs->{order_by}} - $ord_cnt - 1) ]
+ @{$attrs->{order_by}}[ 0 .. $ord_cnt - 1]
];
}
+ # mangle {from}
+ my $join_root = shift @$from;
+ my @outer_from = @$from;
+
+ my %inner_joins;
+ my %join_info = map { $_->[0]{-alias} => $_->[0] } (@$from);
- # mangle the head of the {from}
- my $self_ident = shift @$from;
+ # in complex search_related chains $alias may *not* be 'me'
+ # so always include it in the inner join, and also shift away
+ # from the outer stack, so that the two datasets actually do
+ # meet
+ if ($join_root->{-alias} ne $alias) {
+ $inner_joins{$alias} = 1;
- # this map indicates which aliases need to be joined if we want
- # to join a specific alias
- # (e.g. join => { cds => 'tracks' } - tracks will need cds too )
- my %join_map = map { $_->[0]{-alias} => $_->[0]{-join_path} } (@$from);
+ while (@outer_from && $outer_from[0][0]{-alias} ne $alias) {
+ shift @outer_from;
+ }
+ if (! @outer_from) {
+ $self->throw_exception ("Unable to find '$alias' in the {from} stack, something is wrong");
+ }
+
+ shift @outer_from; # the new subquery will represent this alias, so get rid of it
+ }
- my (%inner_joins);
# decide which parts of the join will remain on the inside
- # (we do not need the purely-prefetch ones)
+ #
+ # this is not a very viable optimisation, but it was written
+ # before I realised this, so might as well remain. We can throw
+ # away _any_ branches of the join tree that are:
+ # 1) not mentioned in the condition/order
+ # 2) left-join leaves (or left-join leaf chains)
+ # Most of the join conditions will not satisfy this, but for real
+ # complex queries some might, and we might make some RDBMS happy.
+ #
#
# since we do not have introspectable SQLA, we fall back to ugly
# scanning of raw SQL for WHERE, and for pieces of ORDER BY
# in order to determine what goes into %inner_joins
# It may not be very efficient, but it's a reasonable stop-gap
{
- # produce stuff unquoted, so it's easier to scan
- my $sql_maker = $self->sql_maker;
+ # produce stuff unquoted, so it can be scanned
local $sql_maker->{quote_char};
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ $sep = "\Q$sep\E";
my @order_by = (map
{ ref $_ ? $_->[0] : $_ }
);
my $where_sql = $sql_maker->where ($where);
+ my $select_sql = $sql_maker->_recurse_fields ($sub_select);
# sort needed joins
- for my $alias (keys %join_map) {
+ for my $alias (keys %join_info) {
# any table alias found on a column name in where or order_by
# gets included in %inner_joins
# Also any parent joins that are needed to reach this particular alias
- # (e.g. join => { cds => 'tracks' } - tracks will bring cds too )
- for my $piece ($where_sql, @order_by ) {
- if ($piece =~ /\b$alias\./) {
+ for my $piece ($select_sql, $where_sql, @order_by ) {
+ if ($piece =~ /\b $alias $sep/x) {
$inner_joins{$alias} = 1;
- $inner_joins{$_} = 1 for @{$join_map{$alias}};
}
}
}
}
- # construct the inner $from for the subquery
- my $inner_from = [ $self_ident ];
- if (keys %inner_joins) {
- for my $j (@$from) {
- push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+ # scan for non-leaf/non-left joins and mark as needed
+ # also mark all ancestor joins that are needed to reach this particular alias
+ # (e.g. join => { cds => 'tracks' } - tracks will bring cds too )
+ #
+ # traverse by the size of the -join_path i.e. reverse depth first
+ for my $alias (sort { @{$join_info{$b}{-join_path}} <=> @{$join_info{$a}{-join_path}} } (keys %join_info) ) {
+
+ my $j = $join_info{$alias};
+ $inner_joins{$alias} = 1 if (! $j->{-join_type} || ($j->{-join_type} !~ /^left$/i) );
+
+ if ($inner_joins{$alias}) {
+ $inner_joins{$_} = 1 for (@{$j->{-join_path}});
}
+ }
+
+ # construct the inner $from for the subquery
+ my $inner_from = [ $join_root ];
+ for my $j (@$from) {
+ push @$inner_from, $j if $inner_joins{$j->[0]{-alias}};
+ }
- # if a multi-type join was needed in the subquery ("multi" is indicated by
- # presence in {collapse}) - add a group_by to simulate the collapse in the subq
- for my $alias (keys %inner_joins) {
+ # if a multi-type join was needed in the subquery ("multi" is indicated by
+ # presence in {collapse}) - add a group_by to simulate the collapse in the subq
+ for my $alias (keys %inner_joins) {
- # the dot comes from some weirdness in collapse
- # remove after the rewrite
- if ($attrs->{collapse}{".$alias"}) {
- $sub_attrs->{group_by} = $sub_select;
- last;
- }
+ # the dot comes from some weirdness in collapse
+ # remove after the rewrite
+ if ($attrs->{collapse}{".$alias"}) {
+ $sub_attrs->{group_by} ||= $sub_select;
+ last;
}
}
$sub_attrs
);
- # put it back in $from
- unshift @$from, { $alias => $subq };
+ # put it in the new {from}
+ unshift @outer_from, {
+ -alias => $alias,
+ -source_handle => $join_root->{-source_handle},
+ $alias => $subq,
+ };
# This is totally horrific - the $where ends up in both the inner and outer query
- # Unfortunately not much can be done until SQLA2 introspection arrives
+ # Unfortunately not much can be done until SQLA2 introspection arrives, and even
+ # then if where conditions apply to the *right* side of the prefetch, you may have
+ # to both filter the inner select (e.g. to apply a limit) and then have to re-filter
+ # the outer select to exclude joins you didin't want in the first place
#
# OTOH it can be seen as a plus: <ash> (notes that this query would make a DBA cry ;)
- return ($from, $select, $where, $attrs);
+ return (\@outer_from, $select, $where, $attrs);
}
sub _resolve_ident_sources {
my ($self, $ident) = @_;
my $alias2source = {};
+ my $rs_alias;
# 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;
+ $rs_alias = 'me';
}
elsif (ref $ident eq 'ARRAY') {
my $tabinfo;
if (ref $_ eq 'HASH') {
$tabinfo = $_;
+ $rs_alias = $tabinfo->{-alias};
}
if (ref $_ eq 'ARRAY' and ref $_->[0] eq 'HASH') {
$tabinfo = $_->[0];
}
}
- return $alias2source;
+ return ($alias2source, $rs_alias);
}
-sub count {
- my ($self, $source, $attrs) = @_;
-
- my $tmp_attrs = { %$attrs };
-
- # take off any limits, record_filter is cdbi, and no point of ordering a count
- delete $tmp_attrs->{$_} for (qw/select as rows offset order_by record_filter/);
-
- # overwrite the selector
- $tmp_attrs->{select} = { count => '*' };
-
- my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs);
- my ($count) = $tmp_rs->cursor->next;
-
- # if the offset/rows attributes are still present, we did not use
- # a subquery, so we need to make the calculations in software
- $count -= $attrs->{offset} if $attrs->{offset};
- $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count;
- $count = 0 if ($count < 0);
-
- return $count;
-}
+# Takes $ident, \@column_names
+#
+# returns { $column_name => \%column_info, ... }
+# also note: this adds -result_source => $rsrc to the column info
+#
+# usage:
+# my $col_sources = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
+sub _resolve_column_info {
+ my ($self, $ident, $colnames) = @_;
+ my ($alias2src, $root_alias) = $self->_resolve_ident_sources($ident);
-sub count_grouped {
- my ($self, $source, $attrs) = @_;
+ my $sep = $self->_sql_maker_opts->{name_sep} || '.';
+ $sep = "\Q$sep\E";
- # copy for the subquery, we need to do some adjustments to it too
- my $sub_attrs = { %$attrs };
+ my (%return, %converted);
+ foreach my $col (@$colnames) {
+ my ($alias, $colname) = $col =~ m/^ (?: ([^$sep]+) $sep)? (.+) $/x;
- # these can not go in the subquery, and there is no point of ordering it
- delete $sub_attrs->{$_} for qw/collapse select as order_by/;
+ # deal with unqualified cols - we assume the main alias for all
+ # unqualified ones, ugly but can't think of anything better right now
+ $alias ||= $root_alias;
- # 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
- # Note: we check $attrs, as $sub_attrs has collapse deleted
- if (ref $attrs->{collapse} and keys %{$attrs->{collapse}} ) {
- delete $sub_attrs->{group_by};
+ my $rsrc = $alias2src->{$alias};
+ $return{$col} = $rsrc && { %{$rsrc->column_info($colname)}, -result_source => $rsrc };
}
+ return \%return;
+}
- $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 collapse group_by having having_bind rows offset/;
-
- return $self->count ($source, $attrs);
+# Returns a counting SELECT for a simple count
+# query. Abstracted so that a storage could override
+# this to { count => 'firstcol' } or whatever makes
+# sense as a performance optimization
+sub _count_select {
+ #my ($self, $source, $rs_attrs) = @_;
+ return { count => '*' };
}
+# Returns a SELECT which will end up in the subselect
+# There may or may not be a group_by, as the subquery
+# might have been called to accomodate a limit
#
-# 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.
+# Most databases would be happy with whatever ends up
+# here, but some choke in various ways.
#
-sub _grouped_count_select {
- my ($self, $source, $rs_args) = @_;
- return $rs_args->{group_by};
+sub _subq_count_select {
+ my ($self, $source, $rs_attrs) = @_;
+ return $rs_attrs->{group_by} if $rs_attrs->{group_by};
+
+ my @pcols = map { join '.', $rs_attrs->{alias}, $_ } ($source->primary_columns);
+ return @pcols ? \@pcols : [ 1 ];
}
+
sub source_bind_attributes {
my ($self, $source) = @_;
-
+
my $bind_attributes;
foreach my $column ($source->columns) {
-
+
my $data_type = $source->column_info($column)->{data_type} || '';
$bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
if $data_type;
{ add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 }
-merged with the hash passed in. To disable any of those features, pass in a
+merged with the hash passed in. To disable any of those features, pass in a
hashref like the following
{ ignore_constraint_names => 0, # ... other options }
-Note that this feature is currently EXPERIMENTAL and may not work correctly
+Note that this feature is currently EXPERIMENTAL and may not work correctly
across all databases, or fully handle complex relationships.
WARNING: Please check all SQL files created, before applying them.
$version ||= $schema_version;
$sqltargs = {
- add_drop_table => 1,
+ add_drop_table => 1,
ignore_constraint_names => 1,
ignore_index_names => 1,
%{$sqltargs || {}}
}
print $file $output;
close($file);
-
+
next unless ($preversion);
require SQL::Translator::Diff;
carp("Overwriting existing diff file - $difffile");
unlink($difffile);
}
-
+
my $source_schema;
{
my $t = SQL::Translator->new($sqltargs);
unless ( $source_schema->name );
}
- # The "new" style of producers have sane normalization and can support
+ # The "new" style of producers have sane normalization and can support
# diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
# And we have to diff parsed SQL against parsed SQL.
my $dest_schema = $sqlt_schema;
$dest_schema->name( $filename )
unless $dest_schema->name;
}
-
+
my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
$dest_schema, $db,
$sqltargs
);
- if(!open $file, ">$difffile") {
+ if(!open $file, ">$difffile") {
$self->throw_exception("Can't write to $difffile ($!)");
next;
}
if(-f $filename)
{
my $file;
- open($file, "<$filename")
+ open($file, "<$filename")
or $self->throw_exception("Can't open $filename ($!)");
my @rows = <$file>;
close($file);
eval qq{use SQL::Translator::Producer::${type}};
$self->throw_exception($@) if $@;
- # sources needs to be a parser arg, but for simplicty allow at top level
+ # sources needs to be a parser arg, but for simplicty allow at top level
# coming in
$sqltargs->{parser_args}{sources} = delete $sqltargs->{sources}
if exists $sqltargs->{sources};
sub is_replicating {
return;
-
+
}
=head2 lag_behind_master
projects / dbsrgits/DBIx-Class.git / blobdiff