From 52aa24ac076b97096ff29e7a59331654620f230c Mon Sep 17 00:00:00 2001 From: Michael Andreen Date: Sun, 29 Nov 2009 00:01:10 +0100 Subject: [PATCH] New infrastructure for commands with basic commands converted Replace the method attributes and instead let every command extend the Command class. Provide a command subroutine that is used to register commands, which takes name, a hash of parameters and the class. The Command class is simplified, the help, type and acl are reduced to just one string instead of a list of strings. --- Command.pm | 17 +++----- Commands/Basic.pm | 100 +++++++++++++++++++++++----------------------- Dispatcher.pm | 87 ++++++++++++++-------------------------- 3 files changed, 86 insertions(+), 118 deletions(-) diff --git a/Command.pm b/Command.pm index e38ba13..6242936 100644 --- a/Command.pm +++ b/Command.pm @@ -25,37 +25,30 @@ use Moose; has acl => ( is => 'ro', - isa => 'ArrayRef[Str]', + isa => 'Str', predicate => 'has_acl', ); has type => ( is => 'ro', - isa => 'ArrayRef[Str]', - default => sub { ['pub'] }, + isa => 'Str', + default => 'pub', ); has help => ( - is => 'ro', - isa => 'ArrayRef[Str]', - default => sub{ ['No help for this command'] }, -); - -has name => ( is => 'ro', isa => 'Str', default => 'No help for this command', ); -has func => ( +has name => ( is => 'ro', - isa => 'CodeRef', + isa => 'Str', required => 1, ); sub execute { my ($self,$c,$args) = @_; - $self->func->(@_); } 1; diff --git a/Commands/Basic.pm b/Commands/Basic.pm index fd30f0f..1249f20 100644 --- a/Commands/Basic.pm +++ b/Commands/Basic.pm @@ -1,5 +1,5 @@ #************************************************************************** -# Copyright (C) 2008 by Michael Andreen * +# Copyright (C) 2009 by Michael Andreen * # * # This program is free software; you can redistribute it and/or modify * # it under the terms of the GNU General Public License as published by * @@ -17,68 +17,68 @@ # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * #**************************************************************************/ -package NDIRC::Commands::Basic; - use strict; use warnings; -use Moose; -use MooseX::MethodAttributes; +use MooseX::Declare; +use NDIRC::Dispatcher; -sub commands - : Help(commands | Gives help about all available commands or lists all commands available in the current channel) -{ - my ($self, $c, $command) = @_; +command commands => { + help => q(commands | Gives help about all available commands or lists all commands available in the current channel), +}, class extends NDIRC::Command { + method execute ($c,$command) { + unless($command){ + my @commands; + for (sort keys %{$c->disp->commands}){ + next unless $c->disp->has_command($_,$c->channel); + my $acl = $c->disp->commands->{$_}->acl; + next if $acl && !$c->check_user_roles($acl); - unless($command){ - my @commands; - for (sort keys %{$c->disp->commands}){ - next unless $c->disp->has_command($_,$c->channel); - my $acl = $c->disp->commands->{$_}->acl; - next if $acl && !$c->check_user_roles(@$acl); - - push @commands,$_; - } - $c->reply(join ', ', @commands); - }elsif (exists $c->disp->commands->{$command}){ - for (@{$c->disp->commands->{$command}->help}){ - $c->reply($_); + push @commands,$_; + } + $c->reply(join ', ', @commands); + }elsif (exists $c->disp->commands->{$command}){ + for (@{$c->disp->commands->{$command}->help}){ + $c->reply($_); + } } } +}; -} - -sub help - : Help(Prints basic help) - : Type(help) -{ - my ($self, $c, $command) = @_; +command help => { + help => q(Prints basic help), + type => 'help', +}, class extends NDIRC::Command { + method execute ($c,$command) { - $c->reply("Use .commands to show help about a specific command. " - . "Use .commands to list the diffenrent commands you have access to in this channel. " - . "Instead of . you can use ! to get reply in pm or ~ to get reply in channel."); -} + $c->reply("Use .commands to show help about a specific command. " + . "Use .commands to list the diffenrent commands you have access to in this channel. " + . "Instead of . you can use ! to get reply in pm or ~ to get reply in channel."); + } +}; -sub say - : Help(.say target message | sends message to target) - : Type(pm) - : ACL(irc_say) -{ - my ($self, $c, $msg) = @_; - my ($target,$message) = $msg =~ /^(\S+)\s+(.+)$/ or die 'ARGS'; +command say => { + help => q(.say target message | sends message to target), + type => q(pm), + acl => q(irc_say), +}, class extends NDIRC::Command { + method execute ($c,$msg) { + my ($target,$message) = $msg =~ /^(\S+)\s+(.+)$/ or die 'ARGS'; - $c->message(privmsg => $target => $message ); -} + $c->message(privmsg => $target => $message ); + } +}; -sub cmd - : Help(.run command args | run a given command) - : Type(pm) - : ACL(irc_cmd) -{ - my ($self, $c, $msg) = @_; +command cmd => { + help => q(.cmd command args | run a given irc command), + type => q(pm), + acl => q(irc_cmd), +}, class extends NDIRC::Command { + method execute ($c,$msg) { - $c->command(split /\s/, $msg); -} + $c->command(split /\s/, $msg); + } +}; 1; diff --git a/Dispatcher.pm b/Dispatcher.pm index 7c4b0a6..107ed7e 100644 --- a/Dispatcher.pm +++ b/Dispatcher.pm @@ -23,11 +23,16 @@ use warnings; use feature ':5.10'; use Moose; -use Symbol; +use Moose::Exporter; use Set::Object (); use NDIRC::Command; +Moose::Exporter->setup_import_methods( + as_is => [ 'command' ] +); + + has commands => ( is => 'ro', @@ -47,68 +52,45 @@ has targets => ( default => sub{ {} }, ); +my $DISP; + sub load { my $self = shift; + $DISP = $self; + for (@_){ - my $class = "NDIRC::Commands::$_"; my $file = "NDIRC/Commands/$_.pm"; - Symbol::delete_package($class); unless (my $return = do $file){ warn "couldn't parse $file: $@" if $@; warn "couldn't do $file: $!" if $!; warn "couldn't run $file" unless $return; - }else { - say "\nLoading $class"; - $self->load_class($class); - } } } -sub load_class { - my ($self,$class) = @_; - - my @subs = eval "$class->meta->get_method_list"; - for my $c (@subs){ - my $attr = eval "$class->meta->get_method('$c')->attributes"; - if (@$attr){ - print "Command: $c "; - my %c = (channels => ['all']); - my @aliases; - for (@{$attr}){ - #Parse attributes, from Attribute::Handlers - my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next; - my $evaled = eval("package Temp; no warnings; - local \$SIG{__WARN__}=sub{die}; [$data]"); - $evaled = ($evaled && $data =~ /^\s*\[/) ? [$evaled] - : ($evaled) ? $evaled : [$data]; - - given ($attr){ - when ('Alias'){ - @aliases = @$evaled; - } - default { - $c{lc $attr} = $evaled; - } - } - } - push @aliases, $c; - my $f = eval "\\&${class}::$c"; - $c{func} = $f; - for my $a (@aliases){ - $c{name} = $a; - my $co = NDIRC::Command->new(\%c); - $self->commands->{$a} = $co; - } - } +sub command ($$$) { + my ($c,$a,$class) = @_; + my %c = %{$a}; + my @aliases; + if (exists $c{alias}){ + @aliases = @{$c{alias}} if ref $c{alias} eq 'ARRAY'; + push @aliases, $c{alias} if ref $c{alias} eq ''; + } + push @aliases, $c; + say "Command: (@aliases)"; + for my $a (@aliases){ + $c{name} = $a; + my $co = $class->new_object(\%c); + $DISP->commands->{$a} = $co; } } sub add_channel { my ($self,$channel,$types) = @_; + $types = Set::Object->new(@{$types}); $self->channels->{lc $channel} = $types; } @@ -116,16 +98,11 @@ sub has_command { my ($self,$command,$channel) = @_; $channel = lc $channel; - return 0 unless defined $command && exists $self->commands->{$command}; - - my $types = Set::Object->new(@{$self->commands->{$command}->type}); - my @types = qw/pub/; - @types = @{$self->channels->{$channel}} if exists $self->channels->{$channel}; + return 0 unless exists $self->commands->{$command}; + return 0 unless exists $self->channels->{$channel}; - for (@types){ - return 1 if $types->element($_); - } - return 0; + $command = $self->commands->{$command}; + return $self->channels->{$channel}->has($command->type); } sub set_target { @@ -138,7 +115,7 @@ sub run_command { return 0 unless exists $self->commands->{$command}; my $acl = $self->commands->{$command}->acl; - return 0 if $acl && !$c->check_user_roles(@$acl); + return 0 if $acl && !$c->check_user_roles($acl); $args //= ''; @@ -148,9 +125,7 @@ sub run_command { if ($@){ given ($@){ when(/^ARGS/){ - for (@{$c->disp->commands->{$command}->help}){ - $c->reply($_); - } + $c->reply($c->disp->commands->{$command}->help); } default { $c->reply("Something went wrong. If it is not temporary, please report it. '$_'"); -- 2.39.2