use strict;
use warnings;
-use Sub::Name ();
-use base qw/Class::Data::Inheritable/;
+use base 'Class::Data::Inheritable';
use Clone;
use DBIx::Class::CDBICompat::Relationship;
+use DBIx::Class::_Util qw(quote_sub perlstring);
__PACKAGE__->mk_classdata('__meta_info' => {});
my $rel_info;
+ # Class::DBI allows Non database has_a with implicit deflate and inflate
+ # Hopefully the following will catch Non-database tables.
+ if( !$f_class->isa('DBIx::Class::Row') and !$f_class->isa('Class::DBI::Row') ) {
+ $args{'inflate'} ||= sub { $f_class->new(shift) }; # implicit inflate by calling new
+ $args{'deflate'} ||= sub { shift() . '' }; # implicit deflate by stringification
+ }
+
if ($args{'inflate'} || $args{'deflate'}) { # Non-database has_a
if (!ref $args{'inflate'}) {
my $meth = $args{'inflate'};
);
if (@f_method) {
- no strict 'refs';
- no warnings 'redefine';
- my $post_proc = sub { my $o = shift; $o = $o->$_ for @f_method; $o; };
- my $name = join '::', $class, $rel;
- *$name = Sub::Name::subname $name,
- sub {
- my $rs = shift->search_related($rel => @_);
- $rs->{attrs}{record_filter} = $post_proc;
- return (wantarray ? $rs->all : $rs);
- };
+ quote_sub "${class}::${rel}", sprintf( <<'EOC', perlstring $rel), { '$rf' => \sub { my $o = shift; $o = $o->$_ for @f_method; $o } };
+ my $rs = shift->search_related( %s => @_);
+ $rs->{attrs}{record_filter} = $rf;
+ return (wantarray ? $rs->all : $rs);
+EOC
+
return 1;
}
-
}
return shift->search_related(shift)->new_result(shift);
}
+=head1 FURTHER QUESTIONS?
+
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
+
+=head1 COPYRIGHT AND LICENSE
+
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
+
+=cut
+
1;