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   9372 use strict;
  15         32  
  15         484  
3 15     15   112 use warnings;
  15         34  
  15         480  
4 15     15   82 use parent "DBIx::DataModel::Meta";
  15         28  
  15         121  
5 15     15   953 use DBIx::DataModel;
  15         40  
  15         111  
6 15     15   93 use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors/;
  15         29  
  15         866  
7              
8 15     15   108 use Scalar::Util qw/looks_like_number weaken/;
  15         45  
  15         891  
9 15     15   93 use Params::Validate qw/validate_with SCALAR HASHREF ARRAYREF OBJECT/;
  15         45  
  15         1129  
10 15     15   100 use Carp::Clan qw[^(DBIx::DataModel::|SQL::Abstract)];
  15         53  
  15         203  
11 15     15   1663 use namespace::clean;
  15         35  
  15         81  
12              
13 15     15   4975 {no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}
  15         35  
  15         7512  
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 118 my $class = shift;
28              
29             # parse arguments and create $self
30 58         1377 my $self = validate_with(
31             params => \@_,
32             spec => $path_spec,
33             allow_extra => 0,
34             );
35              
36 58         1732 my $path = $self->{name};
37 58         365 weaken $self->{$_} for qw/from to association/;
38              
39             # add this path into the 'from' metaclass
40 58 50       200 not $self->{from}{path}{$path}
41             or croak "$self->{from}{class} already has a path '$path'";
42 58         137 $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     277 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         160 $self->{name}); # path to follow
51             push @navigation_args, {-result_as => "firstrow"}
52 58 100       184 if $self->{multiplicity}[1] == 1;
53 58         271 $self->{from}->define_navigation_method(@navigation_args);
54              
55 58         283 bless $self, $class;
56             }
57              
58             define_readonly_accessors(__PACKAGE__, keys %$path_spec);
59              
60              
61             sub opposite {
62 3     3 1 21 my $self = shift;
63 3         10 my $opposite_direction = reverse $self->direction;
64 3         8 my $opposite_path = "path_".$opposite_direction;
65 3         10 return $self->association->$opposite_path;
66             }
67              
68              
69             1;
70              
71              
72             __END__