lib/DBIx/Class/CDBICompat/Relationship.pm

   1 package
   2     DBIx::Class::CDBICompat::Relationship;
   3
   4 use strict;
   5 use warnings;
   6 use Sub::Name ();
   7
   8 =head1 NAME
   9
  10 DBIx::Class::CDBICompat::Relationship - Emulate the Class::DBI::Relationship object returned from meta_info()
  11
  12 =head1 DESCRIPTION
  13
  14 Emulate the Class::DBI::Relationship object returned from C<meta_info()>.
  15
  16 =cut
  17
  18 my %method2key = (
  19     name            => 'type',
  20     class           => 'self_class',
  21     accessor        => 'accessor',
  22     foreign_class   => 'class',
  23     args            => 'args',
  24 );
  25
  26 sub new {
  27     my($class, $args) = @_;
  28
  29     return bless $args, $class;
  30 }
  31
  32 for my $method (keys %method2key) {
  33     my $key = $method2key{$method};
  34     my $code = sub {
  35         $_[0]->{$key};
  36     };
  37
  38     no strict 'refs';
  39     *{$method} = Sub::Name::subname $method, $code;
  40 }
  41
  42 1;