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
|
package Mock::CommandRegistry;
use strict;
use warnings;
use fields qw/_commands/;
sub new {
my Mock::CommandRegistry $self = shift;
unless ($self) {
$self = fields::new($self);
$self->{_commands} = {};
}
bless {}, $self;
}
sub run {
my ($self, $command, %ctx) = @_;
# XXX should run all commands matching? Only first?
...
}
sub run_owned {
my ($self, $owner, $command, %ctx) = @_;
die "$owner::$command not registered\n"
unless $self->is_registered_to_owner($owner, $command);
# XXX plugins need to eventually use the ctx hash directly. Much more
# readable than remembering the long chain of magic positional args each
# time you write a new cmd plugin
my @args = (
$ctx{irc},
$ctx{logger},
$ctx{who},
$ctx{where},
$ctx{ided},
$ctx{rest},
$ctx{no_reenter},
$ctx{args}
);
$self->{_commands}->{$owner}->{$command}->(@args);
}
sub is_registered {
my ($self, $command) = @_;
# XXX should tell if any owner registers a given command
...
}
sub is_registered_to_owner {
my ($self, $owner, $command) = @_;
defined $self->{_commands}->{$owner}->{$command};
}
sub register {
my ($self, $owner, $command, $coderef) = @_;
$self->{_commands}->{$owner}->{$command} = $coderef;
}
1;
|
