File Coverage

blib/lib/DBIx/DataModel/Meta/Path.pm

Criterion	Covered	Total	%
statement	46	46	100.0
branch	5	6	83.3
condition			n/a
subroutine	12	12	100.0
pod	2	2	100.0
total	65	66	98.4

package DBIx::DataModel::Meta::Path;
use strict;
use warnings;
use parent "DBIx::DataModel::Meta";
use DBIx::DataModel;
use DBIx::DataModel::Meta::Utils qw/define_readonly_accessors/;

use Scalar::Util                 qw/looks_like_number weaken/;
use Params::Validate             qw/validate_with SCALAR HASHREF ARRAYREF OBJECT/;
use Carp::Clan                   qw[^(DBIx::DataModel::|SQL::Abstract)];
use namespace::clean;

{no strict 'refs'; *CARP_NOT = \@DBIx::DataModel::CARP_NOT;}

my $path_spec = {
  name         => {type => SCALAR},
  from         => {isa  => 'DBIx::DataModel::Meta::Source::Table'},
  to           => {isa  => 'DBIx::DataModel::Meta::Source::Table'},
  on           => {type => HASHREF}, # join condition
  multiplicity => {type => ARRAYREF},
  association  => {type => OBJECT,
                   isa  => "DBIx::DataModel::Meta::Association"},
  direction    => {type => SCALAR, regex => qr/^(AB|BA)$/},
};

sub new {
  my $class = shift;

  # parse arguments and create $self
  my $self = validate_with(
    params      => \@_,
    spec        => $path_spec,
    allow_extra => 0,
   );

  my $path = $self->{name};
  weaken $self->{$_} for qw/from to association/;

  # add this path into the 'from' metaclass
  not $self->{from}{path}{$path}
    or croak "$self->{from}{class} already has a path '$path'";
  $self->{from}{path}{$path} = $self;
  push @{$self->{from}{components}}, $path
    if $self->{association}{kind} eq 'Composition';

  # install a navigation method into the 'from' table class
  my @navigation_args = ($self->{name},  # method name
                         $self->{name}); # path to follow
  push @navigation_args, {-result_as => "firstrow"}
    if $self->{multiplicity}[1] == 1;
  $self->{from}->define_navigation_method(@navigation_args);

  bless $self, $class;
}

define_readonly_accessors(__PACKAGE__, keys %$path_spec);


sub opposite {
  my $self = shift;
  my $opposite_direction = reverse $self->direction;
  my $opposite_path      = "path_".$opposite_direction;
  return $self->association->$opposite_path;
}


1;


__END__