Dispatcher.pm

   1 #**************************************************************************
   2 #   Copyright (C) 2009 by Michael Andreen <harvATruinDOTnu>               *
   3 #                                                                         *
   4 #   This program is free software; you can redistribute it and/or modify  *
   5 #   it under the terms of the GNU General Public License as published by  *
   6 #   the Free Software Foundation; either version 2 of the License, or     *
   7 #   (at your option) any later version.                                   *
   8 #                                                                         *
   9 #   This program is distributed in the hope that it will be useful,       *
  10 #   but WITHOUT ANY WARRANTY; without even the implied warranty of        *
  11 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *
  12 #   GNU General Public License for more details.                          *
  13 #                                                                         *
  14 #   You should have received a copy of the GNU General Public License     *
  15 #   along with this program; if not, write to the                         *
  16 #   Free Software Foundation, Inc.,                                       *
  17 #   51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.         *
  18 #**************************************************************************/
  19
  20 package NDIRC::Dispatcher;
  21 use strict;
  22 use warnings;
  23 use feature ':5.10';
  24
  25 use Moose;
  26 use Symbol;
  27 use Set::Object ();
  28
  29 use NDIRC::Command;
  30
  31
  32 has commands => (
  33         is => 'rw',
  34         isa => 'HashRef[Object]',
  35         default => sub{ {} },
  36 );
  37
  38 has channels => (
  39         is => 'rw',
  40         isa => 'HashRef[ArrayRef[Str]]',
  41         default => sub{ {} },
  42 );
  43
  44 sub load {
  45         my $self = shift;
  46
  47         for (@_){
  48                 my $class = "NDIRC::Commands::$_";
  49                 my $file = "NDIRC/Commands/$_.pm";
  50                 Symbol::delete_package($class);
  51
  52                 unless (my $return = do $file){
  53                         warn "couldn't parse $file: $@" if $@;
  54                         warn "couldn't do $file: $!"    if $!;
  55                         warn "couldn't run $file"       unless $return;
  56                 }else {
  57                         print "Loading $class\n";
  58                         $self->load_class($class);
  59
  60                 }
  61         }
  62 }
  63
  64 sub load_class {
  65         my ($self,$class) = @_;
  66
  67         my @subs = eval "$class->meta->get_method_list";
  68         for my $c (@subs){
  69                 my $attr = eval "$class->meta->get_method('$c')->attributes";
  70                 if (@$attr){
  71                         print "Command: $c";
  72                         my %c = (channels => ['all']);
  73                         my @aliases;
  74                         for (@{$attr}){
  75                                 #Parse attributes, from Attribute::Handlers
  76                                 my ($attr, $data) = /^([a-z_]\w*)(?:[(](.*)[)])?$/is or next;
  77                                 my $evaled = eval("package Temp; no warnings;
  78                 local \$SIG{__WARN__}=sub{die}; [$data]");
  79                                 $evaled = ($evaled && $data =~ /^\s*\[/)  ? [$evaled]
  80                                         : ($evaled) ? $evaled : [$data];
  81
  82                                 given ($attr){
  83                                         when ('Alias'){
  84                                                 @aliases = @$evaled;
  85                                         }
  86                                         default {
  87                                                 $c{lc $attr} = $evaled;
  88                                         }
  89                                 }
  90                         }
  91                         push @aliases, $c;
  92                         my $f = eval "\\&${class}::$c";
  93                         $c{func} = $f;
  94                         for my $a (@aliases){
  95                                 $c{name} = $a;
  96                                 my $co = NDIRC::Command->new(\%c);
  97                                 $self->commands->{$a} = $co;
  98                         }
  99                 }
 100         }
 101 }
 102
 103 sub add_channel {
 104         my ($self,$channel,$types) = @_;
 105
 106         $self->channels->{lc $channel} = $types;
 107 }
 108
 109 sub has_command {
 110         my ($self,$command,$channel) = @_;
 111         $channel = lc $channel;
 112
 113         return 0 unless defined $command && exists $self->commands->{$command};
 114
 115         my $types = Set::Object->new(@{$self->commands->{$command}->type});
 116         my @types = qw/pub/;
 117         @types = @{$self->channels->{$channel}} if exists $self->channels->{$channel};
 118
 119         for (@types){
 120                 return 1 if $types->element($_);
 121         }
 122         return 0;
 123 }
 124
 125 sub run_command {
 126         my ($self,$c,$command,$args) = @_;
 127
 128         return 0 unless exists $self->commands->{$command};
 129         my $acl = $self->commands->{$command}->acl;
 130         return 0 if $acl && !$c->check_user_roles(@$acl);
 131
 132         $args //= '';
 133
 134         eval {
 135                 $self->commands->{$command}->execute($c,$args)
 136         };
 137         if ($@){
 138                 given ($@){
 139                         when(/^ARGS/){
 140                                 for (@{$c->disp->commands->{$command}->help}){
 141                                         $c->reply($_);
 142                                 }
 143                         }
 144                         default {
 145                                 $c->reply("Something went wrong. If it is not temporary, please report it. '$_'");
 146                         }
 147                 }
 148         }
 149         return 1;
 150 }
 151
 152 1;