File Coverage

lib/BalanceOfPower/Dice.pm
Criterion Covered Total %
statement 94 94 100.0
branch 24 24 100.0
condition 4 10 40.0
subroutine 10 10 100.0
pod 0 6 0.0
total 132 144 91.6


line stmt bran cond sub pod time code
1             package BalanceOfPower::Dice;
2             $BalanceOfPower::Dice::VERSION = '0.400105';
3 13     13   105 use v5.10;
  13         29  
4 13     13   40 use Moo;
  13         12  
  13         59  
5 13     13   2513 use Data::Dumper;
  13         20  
  13         616  
6 13     13   48 use List::Util qw(shuffle);
  13         23  
  13         8897  
7              
8             with 'BalanceOfPower::Role::Logger';
9              
10             has tricks => (
11             is => 'rw',
12             default => sub { {} }
13             );
14             has trick_counters => (
15             is => 'rw',
16             default => sub { {} }
17             );
18             has forced_advisor => (
19             is => 'rw',
20             default => 0
21             );
22             has only_one_nation_acting => (
23             is => 'rw',
24             default => 0
25             );
26              
27             sub random
28             {
29 793     793 0 15753 my $self = shift;
30 793         638 my $min = shift;
31 793         568 my $max = shift;
32 793   33     1256 my $message = shift || "NO MESSAGE [$min-$max]";
33 793         1041 my $out = $self->tricked($message);
34 793 100       1029 if(defined $out)
35             {
36 94         132 $self->write_log($message, $out, 1);
37 94         249 return $out;
38             }
39             else
40             {
41 699         761 my $random_range = $max - $min + 1;
42 699         1152 $out = int(rand($random_range)) + $min;
43 699         922 $self->write_log($message, $out, 0);
44 699         1569 return $out;
45             }
46             }
47              
48             sub random10
49             {
50 898     898 0 22646 my $self = shift;
51 898         734 my $min = shift;
52 898         754 my $max = shift;
53 898   33     1550 my $message = shift || "NO MESSAGE [$min-$max]";
54 898         1294 my $out = $self->tricked($message);
55 898 100       1248 if(defined $out)
56             {
57 53         96 $self->write_log($message, $out, 1);
58 53         146 return $out;
59             }
60             else
61             {
62 845         1396 my $random_range = (($max - $min) / 10) + 1;
63 845         1734 $out = (int(rand($random_range)) * 10) + $min;
64 845         1183 $self->write_log($message, $out, 0);
65 845         2288 return $out;
66             }
67             }
68              
69             sub random_around_zero
70             {
71 159     159 0 7095 my $self = shift;
72 159         141 my $max = shift;
73 159   50     275 my $divider = shift || 1;
74 159         159 my $message = shift;
75 159         231 my $out = $self->tricked($message);
76 159 100       230 if(defined $out)
77             {
78 2         7 $self->write_log($message, $out, 1);
79 2         8 return $out;
80             }
81             else
82             {
83 157         161 my $random_max = $max * 2;
84 157         251 my $r = $self->random(0, $random_max, "Inside dice, from random_around_zero");
85 157         169 $r = $r - $max;
86 157         168 $r = $r / $divider;
87 157         237 $self->write_log($message, $r, 0);
88 157         493 return $r;
89             }
90             }
91             sub shuffle_array
92             {
93 619     619 0 15424 my $self = shift;
94 619   50     1018 my $message = shift || "NO MESSAGE IN SHUFFLE";
95 619         685 my @array = @_;
96 619 100       1100 if($message =~ /^Choosing advisor for (.*)$/)
97             {
98 69         100 my $nation = $1;
99 69         57 my @array_back;
100 69         59 my $tricked = 0;
101 69 100       156 if($self->forced_advisor())
102             {
103 34         48 @array_back = ( $self->forced_advisor() );
104 34         39 $tricked = 1;
105             }
106             else
107             {
108 35         98 @array_back = shuffle @array;
109             }
110 69 100       162 if($self->only_one_nation_acting)
111             {
112 5 100       12 if($self->only_one_nation_acting ne $nation)
113             {
114 4         6 @array_back = ("Noone");
115 4         5 $tricked = 1;
116             }
117             }
118 69         147 $self->write_log($message, "<<array>>, first result: " . $array_back[0], $tricked);
119             return @array_back
120 69         293 }
121              
122 550 100       825 if(@array == 0)
123             {
124 322         427 $self->write_log($message, "<<array>>, Array empty");
125 322         799 return @array;
126             }
127 228         562 @array = shuffle @array;
128 228         621 $self->write_log($message, "<<array>>, first result: " . $array[0]);
129 228         699 return @array;
130             }
131             sub tricked
132             {
133 1850     1850 0 1474 my $self = shift;
134 1850         1425 my $message = shift;
135 1850 100       3647 if(exists $self->tricks->{$message})
136             {
137 155         130 my $index;
138 155 100       308 if(exists $self->trick_counters->{$message})
139             {
140 78         100 $index = $self->trick_counters->{$message};
141             }
142             else
143             {
144 77         76 $index = 0;
145             }
146 155         132 my $result;
147 155 100       269 if(exists $self->tricks->{$message}->[$index])
148             {
149 149         215 $result = $self->tricks->{$message}->[$index];
150             }
151             else
152             {
153 6         7 $result = undef;
154             }
155 155         252 $self->trick_counters->{$message} = $index + 1;
156 155         188 return $result;
157             }
158             else
159             {
160 1695         1936 return undef;
161             }
162             }
163              
164             sub write_log
165             {
166 2469     2469 0 1934 my $self = shift;
167 2469         2163 my $message = shift;
168 2469         1852 my $result = shift;
169 2469         1690 my $tricked = shift;
170 2469 100       3422 if($tricked)
171             {
172 183         219 $message .= " *TRICKED* ";
173             }
174 2469         4314 $message = "[" . $message . "] $result";
175 2469         4618 $self->log($message);
176             }
177              
178             1;