package MyApp::Schema::Artist;
use base qw/DBIx::Class/;
+ __PACKAGE__->load_components(qw/Core/);
__PACKAGE__->table('artist');
__PACKAGE__->add_columns(qw/artistid name/);
__PACKAGE__->set_primary_key('artistid');
package MyApp::Schema::CD;
use base qw/DBIx::Class/;
- __PACKAGE__->table('artist');
+ __PACKAGE__->load_components(qw/Core/);
+ __PACKAGE__->table('cd');
__PACKAGE__->add_columns(qw/cdid artist title year/);
__PACKAGE__->set_primary_key('cdid');
__PACKAGE__->belongs_to(artist => 'MyApp::Schema::Artist');
=head1 METHODS
-=head2 new($source, \%$attrs)
+=head2 new
+
+=head3 Arguments: ($source, \%$attrs)
The resultset constructor. Takes a source object (usually a
L<DBIx::Class::ResultSourceProxy::Table>) and an attribute hash (see L</ATRRIBUTES>
}
#use Data::Dumper; warn Dumper(@{$attrs}{qw/select as/});
$attrs->{from} ||= [ { $alias => $source->from } ];
+ $attrs->{seen_join} ||= {};
if (my $join = delete $attrs->{join}) {
foreach my $j (ref $join eq 'ARRAY'
? (@{$join}) : ($join)) {
$seen{$j} = 1;
}
}
- push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}));
+ push(@{$attrs->{from}}, $source->resolve_join($join, $attrs->{alias}, $attrs->{seen_join}));
}
$attrs->{group_by} ||= $attrs->{select} if delete $attrs->{distinct};
my $self = shift;
#use Data::Dumper;warn Dumper(@_);
+ my $rs;
+ if( @_ ) {
+
+ my $attrs = { %{$self->{attrs}} };
+ if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+ $attrs = { %$attrs, %{ pop(@_) } };
+ }
- my $attrs = { %{$self->{attrs}} };
- if (@_ > 1 && ref $_[$#_] eq 'HASH') {
- $attrs = { %$attrs, %{ pop(@_) } };
- }
-
- my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
- if (defined $where) {
- $where = (defined $attrs->{where}
+ my $where = (@_ ? ((@_ == 1 || ref $_[0] eq "HASH") ? shift : {@_}) : undef());
+ if (defined $where) {
+ $where = (defined $attrs->{where}
? { '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, $attrs->{where} ] }
: $where);
- $attrs->{where} = $where;
- }
-
- my $rs = (ref $self)->new($self->result_source, $attrs);
+ $attrs->{where} = $where;
+ }
+ $rs = (ref $self)->new($self->result_source, $attrs);
+ }
+ else {
+ $rs = $self;
+ $rs->reset();
+ }
return (wantarray ? $rs->all : $rs);
}
return $self->search(\$cond, $attrs);
}
-=head2 find(@colvalues), find(\%cols, \%attrs?)
+=head2 find
+
+=head3 Arguments: (@colvalues) | (\%cols, \%attrs?)
Finds a row based on its primary key or unique constraint. For example:
$query->{$self->{attrs}{alias}.'.'.$_} = delete $query->{$_};
}
#warn Dumper($query);
- return $self->search($query,$attrs)->next;
+ return (keys %$attrs
+ ? $self->search($query,$attrs)->single
+ : $self->single($query));
}
=head2 search_related
=cut
sub search_related {
- my ($self, $rel, @rest) = @_;
- my $rel_obj = $self->result_source->relationship_info($rel);
- $self->throw_exception(
- "No such relationship ${rel} in search_related")
- unless $rel_obj;
- my $rs = $self->search(undef, { join => $rel });
- return $self->result_source->schema->resultset($rel_obj->{class}
- )->search( undef,
- { %{$rs->{attrs}},
- alias => $rel,
- select => undef(),
- as => undef() }
- )->search(@rest);
+ return shift->related_resultset(shift)->search(@_);
}
=head2 cursor
$attrs->{where},$attrs);
}
+=head2 single
+
+Inflates the first result without creating a cursor
+
+=cut
+
+sub single {
+ my ($self, $extra) = @_;
+ my ($attrs) = $self->{attrs};
+ $attrs = { %$attrs };
+ if ($extra) {
+ if (defined $attrs->{where}) {
+ $attrs->{where} = {
+ '-and'
+ => [ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
+ delete $attrs->{where}, $extra ]
+ };
+ } else {
+ $attrs->{where} = $extra;
+ }
+ }
+ my @data = $self->result_source->storage->select_single(
+ $self->{from}, $attrs->{select},
+ $attrs->{where},$attrs);
+ return (@data ? $self->_construct_object(@data) : ());
+}
+
+
=head2 search_like
Perform a search, but use C<LIKE> instead of equality as the condition. Note
return $class->search($query, { %$attrs });
}
-=head2 slice($first, $last)
+=head2 slice
+
+=head3 Arguments: ($first, $last)
Returns a subset of elements from the resultset.
sub next {
my ($self) = @_;
+ my $cache = $self->get_cache;
+ if( @$cache ) {
+ $self->{all_cache_position} ||= 0;
+ my $obj = $cache->[$self->{all_cache_position}];
+ $self->{all_cache_position}++;
+ return $obj;
+ }
my @row = $self->cursor->next;
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
sub _construct_object {
my ($self, @row) = @_;
+ my @row_orig = @row; # copy @row for key comparison later, because @row will change
my @as = @{ $self->{attrs}{as} };
+#use Data::Dumper; warn Dumper \@as;
#warn "@cols -> @row";
my $info = [ {}, {} ];
foreach my $as (@as) {
+ my $rs = $self;
my $target = $info;
my @parts = split(/\./, $as);
my $col = pop(@parts);
foreach my $p (@parts) {
$target = $target->[1]->{$p} ||= [];
+
+ $rs = $rs->related_resultset($p) if $rs->{attrs}->{cache};
}
- $target->[0]->{$col} = shift @row;
+
+ $target->[0]->{$col} = shift @row
+ if ref($target->[0]) ne 'ARRAY'; # arrayref is pre-inflated objects, do not overwrite
}
#use Data::Dumper; warn Dumper(\@as, $info);
my $new = $self->result_source->result_class->inflate_result(
$self->result_source, @$info);
$new = $self->{attrs}{record_filter}->($new)
if exists $self->{attrs}{record_filter};
+
+ if( $self->{attrs}->{cache} ) {
+ while( my( $rel, $rs ) = each( %{$self->{related_resultsets}} ) ) {
+ $rs->all;
+ #warn "$rel:", @{$rs->get_cache};
+ }
+ $self->build_rr( $self, $new );
+ }
+
return $new;
}
+
+sub build_rr {
+ # build related resultsets for supplied object
+ my ( $self, $context, $obj ) = @_;
+
+ my $re = qr/^\w+\./;
+ while( my ($rel, $rs) = each( %{$context->{related_resultsets}} ) ) {
+ #warn "context:", $context->result_source->name, ", rel:$rel, rs:", $rs->result_source->name;
+ my @objs = ();
+ my $map = {};
+ my $cond = $context->result_source->relationship_info($rel)->{cond};
+ keys %$cond;
+ while( my( $rel_key, $pk ) = each(%$cond) ) {
+ $rel_key =~ s/$re//;
+ $pk =~ s/$re//;
+ $map->{$rel_key} = $pk;
+ }
+
+ $rs->reset();
+ while( my $rel_obj = $rs->next ) {
+ while( my( $rel_key, $pk ) = each(%$map) ) {
+ if( $rel_obj->get_column($rel_key) eq $obj->get_column($pk) ) {
+ push @objs, $rel_obj;
+ }
+ }
+ }
+
+ my $rel_rs = $obj->related_resultset($rel);
+ $rel_rs->{attrs}->{cache} = 1;
+ $rel_rs->set_cache( \@objs );
+
+ while( my $rel_obj = $rel_rs->next ) {
+ $self->build_rr( $rs, $rel_obj );
+ }
+
+ }
+
+}
-=head2 result_source
+=head2 result_source
Returns a reference to the result source for this recordset.
my $self = shift;
return $self->search(@_)->count if @_ && defined $_[0];
unless (defined $self->{count}) {
+ return scalar @{ $self->get_cache }
+ if @{ $self->get_cache };
my $group_by;
my $select = { 'count' => '*' };
if( $group_by = delete $self->{attrs}{group_by} ) {
- my @distinct = @$group_by;
+ my @distinct = (ref $group_by ? @$group_by : ($group_by));
# todo: try CONCAT for multi-column pk
my @pk = $self->result_source->primary_columns;
if( scalar(@pk) == 1 ) {
my $pk = shift(@pk);
my $alias = $self->{attrs}{alias};
my $re = qr/^($alias\.)?$pk$/;
- foreach my $column ( @$group_by ) {
+ foreach my $column ( @distinct) {
if( $column =~ $re ) {
@distinct = ( $column );
last;
sub all {
my ($self) = @_;
+ return @{ $self->get_cache }
+ if @{ $self->get_cache };
+ if( $self->{attrs}->{cache} ) {
+ my @obj = map { $self->_construct_object(@$_); }
+ $self->cursor->all;
+ $self->set_cache( \@obj );
+ return @{ $self->get_cache };
+ }
return map { $self->_construct_object(@$_); }
$self->cursor->all;
}
sub reset {
my ($self) = @_;
+ $self->{all_cache_position} = 0;
$self->cursor->reset;
return $self;
}
return $_[0]->reset->next;
}
-=head2 update(\%values)
+=head2 update
+
+=head3 Arguments: (\%values)
Sets the specified columns in the resultset to the supplied values.
$self->result_source->from, $values, $self->{cond});
}
-=head2 update_all(\%values)
+=head2 update_all
+
+=head3 Arguments: (\%values)
Fetches all objects and updates them one at a time. Note that C<update_all>
will run cascade triggers while L</update> will not.
sub delete {
my ($self) = @_;
- $self->result_source->storage->delete($self->result_source->from, $self->{cond});
+ my $del = {};
+ $self->throw_exception("Can't delete on resultset with condition unless hash or array")
+ unless (ref($self->{cond}) eq 'HASH' || ref($self->{cond}) eq 'ARRAY');
+ if (ref $self->{cond} eq 'ARRAY') {
+ $del = [ map { my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^\.]+)$/;
+ $hash{$1} = $_->{$key};
+ }; \%hash; } @{$self->{cond}} ];
+ } elsif ((keys %{$self->{cond}})[0] eq '-and') {
+ $del->{-and} = [ map { my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^\.]+)$/;
+ $hash{$1} = $_->{$key};
+ }; \%hash; } @{$self->{cond}{-and}} ];
+ } else {
+ foreach my $key (keys %{$self->{cond}}) {
+ $key =~ /([^\.]+)$/;
+ $del->{$1} = $self->{cond}{$key};
+ }
+ }
+ $self->result_source->storage->delete($self->result_source->from, $del);
return 1;
}
$self->{count}, $attrs->{rows}, $self->{page});
}
-=head2 page($page_num)
+=head2 page
+
+=head3 Arguments: ($page_num)
Returns a new resultset for the specified page.
return (ref $self)->new($self->result_source, $attrs);
}
-=head2 new_result(\%vals)
+=head2 new_result
+
+=head3 Arguments: (\%vals)
Creates a result in the resultset's result class.
$obj;
}
-=head2 create(\%vals)
+=head2 create
+
+=head3 Arguments: (\%vals)
Inserts a record into the resultset and returns the object.
return $self->new_result($attrs)->insert;
}
-=head2 find_or_create(\%vals, \%attrs?)
+=head2 find_or_create
+
+=head3 Arguments: (\%vals, \%attrs?)
$class->find_or_create({ key => $val, ... });
return $row;
}
+=head2 get_cache
+
+Gets the contents of the cache for the resultset.
+
+=cut
+
+sub get_cache {
+ my $self = shift;
+ return $self->{all_cache} || [];
+}
+
+=head2 set_cache
+
+Sets the contents of the cache for the resultset. Expects an arrayref of objects of the same class as those produced by the resultset.
+
+=cut
+
+sub set_cache {
+ my ( $self, $data ) = @_;
+ $self->throw_exception("set_cache requires an arrayref")
+ if ref $data ne 'ARRAY';
+ my $result_class = $self->result_source->result_class;
+ foreach( @$data ) {
+ $self->throw_exception("cannot cache object of type '$_', expected '$result_class'")
+ if ref $_ ne $result_class;
+ }
+ $self->{all_cache} = $data;
+}
+
+=head2 clear_cache
+
+Clears the cache for the resultset.
+
+=cut
+
+sub clear_cache {
+ my $self = shift;
+ $self->set_cache([]);
+}
+
+=head2 related_resultset
+
+Returns a related resultset for the supplied relationship name.
+
+ $rs = $rs->related_resultset('foo');
+
+=cut
+
+sub related_resultset {
+ my ( $self, $rel, @rest ) = @_;
+ $self->{related_resultsets} ||= {};
+ my $resultsets = $self->{related_resultsets};
+ if( !exists $resultsets->{$rel} ) {
+ #warn "fetching related resultset for rel '$rel'";
+ 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;
+ if( $self->{attrs}->{cache} ) {
+ $rs = $self->search(undef);
+ }
+ else {
+ $rs = $self->search(undef, { join => $rel });
+ }
+ #use Data::Dumper; die Dumper $rs->{attrs};#$rs = $self->search( undef );
+ #use Data::Dumper; warn Dumper $self->{attrs}, Dumper $rs->{attrs};
+ my $alias = (defined $rs->{attrs}{seen_join}{$rel}
+ && $rs->{attrs}{seen_join}{$rel} > 1
+ ? join('_', $rel, $rs->{attrs}{seen_join}{$rel})
+ : $rel);
+ $resultsets->{$rel} =
+ $self->result_source->schema->resultset($rel_obj->{class}
+ )->search( undef,
+ { %{$rs->{attrs}},
+ alias => $alias,
+ select => undef(),
+ as => undef() }
+ )->search(@rest);
+ }
+ return $resultsets->{$rel};
+}
+
=head2 throw_exception
See Schema's throw_exception
Which column(s) to order the results by. This is currently passed through
directly to SQL, so you can give e.g. C<foo DESC> for a descending order.
-=head2 cols (arrayref)
+=head2 cols
+
+=head3 Arguments: (arrayref)
Shortcut to request a particular set of columns to be retrieved. Adds
C<me.> onto the start of any column without a C<.> in it and sets C<select>
from that, then auto-populates C<as> from C<select> as normal.
-=head2 include_columns (arrayref)
+=head2 include_columns
+
+=head3 Arguments: (arrayref)
Shortcut to include additional columns in the returned results - for example
would add a 'name' column to the information passed to object inflation
-=head2 select (arrayref)
+=head2 select
+
+=head3 Arguments: (arrayref)
Indicates which columns should be selected from the storage. You can use
column names, or in the case of RDBMS back ends, function or stored procedure
attribute, the column names returned are storage-dependent. E.g. MySQL would
return a column named C<count(column_to_count)> in the above example.
-=head2 as (arrayref)
+=head2 as
+
+=head3 Arguments: (arrayref)
Indicates column names for object inflation. This is used in conjunction with
C<select>, usually when C<select> contains one or more function or stored
If you want to fetch related objects from other tables as well, see C<prefetch>
below.
-=head2 prefetch arrayref/hashref
+=head2 prefetch
+
+=head3 Arguments: arrayref/hashref
Contains one or more relationships that should be fetched along with the main
query (when they are accessed afterwards they will have already been
C<has_one> (or if you're using C<add_relationship>, any relationship declared
with an accessor type of 'single' or 'filter').
-=head2 from (arrayref)
+=head2 from
+
+=head3 Arguments: (arrayref)
The C<from> attribute gives you manual control over the C<FROM> clause of SQL
statements generated by L<DBIx::Class>, allowing you to express custom C<JOIN>
Can also be used to simulate an SQL C<LIMIT>.
-=head2 group_by (arrayref)
+=head2 group_by
+
+=head3 Arguments: (arrayref)
A arrayref of columns to group by. Can include columns of joined tables.
projects / dbsrgits/DBIx-Class.git / blobdiff