Commit | Line | Data |
---|---|---|
a9c8094b | 1 | package |
2 | DBIx::Class::CDBICompat::Relationship; | |
3 | ||
4 | use strict; | |
5 | use warnings; | |
ddc0a6c8 | 6 | use Sub::Name (); |
a9c8094b | 7 | |
8 | =head1 NAME | |
9 | ||
b24d86a1 | 10 | DBIx::Class::CDBICompat::Relationship - Emulate the Class::DBI::Relationship object returned from meta_info() |
a9c8094b | 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', | |
1097f5e4 | 23 | args => 'args', |
a9c8094b | 24 | ); |
25 | ||
26 | sub new { | |
27 | my($class, $args) = @_; | |
d4daee7b | 28 | |
a9c8094b | 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 | }; | |
d4daee7b | 37 | |
a9c8094b | 38 | no strict 'refs'; |
ddc0a6c8 | 39 | *{$method} = Sub::Name::subname $method, $code; |
a9c8094b | 40 | } |
41 | ||
a9c8094b | 42 | 1; |