Revision history for DBIx::Class
+ - modified SQLT parser to skip dupe table names
+ - 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
+ - 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
+ 0.06002 2006-04-20 00:42:41
+ - fix set_from_related to accept undef
+ - fix to Dumper-induced hash iteration bug
+ - fix to copy() with non-composed resultsource
- fix to ->search without args to clone rs but maintain cache
- grab $self->dbh once per function in Storage::DBI
- nuke ResultSource caching of ->resultset for consistency reasons
- remove build dependency on version.pm
0.05004 2006-02-13 20:59:00
- - allow specification of related columns via cols attr when primary
+ - allow specification of related columns via cols attr when primary
keys of the related table are not fetched
- fix count for group_by as scalar
- add horrific fix to make Oracle's retarded limit syntax work
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);
"condition for $rel is of type ".
(ref $cond ? ref $cond : 'plain scalar')
) unless ref $cond eq 'HASH';
- my $f_class = $self->result_source->schema->class($rel_obj->{class});
- $self->throw_exception( "Object $f_obj isn't a ".$f_class )
- unless $f_obj->isa($f_class);
+ if (defined $f_obj) {
+ my $f_class = $self->result_source->schema->class($rel_obj->{class});
+ $self->throw_exception( "Object $f_obj isn't a ".$f_class )
+ unless $f_obj->isa($f_class);
+ }
$self->set_columns(
$self->result_source->resolve_condition(
$rel_obj->{cond}, $f_obj, $rel));
schema from _relationships/);
__PACKAGE__->mk_group_accessors('component_class' => qw/resultset_class
- result_class/);
+ result_class source_name/);
=head1 NAME
sub add_columns {
my ($self, @cols) = @_;
$self->_ordered_columns(\@cols) unless $self->_ordered_columns;
-
+
my @added;
my $columns = $self->_columns;
while (my $col = shift @cols) {
return @{$self->{_ordered_columns}||[]};
}
+=head2 remove_columns
+
+ $table->remove_columns(qw/col1 col2 col3/);
+
+Removes columns from the result source.
+
+=head2 remove_column
+
+ $table->remove_column('col');
+
+Convenience alias to remove_columns.
+
+=cut
+
+sub remove_columns {
+ my ($self, @cols) = @_;
+
+ return unless $self->_ordered_columns;
+
+ my $columns = $self->_columns;
+ my @remaining;
+
+ foreach my $col (@{$self->_ordered_columns}) {
+ push @remaining, $col unless grep(/$col/, @cols);
+ }
+
+ foreach (@cols) {
+ undef $columns->{$_};
+ };
+
+ $self->_ordered_columns(\@remaining);
+}
+
+*remove_column = \&remove_columns;
+
=head2 set_primary_key
=over 4
=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
An arrayref containing a list of accessors in the foreign class to proxy in
the main class. If, for example, you do the following:
-
+
CD->might_have(liner_notes => 'LinerNotes', undef, {
proxy => [ qw/notes/ ],
});
-
+
Then, assuming LinerNotes has an accessor named notes, you can do:
my $cd = CD->find(1);
return exists $self->_relationships->{$rel};
}
+=head2 reverse_relationship_info
+
+=over 4
+
+=item Arguments: $relname
+
+=back
+
+Returns an array of hash references of relationship information for
+the other side of the specified relationship name.
+
+=cut
+
+sub reverse_relationship_info {
+ my ($self, $rel) = @_;
+ my $rel_info = $self->relationship_info($rel);
+ my $ret = {};
+
+ return $ret unless ((ref $rel_info->{cond}) eq 'HASH');
+
+ my @cond = keys(%{$rel_info->{cond}});
+ my @refkeys = map {/^\w+\.(\w+)$/} @cond;
+ my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} @cond;
+
+ # Get the related result source for this relationship
+ my $othertable = $self->related_source($rel);
+
+ # Get all the relationships for that source that related to this source
+ # whose foreign column set are our self columns on $rel and whose self
+ # columns are our foreign columns on $rel.
+ my @otherrels = $othertable->relationships();
+ my $otherrelationship;
+ foreach my $otherrel (@otherrels) {
+ my $otherrel_info = $othertable->relationship_info($otherrel);
+
+ my $back = $othertable->related_source($otherrel);
+ next unless $back->name eq $self->name;
+
+ my @othertestconds;
+
+ if (ref $otherrel_info->{cond} eq 'HASH') {
+ @othertestconds = ($otherrel_info->{cond});
+ }
+ elsif (ref $otherrel_info->{cond} eq 'ARRAY') {
+ @othertestconds = @{$otherrel_info->{cond}};
+ }
+ else {
+ next;
+ }
+
+ foreach my $othercond (@othertestconds) {
+ my @other_cond = keys(%$othercond);
+ my @other_refkeys = map {/^\w+\.(\w+)$/} @other_cond;
+ my @other_keys = map {$othercond->{$_} =~ /^\w+\.(\w+)$/} @other_cond;
+ next if (!$self->compare_relationship_keys(\@refkeys, \@other_keys) ||
+ !$self->compare_relationship_keys(\@other_refkeys, \@keys));
+ $ret->{$otherrel} = $otherrel_info;
+ }
+ }
+ return $ret;
+}
+
+=head2 compare_relationship_keys
+
+=over 4
+
+=item Arguments: $keys1, $keys2
+
+=back
+
+Returns true if both sets of keynames are the same, false otherwise.
+
+=cut
+
+sub compare_relationship_keys {
+ my ($self, $keys1, $keys2) = @_;
+
+ # Make sure every keys1 is in keys2
+ my $found;
+ foreach my $key (@$keys1) {
+ $found = 0;
+ foreach my $prim (@$keys2) {
+ if ($prim eq $key) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+
+ # Make sure every key2 is in key1
+ if ($found) {
+ foreach my $prim (@$keys2) {
+ $found = 0;
+ foreach my $key (@$keys1) {
+ if ($prim eq $key) {
+ $found = 1;
+ last;
+ }
+ }
+ last unless $found;
+ }
+ }
+
+ return $found;
+}
+
=head2 resolve_join
=over 4
#warn %$cond;
if (ref $cond eq 'HASH') {
my %ret;
- while (my ($k, $v) = each %{$cond}) {
+ foreach my $k (keys %{$cond}) {
+ my $v = $cond->{$k};
# XXX should probably check these are valid columns
$k =~ s/^foreign\.// ||
$self->throw_exception("Invalid rel cond key ${k}");
#warn "$self $k $for $v";
$ret{$k} = $for->get_column($v);
#warn %ret;
+ } elsif (!defined $for) { # undef, i.e. "no object"
+ $ret{$k} = undef;
} elsif (ref $as) { # reverse object
$ret{$v} = $as->get_column($k);
+ } elsif (!defined $as) { # undef, i.e. "no reverse object"
+ $ret{$v} = undef;
} else {
$ret{"${as}.${k}"} = "${for}.${v}";
}
);
}
+=head2 source_name
+
+=over 4
+
+=item Arguments: $source_name
+
+=back
+
+Set the name of the result source when it is loaded into a schema.
+This is usefull if you want to refer to a result source by a name other than
+its class name.
+
+ package ArchivedBooks;
+ use base qw/DBIx::Class/;
+ __PACKAGE__->table('books_archive');
+ __PACKAGE__->source_name('Books');
+
+ # from your schema...
+ $schema->resultset('Books')->find(1);
+
=head2 throw_exception
See L<DBIx::Class::Schema/"throw_exception">.
if ($attrs) {
$new->throw_exception("attrs must be a hashref")
unless ref($attrs) eq 'HASH';
- while (my ($k, $v) = each %$attrs) {
+ foreach my $k (keys %$attrs) {
$new->throw_exception("No such column $k on $class")
unless $class->has_column($k);
- $new->store_column($k => $v);
+ $new->store_column($k => $attrs->{$k});
}
}
return $new;
sub set_columns {
my ($self,$data) = @_;
- while (my ($col,$val) = each %$data) {
- $self->set_column($col,$val);
+ foreach my $col (keys %$data) {
+ $self->set_column($col,$data->{$col});
}
return $self;
}
if $self->result_source->column_info($col)->{is_auto_increment};
}
my $new = bless { _column_data => $col_data }, ref $self;
+ $new->result_source($self->result_source);
$new->set_columns($changes);
$new->insert;
foreach my $rel ($self->result_source->relationships) {
=head2 is_changed
- my @changed_col_names = $obj->is_changed
+ my @changed_col_names = $obj->is_changed();
+ if ($obj->is_changed()) { ... }
=cut
sub is_changed {
return keys %{shift->{_dirty_columns} || {}};
+}
+
+=head2 is_column_changed
+
+ if ($obj->is_column_changed('col')) { ... }
+
+=cut
+
+sub is_column_changed {
+ my( $self, $col ) = @_;
+ return exists $self->{_dirty_columns}->{$col};
}
=head2 result_source
use strict;
use warnings;
- plan tests => 29;
-plan tests => 26;
++plan tests => 30;
# has_a test
my $cd = $schema->resultset("CD")->find(4);
} );
$track->set_from_related( cd => $cd );
- if ($INC{'DBICTest/HelperRels.pm'}) { # except inflated object
+ if ($INC{'DBICTest/HelperRels.pm'}) { # expect inflated object
is($track->disc->cdid, 4, 'set_from_related ok, including alternative accessor' );
} else {
is( $track->cd, 4, 'set_from_related ok' );
}
+ $track->set_from_related( cd => undef );
+
+ ok( !defined($track->cd), 'set_from_related with undef ok');
+
+
# update_from_related, the same as set_from_related, but it calls update afterwards
$track = $schema->resultset("Track")->create( {
trackid => 2,
$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
projects / dbsrgits/DBIx-Class.git / commitdiff