X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FRelationship.pm;h=b0c10fae62116d48297e4b348c673492655434fd;hb=b6cd6;hp=a702bd287250f82f66c99909be03b8afdf31c3cc;hpb=aa11d765d7345d63fbc497b4b5c16776eedbaa6e;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/CDBICompat/Relationship.pm b/lib/DBIx/Class/CDBICompat/Relationship.pm index a702bd2..b0c10fa 100644 --- a/lib/DBIx/Class/CDBICompat/Relationship.pm +++ b/lib/DBIx/Class/CDBICompat/Relationship.pm @@ -3,18 +3,16 @@ package use strict; use warnings; - +use Sub::Name (); =head1 NAME -DBIx::Class::CDBICompat::Relationship +DBIx::Class::CDBICompat::Relationship - Emulate the Class::DBI::Relationship object returned from meta_info() =head1 DESCRIPTION Emulate the Class::DBI::Relationship object returned from C. -The C method does not return any useful result as it's not clear what it should contain nor if any of the information is applicable to DBIx::Class. - =cut my %method2key = ( @@ -22,11 +20,12 @@ my %method2key = ( class => 'self_class', accessor => 'accessor', foreign_class => 'class', + args => 'args', ); sub new { my($class, $args) = @_; - + return bless $args, $class; } @@ -35,15 +34,9 @@ for my $method (keys %method2key) { my $code = sub { $_[0]->{$key}; }; - - no strict 'refs'; - *{$method} = $code; -} -sub args { - warn "args() is unlikely to ever work"; - return undef; + no strict 'refs'; + *{$method} = Sub::Name::subname $method, $code; } - 1;