- added remove_column(s) to ResultSource/ResultSourceProxy
- added add_column alias to ResultSourceProxy
- added source_name to ResultSource
- - load_classes now uses source_name and sets it if necessary
+ - load_classes now uses source_name and sets it if necessary
+ - add update_or_create_related to Relationship::Base
+ - add find_or_new to ResultSet/ResultSetProxy and find_or_new_related
+ to Relationship::Base
+ - add accessors for unique constraint names and coulums to
+ ResultSource/ResultSourceProxy
+ - rework ResultSet::find() to search unique constraints
+ - CDBICompat: modify retrieve to fix column casing when ColumnCase is
+ loaded
+ - CDBICompat: override find_or_create to fix column casing when
+ ColumnCase is loaded
0.06002
- grab $self->dbh once per function in Storage::DBI
return $class->next::method(lc($col));
}
+# _build_query
+#
+# Build a query hash for find, et al. Overrides Retrieve::_build_query.
+
+sub _build_query {
+ my ($self, $query) = @_;
+
+ my %new_query;
+ $new_query{lc $_} = $query->{$_} for keys %$query;
+
+ return \%new_query;
+}
+
sub _mk_group_accessors {
my ($class, $type, $group, @fields) = @_;
#warn join(', ', map { ref $_ ? (@$_) : ($_) } @fields);
use warnings FATAL => 'all';
-sub retrieve {
- die "No args to retrieve" unless @_ > 1;
- shift->find(@_);
+sub retrieve {
+ my $self = shift;
+ die "No args to retrieve" unless @_ > 0;
+
+ my @cols = $self->primary_columns;
+
+ my $query;
+ if (ref $_[0] eq 'HASH') {
+ $query = { %{$_[0]} };
+ }
+ elsif (@_ == @cols) {
+ $query = {};
+ @{$query}{@cols} = @_;
+ }
+ else {
+ $query = {@_};
+ }
+
+ $query = $self->_build_query($query);
+ $self->find($query);
+}
+
+sub find_or_create {
+ my $self = shift;
+ my $query = ref $_[0] eq 'HASH' ? shift : {@_};
+
+ $query = $self->_build_query($query);
+ $self->next::method($query);
+}
+
+# _build_query
+#
+# Build a query hash. Defaults to a no-op; ColumnCase overrides.
+
+sub _build_query {
+ my ($self, $query) = @_;
+
+ return $query;
}
sub retrieve_from_sql {
return $self->search_related($rel)->find(@_);
}
+=head2 find_or_new_related
+
+ my $new_obj = $obj->find_or_new_related('relname', \%col_data);
+
+Find an item of a related class. If none exists, instantiate a new item of the
+related class. The object will not be saved into your storage until you call
+L<DBIx::Class::Row/insert> on it.
+
+=cut
+
+sub find_or_new_related {
+ my $self = shift;
+ return $self->find_related(@_) || $self->new_related(@_);
+}
+
=head2 find_or_create_related
my $new_obj = $obj->find_or_create_related('relname', \%col_data);
Find or create an item of a related class. See
-L<DBIx::Class::ResultSet/"find_or_create"> for details.
+L<DBIx::Class::ResultSet/find_or_create> for details.
=cut
return $self->find_related(@_) || $self->create_related(@_);
}
+=head2 update_or_create_related
+
+ my $updated_item = $obj->update_or_create_related('relname', \%col_data, \%attrs?);
+
+Update or create an item of a related class. See
+L<DBIx::Class::ResultSet/"update_or_create"> for details.
+
+=cut
+
+sub update_or_create_related {
+ my $self = shift;
+ my $rel = shift;
+ return $self->related_resultset($rel)->update_or_create(@_);
+}
+
=head2 set_from_related
$book->set_from_related('author', $author_obj);
=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' }
);
-See also L</find_or_create> and L</update_or_create>.
+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>. 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(@_) : {});
+
+ # 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 @cols = $self->result_source->primary_columns;
- if (exists $attrs->{key}) {
- my %uniq = $self->result_source->unique_constraints;
+ 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 $uniq{$attrs->{key}};
- @cols = @{ $uniq{$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"
+ );
}
- #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
+
+ # 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 @cols;
-
- my $query;
- if (ref $vals[0] eq 'HASH') {
- $query = { %{$vals[0]} };
- } elsif (@cols == @vals) {
- $query = {};
- @{$query}{@cols} = @vals;
- } else {
- $query = {@vals};
- }
- foreach my $key (grep { ! m/\./ } keys %$query) {
- $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
+ ) unless @constraint_names;
+
+ 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);
+
+ # Add the ResultSet's alias
+ foreach my $key (grep { ! m/\./ } keys %$unique_query) {
+ $unique_query->{"$self->{attrs}{alias}.$key"} = delete $unique_query->{$key};
+ }
+
+ push @unique_queries, $unique_query if %$unique_query;
}
- #warn Dumper($query);
-
+
+ # Handle cases where the ResultSet already defines the query
+ 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;
- } 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);
+ }
+}
+
+# _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
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
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
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);
sub find { shift->resultset_instance->find(@_); }
sub create { shift->resultset_instance->create(@_); }
sub find_or_create { shift->resultset_instance->find_or_create(@_); }
+sub find_or_new { shift->resultset_instance->find_or_new(@_); }
sub update_or_create { shift->resultset_instance->update_or_create(@_); }
1;
=head2 add_unique_constraint
Declare a unique constraint on this source. Call once for each unique
-constraint. Unique constraints are used when you call C<find> on a
-L<DBIx::Class::ResultSet>. Only columns in the constraint are searched,
-for example:
+constraint.
# For UNIQUE (column1, column2)
__PACKAGE__->add_unique_constraint(
constraint_name => [ qw/column1 column2/ ],
);
+Unique constraints are used, for example, when you call
+L<DBIx::Class::ResultSet/find>. Only columns in the constraint are searched.
+
=cut
sub add_unique_constraint {
return %{shift->_unique_constraints||{}};
}
+=head2 unique_constraint_names
+
+Returns the list of unique constraint names defined on this source.
+
+=cut
+
+sub unique_constraint_names {
+ my ($self) = @_;
+
+ my %unique_constraints = $self->unique_constraints;
+
+ return keys %unique_constraints;
+}
+
+=head2 unique_constraint_columns
+
+Returns the list of columns that make up the specified unique constraint.
+
+=cut
+
+sub unique_constraint_columns {
+ my ($self, $constraint_name) = @_;
+
+ my %unique_constraints = $self->unique_constraints;
+
+ $self->throw_exception(
+ "Unknown unique constraint $constraint_name on '" . $self->name . "'"
+ ) unless exists $unique_constraints{$constraint_name};
+
+ return @{ $unique_constraints{$constraint_name} };
+}
+
=head2 from
Returns an expression of the source to be supplied to storage to specify
shift->result_source_instance->unique_constraints(@_);
}
+sub unique_constraint_names {
+ shift->result_source_instance->unique_constraint_names(@_);
+}
+
+sub unique_constraint_columns {
+ shift->result_source_instance->unique_constraint_columns(@_);
+}
+
sub add_relationship {
my ($class, $rel, @rest) = @_;
my $source = $class->result_source_instance;
__PACKAGE__->set_primary_key('employee_id');
__PACKAGE__->position_column('position');
+__PACKAGE__->add_unique_constraint(position_group => [ qw/position group_id/ ]);
+
__PACKAGE__->mk_classdata('field_name_for', {
employee_id => 'primary key',
position => 'list position',
sub run_tests {
my $schema = shift;
-plan tests => 51;
+plan tests => 55;
# figure out if we've got a version of sqlite that is older than 3.2.6, in
# which case COUNT(DISTINCT()) doesn't work
is($schema->resultset("Artist")->count, 4, 'count ok');
+# test find_or_new
+{
+ my $existing_obj = $schema->resultset('Artist')->find_or_new({
+ artistid => 4,
+ });
+
+ is($existing_obj->name, 'Man With A Spoon', 'find_or_new: found existing artist');
+ ok($existing_obj->in_storage, 'existing artist is in storage');
+
+ my $new_obj = $schema->resultset('Artist')->find_or_new({
+ artistid => 5,
+ name => 'find_or_new',
+ });
+
+ is($new_obj->name, 'find_or_new', 'find_or_new: instantiated a new artist');
+ ok(! $new_obj->in_storage, 'new artist is not in storage');
+}
+
my $cd = $schema->resultset("CD")->find(1);
my %cols = $cd->get_columns;
use strict;
use warnings;
-plan tests => 25;
+plan tests => 29;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
$artist->delete_related( cds => { title => 'Greatest Hits' });
cmp_ok( $schema->resultset("CD")->search( title => 'Greatest Hits' ), '==', 0, 'delete_related ok' );
+# find_or_new_related with an existing record
+$cd = $artist->find_or_new_related( 'cds', { title => 'Big Flop' } );
+is( $cd->year, 2005, 'find_or_new_related on existing record ok' );
+ok( $cd->in_storage, 'find_or_new_related on existing record: is in_storage' );
+
+# find_or_new_related instantiating a new record
+$cd = $artist->find_or_new_related( 'cds', {
+ title => 'Greatest Hits 2: Louder Than Ever',
+ year => 2007,
+} );
+is( $cd->title, 'Greatest Hits 2: Louder Than Ever', 'find_or_new_related new record ok' );
+ok( ! $cd->in_storage, 'find_or_new_related on a new record: not in_storage' );
+
SKIP: {
skip "relationship checking needs fixing", 1;
# try to add a bogus relationship using the wrong cols
sub run_tests {
my $schema = shift;
-plan tests => 18;
+plan tests => 34;
my $artistid = 1;
my $title = 'UNIQUE Constraint';
is($cd2->title, $cd1->title, 'title is correct');
is($cd2->year, $cd1->year, 'year is correct');
-my $cd3 = $schema->resultset('CD')->update_or_create(
+my $cd3 = $schema->resultset('CD')->find($artistid, $title, { key => 'artist_title' });
+
+is($cd3->get_column('artist'), $cd1->get_column('artist'), 'find by specific key, ordered columns: artist is correct');
+is($cd3->title, $cd1->title, 'title is correct');
+is($cd3->year, $cd1->year, 'year is correct');
+
+my $cd4 = $schema->resultset('CD')->update_or_create(
{
artist => $artistid,
title => $title,
},
);
-ok(! $cd3->is_changed, 'update_or_create without key: row is clean');
-is($cd3->cdid, $cd2->cdid, 'cdid is correct');
-is($cd3->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
-is($cd3->title, $cd2->title, 'title is correct');
-is($cd3->year, 2007, 'updated year is correct');
+ok(! $cd4->is_changed, 'update_or_create without key: row is clean');
+is($cd4->cdid, $cd2->cdid, 'cdid is correct');
+is($cd4->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd4->title, $cd2->title, 'title is correct');
+is($cd4->year, 2007, 'updated year is correct');
-my $cd4 = $schema->resultset('CD')->update_or_create(
+my $cd5 = $schema->resultset('CD')->update_or_create(
{
artist => $artistid,
title => $title,
{ key => 'artist_title' }
);
-ok(! $cd4->is_changed, 'update_or_create by specific key: row is clean');
-is($cd4->cdid, $cd2->cdid, 'cdid is correct');
-is($cd4->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
-is($cd4->title, $cd2->title, 'title is correct');
-is($cd4->year, 2007, 'updated year is correct');
+ok(! $cd5->is_changed, 'update_or_create by specific key: row is clean');
+is($cd5->cdid, $cd2->cdid, 'cdid is correct');
+is($cd5->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd5->title, $cd2->title, 'title is correct');
+is($cd5->year, 2007, 'updated year is correct');
-my $cd5 = $schema->resultset('CD')->update_or_create(
+my $cd6 = $schema->resultset('CD')->update_or_create(
{
cdid => $cd2->cdid,
artist => 1,
{ key => 'primary' }
);
-ok(! $cd5->is_changed, 'update_or_create by PK: row is clean');
-is($cd5->cdid, $cd2->cdid, 'cdid is correct');
-is($cd5->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
-is($cd5->title, $cd2->title, 'title is correct');
-is($cd5->year, 2005, 'updated year is correct');
+ok(! $cd6->is_changed, 'update_or_create by PK: row is clean');
+is($cd6->cdid, $cd2->cdid, 'cdid is correct');
+is($cd6->get_column('artist'), $cd2->get_column('artist'), 'artist is correct');
+is($cd6->title, $cd2->title, 'title is correct');
+is($cd6->year, 2005, 'updated year is correct');
+
+my $cd7 = $schema->resultset('CD')->find_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2010,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd7->cdid, $cd1->cdid, 'find_or_create by specific key: cdid is correct');
+is($cd7->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd7->title, $cd1->title, 'title is correct');
+is($cd7->year, $cd1->year, 'year is correct');
+
+my $artist = $schema->resultset('Artist')->find($artistid);
+my $cd8 = $artist->find_or_create_related('cds',
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2020,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd8->cdid, $cd1->cdid, 'find_or_create related by specific key: cdid is correct');
+is($cd8->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd8->title, $cd1->title, 'title is correct');
+is($cd8->year, $cd1->year, 'year is correct');
+
+my $cd9 = $artist->update_or_create_related('cds',
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2021,
+ },
+ { key => 'artist_title' }
+);
+
+ok(! $cd9->is_changed, 'update_or_create by specific key: row is clean');
+is($cd9->cdid, $cd1->cdid, 'cdid is correct');
+is($cd9->get_column('artist'), $cd1->get_column('artist'), 'artist is correct');
+is($cd9->title, $cd1->title, 'title is correct');
+is($cd9->year, 2021, 'year is correct');
}
projects / dbsrgits/DBIx-Class.git / commitdiff