X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=4e8467eaad5bc96bb67136995511f7e8464323dc;hb=7e51afbf1951bc8febf00897e5e3f0f25dfc34aa;hp=636754b6db238ecde37bf9351f44a1c6a777b03f;hpb=2b0334f87ded2e6bfeecc2aeebfe5d8d5f454a21;p=dbsrgits%2FDBIx-Class-Historic.git
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 636754b..4e8467e 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -11,9 +11,11 @@ use Data::Page;
use Storable;
use DBIx::Class::ResultSetColumn;
use DBIx::Class::ResultSourceHandle;
+use List::Util ();
+use Scalar::Util ();
use base qw/DBIx::Class/;
-__PACKAGE__->mk_group_accessors('simple' => qw/result_class _source_handle/);
+__PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
=head1 NAME
@@ -21,8 +23,8 @@ DBIx::Class::ResultSet - Responsible for fetching and creating resultset.
=head1 SYNOPSIS
- my $rs = $schema->resultset('User')->search(registered => 1);
- my @rows = $schema->resultset('CD')->search(year => 2005);
+ my $rs = $schema->resultset('User')->search({ registered => 1 });
+ my @rows = $schema->resultset('CD')->search({ year => 2005 })->all();
=head1 DESCRIPTION
@@ -52,7 +54,10 @@ In the examples below, the following table classes are used:
=head1 OVERLOADING
-If a resultset is used as a number it returns the C. However, if it is used as a boolean it is always true. So if you want to check if a result set has any results use C. C will always be true.
+If a resultset is used in a numeric context it returns the L.
+However, if it is used in a booleand context it is always true. So if
+you want to check if a resultset has any results use C.
+C will always be true.
=head1 METHODS
@@ -99,9 +104,10 @@ sub new {
$attrs->{alias} ||= 'me';
+ # Creation of {} and bless separated to mitigate RH perl bug
+ # see https://bugzilla.redhat.com/show_bug.cgi?id=196836
my $self = {
_source_handle => $source,
- result_class => $attrs->{result_class} || $source->resolve->result_class,
cond => $attrs->{where},
count => undef,
pager => undef,
@@ -110,6 +116,10 @@ sub new {
bless $self, $class;
+ $self->result_class(
+ $attrs->{result_class} || $source->resolve->result_class
+ );
+
return $self;
}
@@ -142,6 +152,8 @@ L. For more examples of using this function, see
L. For a complete
documentation for the first argument, see L.
+For more help on using joins with search, see L.
+
=cut
sub search {
@@ -168,22 +180,30 @@ always return a resultset, even in list context.
sub search_rs {
my $self = shift;
- my $rows;
-
- unless (@_) { # no search, effectively just a clone
- $rows = $self->get_cache;
- }
-
my $attrs = {};
$attrs = pop(@_) if @_ > 1 and ref $_[$#_] eq 'HASH';
my $our_attrs = { %{$self->{attrs}} };
my $having = delete $our_attrs->{having};
my $where = delete $our_attrs->{where};
+ my $rows;
+
+ my %safe = (alias => 1, cache => 1);
+
+ unless (
+ (@_ && defined($_[0])) # @_ == () or (undef)
+ ||
+ (keys %$attrs # empty attrs or only 'safe' attrs
+ && List::Util::first { !$safe{$_} } keys %$attrs)
+ ) {
+ # no search, effectively just a clone
+ $rows = $self->get_cache;
+ }
+
my $new_attrs = { %{$our_attrs}, %{$attrs} };
# merge new attrs into inherited
- foreach my $key (qw/join prefetch/) {
+ foreach my $key (qw/join prefetch +select +as/) {
next unless exists $attrs->{$key};
$new_attrs->{$key} = $self->_merge_attr($our_attrs->{$key}, $attrs->{$key});
}
@@ -268,6 +288,13 @@ sub search_rs {
Pass a literal chunk of SQL to be added to the conditional part of the
resultset query.
+CAVEAT: C is provided for Class::DBI compatibility and should
+only be used in that context. There are known problems using C
+in chained queries; it can result in bind values in the wrong order. See
+L and
+L for searching techniques that do not
+require C.
+
=cut
sub search_literal {
@@ -283,7 +310,7 @@ sub search_literal {
=item Arguments: @values | \%cols, \%attrs?
-=item Return Value: $row_object
+=item Return Value: $row_object | undef
=back
@@ -312,11 +339,18 @@ Additionally, you can specify the columns explicitly by name:
If the C is specified as C, it searches only on the primary key.
If no C is specified, it searches on all unique constraints defined on the
-source, including the primary key.
+source for which column data is provided, including the primary key.
If your table does not have a primary key, you B provide a value for the
C attribute matching one of the unique constraints on the source.
+In addition to C, L recognizes and applies standard
+L in the same way as L does.
+
+Note: If your query does not return only one row, a warning is generated:
+
+ Query returned more than one row
+
See also L and L. For information on how to
declare unique constraints, see
L.
@@ -368,25 +402,46 @@ sub find {
@{$input_query}{@keys} = values %related;
}
- my @unique_queries = $self->_unique_queries($input_query, $attrs);
# Build the final query: Default to the disjunction of the unique queries,
# but allow the input query in case the ResultSet defines the query or the
# user is abusing find
my $alias = exists $attrs->{alias} ? $attrs->{alias} : $self->{attrs}{alias};
- my $query = @unique_queries
- ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
- : $self->_add_alias($input_query, $alias);
+ my $query;
+ if (exists $attrs->{key}) {
+ my @unique_cols = $self->result_source->unique_constraint_columns($attrs->{key});
+ my $unique_query = $self->_build_unique_query($input_query, \@unique_cols);
+ $query = $self->_add_alias($unique_query, $alias);
+ }
+ else {
+ my @unique_queries = $self->_unique_queries($input_query, $attrs);
+ $query = @unique_queries
+ ? [ map { $self->_add_alias($_, $alias) } @unique_queries ]
+ : $self->_add_alias($input_query, $alias);
+ }
# Run the query
if (keys %$attrs) {
my $rs = $self->search($query, $attrs);
- return keys %{$rs->_resolved_attrs->{collapse}} ? $rs->next : $rs->single;
+ if (keys %{$rs->_resolved_attrs->{collapse}}) {
+ my $row = $rs->next;
+ carp "Query returned more than one row" if $rs->next;
+ return $row;
+ }
+ else {
+ return $rs->single;
+ }
}
else {
- return keys %{$self->_resolved_attrs->{collapse}}
- ? $self->search($query)->next
- : $self->single($query);
+ if (keys %{$self->_resolved_attrs->{collapse}}) {
+ my $rs = $self->search($query);
+ my $row = $rs->next;
+ carp "Query returned more than one row" if $rs->next;
+ return $row;
+ }
+ else {
+ return $self->single($query);
+ }
}
}
@@ -476,6 +531,17 @@ sub search_related {
return shift->related_resultset(shift)->search(@_);
}
+=head2 search_related_rs
+
+This method works exactly the same as search_related, except that
+it guarantees a restultset, even in list context.
+
+=cut
+
+sub search_related_rs {
+ return shift->related_resultset(shift)->search_rs(@_);
+}
+
=head2 cursor
=over 4
@@ -513,11 +579,29 @@ sub cursor {
my $cd = $schema->resultset('CD')->single({ year => 2001 });
Inflates the first result without creating a cursor if the resultset has
-any records in it; if not returns nothing. Used by L as an optimisation.
+any records in it; if not returns nothing. Used by L as a lean version of
+L.
+
+While this method can take an optional search condition (just like L)
+being a fast-code-path it does not recognize search attributes. If you need to
+add extra joins or similar, call L and then chain-call L on the
+L returned.
-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.
+=over
+
+=item B
+
+As of 0.08100, this method enforces the assumption that the preceeding
+query returns only one row. If more than one row is returned, you will receive
+a warning:
+
+ Query returned more than one row
+
+In this case, you should be using L or L instead, or if you really
+know what you are doing, use the L attribute to explicitly limit the size
+of the resultset.
+
+=back
=cut
@@ -653,8 +737,8 @@ sub get_column {
$cd_rs = $rs->search_like({ title => '%blue%'});
Performs a search, but uses C instead of C<=> as the condition. Note
-that this is simply a convenience method. You most likely want to use
-L with specific operators.
+that this is simply a convenience method retained for ex Class::DBI users.
+You most likely want to use L with specific operators.
For more information, see L.
@@ -907,6 +991,14 @@ L<"table"|DBIx::Class::Manual::Glossary/"ResultSource"> class.
=cut
+sub result_class {
+ my ($self, $result_class) = @_;
+ if ($result_class) {
+ $self->ensure_class_loaded($result_class);
+ $self->_result_class($result_class);
+ }
+ $self->_result_class;
+}
=head2 count
@@ -922,7 +1014,7 @@ Performs an SQL C with the same query as the resultset was built
with to find the number of elements. If passed arguments, does a search
on the resultset and counts the results of that.
-Note: When using C with C, L emulates C
+Note: When using C with C, L emulates C
using C. Some databases (notably SQLite) do
not support C with multiple columns. If you are using such a
database, you should only use columns from the main table in your C
@@ -1215,11 +1307,26 @@ Deletes the contents of the resultset from its result source. Note that this
will not run DBIC cascade triggers. See L if you need triggers
to run. See also L.
+delete may not generate correct SQL for a query with joins or a resultset
+chained from a related resultset. In this case it will generate a warning:-
+
+ WARNING! Currently $rs->delete() does not generate proper SQL on
+ joined resultsets, and may delete rows well outside of the contents
+ of $rs. Use at your own risk
+
+In these cases you may find that delete_all is more appropriate, or you
+need to respecify your query in a way that can be expressed without a join.
+
=cut
sub delete {
my ($self) = @_;
-
+ $self->throw_exception("Delete should not be passed any arguments")
+ if $_[1];
+ carp( 'WARNING! Currently $rs->delete() does not generate proper SQL'
+ . ' on joined resultsets, and may delete rows well outside of the'
+ . ' contents of $rs. Use at your own risk' )
+ if ( $self->{attrs}{seen_join} );
my $cond = $self->_cond_for_update_delete;
$self->result_source->storage->delete($self->result_source, $cond);
@@ -1255,8 +1362,9 @@ sub delete_all {
=back
-Pass an arrayref of hashrefs. Each hashref should be a structure suitable for
-submitting to a $resultset->create(...) method.
+Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
+For the arrayref of hashrefs style each hashref should be a structure suitable
+forsubmitting to a $resultset->create(...) method.
In void context, C in L is used
to insert the data, as this is a faster method.
@@ -1296,7 +1404,18 @@ Example: Assuming an Artist Class that has many CDs Classes relating:
print $ArtistOne->name; ## response is 'Artist One'
print $ArtistThree->cds->count ## reponse is '2'
-
+
+For the arrayref of arrayrefs style, the first element should be a list of the
+fieldsnames to which the remaining elements are rows being inserted. For
+example:
+
+ $Arstist_rs->populate([
+ [qw/artistid name/],
+ [100, 'A Formally Unknown Singer'],
+ [101, 'A singer that jumped the shark two albums ago'],
+ [102, 'An actually cool singer.'],
+ ]);
+
Please note an important effect on your data when choosing between void and
wantarray context. Since void context goes straight to C in
L this will skip any component that is overriding
@@ -1308,7 +1427,10 @@ values.
=cut
sub populate {
- my ($self, $data) = @_;
+ my $self = shift @_;
+ my $data = ref $_[0][0] eq 'HASH'
+ ? $_[0] : ref $_[0][0] eq 'ARRAY' ? $self->_normalize_populate_args($_[0]) :
+ $self->throw_exception('Populate expects an arrayref of hashes or arrayref of arrayrefs');
if(defined wantarray) {
my @created;
@@ -1382,6 +1504,28 @@ sub populate {
}
}
+=head2 _normalize_populate_args ($args)
+
+Private method used by L to normalize it's incoming arguments. Factored
+out in case you want to subclass and accept new argument structures to the
+L method.
+
+=cut
+
+sub _normalize_populate_args {
+ my ($self, $data) = @_;
+ my @names = @{shift(@$data)};
+ my @results_to_create;
+ foreach my $datum (@$data) {
+ my %result_to_create;
+ foreach my $index (0..$#names) {
+ $result_to_create{$names[$index]} = $$datum[$index];
+ }
+ push @results_to_create, \%result_to_create;
+ }
+ return \@results_to_create;
+}
+
=head2 pager
=over 4
@@ -1434,7 +1578,7 @@ sub page {
=item Arguments: \%vals
-=item Return Value: $object
+=item Return Value: $rowobject
=back
@@ -1451,15 +1595,41 @@ sub new_result {
my ($self, $values) = @_;
$self->throw_exception( "new_result needs a hash" )
unless (ref $values eq 'HASH');
- $self->throw_exception(
- "Can't abstract implicit construct, condition not a hash"
- ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
+ my %new;
my $alias = $self->{attrs}{alias};
- my $collapsed_cond = $self->{cond} ? $self->_collapse_cond($self->{cond}) : {};
- my %new = (
+
+ if (
+ defined $self->{cond}
+ && $self->{cond} eq $DBIx::Class::ResultSource::UNRESOLVABLE_CONDITION
+ ) {
+ %new = %{$self->{attrs}{related_objects}};
+ } else {
+ $self->throw_exception(
+ "Can't abstract implicit construct, condition not a hash"
+ ) if ($self->{cond} && !(ref $self->{cond} eq 'HASH'));
+
+ my $collapsed_cond = (
+ $self->{cond}
+ ? $self->_collapse_cond($self->{cond})
+ : {}
+ );
+
+ # precendence must be given to passed values over values inherited from
+ # the cond, so the order here is important.
+ my %implied = %{$self->_remove_alias($collapsed_cond, $alias)};
+ while( my($col,$value) = each %implied ){
+ if(ref($value) eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '='){
+ $new{$col} = $value->{'='};
+ next;
+ }
+ $new{$col} = $value if $self->_is_deterministic_value($value);
+ }
+ }
+
+ %new = (
+ %new,
%{ $self->_remove_alias($values, $alias) },
- %{ $self->_remove_alias($collapsed_cond, $alias) },
-source_handle => $self->_source_handle,
-result_source => $self->result_source, # DO NOT REMOVE THIS, REQUIRED
);
@@ -1467,6 +1637,20 @@ sub new_result {
return $self->result_class->new(\%new);
}
+# _is_deterministic_value
+#
+# Make an effor to strip non-deterministic values from the condition,
+# to make sure new_result chokes less
+
+sub _is_deterministic_value {
+ my $self = shift;
+ my $value = shift;
+ my $ref_type = ref $value;
+ return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
+ return 1 if Scalar::Util::blessed($value);
+ return 0;
+}
+
# _collapse_cond
#
# Recursively collapse the condition.
@@ -1531,16 +1715,33 @@ sub _remove_alias {
=item Arguments: \%vals, \%attrs?
-=item Return Value: $object
+=item Return Value: $rowobject
=back
-Find an existing record from this resultset. If none exists, instantiate a new
-result object and return it. The object will not be saved into your storage
+ my $artist = $schema->resultset('Artist')->find_or_new(
+ { artist => 'fred' }, { key => 'artists' });
+
+ $cd->cd_to_producer->find_or_new({ producer => $producer },
+ { key => 'primary });
+
+Find an existing record from this resultset, based on it's primary
+key, or a unique constraint. If none exists, instantiate a new result
+object and return it. The object will not be saved into your storage
until you call L on it.
+You most likely want this method when looking for existing rows using
+a unique constraint that is not the primary key, or looking for
+related rows.
+
If you want objects to be saved immediately, use L instead.
+B: C is probably not what you want when creating a
+new row in a table that uses primary keys supplied by the
+database. Passing in a primary key column with a value of I
+will cause L to attempt to search for a row with a value of
+I.
+
=cut
sub find_or_new {
@@ -1557,7 +1758,7 @@ sub find_or_new {
=item Arguments: \%vals
-=item Return Value: $object
+=item Return Value: a L $object
=back
@@ -1629,13 +1830,14 @@ sub create {
=item Arguments: \%vals, \%attrs?
-=item Return Value: $object
+=item Return Value: $rowobject
=back
- $class->find_or_create({ key => $val, ... });
+ $cd->cd_to_producer->find_or_create({ producer => $producer },
+ { key => 'primary });
-Tries to find a record based on its primary key or unique constraint; if none
+Tries to find a record based on its primary key or unique constraints; if none
is found, creates one and returns that instead.
my $cd = $schema->resultset('CD')->find_or_create({
@@ -1656,6 +1858,18 @@ constraint. For example:
{ key => 'cd_artist_title' }
);
+B: Because find_or_create() reads from the database and then
+possibly inserts based on the result, this method is subject to a race
+condition. Another process could create a record in the table after
+the find has completed and before the create has started. To avoid
+this problem, use find_or_create() inside a transaction.
+
+B: C is probably not what you want when creating
+a new row in a table that uses primary keys supplied by the
+database. Passing in a primary key column with a value of I
+will cause L to attempt to search for a row with a value of
+I.
+
See also L and L. For information on how to declare
unique constraints, see L.
@@ -1675,11 +1889,11 @@ sub find_or_create {
=item Arguments: \%col_values, { key => $unique_constraint }?
-=item Return Value: $object
+=item Return Value: $rowobject
=back
- $class->update_or_create({ col => $val, ... });
+ $resultset->update_or_create({ col => $val, ... });
First, searches for an existing row matching one of the unique constraints
(including the primary key) on the source of this resultset. If a row is
@@ -1699,6 +1913,14 @@ For example:
{ key => 'cd_artist_title' }
);
+ $cd->cd_to_producer->update_or_create({
+ producer => $producer,
+ name => 'harry',
+ }, {
+ key => 'primary,
+ });
+
+
If no C is specified, it searches on all unique constraints defined on the
source, including the primary key.
@@ -1707,6 +1929,12 @@ If the C is specified as C, it searches only on the primary key.
See also L and L. For information on how to declare
unique constraints, see L.
+B: C is probably not what you want when
+looking for a row in a table that uses primary keys supplied by the
+database, unless you actually have a key value. Passing in a primary
+key column with a value of I will cause L to attempt to
+search for a row with a value of I.
+
=cut
sub update_or_create {
@@ -1735,6 +1963,9 @@ sub update_or_create {
Gets the contents of the cache for the resultset, if the cache is set.
+The cache is populated either by using the L attribute to
+L or by calling L.
+
=cut
sub get_cache {
@@ -1756,6 +1987,9 @@ of objects of the same class as those produced by the resultset. Note that
if the cache is set the resultset will return the cached objects rather
than re-querying the database even if the cache attr is not set.
+The contents of the cache can also be populated by using the
+L attribute to L.
+
=cut
sub set_cache {
@@ -1860,6 +2094,49 @@ sub related_resultset {
};
}
+=head2 current_source_alias
+
+=over 4
+
+=item Arguments: none
+
+=item Return Value: $source_alias
+
+=back
+
+Returns the current table alias for the result source this resultset is built
+on, that will be used in the SQL query. Usually it is C.
+
+Currently the source alias that refers to the result set returned by a
+L/L family method depends on how you got to the resultset: it's
+C by default, but eg. L aliases it to the related result
+source name (and keeps C referring to the original result set). The long
+term goal is to make L always alias the current resultset as C
+(and make this method unnecessary).
+
+Thus it's currently necessary to use this method in predefined queries (see
+L) when referring to the
+source alias of the current result set:
+
+ # in a result set class
+ sub modified_by {
+ my ($self, $user) = @_;
+
+ my $me = $self->current_source_alias;
+
+ return $self->search(
+ "$me.modified" => $user->id,
+ );
+ }
+
+=cut
+
+sub current_source_alias {
+ my ($self) = @_;
+
+ return ($self->{attrs} || {})->{alias} || 'me';
+}
+
sub _resolve_from {
my ($self, $extra_join) = @_;
my $source = $self->result_source;
@@ -2051,43 +2328,44 @@ sub _calculate_score {
}
sub _merge_attr {
- my ($self, $a, $b) = @_;
+ my ($self, $orig, $import) = @_;
- return $b unless defined($a);
- return $a unless defined($b);
+ return $import unless defined($orig);
+ return $orig unless defined($import);
- $a = $self->_rollout_attr($a);
- $b = $self->_rollout_attr($b);
+ $orig = $self->_rollout_attr($orig);
+ $import = $self->_rollout_attr($import);
my $seen_keys;
- foreach my $b_element ( @{$b} ) {
- # find best candidate from $a to merge $b_element into
+ foreach my $import_element ( @{$import} ) {
+ # find best candidate from $orig to merge $b_element into
my $best_candidate = { position => undef, score => 0 }; my $position = 0;
- foreach my $a_element ( @{$a} ) {
- my $score = $self->_calculate_score( $a_element, $b_element );
+ foreach my $orig_element ( @{$orig} ) {
+ my $score = $self->_calculate_score( $orig_element, $import_element );
if ($score > $best_candidate->{score}) {
$best_candidate->{position} = $position;
$best_candidate->{score} = $score;
}
$position++;
}
- my ($b_key) = ( ref $b_element eq 'HASH' ) ? keys %{$b_element} : ($b_element);
- if ($best_candidate->{score} == 0 || exists $seen_keys->{$b_key}) {
- push( @{$a}, $b_element );
+ my ($import_key) = ( ref $import_element eq 'HASH' ) ? keys %{$import_element} : ($import_element);
+
+ if ($best_candidate->{score} == 0 || exists $seen_keys->{$import_key}) {
+ push( @{$orig}, $import_element );
} else {
- $seen_keys->{$b_key} = 1; # don't merge the same key twice
- my $a_best = $a->[$best_candidate->{position}];
- # merge a_best and b_element together and replace original with merged
- if (ref $a_best ne 'HASH') {
- $a->[$best_candidate->{position}] = $b_element;
- } elsif (ref $b_element eq 'HASH') {
- my ($key) = keys %{$a_best};
- $a->[$best_candidate->{position}] = { $key => $self->_merge_attr($a_best->{$key}, $b_element->{$key}) };
+ my $orig_best = $orig->[$best_candidate->{position}];
+ # merge orig_best and b_element together and replace original with merged
+ if (ref $orig_best ne 'HASH') {
+ $orig->[$best_candidate->{position}] = $import_element;
+ } elsif (ref $import_element eq 'HASH') {
+ my ($key) = keys %{$orig_best};
+ $orig->[$best_candidate->{position}] = { $key => $self->_merge_attr($orig_best->{$key}, $import_element->{$key}) };
}
}
+ $seen_keys->{$import_key} = 1; # don't merge the same key twice
}
- return $a;
+ return $orig;
}
sub result_source {
@@ -2108,7 +2386,12 @@ See L for details.
sub throw_exception {
my $self=shift;
- $self->_source_handle->schema->throw_exception(@_);
+ if (ref $self && $self->_source_handle->schema) {
+ $self->_source_handle->schema->throw_exception(@_)
+ } else {
+ croak(@_);
+ }
+
}
# XXX: FIXME: Attributes docs need clearing up
@@ -2135,6 +2418,10 @@ L) you will need to do C<\'year DESC' >
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.)
+If your L version supports it (>=1.50), you can also use
+C<{-desc => 'year'}>, which takes care of the quoting for you. This is the
+recommended syntax.
+
=head2 columns
=over 4
@@ -2197,7 +2484,7 @@ return a column named C in the above example.
=over 4
Indicates additional columns to be selected from storage. Works the same as
-L but adds columns to the selection.
=back
@@ -2205,7 +2492,7 @@ L