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.400115';
3 13     13   137 use v5.10;
  13         35  
4 13     13   54 use Moo;
  13         19  
  13         77  
5 13     13   3145 use Data::Dumper;
  13         22  
  13         808  
6 13     13   65 use List::Util qw(shuffle);
  13         19  
  13         10469  
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 20466 my $self = shift;
30 793         846 my $min = shift;
31 793         790 my $max = shift;
32 793   33     1670 my $message = shift || "NO MESSAGE [$min-$max]";
33 793         1500 my $out = $self->tricked($message);
34 793 100       1288 if(defined $out)
35             {
36 94         158 $self->write_log($message, $out, 1);
37 94         305 return $out;
38             }
39             else
40             {
41 699         988 my $random_range = $max - $min + 1;
42 699         1868 $out = int(rand($random_range)) + $min;
43 699         1242 $self->write_log($message, $out, 0);
44 699         1979 return $out;
45             }
46             }
47              
48             sub random10
49             {
50 898     898 0 30069 my $self = shift;
51 898         1045 my $min = shift;
52 898         860 my $max = shift;
53 898   33     2052 my $message = shift || "NO MESSAGE [$min-$max]";
54 898         1828 my $out = $self->tricked($message);
55 898 100       1700 if(defined $out)
56             {
57 53         110 $self->write_log($message, $out, 1);
58 53         182 return $out;
59             }
60             else
61             {
62 845         1944 my $random_range = (($max - $min) / 10) + 1;
63 845         2240 $out = (int(rand($random_range)) * 10) + $min;
64 845         1543 $self->write_log($message, $out, 0);
65 845         3013 return $out;
66             }
67             }
68              
69             sub random_around_zero
70             {
71 159     159 0 8663 my $self = shift;
72 159         185 my $max = shift;
73 159   50     332 my $divider = shift || 1;
74 159         178 my $message = shift;
75 159         358 my $out = $self->tricked($message);
76 159 100       295 if(defined $out)
77             {
78 2         8 $self->write_log($message, $out, 1);
79 2         10 return $out;
80             }
81             else
82             {
83 157         204 my $random_max = $max * 2;
84 157         321 my $r = $self->random(0, $random_max, "Inside dice, from random_around_zero");
85 157         243 $r = $r - $max;
86 157         211 $r = $r / $divider;
87 157         326 $self->write_log($message, $r, 0);
88 157         594 return $r;
89             }
90             }
91             sub shuffle_array
92             {
93 633     633 0 21309 my $self = shift;
94 633   50     1357 my $message = shift || "NO MESSAGE IN SHUFFLE";
95 633         889 my @array = @_;
96 633 100       1440 if($message =~ /^Choosing advisor for (.*)$/)
97             {
98 69         144 my $nation = $1;
99 69         69 my @array_back;
100 69         87 my $tricked = 0;
101 69 100       198 if($self->forced_advisor())
102             {
103 34         73 @array_back = ( $self->forced_advisor() );
104 34         58 $tricked = 1;
105             }
106             else
107             {
108 35         135 @array_back = shuffle @array;
109             }
110 69 100       203 if($self->only_one_nation_acting)
111             {
112 5 100       13 if($self->only_one_nation_acting ne $nation)
113             {
114 4         7 @array_back = ("Noone");
115 4         5 $tricked = 1;
116             }
117             }
118 69         198 $self->write_log($message, "<<array>>, first result: " . $array_back[0], $tricked);
119             return @array_back
120 69         351 }
121              
122 564 100       1072 if(@array == 0)
123             {
124 257         424 $self->write_log($message, "<<array>>, Array empty");
125 257         804 return @array;
126             }
127 307         943 @array = shuffle @array;
128 307         1041 $self->write_log($message, "<<array>>, first result: " . $array[0]);
129 307         1256 return @array;
130             }
131             sub tricked
132             {
133 1850     1850 0 2034 my $self = shift;
134 1850         1945 my $message = shift;
135 1850 100       4775 if(exists $self->tricks->{$message})
136             {
137 155         165 my $index;
138 155 100       391 if(exists $self->trick_counters->{$message})
139             {
140 78         147 $index = $self->trick_counters->{$message};
141             }
142             else
143             {
144 77         99 $index = 0;
145             }
146 155         170 my $result;
147 155 100       405 if(exists $self->tricks->{$message}->[$index])
148             {
149 149         281 $result = $self->tricks->{$message}->[$index];
150             }
151             else
152             {
153 6         7 $result = undef;
154             }
155 155         367 $self->trick_counters->{$message} = $index + 1;
156 155         250 return $result;
157             }
158             else
159             {
160 1695         2820 return undef;
161             }
162             }
163              
164             sub write_log
165             {
166 2483     2483 0 2585 my $self = shift;
167 2483         2713 my $message = shift;
168 2483         2326 my $result = shift;
169 2483         2396 my $tricked = shift;
170 2483 100       4567 if($tricked)
171             {
172 183         329 $message .= " *TRICKED* ";
173             }
174 2483         5665 $message = "[" . $message . "] $result";
175 2483         5740 $self->log($message);
176             }
177              
178             1;