'0+' => \&count,
'bool' => sub { 1; },
fallback => 1;
+use Carp::Clan qw/^DBIx::Class/;
use Data::Page;
use Storable;
+use Data::Dumper;
use Scalar::Util qw/weaken/;
use DBIx::Class::ResultSetColumn;
sub search {
my $self = shift;
-
- my $attrs = { %{$self->{attrs}} };
- my $having = delete $attrs->{having};
- $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH';
+ my $rs = $self->search_rs( @_ );
+ return (wantarray ? $rs->all : $rs);
+}
+
+=head2 search_rs
+
+=over 4
+
+=item Arguments: $cond, \%attrs?
+
+=item Return Value: $resultset
+
+=back
+
+This method does the same exact thing as search() except it will
+always return a resultset, even in list context.
+
+=cut
+sub search_rs {
+ my $self = shift;
+
+ my $our_attrs = { %{$self->{attrs}} };
+ my $having = delete $our_attrs->{having};
+ my $attrs = {};
+ $attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
+
+ # merge new attrs into old
+ foreach my $key (qw/join prefetch/) {
+ next unless (exists $attrs->{$key});
+ if (exists $our_attrs->{$key}) {
+ $our_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
+ } else {
+ $our_attrs->{$key} = $attrs->{$key};
+ }
+ delete $attrs->{$key};
+ }
+
+ if (exists $our_attrs->{prefetch}) {
+ $our_attrs->{join} = $self->_merge_attr($our_attrs->{join}, $our_attrs->{prefetch}, 1);
+ }
+
+ my $new_attrs = { %{$our_attrs}, %{$attrs} };
+
+ # merge new where and having into old
my $where = (@_
? ((@_ == 1 || ref $_[0] eq "HASH")
? shift
: {@_}))
: undef());
if (defined $where) {
- $attrs->{where} = (defined $attrs->{where}
+ $new_attrs->{where} = (defined $new_attrs->{where}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $where, $attrs->{where} ] }
+ $where, $new_attrs->{where} ] }
: $where);
}
if (defined $having) {
- $attrs->{having} = (defined $attrs->{having}
+ $new_attrs->{having} = (defined $new_attrs->{having}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
- $having, $attrs->{having} ] }
+ $having, $new_attrs->{having} ] }
: $having);
}
- my $rs = (ref $self)->new($self->result_source, $attrs);
+ my $rs = (ref $self)->new($self->result_source, $new_attrs);
$rs->{_parent_rs} = $self->{_parent_rs} if ($self->{_parent_rs}); #XXX - hack to pass through parent of related resultsets
unless (@_) { # no search, effectively just a clone
my $rows = $self->get_cache;
- if( @{$rows} ) {
+ if ($rows) {
$rs->set_cache($rows);
}
}
- return (wantarray ? $rs->all : $rs);
+ return $rs;
}
=head2 search_literal
{ key => 'artist_title' }
);
-If no C<key> is specified and you explicitly name columns, it searches on all
-unique constraints defined on the source, including the primary key.
-
If the C<key> is specified as C<primary>, it searches only on the primary key.
See also L</find_or_create> and L</update_or_create>. For information on how to
my $self = shift;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
- # Parse out a hash from input
+ # Default to the primary key, but allow a specific key
my @cols = exists $attrs->{key}
? $self->result_source->unique_constraint_columns($attrs->{key})
: $self->result_source->primary_columns;
+ $self->throw_exception(
+ "Can't find unless a primary key or unique constraint is defined"
+ ) unless @cols;
- my $hash;
+ # Parse out a hashref from input
+ my $query;
if (ref $_[0] eq 'HASH') {
- $hash = { %{$_[0]} };
+ $query = { %{$_[0]} };
}
elsif (@_ == @cols) {
- $hash = {};
- @{$hash}{@cols} = @_;
+ $query = {};
+ @{$query}{@cols} = @_;
}
else {
- $self->throw_exception(
- "Arguments to find must be a hashref or match the number of columns in the "
- . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key"
- );
+ # Compatibility: Allow e.g. find(id => $value)
+ carp "find by key => value deprecated; please use a hashref instead";
+ $query = {@_};
}
- # Check the hash we just parsed against our source's unique constraints
- my @constraint_names = exists $attrs->{key}
- ? ($attrs->{key})
- : $self->result_source->unique_constraint_names;
- $self->throw_exception(
- "Can't find unless a primary key or unique constraint is defined"
- ) unless @constraint_names;
-
- my @unique_queries;
- foreach my $name (@constraint_names) {
- my @unique_cols = $self->result_source->unique_constraint_columns($name);
- my $unique_query = $self->_build_unique_query($hash, \@unique_cols);
-
- # Add the ResultSet's alias
- foreach my $key (grep { ! m/\./ } keys %$unique_query) {
- my $alias = $self->{attrs}->{alias};
- $unique_query->{"$alias.$key"} = delete $unique_query->{$key};
- }
-
- push @unique_queries, $unique_query if %$unique_query;
+ # Add the ResultSet's alias
+ foreach my $key (grep { ! m/\./ } keys %$query) {
+ $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
}
- # Handle cases where the ResultSet already defines the query
- my $query = @unique_queries ? \@unique_queries : undef;
-
# Run the query
-
if (keys %$attrs) {
my $rs = $self->search($query, $attrs);
$rs->_resolve;
Inflates the first result without creating a cursor if the resultset has
any records in it; if not returns nothing. Used by L</find> as an optimisation.
+Can optionally take an additional condition *only* - this is a fast-code-path
+method; if you need to add extra joins or similar call ->search and then
+->single without a condition on the $rs returned from that.
+
=cut
sub single {
sub next {
my ($self) = @_;
- if (@{$self->{all_cache} || []}) {
+ if (my $cache = $self->get_cache) {
$self->{all_cache_position} ||= 0;
- return $self->{all_cache}->[$self->{all_cache_position}++];
+ return $cache->[$self->{all_cache_position}++];
}
if ($self->{attrs}{cache}) {
$self->{all_cache_position} = 1;
return $self->_construct_object(@row);
}
-# XXX - this is essentially just the old new(). rewrite / tidy up?
sub _resolve {
my $self = shift;
my $attrs = $self->{attrs};
my $source = ($self->{_parent_rs}) ? $self->{_parent_rs} : $self->{result_source};
- # XXX - this is a hack to prevent dclone dieing because of the code ref, get's put back in $attrs afterwards
+ # XXX - lose storable dclone
my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter});
$attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } };
$attrs->{record_filter} = $record_filter if ($record_filter);
$attrs->{order_by} = [ $attrs->{order_by} ] if
$attrs->{order_by} and !ref($attrs->{order_by});
$attrs->{order_by} ||= [];
+
+ if(my $seladds = delete($attrs->{'+select'})) {
+ my @seladds = (ref($seladds) eq 'ARRAY' ? @$seladds : ($seladds));
+ $attrs->{select} = [
+ @{ $attrs->{select} },
+ map { (m/\./ || ref($_)) ? $_ : "${alias}.$_" } $seladds
+ ];
+ }
+ if(my $asadds = delete($attrs->{'+as'})) {
+ my @asadds = (ref($asadds) eq 'ARRAY' ? @$asadds : ($asadds));
+ $attrs->{as} = [ @{ $attrs->{as} }, @asadds ];
+ }
my $collapse = $attrs->{collapse} || {};
if (my $prefetch = delete $attrs->{prefetch}) {
$self->{_attrs} = $attrs;
}
+sub _merge_attr {
+ my ($self, $a, $b, $is_prefetch) = @_;
+
+ return $b unless $a;
+ if (ref $b eq 'HASH' && ref $a eq 'HASH') {
+ foreach my $key (keys %{$b}) {
+ if (exists $a->{$key}) {
+ $a->{$key} = $self->_merge_attr($a->{$key}, $b->{$key}, $is_prefetch);
+ } else {
+ $a->{$key} = delete $b->{$key};
+ }
+ }
+ return $a;
+ } else {
+ $a = [$a] unless (ref $a eq 'ARRAY');
+ $b = [$b] unless (ref $b eq 'ARRAY');
+
+ my $hash = {};
+ my $array = [];
+ foreach ($a, $b) {
+ foreach my $element (@{$_}) {
+ if (ref $element eq 'HASH') {
+ $hash = $self->_merge_attr($hash, $element, $is_prefetch);
+ } elsif (ref $element eq 'ARRAY') {
+ $array = [@{$array}, @{$element}];
+ } else {
+ if (($b == $_) && $is_prefetch) {
+ $self->_merge_array($array, $element, $is_prefetch);
+ } else {
+ push(@{$array}, $element);
+ }
+ }
+ }
+ }
+
+ if ((keys %{$hash}) && (scalar(@{$array} > 0))) {
+ return [$hash, @{$array}];
+ } else {
+ return (keys %{$hash}) ? $hash : $array;
+ }
+ }
+}
+
+sub _merge_array {
+ my ($self, $a, $b) = @_;
+
+ $b = [$b] unless (ref $b eq 'ARRAY');
+ # add elements from @{$b} to @{$a} which aren't already in @{$a}
+ foreach my $b_element (@{$b}) {
+ push(@{$a}, $b_element) unless grep {$b_element eq $_} @{$a};
+ }
+}
+
sub _construct_object {
my ($self, @row) = @_;
my @as = @{ $self->{_attrs}{as} };
my $info = $self->_collapse_result(\@as, \@row);
- my $new = $self->result_class->inflate_result($self->result_source, @$info, $self->{_parent_rs});
+ my $new = $self->result_class->inflate_result($self->result_source, @$info);
$new = $self->{_attrs}{record_filter}->($new)
if exists $self->{_attrs}{record_filter};
return $new;
$row = $self->{stashed_row} = \@raw;
$tree = $self->_collapse_result($as, $row, $c_prefix);
}
- @$target = @final;
+ @$target = (@final ? @final : [ {}, {} ]);
+ # single empty result to indicate an empty prefetched has_many
}
return $info;
}
sub count {
my $self = shift;
return $self->search(@_)->count if @_ and defined $_[0];
- return scalar @{ $self->get_cache } if @{ $self->get_cache };
+ return scalar @{ $self->get_cache } if $self->get_cache;
my $count = $self->_count;
return 0 unless $count;
$self->_resolve;
my $attrs = { %{ $self->{_attrs} } };
- if ($attrs->{distinct} && (my $group_by = $attrs->{group_by} || $attrs->{select})) {
+ if (my $group_by = delete $attrs->{group_by}) {
delete $attrs->{having};
my @distinct = (ref $group_by ? @$group_by : ($group_by));
# todo: try CONCAT for multi-column pk
}
$select = { count => { distinct => \@distinct } };
- #use Data::Dumper; die Dumper $select;
}
$attrs->{select} = $select;
sub all {
my ($self) = @_;
- return @{ $self->get_cache } if @{ $self->get_cache };
+ return @{ $self->get_cache } if $self->get_cache;
my @obj;
$cond->{-and} = [];
my @cond = @{$self->{cond}{-and}};
- for (my $i = 0; $i < @cond - 1; $i++) {
+ for (my $i = 0; $i <= @cond - 1; $i++) {
my $entry = $cond[$i];
my %hash;
}
else {
$entry =~ /([^.]+)$/;
- $hash{$entry} = $cond[++$i];
+ $hash{$1} = $cond[++$i];
}
push @{$cond->{-and}}, \%hash;
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
- my $row = $self->find($hash, $attrs);
- if (defined $row) {
- $row->set_columns($hash);
- $row->update;
- return $row;
+ my @constraint_names = exists $attrs->{key}
+ ? ($attrs->{key})
+ : $self->result_source->unique_constraint_names;
+ $self->throw_exception(
+ "update_or_create requires a primary key or unique constraint; none is defined on "
+ . $self->result_source->name
+ ) unless @constraint_names;
+
+ my @unique_queries;
+ foreach my $name (@constraint_names) {
+ my @unique_cols = $self->result_source->unique_constraint_columns($name);
+ my $unique_query = $self->_build_unique_query($hash, \@unique_cols);
+
+ push @unique_queries, $unique_query
+ if keys %$unique_query == @unique_cols;
+ }
+
+ if (@unique_queries) {
+ my $row = $self->single(\@unique_queries);
+ if (defined $row) {
+ $row->update($hash);
+ return $row;
+ }
}
return $self->create($hash);
=cut
sub get_cache {
- shift->{all_cache} || [];
+ shift->{all_cache};
}
=head2 set_cache
sub set_cache {
my ( $self, $data ) = @_;
$self->throw_exception("set_cache requires an arrayref")
- if ref $data ne 'ARRAY';
- my $result_class = $self->result_class;
- foreach( @$data ) {
- $self->throw_exception(
- "cannot cache object of type '$_', expected '$result_class'"
- ) if ref $_ ne $result_class;
- }
+ if defined($data) && (ref $data ne 'ARRAY');
$self->{all_cache} = $data;
}
=cut
sub clear_cache {
- shift->set_cache([]);
+ shift->set_cache(undef);
}
=head2 related_resultset
through directly to SQL, so you can give e.g. C<year DESC> for a
descending order on the column `year'.
+Please note that if you have quoting enabled (see
+L<DBIx::Class::Storage/quote_char>) you will need to do C<\'year DESC' > to
+specify an order. (The scalar ref causes it to be passed as raw sql to the DB,
+so you will need to manually quote things as appropriate.)
+
=head2 columns
=over 4
attribute, the column names returned are storage-dependent. E.g. MySQL would
return a column named C<count(employeeid)> in the above example.
+=head2 +select
+
+=over 4
+
+Indicates additional columns to be selected from storage. Works the same as
+L<select> but adds columns to the selection.
+
+=back
+
+=head2 +as
+
+=over 4
+
+Indicates additional column names for those added via L<+select>.
+
+=back
+
=head2 as
=over 4
You can create your own accessors if required - see
L<DBIx::Class::Manual::Cookbook> for details.
+Please note: This will NOT insert an C<AS employee_count> into the SQL statement
+produced, it is used for internal access only. Thus attempting to use the accessor
+in an C<order_by> clause or similar will fail misrably.
+
=head2 join
=over 4
C<has_one> (or if you're using C<add_relationship>, any relationship declared
with an accessor type of 'single' or 'filter').
+=head2 page
+
+=over 4
+
+=item Value: $page
+
+=back
+
+Makes the resultset paged and specifies the page to retrieve. Effectively
+identical to creating a non-pages resultset and then calling ->page($page)
+on it.
+
+If L<rows> attribute is not specified it defualts to 10 rows per page.
+
+=head2 rows
+
+=over 4
+
+=item Value: $rows
+
+=back
+
+Specifes the maximum number of rows for direct retrieval or the number of
+rows per page if the page attribute or method is used.
+
+=head2 offset
+
+=over 4
+
+=item Value: $offset
+
+=back
+
+Specifies the (zero-based) row number for the first row to be returned, or the
+of the first row of the first page if paging is used.
+
+=head2 group_by
+
+=over 4
+
+=item Value: \@columns
+
+=back
+
+A arrayref of columns to group by. Can include columns of joined tables.
+
+ group_by => [qw/ column1 column2 ... /]
+
+=head2 having
+
+=over 4
+
+=item Value: $condition
+
+=back
+
+HAVING is a select statement attribute that is applied between GROUP BY and
+ORDER BY. It is applied to the after the grouping calculations have been
+done.
+
+ having => { 'count(employee)' => { '>=', 100 } }
+
+=head2 distinct
+
+=over 4
+
+=item Value: (0 | 1)
+
+=back
+
+Set to 1 to group by all columns.
+
+=head2 cache
+
+Set to 1 to cache search results. This prevents extra SQL queries if you
+revisit rows in your ResultSet:
+
+ my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
+
+ while( my $artist = $resultset->next ) {
+ ... do stuff ...
+ }
+
+ $rs->first; # without cache, this would issue a query
+
+By default, searches are not cached.
+
+For more examples of using these attributes, see
+L<DBIx::Class::Manual::Cookbook>.
+
=head2 from
=over 4
clauses.
NOTE: Use this on your own risk. This allows you to shoot off your foot!
+
C<join> will usually do what you need and it is strongly recommended that you
avoid using C<from> unless you cannot achieve the desired result using C<join>.
+And we really do mean "cannot", not just tried and failed. Attempting to use
+this because you're having problems with C<join> is like trying to use x86
+ASM because you've got a syntax error in your C. Trust us on this.
+
+Now, if you're still really, really sure you need to use this (and if you're
+not 100% sure, ask the mailing list first), here's an explanation of how this
+works.
-In simple terms, C<from> works as follows:
+The syntax is as follows -
+ [
+ { <alias1> => <table1> },
[
- { <alias> => <table>, -join_type => 'inner|left|right' }
- [] # nested JOIN (optional)
- { <table.column> => <foreign_table.foreign_key> }
- ]
+ { <alias2> => <table2>, -join_type => 'inner|left|right' },
+ [], # nested JOIN (optional)
+ { <table1.column1> => <table2.column2>, ... (more conditions) },
+ ],
+ # More of the above [ ] may follow for additional joins
+ ]
- JOIN
- <alias> <table>
- [JOIN ...]
- ON <table.column> = <foreign_table.foreign_key>
+ <table1> <alias1>
+ JOIN
+ <table2> <alias2>
+ [JOIN ...]
+ ON <table1.column1> = <table2.column2>
+ <more joins may follow>
An easy way to follow the examples below is to remember the following:
# SELECT child.* FROM person child
# INNER JOIN person father ON child.father_id = father.id
-=head2 page
-
-=over 4
-
-=item Value: $page
-
-=back
-
-Makes the resultset paged and specifies the page to retrieve. Effectively
-identical to creating a non-pages resultset and then calling ->page($page)
-on it.
-
-=head2 rows
-
-=over 4
-
-=item Value: $rows
-
-=back
-
-Specifes the maximum number of rows for direct retrieval or the number of
-rows per page if the page attribute or method is used.
-
-=head2 group_by
-
-=over 4
-
-=item Value: \@columns
-
-=back
-
-A arrayref of columns to group by. Can include columns of joined tables.
-
- group_by => [qw/ column1 column2 ... /]
-
-=head2 having
-
-=over 4
-
-=item Value: $condition
-
-=back
-
-HAVING is a select statement attribute that is applied between GROUP BY and
-ORDER BY. It is applied to the after the grouping calculations have been
-done.
-
- having => { 'count(employee)' => { '>=', 100 } }
-
-=head2 distinct
-
-=over 4
-
-=item Value: (0 | 1)
-
-=back
-
-Set to 1 to group by all columns.
-
-=head2 cache
-
-Set to 1 to cache search results. This prevents extra SQL queries if you
-revisit rows in your ResultSet:
-
- my $resultset = $schema->resultset('Artist')->search( undef, { cache => 1 } );
-
- while( my $artist = $resultset->next ) {
- ... do stuff ...
- }
-
- $rs->first; # without cache, this would issue a query
-
-By default, searches are not cached.
-
-For more examples of using these attributes, see
-L<DBIx::Class::Manual::Cookbook>.
-
=cut
1;