X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=aa76a6d36683e9e1048890c8ada2304a9755e257;hb=6a588797;hp=d4f8fab9bec365981692c1d7c8bdd2ac2e03115b;hpb=7c193ab90cb74062c1fc801e1cab35970d0ba25a;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index d4f8fab..aa76a6d 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -86,68 +86,6 @@ sub new { my ($source, $attrs) = @_; weaken $source; - $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } }; - #use Data::Dumper; warn Dumper($attrs); - my $alias = ($attrs->{alias} ||= 'me'); - - $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols}; - delete $attrs->{as} if $attrs->{columns}; - $attrs->{columns} ||= [ $source->columns ] unless $attrs->{select}; - $attrs->{select} = [ - map { m/\./ ? $_ : "${alias}.$_" } @{delete $attrs->{columns}} - ] if $attrs->{columns}; - $attrs->{as} ||= [ - map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} - ]; - if (my $include = delete $attrs->{include_columns}) { - push(@{$attrs->{select}}, @$include); - push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include); - } - #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/}); - - $attrs->{from} ||= [ { $alias => $source->from } ]; - $attrs->{seen_join} ||= {}; - my %seen; - if (my $join = delete $attrs->{join}) { - foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) { - if (ref $j eq 'HASH') { - $seen{$_} = 1 foreach keys %$j; - } else { - $seen{$j} = 1; - } - } - push(@{$attrs->{from}}, $source->resolve_join( - $join, $attrs->{alias}, $attrs->{seen_join}) - ); - } - - $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct}; - $attrs->{order_by} = [ $attrs->{order_by} ] if - $attrs->{order_by} and !ref($attrs->{order_by}); - $attrs->{order_by} ||= []; - - my $collapse = $attrs->{collapse} || {}; - if (my $prefetch = delete $attrs->{prefetch}) { - my @pre_order; - foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) { - if ( ref $p eq 'HASH' ) { - foreach my $key (keys %$p) { - push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias})) - unless $seen{$key}; - } - } else { - push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias})) - unless $seen{$p}; - } - my @prefetch = $source->resolve_prefetch( - $p, $attrs->{alias}, {}, \@pre_order, $collapse); - push(@{$attrs->{select}}, map { $_->[0] } @prefetch); - push(@{$attrs->{as}}, map { $_->[1] } @prefetch); - } - push(@{$attrs->{order_by}}, @pre_order); - } - $attrs->{collapse} = $collapse; -# use Data::Dumper; warn Dumper($collapse) if keys %{$collapse}; if ($attrs->{page}) { $attrs->{rows} ||= 10; @@ -155,12 +93,14 @@ sub new { $attrs->{offset} += ($attrs->{rows} * ($attrs->{page} - 1)); } + $attrs->{alias} ||= 'me'; + bless { result_source => $source, result_class => $attrs->{result_class} || $source->result_class, cond => $attrs->{where}, - from => $attrs->{from}, - collapse => $collapse, +# from => $attrs->{from}, +# collapse => $collapse, count => undef, page => delete $attrs->{page}, pager => undef, @@ -196,44 +136,45 @@ call it as C. sub search { my $self = shift; - - my $rs; - if( @_ ) { - my $attrs = { %{$self->{attrs}} }; - my $having = delete $attrs->{having}; - $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH'; - - my $where = (@_ - ? ((@_ == 1 || ref $_[0] eq "HASH") - ? shift - : ((@_ % 2) - ? $self->throw_exception( - "Odd number of arguments to search") - : {@_})) - : undef()); - if (defined $where) { - $attrs->{where} = (defined $attrs->{where} - ? { '-and' => - [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } - $where, $attrs->{where} ] } - : $where); - } - - if (defined $having) { - $attrs->{having} = (defined $attrs->{having} - ? { '-and' => - [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } - $having, $attrs->{having} ] } - : $having); - } + my $attrs = { %{$self->{attrs}} }; + my $having = delete $attrs->{having}; + $attrs = { %$attrs, %{ pop(@_) } } if @_ > 1 and ref $_[$#_] eq 'HASH'; + + my $where = (@_ + ? ((@_ == 1 || ref $_[0] eq "HASH") + ? shift + : ((@_ % 2) + ? $self->throw_exception( + "Odd number of arguments to search") + : {@_})) + : undef()); + if (defined $where) { + $attrs->{where} = (defined $attrs->{where} + ? { '-and' => + [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + $where, $attrs->{where} ] } + : $where); + } - $rs = (ref $self)->new($self->result_source, $attrs); + if (defined $having) { + $attrs->{having} = (defined $attrs->{having} + ? { '-and' => + [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ } + $having, $attrs->{having} ] } + : $having); } - else { - $rs = $self; - $rs->reset; + + my $rs = (ref $self)->new($self->result_source, $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} ) { + $rs->set_cache($rows); + } } + return (wantarray ? $rs->all : $rs); } @@ -255,6 +196,7 @@ resultset query. =cut +# TODO: needs fixing sub search_literal { my ($self, $cond, @vals) = @_; my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {}); @@ -272,12 +214,17 @@ sub search_literal { =back -Finds a row based on its primary key or unique constraint. For example: +Finds a row based on its primary key or unique constraint. For example, to find +a row by its primary key: my $cd = $schema->resultset('CD')->find(5); -Also takes an optional C attribute, to search by a specific key or unique -constraint. For example: +You can also find a row by a specific unique constraint using the C +attribute. For example: + + my $cd = $schema->resultset('CD')->find('Massive Attack', 'Mezzanine', { key => 'artist_title' }); + +Additionally, you can specify the columns explicitly by name: my $cd = $schema->resultset('CD')->find( { @@ -287,80 +234,93 @@ constraint. For example: { key => 'artist_title' } ); -If no C is specified, it searches on all unique constraints defined on the -source, including the primary key. +If no C is specified and you explicitly name columns, it searches on all +unique constraints defined on the source, including the primary key. If the C is specified as C, it searches only on the primary key. -See also L and L. +See also L and L. For information on how to +declare unique constraints, see +L. =cut sub find { - my ($self, @vals) = @_; - my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {}); + my $self = shift; + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); - my %unique_constraints = $self->result_source->unique_constraints; - $self->throw_exception( - "Can't find unless a primary key or unique constraint is defined" - ) unless %unique_constraints; + # Parse out a hash from input + my @cols = exists $attrs->{key} + ? $self->result_source->unique_constraint_columns($attrs->{key}) + : $self->result_source->primary_columns; - my @constraint_names = keys %unique_constraints; - if (exists $attrs->{key}) { + my $hash; + if (ref $_[0] eq 'HASH') { + $hash = { %{$_[0]} }; + } + elsif (@_ == @cols) { + $hash = {}; + @{$hash}{@cols} = @_; + } + else { $self->throw_exception( - "Unknown key $attrs->{key} on '" . $self->result_source->name . "'" - ) unless exists $unique_constraints{$attrs->{key}}; - - @constraint_names = ($attrs->{key}); + "Arguments to find must be a hashref or match the number of columns in the " + . exists $attrs->{key} ? "$attrs->{key} unique constraint" : "primary key" + ); } - my @unique_hashes; - foreach my $name (@constraint_names) { - my @unique_cols = @{ $unique_constraints{$name} }; - my %unique_hash; - if (ref $vals[0] eq 'HASH') { - # Stupid hack for CDBICompat - my %hash = %{ $vals[0] }; - foreach my $key (keys %hash) { - $hash{lc $key} = delete $hash{$key}; - } + # 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; - %unique_hash = - map { $_ => $hash{$_} } - grep { exists $hash{$_} } - @unique_cols; - } - elsif (@unique_cols == @vals) { - # Assume the argument order corresponds to the constraint definition - @unique_hash{@unique_cols} = @vals; - } - elsif (@vals % 2 == 0) { - # Fix for CDBI calling with a hash - %unique_hash = @vals; - } + 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); - foreach my $key (grep { ! m/\./ } keys %unique_hash) { - $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key}; + # 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}; } - #use Data::Dumper; warn Dumper \@vals, \@unique_cols, \%unique_hash; - push @unique_hashes, \%unique_hash if %unique_hash; + push @unique_queries, $unique_query if %$unique_query; } # Handle cases where the ResultSet already defines the query - my $query = @unique_hashes ? \@unique_hashes : undef; + my $query = @unique_queries ? \@unique_queries : undef; + # Run the query if (keys %$attrs) { my $rs = $self->search($query, $attrs); - return keys %{$rs->{collapse}} ? $rs->next : $rs->single; + return $rs->{attrs}->{prefetch} ? $rs->next : $rs->single; } else { - return keys %{$self->{collapse}} + return ($self->{attrs}->{prefetch}) ? $self->search($query)->next : $self->single($query); } } +# _build_unique_query +# +# Constrain the specified query hash based on the specified column names. + +sub _build_unique_query { + my ($self, $query, $unique_cols) = @_; + + my %unique_query = + map { $_ => $query->{$_} } + grep { exists $query->{$_} } + @$unique_cols; + + return \%unique_query; +} + =head2 search_related =over 4 @@ -401,9 +361,11 @@ L for more information. sub cursor { my ($self) = @_; - my $attrs = { %{$self->{attrs}} }; + + $self->_resolve; + my $attrs = { %{$self->{_attrs}} }; return $self->{cursor} - ||= $self->result_source->storage->select($self->{from}, $attrs->{select}, + ||= $self->result_source->storage->select($attrs->{from}, $attrs->{select}, $attrs->{where},$attrs); } @@ -420,13 +382,14 @@ 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 find() as an optimisation. +any records in it; if not returns nothing. Used by L as an optimisation. =cut sub single { my ($self, $where) = @_; - my $attrs = { %{$self->{attrs}} }; + $self->_resolve; + my $attrs = { %{$self->{_attrs}} }; if ($where) { if (defined $attrs->{where}) { $attrs->{where} = { @@ -438,8 +401,9 @@ sub single { $attrs->{where} = $where; } } + my @data = $self->result_source->storage->select_single( - $self->{from}, $attrs->{select}, + $attrs->{from}, $attrs->{select}, $attrs->{where},$attrs); return (@data ? $self->_construct_object(@data) : ()); } @@ -564,27 +528,100 @@ sub next { @{delete $self->{stashed_row}} : $self->cursor->next ); -# warn Dumper(\@row); use Data::Dumper; return unless (@row); return $self->_construct_object(@row); } +# XXX - this is essentially just the old new(). rewrite / tidy up? +sub _resolve { + my $self = shift; + + return if(exists $self->{_attrs}); #return if _resolve has already been called + + 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 + my $record_filter = delete $attrs->{record_filter} if (defined $attrs->{record_filter}); + $attrs = Storable::dclone($attrs || {}); # { %{ $attrs || {} } }; + my $alias = $attrs->{alias}; + + $attrs->{columns} ||= delete $attrs->{cols} if $attrs->{cols}; + delete $attrs->{as} if $attrs->{columns}; + $attrs->{columns} ||= [ $self->{result_source}->columns ] unless $attrs->{select}; + my $select_alias = ($self->{_parent_rs}) ? $self->{attrs}->{_live_join} : $alias; + $attrs->{select} = [ + map { m/\./ ? $_ : "${select_alias}.$_" } @{delete $attrs->{columns}} + ] if $attrs->{columns}; + $attrs->{as} ||= [ + map { m/^\Q$alias.\E(.+)$/ ? $1 : $_ } @{$attrs->{select}} + ]; + if (my $include = delete $attrs->{include_columns}) { + push(@{$attrs->{select}}, @$include); + push(@{$attrs->{as}}, map { m/([^.]+)$/; $1; } @$include); + } + #use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/}); + + $attrs->{from} ||= [ { $alias => $source->from } ]; + $attrs->{seen_join} ||= {}; + my %seen; + if (my $join = delete $attrs->{join}) { + foreach my $j (ref $join eq 'ARRAY' ? @$join : ($join)) { + if (ref $j eq 'HASH') { + $seen{$_} = 1 foreach keys %$j; + } else { + $seen{$j} = 1; + } + } + + push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join})); + } + + $attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct}; + $attrs->{order_by} = [ $attrs->{order_by} ] if + $attrs->{order_by} and !ref($attrs->{order_by}); + $attrs->{order_by} ||= []; + + my $collapse = $attrs->{collapse} || {}; + if (my $prefetch = delete $attrs->{prefetch}) { + my @pre_order; + foreach my $p (ref $prefetch eq 'ARRAY' ? @$prefetch : ($prefetch)) { + if ( ref $p eq 'HASH' ) { + foreach my $key (keys %$p) { + push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias})) + unless $seen{$key}; + } + } else { + push(@{$attrs->{from}}, $source->resolve_join($p, $attrs->{alias})) + unless $seen{$p}; + } + my @prefetch = $source->resolve_prefetch( + $p, $attrs->{alias}, {}, \@pre_order, $collapse); + push(@{$attrs->{select}}, map { $_->[0] } @prefetch); + push(@{$attrs->{as}}, map { $_->[1] } @prefetch); + } + push(@{$attrs->{order_by}}, @pre_order); + } + $attrs->{collapse} = $collapse; + $attrs->{record_filter} = $record_filter if ($record_filter); + $self->{_attrs} = $attrs; +} + sub _construct_object { my ($self, @row) = @_; - my @as = @{ $self->{attrs}{as} }; - + my @as = @{ $self->{_attrs}{as} }; + my $info = $self->_collapse_result(\@as, \@row); - - my $new = $self->result_class->inflate_result($self->result_source, @$info); - - $new = $self->{attrs}{record_filter}->($new) - if exists $self->{attrs}{record_filter}; + my $new = $self->result_class->inflate_result($self->result_source, @$info, $self->{_parent_rs}); + $new = $self->{_attrs}{record_filter}->($new) + if exists $self->{_attrs}{record_filter}; return $new; } sub _collapse_result { my ($self, $as, $row, $prefix) = @_; + my $live_join = $self->{attrs}->{_live_join} ||=""; my %const; my @copy = @$row; @@ -604,7 +641,7 @@ sub _collapse_result { my $info = [ {}, {} ]; foreach my $key (keys %const) { - if (length $key) { + if (length $key && $key ne $live_join) { my $target = $info; my @parts = split(/\./, $key); foreach my $p (@parts) { @@ -620,9 +657,9 @@ sub _collapse_result { if (defined $prefix) { @collapse = map { m/^\Q${prefix}.\E(.+)$/ ? ($1) : () - } keys %{$self->{collapse}} + } keys %{$self->{_attrs}->{collapse}} } else { - @collapse = keys %{$self->{collapse}}; + @collapse = keys %{$self->{_attrs}->{collapse}}; }; if (@collapse) { @@ -632,7 +669,7 @@ sub _collapse_result { $target = $target->[1]->{$p} ||= []; } my $c_prefix = (defined($prefix) ? "${prefix}.${c}" : $c); - my @co_key = @{$self->{collapse}{$c_prefix}}; + my @co_key = @{$self->{_attrs}->{collapse}{$c_prefix}}; my %co_check = map { ($_, $target->[0]->{$_}); } @co_key; my $tree = $self->_collapse_result($as, $row, $c_prefix); my (@final, @raw); @@ -644,11 +681,9 @@ sub _collapse_result { last unless (@raw = $self->cursor->next); $row = $self->{stashed_row} = \@raw; $tree = $self->_collapse_result($as, $row, $c_prefix); - #warn Data::Dumper::Dumper($tree, $row); } @$target = @final; } - return $info; } @@ -707,7 +742,9 @@ sub count { sub _count { # Separated out so pager can get the full count my $self = shift; my $select = { count => '*' }; - my $attrs = { %{ $self->{attrs} } }; + + $self->_resolve; + my $attrs = { %{ $self->{_attrs} } }; if (my $group_by = delete $attrs->{group_by}) { delete $attrs->{having}; my @distinct = (ref $group_by ? @$group_by : ($group_by)); @@ -731,7 +768,7 @@ sub _count { # Separated out so pager can get the full count # offset, order by and page are not needed to count. record_filter is cdbi delete $attrs->{$_} for qw/rows offset order_by page pager record_filter/; - + my ($count) = (ref $self)->new($self->result_source, $attrs)->cursor->next; return $count; } @@ -774,12 +811,14 @@ sub all { my @obj; - if (keys %{$self->{collapse}}) { + # XXX used to be 'if (keys %{$self->{collapse}})' + # XXX replaced by this as it seemed to do roughly the same thing + # XXX could be bad as never really understood exactly what collapse did + if ($self->{attrs}->{prefetch}) { # Using $self->cursor->all is really just an optimisation. # If we're collapsing has_many prefetches it probably makes # very little difference, and this is cleaner than hacking # _construct_object to survive the approach - $self->cursor->reset; my @row = $self->cursor->next; while (@row) { push(@obj, $self->_construct_object(@row)); @@ -811,6 +850,8 @@ Resets the resultset's cursor, so you can iterate through the elements again. sub reset { my ($self) = @_; + delete $self->{_attrs} if (exists $self->{_attrs}); + $self->{all_cache_position} = 0; $self->cursor->reset; return $self; @@ -1079,6 +1120,32 @@ sub new_result { return $obj; } +=head2 find_or_new + +=over 4 + +=item Arguments: \%vals, \%attrs? + +=item Return Value: $object + +=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 +until you call L on it. + +If you want objects to be saved immediately, use L instead. + +=cut + +sub find_or_new { + my $self = shift; + my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {}); + my $hash = ref $_[0] eq 'HASH' ? shift : {@_}; + my $exists = $self->find($hash, $attrs); + return defined $exists ? $exists : $self->new_result($hash); +} + =head2 create =over 4 @@ -1135,7 +1202,8 @@ constraint. For example: { key => 'artist_title' } ); -See also L and L. +See also L and L. For information on how to declare +unique constraints, see L. =cut @@ -1182,7 +1250,8 @@ source, including the primary key. If the C is specified as C, it searches only on the primary key. -See also L and L. +See also L and L. For information on how to declare +unique constraints, see L. =cut @@ -1285,28 +1354,28 @@ Returns a related resultset for the supplied relationship name. sub related_resultset { my ( $self, $rel ) = @_; + $self->{related_resultsets} ||= {}; return $self->{related_resultsets}{$rel} ||= do { - #warn "fetching related resultset for rel '$rel'"; + #warn "fetching related resultset for rel '$rel' " . $self->result_source->{name}; my $rel_obj = $self->result_source->relationship_info($rel); $self->throw_exception( "search_related: result source '" . $self->result_source->name . "' has no such relationship ${rel}") unless $rel_obj; #die Dumper $self->{attrs}; - my $rs = $self->search(undef, { join => $rel }); - my $alias = defined $rs->{attrs}{seen_join}{$rel} - && $rs->{attrs}{seen_join}{$rel} > 1 - ? join('_', $rel, $rs->{attrs}{seen_join}{$rel}) - : $rel; - - $self->result_source->schema->resultset($rel_obj->{class} + my $rs = $self->result_source->schema->resultset($rel_obj->{class} )->search( undef, - { %{$rs->{attrs}}, - alias => $alias, + { %{$self->{attrs}}, select => undef, - as => undef } + as => undef, + join => $rel, + _live_join => $rel } ); + + # keep reference of the original resultset + $rs->{_parent_rs} = $self->result_source; + return $rs; }; }