package Mafia;
-use 5.014000;
+use 5.010001;
use strict;
use warnings;
-no if $] > 5.017011, warnings => 'experimental::smartmatch';
use parent qw/Exporter/;
use constant;
use Storable qw/dclone/;
-our $VERSION = '0.001';
+our $VERSION = '0.001002';
sub defconst { constant->import($_ => $_) for @_ }
defconst qw/ACT_KILL ACT_LYNCH ACT_PROTECT ACT_GUARD ACT_ROLEBLOCK ACT_GUNCHECK ACT_TRACK ACT_WATCH ACT_ROLECOP ACT_COP ACT_TRACK_RESULT ACT_WATCH_RESULT ACT_HIDE/;
}
-use constant +{
+use constant +{ ## no critic (Capitalization)
townie => town,
ROLE => [vanilla, goon, doctor, vigilante, roleblocker, jailkeeper, gunsmith, tracker, watcher, bodyguard, rolecop, cop, sk, hider],
FACTION => [mafia, town],
GUNROLES => [vigilante, gunsmith],
};
+my %ROLE_HASH = map { $_ => 1 } @{ROLE()};
+my %FACTION_HASH = map { $_ => 1 } @{FACTION()};
+my %FLAG_HASH = map { $_ => 1 } @{FLAG()};
+my %INVESTIGATIVE_ACTIONS_HASH = map { $_ => 1 } @{INVESTIGATIVE_ACTIONS()};
+my %GUNROLES_HASH = map { $_ => 1 } @{GUNROLES()};
+
our @EXPORT = do {
- no strict 'refs';
+ no strict 'refs'; ## no critic (ProhibitNoStrict)
grep { $_ !~ [qw/import/] and exists &$_ } keys %{__PACKAGE__ . '::'};
};
return "Night $nightcnt" unless $isday;
}
-sub rolename {
+sub rolename { ## no critic (RequireArgUnpacking)
my %player = %{$players{$_[0]}};
my ($faction, $role) = ($player{faction}, $player{role});
if (defined $faction && $faction eq town && $role eq vanilla) {
sub msg {
my ($type, @args) = @_;
- given ($type){
- when (MSG_NIGHT) {
+ my %msg_lut = (
+ MSG_NIGHT => sub {
my ($night) = @args;
say '' unless $first;
$first = 0;
say "It is Night $night";
- }
+ },
- when (MSG_DAY) {
+ MSG_DAY => sub {
my ($day) = @args;
say '' unless $first;
$first = 0;
say "It is Day $day";
- }
+ },
- when (MSG_PLAYERS_ALIVE) {
+ MSG_PLAYERS_ALIVE => sub {
@args = sort @args;
- say "Players alive: ", join ', ', @args
- }
+ say 'Players alive: ', join ', ', @args
+ },
- when (MSG_DEATH) {
+ MSG_DEATH => sub {
my %args = @args;
my ($who, $reason) = @args{'target', 'reason'};
my $phase = phase;
my $rolename = rolename $who;
say "$who ($rolename) — $reason $phase";
- }
+ },
- when (MSG_GUNCHECK) {
+ MSG_GUNCHECK => sub {
my %args = @args;
my ($gunsmith, $who, $hasgun) = @args{'source', 'target', 'result'};
say "$gunsmith: $who has a gun" if $hasgun;
say "$gunsmith: $who does not have a gun" unless $hasgun;
- }
+ },
- when (MSG_NORESULT) {
+ MSG_NORESULT => sub {
my %args = @args;
my ($who) = $args{'source'};
say "$who: No result"
- }
+ },
- when (MSG_TRACK) {
+ MSG_TRACK => sub {
my %args = @args;
my ($tracker, $who, $result) = @args{'source', 'target', 'result'};
my @result = @{$result};
local $, = ', ';
say "$tracker: $who did not visit anyone" unless scalar @result;
say "$tracker: $who visited: @result" if scalar @result;
- }
+ },
- when (MSG_WATCH) {
+ MSG_WATCH => sub {
my %args = @args;
my ($watcher, $who, $result) = @args{'source', 'target', 'result'};
my @result = @{$result};
local $, = ', ';
say "$watcher: $who was not visited by anyone" unless scalar @result;
say "$watcher: $who was visited by: @result" if scalar @result;
- }
+ },
- when (MSG_ROLECOP) {
+ MSG_ROLECOP => sub {
my %args = @args;
my ($rolecop, $who, $role) = @args{'source', 'target', 'result'};
say "$rolecop: $who\'s role is: $role"
- }
+ },
- when (MSG_COP) {
+ MSG_COP => sub {
my %args = @args;
my ($cop, $who, $ismafia) = @args{'source', 'target', 'result'};
say "$cop: $who is mafia" if $ismafia;
say "$cop: $who is not mafia" unless $ismafia;
- }
- }
+ },
+ );
+
+ $msg_lut{$type}->();
}
sub putaction {
if (exists $args{target} && exists $args{source} && $players{$args{target}}{faction} eq mafia && $players{$args{source}}{weak}) {
putaction($delay, ACT_KILL, target => $args{source}, reason => 'targeted scum');
}
- push $actions[$delay]->{$type}, \%args
+ push @{$actions[$delay]->{$type}}, \%args
}
-sub doaction {
+sub doaction { ## no critic (ProhibitExcessComplexity)
my ($type, $args) = @_;
my %args = %$args;
my $source = $args{source};
if (defined $source && defined $target) {
# Watcher and tracker variables
$tplayers{$source}{targets} //= [];
- push $tplayers{$source}{targets}, $target;
+ push @{$tplayers{$source}{targets}}, $target;
$tplayers{$target}{sources} //= [];
- push $tplayers{$target}{sources}, $source;
+ push @{$tplayers{$target}{sources}}, $source;
# Copy this action to everybody hiding behind $target
if (exists $tplayers{$target}{hiders}) {
for my $target (@{$tplayers{$target}{hiders}}) {
- my %args = %args;
- $args{target} = $target;
- $args{hidepierce} = 1;
- doaction($type, \%args);
+ my %new_args = %args;
+ $new_args{target} = $target;
+ $new_args{hidepierce} = 1;
+ doaction($type, \%new_args);
}
}
my $hidden = $tplayers{$target}{hidden};
my $hidepierce = $args{hidepierce};
if ($source && (( $roleblocked && !$strongkill ) || ($hidden && !$hidepierce) )) {
- msg MSG_NORESULT, %args if $type ~~ INVESTIGATIVE_ACTIONS;
+ msg MSG_NORESULT, %args if $INVESTIGATIVE_ACTIONS_HASH{$type};
return
}
}
-
- given ($type) {
- when(ACT_KILL) {
+ my %act_lut = (
+ ACT_KILL => sub {
break if $tplayers{$target}{bulletproof} && defined $source;
if ($tplayers{$target}{guard_count} && defined $source) {
$tplayers{$target}{guard_count}--;
# Copy this action to the first guard
- $args{target} = shift $tplayers{$target}{guards};
+ $args{target} = shift @{$tplayers{$target}{guards}};
@_ = ($type, %args);
goto &doaction;
}
}
msg MSG_DEATH, %args;
delete $players{$target}
- }
+ },
- when(ACT_LYNCH){
+ ACT_LYNCH => sub {
if ($tplayers{$target}{guard_count}) {
$tplayers{$target}{guard_count}--;
- $args{target} = shift $tplayers{$target}{guards};
+ $args{target} = shift @{$tplayers{$target}{guards}};
$target=$args{target};
}
if ($tplayers{$target}{protection}) {
}
msg MSG_DEATH, %args, reason => 'lynched';
delete $players{$target}
- }
+ },
- when(ACT_PROTECT){
+ ACT_PROTECT => sub {
my $count = $args{count} // 1;
$tplayers{$target}{protection} += $count unless $tplayers{$target}{macho}
- }
+ },
- when(ACT_ROLEBLOCK){
+ ACT_ROLEBLOCK => sub {
$tplayers{$target}{roleblocked} = 1
- }
+ },
- when(ACT_GUNCHECK){
+ ACT_GUNCHECK => sub {
my $role = $players{$target}{role};
- my $hasgun = $role ~~ GUNROLES || ($players{$target}{faction} eq mafia && $role ne doctor);
+ my $hasgun = $GUNROLES_HASH{$role} || ($players{$target}{faction} eq mafia && $role ne doctor);
msg MSG_GUNCHECK, %args, result => $hasgun
- }
+ },
- when(ACT_TRACK_RESULT){
+ ACT_TRACK_RESULT => sub {
msg MSG_TRACK, %args, result => [ uniq @{$tplayers{$target}{targets} // []} ];
- }
+ },
- when(ACT_WATCH_RESULT){
+ ACT_WATCH_RESULT => sub {
msg MSG_WATCH, %args, result => [ uniq @{$tplayers{$target}{sources} // []} ];
- }
+ },
- when(ACT_GUARD){
+ ACT_GUARD => sub {
$tplayers{$target}{guard_count}++;
$tplayers{$target}{guards} //= [];
- push $tplayers{$target}{guards}, $source;
- }
+ push @{$tplayers{$target}{guards}}, $source;
+ },
- when(ACT_ROLECOP){
+ ACT_ROLECOP => sub {
my $result = $players{$target}{role};
$result = vanilla if $result eq goon;
msg MSG_ROLECOP, %args, result => ucfirst $result
- }
+ },
- when(ACT_COP){
+ ACT_COP => sub {
my $result = $players{$target}{faction} eq mafia;
$result = 1 if $players{$target}{miller};
$result = 0 if $players{$target}{godfather};
msg MSG_COP, %args, result => $result
- }
+ },
- when(ACT_HIDE){
+ ACT_HIDE => sub {
$tplayers{$source}{hidden} = 1;
$tplayers{$target}{hiders} //= [];
- push $tplayers{$target}{hiders}, $source
- }
- }
+ push @{$tplayers{$target}{hiders}}, $source
+ },
+ );
+
+ $act_lut{$type}->();
}
sub process_phase_change {
my ($name, @args) = @_;
my %player;
for my $trait (@args) {
- given ($trait) {
- $player{role} = $trait when ROLE;
- $player{faction} = $trait when FACTION;
- $player{$trait} = 1 when FLAG;
- }
+ $player{role} = $trait if $ROLE_HASH{$trait};
+ $player{faction} = $trait if $FACTION_HASH{$trait};
+ $player{$trait} = 1 if $FLAG_HASH{$trait};
}
$players{$name} = \%player;
night;
-=head1 DESCRPTION
+=head1 DESCRIPTION
Mafia.pm is a Perl extension for easily moderating Mafia games. You don't even need to know Perl to use it (see L<"WHAT YOU NEED TO KNOW"> for details).
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2013 by Marius Gavrilescu
+Copyright (C) 2013-2015 by Marius Gavrilescu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
projects / mafia.git / blobdiff