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