File Coverage

lib/Catan/Map/Intersection.pm
Criterion Covered Total %
statement 44 44 100.0
branch 10 14 71.4
condition 10 21 47.6
subroutine 10 10 100.0
pod 0 4 0.0
total 74 93 79.5


line stmt bran cond sub pod time code
1             package Catan::Map::Intersection;
2             $Catan::Map::Intersection::VERSION = '0.03';
3 3     3   14 use strict;
  3     1   6  
  3         72  
  1         866  
  1         4  
  1         21  
4 3     3   20 use warnings;
  3     1   6  
  3         86  
  1         5  
  1         1  
  1         35  
5              
6             use overload
7 3         16 '""' => 'uuid',
  1         8  
8 3     3   14 fallback => 1;
  3     1   5  
  1         4  
  1         2  
9              
10             sub new
11             {
12 1055     1055 0 1728 my ($class, $tiles) = @_;
13              
14 1055 50 33     6552 die 'Intersection->new() requires an arrayref of 3 tiles'
      33        
15             unless $tiles && ref $tiles eq 'ARRAY' && @$tiles == 3;
16              
17             # check tiles are joined
18 1055         1643 for my $t1 (@$tiles)
19             {
20 3163         46004 for my $t2 (@$tiles)
21             {
22 9489 100 100     105556 die 'Invalid intersection - all 3 tiles must be next to each other'
23             unless $t1 eq $t2 || $t1->hex_distance($t2) == 1;
24             }
25             }
26              
27             bless {
28             location => $tiles,
29 1054         2803 uuid => join('|', map {$_->id} sort {$a->id cmp $b->id} @$tiles),
  3162         14719  
  2785         12925  
30             }, $class;
31             }
32              
33 99761     99761 0 329573 sub uuid { $_[0]->{uuid} }
34              
35             sub is_colliding
36             {
37 3441     3441 0 4457 my ($self, $location) = @_;
38              
39 3441 50 33     6575 die 'is_colliding requires an Intersection or Path object as an argument'
      33        
40             unless $location && ($location->isa('Catan::Map::Intersection')
41             || $location->isa('Catan::Map::Path'));
42 3441 50       15283 return $location->isa('Catan::Map::Path')
43             ? $location->is_colliding($self)
44             : $self eq $location;
45             }
46              
47             sub is_adjacent
48             {
49 20140     20140 0 26921 my ($self, $location) = @_;
50              
51 20140 50 66     35599 die 'is_adjacent requires an Intersection or tile object as an argument'
      33        
52             unless $location
53             && ( $location->isa('Catan::Map::Intersection')
54             || $location->isa('Catan::Map::Tile'));
55              
56 20140         30467 my ($matching_tiles, $tiles_to_match) = (0);
57 20140 100       51712 if ($location->isa('Catan::Map::Intersection'))
58             {
59 18145         19689 $tiles_to_match = 2;
60              
61             # intersections are adjacent if they share 2 coordinates with the intersection
62 18145         20436 for my $hex (@{$self->{location}})
  18145         35345  
63             {
64 54435         62712 $matching_tiles += grep($hex eq $_, @{$location->{location}});
  54435         153714  
65             }
66             }
67             else
68             {
69 1995         2476 $tiles_to_match = 1;
70             # tiles are adjacent if they share 1 coordinate with the intersection
71 1995         2446 for my $tile (@{$self->{location}})
  1995         4485  
72             {
73 5985 100       14411 $matching_tiles += $tile eq $location ? 1 : 0;
74             }
75             }
76 20140         103026 return $matching_tiles == $tiles_to_match;
77             }
78              
79             1;
80              
81             __END__