X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FRelationships.pm;h=58b29e06cc3a67d9a4158ecc4037404db1ed8125;hb=aa56106b252283cef5338312d66fdf62cc92df20;hp=0a4b4755db0090e1d8448d804f8a445511ca34a3;hpb=c79bd6e9b40607d08e41879ecad0804c38bf14dc;p=dbsrgits%2FDBIx-Class-Historic.git diff --git a/lib/DBIx/Class/CDBICompat/Relationships.pm b/lib/DBIx/Class/CDBICompat/Relationships.pm index 0a4b475..58b29e0 100644 --- a/lib/DBIx/Class/CDBICompat/Relationships.pm +++ b/lib/DBIx/Class/CDBICompat/Relationships.pm @@ -3,7 +3,7 @@ package # hide from PAUSE use strict; use warnings; - +use Sub::Name (); use base qw/Class::Data::Inheritable/; use Clone; @@ -14,7 +14,7 @@ __PACKAGE__->mk_classdata('__meta_info' => {}); =head1 NAME -DBIx::Class::CDBICompat::Relationships +DBIx::Class::CDBICompat::Relationships - Emulate has_a(), has_many(), might_have() and meta_info() =head1 DESCRIPTION @@ -24,10 +24,10 @@ Emulate C, C, C and C. sub has_a { my($self, $col, @rest) = @_; - + $self->_declare_has_a($col, @rest); $self->_mk_inflated_column_accessor($col); - + return 1; } @@ -37,7 +37,7 @@ sub _declare_has_a { $self->throw_exception( "No such column ${col}" ) unless $self->has_column($col); $self->ensure_class_loaded($f_class); - + my $rel_info; if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a @@ -50,7 +50,7 @@ sub _declare_has_a { $args{'deflate'} = sub { shift->$meth; }; } $self->inflate_column($col, \%args); - + $rel_info = { class => $f_class }; @@ -59,9 +59,9 @@ sub _declare_has_a { $self->belongs_to($col, $f_class); $rel_info = $self->result_source_instance->relationship_info($col); } - + $rel_info->{args} = \%args; - + $self->_extend_meta( has_a => $col, $rel_info @@ -72,7 +72,7 @@ sub _declare_has_a { sub _mk_inflated_column_accessor { my($class, $col) = @_; - + return $class->mk_group_accessors('inflated_column' => $col); } @@ -122,7 +122,8 @@ sub has_many { no strict 'refs'; no warnings 'redefine'; my $post_proc = sub { my $o = shift; $o = $o->$_ for @f_method; $o; }; - *{"${class}::${rel}"} = + my $name = join '::', $class, $rel; + *$name = Sub::Name::subname $name, sub { my $rs = shift->search_related($rel => @_); $rs->{attrs}{record_filter} = $post_proc; @@ -136,7 +137,7 @@ sub has_many { sub might_have { my ($class, $rel, $f_class, @columns) = @_; - + my $ret; if (ref $columns[0] || !defined $columns[0]) { $ret = $class->next::method($rel, $f_class, @columns); @@ -152,7 +153,7 @@ sub might_have { might_have => $rel, $rel_info ); - + return $ret; }