#**************************************************************************
-# Copyright (C) 2008 by Michael Andreen <harvATruinDOTnu> *
+# 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 *
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *
#**************************************************************************/
-package NDIRC::Commands::Basic;
-
use strict;
use warnings;
-use Moose;
-use MooseX::MethodAttributes;
+use MooseX::Declare;
+use NDIRC::Dispatcher;
-sub commands
- : Help(commands <command> | Gives help about all available commands or lists all commands available in the current channel)
-{
- my ($self, $c, $command) = @_;
+command commands => {
+ help => q(commands <command> | Gives help about all available commands or lists all commands available in the current channel),
+}, class extends NDIRC::Command {
+ method execute ($c,$command) {
+ unless($command){
+ my @commands;
+ for (sort keys %{$c->disp->commands}){
+ next unless $c->disp->has_command($_,$c->channel);
+ my $acl = $c->disp->commands->{$_}->acl;
+ next if $acl && !$c->check_user_roles($acl);
- unless($command){
- my @commands;
- for (sort keys %{$c->disp->commands}){
- next unless $c->disp->has_command($_,$c->channel);
- my $acl = $c->disp->commands->{$_}->acl;
- next if $acl && !$c->check_user_roles(@$acl);
-
- push @commands,$_;
- }
- $c->reply(join ', ', @commands);
- }elsif (exists $c->disp->commands->{$command}){
- for (@{$c->disp->commands->{$command}->help}){
- $c->reply($_);
+ push @commands,$_;
+ }
+ $c->reply(join ', ', @commands);
+ }elsif (exists $c->disp->commands->{$command}){
+ for (@{$c->disp->commands->{$command}->help}){
+ $c->reply($_);
+ }
}
}
+};
-}
-
-sub help
- : Help(Prints basic help)
- : Type(help)
-{
- my ($self, $c, $command) = @_;
+command help => {
+ help => q(Prints basic help),
+ type => 'help',
+}, class extends NDIRC::Command {
+ method execute ($c,$command) {
- $c->reply("Use .commands <command> to show help about a specific command. "
- . "Use .commands to list the diffenrent commands you have access to in this channel. "
- . "Instead of . you can use ! to get reply in pm or ~ to get reply in channel.");
-}
+ $c->reply("Use .commands <command> to show help about a specific command. "
+ . "Use .commands to list the diffenrent commands you have access to in this channel. "
+ . "Instead of . you can use ! to get reply in pm or ~ to get reply in channel.");
+ }
+};
-sub say
- : Help(.say target message | sends message to target)
- : Type(pm)
- : ACL(irc_say)
-{
- my ($self, $c, $msg) = @_;
- my ($target,$message) = $msg =~ /^(\S+)\s+(.+)$/ or die 'ARGS';
+command say => {
+ help => q(.say target message | sends message to target),
+ type => q(pm),
+ acl => q(irc_say),
+}, class extends NDIRC::Command {
+ method execute ($c,$msg) {
+ my ($target,$message) = $msg =~ /^(\S+)\s+(.+)$/ or die 'ARGS';
- $c->message(privmsg => $target => $message );
-}
+ $c->message(privmsg => $target => $message );
+ }
+};
-sub cmd
- : Help(.run command args | run a given command)
- : Type(pm)
- : ACL(irc_cmd)
-{
- my ($self, $c, $msg) = @_;
+command cmd => {
+ help => q(.cmd command args | run a given irc command),
+ type => q(pm),
+ acl => q(irc_cmd),
+}, class extends NDIRC::Command {
+ method execute ($c,$msg) {
- $c->command(split /\s/, $msg);
-}
+ $c->command(split /\s/, $msg);
+ }
+};
1;
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',
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;
}
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 {
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 //= '';
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. '$_'");