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 16     16   12769 use strict;
  16         38  
  16         638  
3 16     16   88 use warnings;
  16         32  
  16         1101  
4 16     16   103 use parent "DBIx::DataModel::Meta";
  16         44  
  16         170  
5 16     16   1264 use DBIx::DataModel;
  16         44  
  16         132  
6 16     16   97 use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors/;
  16         31  
  16         997  
7 16     16   95 use DBIx::DataModel::Carp;
  16         46  
  16         119  
8              
9 16     16   1011 use Scalar::Util qw/looks_like_number weaken/;
  16         35  
  16         1122  
10 16     16   102 use Params::Validate qw/validate_with SCALAR HASHREF ARRAYREF OBJECT/;
  16         30  
  16         1284  
11 16     16   96 use namespace::clean;
  16         27  
  16         156  
12              
13 16     16   5480 {no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}
  16         88  
  16         9091  
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 60     60 1 118 my $class = shift;
28              
29             # parse arguments and create $self
30 60         1741 my $self = validate_with(
31             params => \@_,
32             spec => $path_spec,
33             allow_extra => 0,
34             );
35              
36 60         1915 my $path = $self->{name};
37 60         274 weaken $self->{$_} for qw/from to association/;
38              
39             # add this path into the 'from' metaclass
40 60 50       215 not $self->{from}{path}{$path}
41             or croak "$self->{from}{class} already has a path '$path'";
42 60         153 $self->{from}{path}{$path} = $self;
43              
44             # if this is a composition path, remember it in the 'components' array
45 14         56 push @{$self->{from}{components}}, $path
46 60 100 100     264 if $self->{association}{kind} eq 'Composition' && $self->{direction} eq 'AB';
47              
48             # install a navigation method into the 'from' table class
49             my @navigation_args = ($self->{name}, # method name
50 60         178 $self->{name}); # path to follow
51             push @navigation_args, {-result_as => "firstrow"}
52 60 100       231 if $self->{multiplicity}[1] == 1;
53 60         273 $self->{from}->define_navigation_method(@navigation_args);
54              
55 60         845 bless $self, $class;
56             }
57              
58             define_readonly_accessors(__PACKAGE__, keys %$path_spec);
59              
60              
61             sub opposite {
62 3     3 1 25 my $self = shift;
63 3         12 my $opposite_direction = reverse $self->direction;
64 3         7 my $opposite_path = "path_".$opposite_direction;
65 3         11 return $self->association->$opposite_path;
66             }
67              
68              
69             1;
70              
71              
72             __END__