X-Git-Url: https://ruin.nu/git/?p=NDIRC.git;a=blobdiff_plain;f=Dispatcher.pm;h=107ed7eaa778fc962f44281a667317c984cd32ac;hp=7c4b0a60618c10eaa56180bf1dcd9729102c38b9;hb=52aa24ac076b97096ff29e7a59331654620f230c;hpb=f58cbcf0fb3bfa5d89c5bb3b7fb928d8b1f35c9a diff --git a/Dispatcher.pm b/Dispatcher.pm index 7c4b0a6..107ed7e 100644 --- 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. '$_'");