File Coverage

lib/Settlers/Map/Path.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	8	14	57.1
condition	12	21	57.1
subroutine	12	12	100.0
pod	0	6	0.0
total	66	87	75.8

package Settlers::Map::Path;
$Settlers::Map::Path::VERSION = '0.07';
use strict;
use warnings;

use overload
  '""' => 'uuid',
  fallback => 1;

sub new
{
  my ($class, $intersections) = @_;
  die 'Path->new() requires an arrayref of 2 intersections'
    unless $intersections && ref $intersections eq 'ARRAY' && @$intersections == 2;

  die 'Path->new() start and end intersections must be adjacent'
    unless $intersections->[0]->is_adjacent($intersections->[1]);

  bless {
    uuid  => join(' ', sort $intersections->[0]->uuid, $intersections->[1]->uuid),
    start => $intersections->[0],
    end   => $intersections->[1],
  }, $class;
}

sub start    { $_[0]->{start} }
sub end      { $_[0]->{end} }
sub uuid     { $_[0]->{uuid} }

sub is_adjacent
{
  my ($self, $obj) = @_;

  die 'is_adjacent requires an intersection or path argument'
    unless $obj &&
      ($obj->isa('Settlers::Map::Intersection')
       || $obj->isa('Settlers::Map::Path'));

  if ($obj->isa('Settlers::Map::Intersection'))
  {
    return $obj eq $self->{start} || $obj eq $self->{end};
  }
  elsif ($obj->isa('Settlers::Map::Path'))
  {
    return 0 if $self->is_colliding($obj);
    return  $obj->{start} eq $self->{start} || $obj->{start} eq $self->{end}
           || $obj->{end} eq $self->{start} || $obj->{end} eq $self->{end};
  }
}

sub is_colliding
{
  my ($self, $obj) = @_;

  die 'is_colliding requires a path argument'
    unless $obj && $obj->isa('Settlers::Map::Path');

  return $obj eq $self;
}
1;

__END__