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;
$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,
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);
}
=cut
+# TODO: needs fixing
sub search_literal {
my ($self, $cond, @vals) = @_;
my $attrs = (ref $vals[$#vals] eq 'HASH' ? { %{ pop(@vals) } } : {});
=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<key> 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<key>
+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(
{
{ key => 'artist_title' }
);
-If no C<key> is specified, it searches on all unique constraints defined on the
-source, including the primary key.
+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>.
+See also L</find_or_create> and L</update_or_create>. For information on how to
+declare unique constraints, see
+L<DBIx::Class::ResultSource/add_unique_constraint>.
=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
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);
}
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</find> 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} = {
$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) : ());
}
@{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;
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) {
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) {
$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);
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;
}
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));
# 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;
}
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));
sub reset {
my ($self) = @_;
+ delete $self->{_attrs} if (exists $self->{_attrs});
+
$self->{all_cache_position} = 0;
$self->cursor->reset;
return $self;
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<DBIx::Class::Row/insert> on it.
+
+If you want objects to be saved immediately, use L</find_or_create> 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
{ key => 'artist_title' }
);
-See also L</find> and L</update_or_create>.
+See also L</find> and L</update_or_create>. For information on how to declare
+unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
=cut
If the C<key> is specified as C<primary>, it searches only on the primary key.
-See also L</find> and L</find_or_create>.
+See also L</find> and L</find_or_create>. For information on how to declare
+unique constraints, see L<DBIx::Class::ResultSource/add_unique_constraint>.
=cut
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;
};
}
projects / dbsrgits/DBIx-Class.git / blobdiff