view release on metacpan or  search on metacpan

lib/Alice/Role/Commands.pm  view on Meta::CPAN

package Alice::Role::Commands;

use Any::Moose 'Role';

use List::MoreUtils qw/none/;
use Try::Tiny;
use Class::Throwable qw/NetworkRequired InvalidNetwork ChannelRequired
                        InvalidArguments UnknownCommand/;

our %COMMANDS;
my $SRVOPT = qr/\-(\S+)\s*/;

sub commands {
  return grep {$_->{eg}} values %COMMANDS;
}

sub irc_command {
  my ($self, $req) = @_;

  try {
    my ($command, $args) = $self->match_irc_command($req->line);
    if ($command) {
      $self->run_irc_command($command, $req, $args);
    }
    else {
      throw UnknownCommand $req->line ." does not match any known commands. Try /help";
    }
  }
  catch {
    $req->reply("$_");
  }
}

sub match_irc_command {
  my ($self, $line) = @_;

  $line = "/say $line" unless substr($line, 0, 1) eq "/";

  for my $name (keys %COMMANDS) {

    if ($line =~ m{^/$name\b\s*(.*)}) {
      my $args = $1;
      return ($name, $args);
    }
  }
}

sub run_irc_command {
  my ($self, $name, $req, $args) = @_;
  my $command = $COMMANDS{$name};
  my $opts = [];

  # must be in a channel
  my $type = $req->window->type;
  if ($command->{window_type} and none {$_ eq $type} @{$command->{window_type}}) {
    my $types = join " or ", @{$command->{window_type}};
    throw ChannelRequired "Must be in a $types for /$command->{name}.";
  }

  my $network = $req->window->network;

  # determine the network can be overridden
  if ($command->{network} and $args =~ s/^$SRVOPT//) {
    $network = $1;
  }