use Storable;
use Scalar::Util qw/weaken/;
+use DBIx::Class::ResultSetColumn;
use base qw/DBIx::Class/;
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
=head1 METHODS
-=head2 new
+=head2 new
=over 4
my ($self, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @cols = $self->result_source->primary_columns;
+ 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;
+
+ my @constraint_names = keys %unique_constraints;
if (exists $attrs->{key}) {
- my %uniq = $self->result_source->unique_constraints;
$self->throw_exception(
"Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
- ) unless exists $uniq{$attrs->{key}};
- @cols = @{ $uniq{$attrs->{key}} };
- }
- #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
- $self->throw_exception(
- "Can't find unless a primary key or unique constraint is defined"
- ) unless @cols;
-
- my $query;
- if (ref $vals[0] eq 'HASH') {
- $query = { %{$vals[0]} };
- } elsif (@cols == @vals) {
- $query = {};
- @{$query}{@cols} = @vals;
- } else {
- $query = {@vals};
+ ) unless exists $unique_constraints{$attrs->{key}};
+
+ @constraint_names = ($attrs->{key});
}
- foreach my $key (grep { ! m/\./ } keys %$query) {
- $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
+
+ my @unique_hashes;
+ foreach my $name (@constraint_names) {
+ my @unique_cols = @{ $unique_constraints{$name} };
+ my %unique_hash;
+ if (ref $vals[0] eq 'HASH') {
+ %unique_hash =
+ map { $_ => $vals[0]->{$_} }
+ grep { exists $vals[0]->{$_} }
+ @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;
+ }
+
+ foreach my $key (grep { ! m/\./ } keys %unique_hash) {
+ $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key};
+ }
+
+ #use Data::Dumper; warn Dumper \@vals, \@unique_cols, \%unique_hash;
+ push @unique_hashes, \%unique_hash if %unique_hash;
}
- #warn Dumper($query);
-
+
+ # Handle cases where the ResultSet already defines the query
+ my $query = @unique_hashes ? \@unique_hashes : undef;
+
if (keys %$attrs) {
- my $rs = $self->search($query,$attrs);
- return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
- } else {
- return keys %{$self->{collapse}} ?
- $self->search($query)->next :
- $self->single($query);
+ my $rs = $self->search($query, $attrs);
+ return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+ }
+ else {
+ return keys %{$self->{collapse}}
+ ? $self->search($query)->next
+ : $self->single($query);
}
}
if ($where) {
if (defined $attrs->{where}) {
$attrs->{where} = {
- '-and' =>
+ '-and' =>
[ map { ref $_ eq 'ARRAY' ? [ -or => $_ ] : $_ }
$where, delete $attrs->{where} ]
};
return (@data ? $self->_construct_object(@data) : ());
}
+=head2 get_column
+
+=over 4
+
+=item Arguments: $cond?
+
+=item Return Value: $resultsetcolumn
+
+=back
+
+ my $max_length = $rs->get_column('length')->max;
+
+Returns a ResultSetColumn instance for $column based on $self
+
+=cut
+
+sub get_column {
+ my ($self, $column) = @_;
+
+ my $new = DBIx::Class::ResultSetColumn->new($self, $column);
+ return $new;
+}
=head2 search_like
sub slice {
my ($self, $min, $max) = @_;
- my $attrs = { %{ $self->{attrs} || {} } };
- $attrs->{offset} ||= 0;
+ my $attrs = {}; # = { %{ $self->{attrs} || {} } };
+ $attrs->{offset} = $self->{attrs}{offset} || 0;
$attrs->{offset} += $min;
$attrs->{rows} = ($max ? ($max - $min + 1) : 1);
- my $slice = (ref $self)->new($self->result_source, $attrs);
- return (wantarray ? $slice->all : $slice);
+ return $self->search(undef(), $attrs);
+ #my $slice = (ref $self)->new($self->result_source, $attrs);
+ #return (wantarray ? $slice->all : $slice);
}
=head2 next
print $cd->title;
}
+Note that you need to store the resultset object, and call C<next> on it.
+Calling C<< resultset('Table')->next >> repeatedly will always return the
+first record from the resultset.
+
=cut
sub next {
return ($self->all)[0];
}
my @row = (exists $self->{stashed_row} ?
- @{delete $self->{stashed_row}} :
- $self->cursor->next
+ @{delete $self->{stashed_row}} :
+ $self->cursor->next
);
# warn Dumper(\@row); use Data::Dumper;
return unless (@row);
my @collapse;
if (defined $prefix) {
@collapse = map {
- m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
+ m/^\Q${prefix}.\E(.+)$/ ? ($1) : ()
} keys %{$self->{collapse}}
} else {
@collapse = keys %{$self->{collapse}};
my (@final, @raw);
while ( !(grep {
!defined($tree->[0]->{$_}) ||
- $co_check{$_} ne $tree->[0]->{$_}
+ $co_check{$_} ne $tree->[0]->{$_}
} @co_key) ) {
push(@final, $tree);
last unless (@raw = $self->cursor->next);
@distinct = ($column);
last;
}
- }
+ }
}
$select = { count => { distinct => \@distinct } };
return $_[0]->reset->next;
}
+# _cond_for_update_delete
+#
+# update/delete require the condition to be modified to handle
+# the differing SQL syntax available. This transforms the $self->{cond}
+# appropriately, returning the new condition.
+
+sub _cond_for_update_delete {
+ my ($self) = @_;
+ my $cond = {};
+
+ if (!ref($self->{cond})) {
+ # No-op. No condition, we're updating/deleting everything
+ }
+ elsif (ref $self->{cond} eq 'ARRAY') {
+ $cond = [
+ map {
+ my %hash;
+ foreach my $key (keys %{$_}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $_->{$key};
+ }
+ \%hash;
+ } @{$self->{cond}}
+ ];
+ }
+ elsif (ref $self->{cond} eq 'HASH') {
+ if ((keys %{$self->{cond}})[0] eq '-and') {
+ $cond->{-and} = [];
+
+ my @cond = @{$self->{cond}{-and}};
+ for (my $i = 0; $i < @cond - 1; $i++) {
+ my $entry = $cond[$i];
+
+ my %hash;
+ if (ref $entry eq 'HASH') {
+ foreach my $key (keys %{$entry}) {
+ $key =~ /([^.]+)$/;
+ $hash{$1} = $entry->{$key};
+ }
+ }
+ else {
+ $entry =~ /([^.]+)$/;
+ $hash{$entry} = $cond[++$i];
+ }
+
+ push @{$cond->{-and}}, \%hash;
+ }
+ }
+ else {
+ foreach my $key (keys %{$self->{cond}}) {
+ $key =~ /([^.]+)$/;
+ $cond->{$1} = $self->{cond}{$key};
+ }
+ }
+ }
+ else {
+ $self->throw_exception(
+ "Can't update/delete on resultset with condition unless hash or array"
+ );
+ }
+
+ return $cond;
+}
+
+
=head2 update
=over 4
my ($self, $values) = @_;
$self->throw_exception("Values for update must be a hash")
unless ref $values eq 'HASH';
+
+ my $cond = $self->_cond_for_update_delete;
+
return $self->result_source->storage->update(
- $self->result_source->from, $values, $self->{cond}
+ $self->result_source->from, $values, $cond
);
}
my ($self) = @_;
my $del = {};
- if (!ref($self->{cond})) {
-
- # No-op. No condition, we're deleting everything
-
- } elsif (ref $self->{cond} eq 'ARRAY') {
-
- $del = [ map { my %hash;
- foreach my $key (keys %{$_}) {
- $key =~ /([^.]+)$/;
- $hash{$1} = $_->{$key};
- }; \%hash; } @{$self->{cond}} ];
-
- } elsif (ref $self->{cond} eq 'HASH') {
+ my $cond = $self->_cond_for_update_delete;
- if ((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};
- }
- }
-
- } else {
- $self->throw_exception(
- "Can't delete on resultset with condition unless hash or array"
- );
- }
-
- $self->result_source->storage->delete($self->result_source->from, $del);
+ $self->result_source->storage->delete($self->result_source->from, $cond);
return 1;
}
my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
- my %unique_constraints = $self->result_source->unique_constraints;
- my @constraint_names = (exists $attrs->{key}
- ? ($attrs->{key})
- : keys %unique_constraints);
-
- my @unique_hashes;
- foreach my $name (@constraint_names) {
- my @unique_cols = @{ $unique_constraints{$name} };
- my %unique_hash =
- map { $_ => $hash->{$_} }
- grep { exists $hash->{$_} }
- @unique_cols;
-
- push @unique_hashes, \%unique_hash
- if (scalar keys %unique_hash == scalar @unique_cols);
- }
-
- if (@unique_hashes) {
- my $row = $self->single(\@unique_hashes);
- if (defined $row) {
- $row->set_columns($hash);
- $row->update;
- return $row;
- }
+ my $row = $self->find($hash, $attrs);
+ if (defined $row) {
+ $row->set_columns($hash);
+ $row->update;
+ return $row;
}
return $self->create($hash);
=back
-Contains one or more relationships that should be fetched along with the main
+Contains one or more relationships that should be fetched along with the main
query (when they are accessed afterwards they will have already been
"prefetched"). This is useful for when you know you will need the related
objects, because it saves at least one query:
In simple terms, C<from> works as follows:
[
- { <alias> => <table>, -join-type => 'inner|left|right' }
+ { <alias> => <table>, -join_type => 'inner|left|right' }
[] # nested JOIN (optional)
{ <table.column> => <foreign_table.foreign_key> }
]
from => [
{ child => 'person' },
[
- { father => 'person', -join-type => 'inner' },
+ { father => 'person', -join_type => 'inner' },
{ 'father.id' => 'child.father_id' }
],
]
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
... do stuff ...
}
- $rs->first; # without cache, this would issue a query
+ $rs->first; # without cache, this would issue a query
By default, searches are not cached.
projects / dbsrgits/DBIx-Class.git / blobdiff