| 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; |