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.

diff --git a/Command.pm b/Command.pm
index e38ba131f5211f6c3712163b5195029d9fadcb79..62429366c3cf946280f44b77e4fc4117ebffaf74 100644 (file)
--- 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 fd30f0f728ec4b5aad9302e591166eadd6073211..1249f201586bc6155be184807f3ddee1697196bb 100644 (file)
--- a/Commands/Basic.pm
+++ b/Commands/Basic.pm
@@ -1,5 +1,5 @@
 #**************************************************************************
-#   Copyright (C) 2008 by Michael Andreen <harvATruinDOTnu>               *
+#   Copyright (C) 2009 by Michael Andreen <harvATruinDOTnu>               *
 #                                                                         *
 #   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 <command> | Gives help about all available commands or lists all commands available in the current channel)
-{
-       my ($self, $c, $command) = @_;
+command commands => {
+       help => q(commands <command> | 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 <command> 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 <command> 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 7c4b0a60618c10eaa56180bf1dcd9729102c38b9..107ed7eaa778fc962f44281a667317c984cd32ac 100644 (file)
--- 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. '$_'");