Basic infrastructure for new irc command dispatcher

[NDIRC.git] / Dispatcher.pm

diff --git a/Dispatcher.pm b/Dispatcher.pm
new file mode 100644 (file)
index 0000000..5da34bd
--- /dev/null
+++ b/Dispatcher.pm
@@ -0,0 +1,151 @@
+#**************************************************************************
+#   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  *
+#   the Free Software Foundation; either version 2 of the License, or     *
+#   (at your option) any later version.                                   *
+#                                                                         *
+#   This program is distributed in the hope that it will be useful,       *
+#   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
+#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
+#   GNU General Public License for more details.                          *
+#                                                                         *
+#   You should have received a copy of the GNU General Public License     *
+#   along with this program; if not, write to the                         *
+#   Free Software Foundation, Inc.,                                       *
+#   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
+#**************************************************************************/
+
+package NDIRC::Dispatcher;
+use strict;
+use warnings;
+use feature ':5.10';
+
+use Moose;
+use Symbol;
+use Set::Object ();
+
+use NDIRC::Command;
+
+
+has commands => (
+       is => 'rw',
+       isa => 'HashRef[Object]',
+       default => sub{ {} },
+);
+
+has channels => (
+       is => 'rw',
+       isa => 'HashRef[ArrayRef[Str]]',
+       default => sub{ {} },
+);
+
+sub load {
+       my $self = shift;
+
+       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 {
+                       print "Loading $class\n";
+                       $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 add_channel {
+       my ($self,$channel,$types) = @_;
+
+       $self->channels->{lc $channel} = $types;
+}
+
+sub has_command {
+       my ($self,$command,$channel) = @_;
+       $channel = lc $channel;
+
+       return 0 unless 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};
+
+       for (@types){
+               return 1 if $types->element($_);
+       }
+       return 0;
+}
+
+sub run_command {
+       my ($self,$c,$command,$args) = @_;
+
+       return 0 unless exists $self->commands->{$command};
+       my $acl = $self->commands->{$command}->acl;
+       return 0 if $acl && !$c->check_user_roles(@$acl);
+
+       $args //= '';
+
+       eval {
+               $self->commands->{$command}->execute($c,$args)
+       };
+       if ($@){
+               given ($@){
+                       when(/^ARGS/){
+                               for (@{$c->disp->commands->{$command}->help}){
+                                       $c->reply($_);
+                               }
+                       }
+                       default {
+                               $c->reply("Something went wrong. If it is not temporary, please report it. '$_'");
+                       }
+               }
+       }
+}
+
+1;