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 Moose::Exporter;
  27 use Set::Object ();
  28
  29 use NDIRC::Command;
  30
  31 Moose::Exporter->setup_import_methods(
  32         as_is => [ 'command' ]
  33 );
  34
  35
  36
  37 has commands => (
  38         is => 'ro',
  39         isa => 'HashRef[Object]',
  40         default => sub{ {} },
  41 );
  42
  43 has channels => (
  44         is => 'ro',
  45         isa => 'HashRef[ArrayRef[Str]]',
  46         default => sub{ {} },
  47 );
  48
  49
  50 my $DISP;
  51
  52 sub load {
  53         my $self = shift;
  54
  55         $DISP = $self;
  56
  57         for (@_){
  58                 my $file = "NDIRC/Commands/$_.pm";
  59
  60                 unless (my $return = do $file){
  61                         warn "couldn't parse $file: $@" if $@;
  62                         warn "couldn't do $file: $!"    if $!;
  63                         warn "couldn't run $file"       unless $return;
  64                 }
  65         }
  66         $DISP = undef;
  67 }
  68
  69 sub command ($$$) {
  70         my ($c,$a,$class) = @_;
  71         my %c = %{$a};
  72         my @aliases;
  73         if (exists $c{alias}){
  74                 @aliases = @{$c{alias}} if ref $c{alias} eq 'ARRAY';
  75                 push @aliases, $c{alias} if ref $c{alias} eq '';
  76         }
  77         push @aliases, $c;
  78         say "Command: (@aliases)";
  79         for my $a (@aliases){
  80                 $c{name} = $a;
  81                 my $co = $class->new_object(\%c);
  82                 $DISP->commands->{$a} = $co;
  83         }
  84 }
  85
  86 sub add_channel {
  87         my ($self,$channel,$types) = @_;
  88
  89         $types = Set::Object->new(@{$types});
  90         $types->insert('universal');
  91         $self->channels->{lc $channel} = $types;
  92 }
  93
  94 sub has_command {
  95         my ($self,$command,$channel) = @_;
  96         $channel = lc $channel;
  97
  98         return 0 unless defined $command && defined $channel;
  99         return 0 unless exists $self->commands->{$command};
 100         $command = $self->commands->{$command};
 101         return 1 if $command->type eq 'universal';
 102         return 0 unless exists $self->channels->{$channel};
 103
 104         return $self->channels->{$channel}->has($command->type);
 105 }
 106
 107 sub run_command {
 108         my ($self,$c,$command,$args) = @_;
 109
 110         return 0 unless exists $self->commands->{$command};
 111         my $acl = $self->commands->{$command}->acl;
 112         return 0 if $acl && !$c->check_user_roles($acl);
 113
 114         $args //= '';
 115
 116         eval {
 117                 $self->commands->{$command}->execute($c,$args)
 118         };
 119         if ($@){
 120                 given ($@){
 121                         when(/^ARGS/){
 122                                 $c->reply($c->disp->commands->{$command}->help);
 123                         }
 124                         default {
 125                                 $c->reply("Something went wrong. If it is not temporary, please report it. '$_'");
 126                         }
 127                 }
 128         }
 129         return 1;
 130 }
 131
 132 1;