use strict;
use warnings;
-sub add_relationship {
- my ($class, $rel, @rest) = @_;
- my $ret = $class->next::method($rel => @rest);
- my $rel_obj = $class->relationship_info($rel);
- if (my $acc_type = $rel_obj->{attrs}{accessor}) {
+sub register_relationship {
+ my ($class, $rel, $info) = @_;
+ if (my $acc_type = $info->{attrs}{accessor}) {
$class->add_relationship_accessor($rel => $acc_type);
}
- return $ret;
+ $class->next::method($rel => $info);
}
sub add_relationship_accessor {
=back
+=head2 register_relationship($relname, $rel_info)
+
+Registers a relationship on the class
+
=cut
+sub register_relationship { }
+
=head2 search_related
My::Table->search_related('relname', $cond, $attrs);
my $ret = $self->next::method(@rest);
- my %rels = map { $_ => $self->relationship_info($_) } $self->relationships;
+ my $source = $self->result_source;
+ my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
my @cascade = grep { $rels{$_}{attrs}{cascade_delete} } keys %rels;
foreach my $rel (@cascade) {
$self->search_related($rel)->delete;
my $ret = $self->next::method(@rest);
- my %rels = map { $_ => $self->relationship_info($_) } $self->relationships;
+ my $source = $self->result_source;
+ my %rels = map { $_ => $source->relationship_info($_) } $source->relationships;
my @cascade = grep { $rels{$_}{attrs}{cascade_update} } keys %rels;
foreach my $rel (@cascade) {
$_->update for $self->$rel;
use base qw/DBIx::Class/;
-sub add_relationship {
- my ($class, $rel, @rest) = @_;
- my $ret = $class->next::method($rel => @rest);
- if (my $proxy_list = $class->relationship_info($rel)->{attrs}{proxy}) {
+sub register_relationship {
+ my ($class, $rel, $info) = @_;
+ if (my $proxy_list = $info->{attrs}{proxy}) {
$class->proxy_to_related($rel,
(ref $proxy_list ? @$proxy_list : $proxy_list));
}
- return $ret;
+ $class->next::method($rel, $info);
}
sub proxy_to_related {
sub primary_columns { shift->result_source_instance->primary_columns(@_); }
sub add_relationship {
- shift->result_source_instance->add_relationship(@_);
+ my ($class, $rel, @rest) = @_;
+ my $source = $class->result_source_instance;
+ $source->add_relationship($rel => @rest);
+ $class->register_relationship($rel => $source->relationship_info($rel));
}
sub relationships {
Accessor to the ResultSource this object was created from
-=head2 register_column
+=head2 register_column($column, $column_info)
Registers a column on the class and creates an accessor for it
sub next {
my ($self) = @_;
if ($self->{attrs}{rows} && $self->{pos} >= $self->{attrs}{rows}) {
+ $self->{sth}->finish if $self->{sth}->{Active};
delete $self->{sth};
$self->{done} = 1;
}