1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/usr/bin/perl
package Bot::Games;
use Bot::Games::OO;
use Module::Pluggable
search_path => 'Bot::Games::Game',
except => ['Bot::Games::Game::Ghostlike'],
sub_name => 'games';
extends 'Bot::BasicBot';
has prefix => (
is => 'rw',
isa => 'Str',
default => '!',
);
has active_games => (
is => 'ro',
isa => 'HashRef[Bot::Games::Game]',
lazy => 1,
default => sub { {} },
);
has done_init => (
is => 'ro',
isa => 'HashRef[Bool]',
lazy => 1,
default => sub { {} },
);
sub _get_command {
my ($game, $action) = @_;
my $method_meta = $game->meta->find_method_by_name($action);
return $method_meta
if blessed($method_meta)
&& $method_meta->meta->can('does_role')
&& $method_meta->meta->does_role('Bot::Games::Meta::Role::Command');
}
sub said {
my $self = shift;
my ($args) = @_;
my $prefix = $self->prefix;
my $say = sub { $self->say(%$args, body => $self->_format(@_)) };
return if $args->{channel} eq 'msg';
return unless $args->{body} =~ /^$prefix(\w+)(?:\s+(.*))?/;
my ($game_name, $action) = ($1, $2);
return unless $self->valid_game($game_name);
my $output;
my $game = $self->active_games->{$game_name};
if (!defined $game) {
my $game_package = $self->game_package($game_name);
eval "require $game_package";
$game = $game_package->new;
$self->active_games->{$game_name} = $game;
$self->done_init->{$game_name} = 0;
}
if (!$self->done_init->{$game_name}
&& (!defined($action) || $action !~ /^-/)) {
$say->($game->init($args->{who})) if $game->can('init');
$self->done_init->{$game_name} = 1;
}
return unless defined $action;
if ($action =~ /^-(\w+)\s*(.*)/) {
my ($action, $arg) = ($1, $2);
# XXX: maybe the meta stuff should get pushed out into the plugins
# themselves, and this should become $game->meta->get_command or so?
if (my $method_meta = _get_command($game, $action)) {
$say->($method_meta->execute($game, $arg,
{player => $args->{who}}));
}
else {
$say->("Unknown command $action for game $game_name");
}
}
else {
# XXX: need better handling for "0", but B::BB doesn't currently
# handle that properly either, so
# also, this should probably be factored into $say, i think?
my $turn = $game->turn($args->{who}, $action);
$say->($turn) if $turn;
}
if (my $end_msg = $game->is_over) {
$say->($end_msg);
delete $self->active_games->{$game_name};
}
return;
}
sub valid_game {
my $self = shift;
my ($name) = @_;
my $package = $self->game_package($name);
return (grep { $package eq $_ } $self->games) ? 1 : 0;
}
sub game_package {
my $self = shift;
my ($name) = @_;
return 'Bot::Games::Game::' . ucfirst($name);
}
sub _format {
my $self = shift;
my ($to_print) = @_;
if (blessed $to_print) {
$to_print = "$to_print";
}
elsif (ref($to_print) && ref($to_print) eq 'ARRAY') {
$to_print = join ', ', @$to_print;
}
elsif (!$to_print) {
$to_print = 'false';
}
return $to_print;
}
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
no Bot::Games::OO;
1;
|
