[Dbix-class] RFC: Round two for UNIQUE constraints
Daniel Westermann-Clark
daniel at acceleration.net
Mon Jan 23 04:08:03 CET 2006
On 2006-01-22 15:45:50 +0000, Matt S Trout wrote:
> I think the constraints should be named, since everything else is.
Take a gander at the attached patch. It lets you name constraints:
__PACKAGE__->add_unique_constraint(artist_title => [ qw/artist title/ ]);
Calling set_primary_key automatically adds a unique constraint named
'primary'.
By default update_or_create operates on all unique constraints for
which values are specified.
Alternatively when you do a find, find_or_create, or update_or_create,
you can specify a key attribute:
my $cd = $schema->resultset('CD')->update_or_create(
{
artist => $artistid,
title => $title,
year => 2007,
},
{ key => 'artist_title' }
);
The changes are tested in 20unique.tl; everything passes here.
--
Daniel Westermann-Clark
-------------- next part --------------
Auto-merging (0, 4415) /local/DBIx-Class to /mirror/bast/branches/DBIx-Class-resultset (base /mirror/bast/branches/DBIx-Class-resultset:4410).
Patching locally against mirror source http://dev.catalyst.perl.org/repos/bast.
A t/run/20unique.tl
A t/helperrels/20unique.t
U t/lib/DBICTest/Schema/CD.pm
U lib/DBIx/Class/ResultSourceInstance.pm
U lib/DBIx/Class/ResultSet.pm
U lib/DBIx/Class/ResultSource.pm
==== Patch <-> level 1
Source: 20164c6d-cd09-0410-925d-b4c4e616b846:/local/DBIx-Class:4415
Target: bd8105ee-0ff8-0310-8827-fb3f25b6796d:/branches/DBIx-Class-resultset:549
(http://dev.catalyst.perl.org/repos/bast)
Log:
r4375 at fortuna: dwc | 2006-01-21 19:38:25 -0500
r4376 at fortuna: dwc | 2006-01-21 20:13:17 -0500
First pass at UNIQUE constraints
r4382 at fortuna: dwc | 2006-01-21 20:58:40 -0500
Create the row directly
r4383 at fortuna: dwc | 2006-01-21 21:18:38 -0500
Add basic test
r4384 at fortuna: dwc | 2006-01-21 21:23:56 -0500
Spacing
r4404 at fortuna: dwc | 2006-01-22 12:43:39 -0500
Spacing
r4405 at fortuna: dwc | 2006-01-22 13:34:22 -0500
- Name unique constraints (primary key is automatically added as 'primary')
- Change update_or_create to take a 'key' attribute; by default it operates on all unique constraints
- Update tests to test named unique constraints
r4412 at fortuna: dwc | 2006-01-22 18:43:13 -0500
Add key attribute to find and find_or_create
r4413 at fortuna: dwc | 2006-01-22 18:44:04 -0500
Fix syntax
r4414 at fortuna: dwc | 2006-01-22 20:44:09 -0500
Add examples of find, find_or_create, and update_or_create
r4415 at fortuna: dwc | 2006-01-22 21:48:57 -0500
Spacing
=== t/run/20unique.tl
==================================================================
--- t/run/20unique.tl (revision 549)
+++ t/run/20unique.tl (patch - level 1)
@@ -0,0 +1,74 @@
+sub run_tests {
+my $schema = shift;
+
+plan tests => 18;
+
+my $artistid = 1;
+my $title = 'UNIQUE Constraint';
+
+my $cd1 = $schema->resultset('CD')->find_or_create({
+ artist => $artistid,
+ title => $title,
+ year => 2005,
+});
+
+my $cd2 = $schema->resultset('CD')->find(
+ {
+ artist => $artistid,
+ title => $title,
+ },
+ { key => 'artist_title' }
+);
+
+is($cd2->get_column('artist'), $cd1->get_column('artist'), 'find by specific key: artist is correct');
+is($cd2->title, $cd1->title, 'title is correct');
+is($cd2->year, $cd1->year, 'year is correct');
+
+my $cd3 = $schema->resultset('CD')->update_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2007,
+ },
+);
+
+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');
+
+my $cd4 = $schema->resultset('CD')->update_or_create(
+ {
+ artist => $artistid,
+ title => $title,
+ year => 2007,
+ },
+ { 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');
+
+my $cd5 = $schema->resultset('CD')->update_or_create(
+ {
+ cdid => $cd2->cdid,
+ artist => 1,
+ title => $cd2->title,
+ year => 2005,
+ },
+ { 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');
+
+}
+
+1;
=== t/helperrels/20unique.t
==================================================================
--- t/helperrels/20unique.t (revision 549)
+++ t/helperrels/20unique.t (patch - level 1)
@@ -0,0 +1,7 @@
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+use DBICTest::HelperRels;
+
+require "t/run/20unique.tl";
+run_tests(DBICTest->schema);
=== t/lib/DBICTest/Schema/CD.pm
==================================================================
--- t/lib/DBICTest/Schema/CD.pm (revision 549)
+++ t/lib/DBICTest/Schema/CD.pm (patch - level 1)
@@ -5,5 +5,6 @@
DBICTest::Schema::CD->table('cd');
DBICTest::Schema::CD->add_columns(qw/cdid artist title year/);
DBICTest::Schema::CD->set_primary_key('cdid');
+DBICTest::Schema::CD->add_unique_constraint(artist_title => [ qw/artist title/ ]);
1;
=== lib/DBIx/Class/ResultSourceInstance.pm
==================================================================
--- lib/DBIx/Class/ResultSourceInstance.pm (revision 549)
+++ lib/DBIx/Class/ResultSourceInstance.pm (patch - level 1)
@@ -35,6 +35,9 @@
sub set_primary_key { shift->result_source_instance->set_primary_key(@_); }
sub primary_columns { shift->result_source_instance->primary_columns(@_); }
+sub add_unique_constraint { shift->result_source_instance->add_unique_constraint(@_); }
+sub unique_constraints { shift->result_source_instance->unique_constraints(@_); }
+
sub add_relationship {
my ($class, $rel, @rest) = @_;
my $source = $class->result_source_instance;
=== lib/DBIx/Class/ResultSet.pm
==================================================================
--- lib/DBIx/Class/ResultSet.pm (revision 549)
+++ lib/DBIx/Class/ResultSet.pm (patch - level 1)
@@ -16,8 +16,8 @@
=head1 SYNOPSIS
-my $rs = MyApp::DB::Class->search(registered => 1);
-my @rows = MyApp::DB::Class->search(foo => 'bar');
+ my $rs = MyApp::DB::Class->search(registered => 1);
+ my @rows = MyApp::DB::Class->search(foo => 'bar');
=head1 DESCRIPTION
@@ -93,12 +93,12 @@
=head2 search
- my @obj = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
- my $new_rs = $rs->search({ foo => 3 });
-
+ my @obj = $rs->search({ foo => 3 }); # "... WHERE foo = 3"
+ my $new_rs = $rs->search({ foo => 3 });
+
If you need to pass in additional attributes but no additional condition,
call it as ->search(undef, \%attrs);
-
+
my @all = $class->search({}, { cols => [qw/foo bar/] }); # "SELECT foo, bar FROM $class_table"
=cut
@@ -128,12 +128,13 @@
return (wantarray ? $rs->all : $rs);
}
-=head2 search_literal
+=head2 search_literal
+
my @obj = $rs->search_literal($literal_where_cond, @bind);
my $new_rs = $rs->search_literal($literal_where_cond, @bind);
Pass a literal chunk of SQL to be added to the conditional part of the
-resultset
+resultset.
=cut
@@ -144,25 +145,57 @@
return $self->search(\$cond, $attrs);
}
-=head2 find(@colvalues), find(\%cols)
+=head2 find(@colvalues), find(\%cols, \%attrs?)
-Finds a row based on its primary key(s).
+Finds a row based on its primary key or unique constraint. For example:
-=cut
+ # In your table class
+ package MyApp::Schema::CD;
+ __PACKAGE__->table('cd');
+ __PACKAGE__->add_columns(qw/cdid artist title year/);
+ __PACKAGE__->set_primary_key('cdid');
+ __PACKAGE__->add_unique_constraint(artist_title => [ qw/artist title/ ]);
+
+ 1;
+
+ # In your application
+ 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:
+
+ my $cd = $schema->resultset('CD')->find_or_create(
+ {
+ artist => 'Massive Attack',
+ title => 'Mezzanine',
+ },
+ { key => 'artist_title' }
+ );
+
+=cut
+
sub find {
my ($self, @vals) = @_;
my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
- my @pk = $self->{source}->primary_columns;
- #use Data::Dumper; warn Dumper($attrs, @vals, @pk);
- $self->{source}->result_class->throw( "Can't find unless primary columns are defined" )
- unless @pk;
+
+ my @cols = $self->{source}->primary_columns;
+ if (exists $attrs->{key}) {
+ my %uniq = $self->{source}->unique_constraints;
+ $self->( "Unknown key " . $attrs->{key} . " on " . $self->name )
+ unless exists $uniq{$attrs->{key}};
+ @cols = @{ $uniq{$attrs->{key}} };
+ }
+ #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
+ $self->{source}->result_class->throw( "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 (@pk == @vals) {
+ } elsif (@cols == @vals) {
$query = {};
- @{$query}{@pk} = @vals;
+ @{$query}{@cols} = @vals;
} else {
$query = {@vals};
}
@@ -211,12 +244,12 @@
$attrs->{where},$attrs);
}
-=head2 search_like
-
-Identical to search except defaults to 'LIKE' instead of '=' in condition
-
-=cut
+=head2 search_like
+Identical to search except defaults to 'LIKE' instead of '=' in condition
+
+=cut
+
sub search_like {
my $class = shift;
my $attrs = { };
@@ -244,7 +277,7 @@
return (wantarray ? $slice->all : $slice);
}
-=head2 next
+=head2 next
Returns the next element in the resultset (undef is there is none).
@@ -435,7 +468,7 @@
=head2 new_result(\%vals)
-Creates a result in the resultset's result class
+Creates a result in the resultset's result class.
=cut
@@ -457,7 +490,7 @@
=head2 create(\%vals)
-Inserts a record into the resultset and returns the object
+Inserts a record into the resultset and returns the object.
Effectively a shortcut for ->new_result(\%vals)->insert
@@ -469,22 +502,122 @@
return $self->new_result($attrs)->insert;
}
-=head2 find_or_create(\%vals)
+=head2 find_or_create(\%vals, \%attrs?)
- $class->find_or_create({ key => $val, ... });
-
+ $class->find_or_create({ key => $val, ... });
+
Searches for a record matching the search condition; if it doesn't find one,
creates one and returns that instead.
-
+
+ # In your table class
+ package MyApp::Schema::CD;
+
+ __PACKAGE__->table('cd');
+ __PACKAGE__->add_columns(qw/cdid artist title year/);
+ __PACKAGE__->set_primary_key('cdid');
+ __PACKAGE__->add_unique_constraint(artist_title => [ qw/artist title/ ]);
+
+ 1;
+
+ # In your application
+ my $cd = $schema->resultset('CD')->find_or_create({
+ cdid => 5,
+ artist => 'Massive Attack',
+ title => 'Mezzanine',
+ year => 2005,
+ });
+
+Also takes an optional C<key> attribute, to search by a specific key or unique
+constraint. For example:
+
+ my $cd = $schema->resultset('CD')->find_or_create(
+ {
+ artist => 'Massive Attack',
+ title => 'Mezzanine',
+ },
+ { key => 'artist_title' }
+ );
+
+See also L</find> and L</update_or_create>.
+
=cut
sub find_or_create {
my $self = shift;
- my $hash = ref $_[0] eq "HASH" ? shift: {@_};
- my $exists = $self->find($hash);
+ 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->create($hash);
}
+=head2 update_or_create
+
+ $class->update_or_create({ key => $val, ... });
+
+First, search for an existing row matching one of the unique constraints
+(including the primary key) on the source of this resultset. If a row is
+found, update it with the other given column values. Otherwise, create a new
+row.
+
+Takes an optional C<key> attribute to search on a specific unique constraint.
+For example:
+
+ # In your application
+ my $cd = $schema->resultset('CD')->update_or_create(
+ {
+ artist => 'Massive Attack',
+ title => 'Mezzanine',
+ year => 1998,
+ },
+ { key => 'artist_title' }
+ );
+
+If no C<key> is specified, it searches on all unique constraints defined on the
+source, including the primary key.
+
+If the C<key> is specified as C<primary>, search only on the primary key.
+
+=cut
+
+sub update_or_create {
+ my $self = shift;
+
+ my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
+ my $hash = ref $_[0] eq "HASH" ? shift : {@_};
+
+ my %unique_constraints = $self->{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);
+ }
+
+ my $row;
+ if (@unique_hashes) {
+ $row = $self->search(\@unique_hashes, { rows => 1 })->first;
+ if ($row) {
+ $row->set_columns($hash);
+ $row->update;
+ }
+ }
+
+ unless ($row) {
+ $row = $self->create($hash);
+ }
+
+ return $row;
+}
+
=head1 ATTRIBUTES
The resultset takes various attributes that modify its behavior.
=== lib/DBIx/Class/ResultSource.pm
==================================================================
--- lib/DBIx/Class/ResultSource.pm (revision 549)
+++ lib/DBIx/Class/ResultSource.pm (patch - level 1)
@@ -11,7 +11,7 @@
__PACKAGE__->load_components(qw/AccessorGroup/);
__PACKAGE__->mk_group_accessors('simple' =>
- qw/_ordered_columns _columns _primaries name resultset_class result_class schema from _relationships/);
+ qw/_ordered_columns _columns _primaries _unique_constraints name resultset_class result_class schema from _relationships/);
=head1 NAME
@@ -131,21 +131,23 @@
my @column_names = $obj->columns;
Returns all column names in the order they were declared to add_columns
-
-=cut
+=cut
+
sub columns {
croak "columns() is a read-only accessor, did you mean add_columns()?" if (@_ > 1);
return @{shift->{_ordered_columns}||[]};
}
-=head2 set_primary_key(@cols)
-
+=head2 set_primary_key(@cols)
+
Defines one or more columns as primary key for this source. Should be
called after C<add_columns>.
-
-=cut
+Additionally, defines a unique constraint named C<primary>.
+
+=cut
+
sub set_primary_key {
my ($self, @cols) = @_;
# check if primary key columns are valid columns
@@ -154,18 +156,53 @@
unless $self->has_column($_);
}
$self->_primaries(\@cols);
+
+ $self->add_unique_constraint(primary => \@cols);
}
-=head2 primary_columns
-
+=head2 primary_columns
+
Read-only accessor which returns the list of primary keys.
-=cut
+=cut
sub primary_columns {
return @{shift->_primaries||[]};
}
+=head2 add_unique_constraint
+
+Declare a unique constraint on this source. Call once for each unique
+constraint.
+
+ # For e.g. UNIQUE (column1, column2)
+ __PACKAGE__->add_unique_constraint(constraint_name => [ qw/column1 column2/ ]);
+
+=cut
+
+sub add_unique_constraint {
+ my ($self, $name, $cols) = @_;
+
+ for (@$cols) {
+ $self->throw("No such column $_ on table ".$self->name)
+ unless $self->has_column($_);
+ }
+
+ my %unique_constraints = $self->unique_constraints;
+ $unique_constraints{$name} = $cols;
+ $self->_unique_constraints(\%unique_constraints);
+}
+
+=head2 unique_constraints
+
+Read-only accessor which returns the list of unique constraints on this source.
+
+=cut
+
+sub unique_constraints {
+ return %{shift->_unique_constraints||{}};
+}
+
=head2 from
Returns an expression of the source to be supplied to storage to specify
More information about the Dbix-class
mailing list