File Coverage

blib/lib/DBIx/DataModel/Meta/Path.pm
Criterion Covered Total %
statement 46 46 100.0
branch 5 6 83.3
condition 3 3 100.0
subroutine 12 12 100.0
pod 2 2 100.0
total 68 69 98.5


line stmt bran cond sub pod time code
1             package DBIx::DataModel::Meta::Path;
2 15     15   8614 use strict;
  15         35  
  15         466  
3 15     15   81 use warnings;
  15         31  
  15         414  
4 15     15   76 use parent "DBIx::DataModel::Meta";
  15         30  
  15         93  
5 15     15   930 use DBIx::DataModel;
  15         52  
  15         73  
6 15     15   103 use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors/;
  15         29  
  15         842  
7              
8 15     15   110 use Scalar::Util qw/looks_like_number weaken/;
  15         31  
  15         940  
9 15     15   114 use Params::Validate qw/validate_with SCALAR HASHREF ARRAYREF OBJECT/;
  15         44  
  15         1033  
10 15     15   112 use Carp::Clan qw[^(DBIx::DataModel::|SQL::Abstract)];
  15         47  
  15         104  
11 15     15   1473 use namespace::clean;
  15         32  
  15         119  
12              
13 15     15   4930 {no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}
  15         33  
  15         6900  
14              
15             my $path_spec = {
16             name => {type => SCALAR},
17             from => {isa => 'DBIx::DataModel::Meta::Source::Table'},
18             to => {isa => 'DBIx::DataModel::Meta::Source::Table'},
19             on => {type => HASHREF}, # join condition
20             multiplicity => {type => ARRAYREF},
21             association => {type => OBJECT,
22             isa => "DBIx::DataModel::Meta::Association"},
23             direction => {type => SCALAR, regex => qr/^(AB|BA)$/},
24             };
25              
26             sub new {
27 58     58 1 112 my $class = shift;
28              
29             # parse arguments and create $self
30 58         1426 my $self = validate_with(
31             params => \@_,
32             spec => $path_spec,
33             allow_extra => 0,
34             );
35              
36 58         1651 my $path = $self->{name};
37 58         349 weaken $self->{$_} for qw/from to association/;
38              
39             # add this path into the 'from' metaclass
40 58 50       231 not $self->{from}{path}{$path}
41             or croak "$self->{from}{class} already has a path '$path'";
42 58         146 $self->{from}{path}{$path} = $self;
43              
44             # if this is a composition path, remember it in the 'components' array
45 14         51 push @{$self->{from}{components}}, $path
46 58 100 100     262 if $self->{association}{kind} eq 'Composition' && $self->{multiplicity}[1] > 1;
47              
48             # install a navigation method into the 'from' table class
49             my @navigation_args = ($self->{name}, # method name
50 58         173 $self->{name}); # path to follow
51             push @navigation_args, {-result_as => "firstrow"}
52 58 100       177 if $self->{multiplicity}[1] == 1;
53 58         262 $self->{from}->define_navigation_method(@navigation_args);
54              
55 58         281 bless $self, $class;
56             }
57              
58             define_readonly_accessors(__PACKAGE__, keys %$path_spec);
59              
60              
61             sub opposite {
62 3     3 1 1522 my $self = shift;
63 3         11 my $opposite_direction = reverse $self->direction;
64 3         6 my $opposite_path = "path_".$opposite_direction;
65 3         12 return $self->association->$opposite_path;
66             }
67              
68              
69             1;
70              
71              
72             __END__