2010-03-22 08:33:44 +01:00
|
|
|
# File: Commands.pm
|
|
|
|
# Author: pragma_
|
|
|
|
#
|
|
|
|
# Purpose: Derives from Registerable class to provide functionality to
|
|
|
|
# register subroutines, along with a command name and admin level.
|
|
|
|
# Registered items will then be executed if their command name matches
|
|
|
|
# a name provided via input.
|
|
|
|
|
2017-03-05 22:33:31 +01:00
|
|
|
# This Source Code Form is subject to the terms of the Mozilla Public
|
|
|
|
# License, v. 2.0. If a copy of the MPL was not distributed with this
|
|
|
|
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
package PBot::Commands;
|
|
|
|
|
|
|
|
use warnings;
|
|
|
|
use strict;
|
|
|
|
|
|
|
|
use base 'PBot::Registerable';
|
|
|
|
|
|
|
|
use Carp ();
|
2014-05-22 03:24:14 +02:00
|
|
|
use Text::ParseWords qw(shellwords);
|
2010-03-22 08:33:44 +01:00
|
|
|
|
|
|
|
sub new {
|
|
|
|
if(ref($_[1]) eq 'HASH') {
|
|
|
|
Carp::croak("Options to Commands should be key/value pairs, not hash reference");
|
|
|
|
}
|
|
|
|
|
|
|
|
my ($class, %conf) = @_;
|
|
|
|
|
|
|
|
my $self = bless {}, $class;
|
|
|
|
$self->initialize(%conf);
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub initialize {
|
|
|
|
my ($self, %conf) = @_;
|
|
|
|
|
|
|
|
$self->SUPER::initialize(%conf);
|
|
|
|
|
|
|
|
my $pbot = delete $conf{pbot};
|
|
|
|
if(not defined $pbot) {
|
|
|
|
Carp::croak("Missing pbot reference to PBot::Commands");
|
|
|
|
}
|
|
|
|
|
|
|
|
$self->{pbot} = $pbot;
|
|
|
|
$self->{name} = undef;
|
|
|
|
$self->{level} = undef;
|
|
|
|
}
|
|
|
|
|
|
|
|
sub register {
|
2016-02-14 03:38:43 +01:00
|
|
|
my ($self, $subref, $name, $level) = @_;
|
2010-03-22 08:33:44 +01:00
|
|
|
|
|
|
|
if((not defined $subref) || (not defined $name) || (not defined $level)) {
|
|
|
|
Carp::croak("Missing parameters to Commands::register");
|
|
|
|
}
|
|
|
|
|
|
|
|
$name = lc $name;
|
|
|
|
|
|
|
|
my $ref = $self->SUPER::register($subref);
|
|
|
|
|
|
|
|
$ref->{name} = $name;
|
|
|
|
$ref->{level} = $level;
|
|
|
|
|
|
|
|
return $ref;
|
|
|
|
}
|
|
|
|
|
2016-02-14 03:38:43 +01:00
|
|
|
sub unregister {
|
2010-03-22 08:33:44 +01:00
|
|
|
my ($self, $name) = @_;
|
|
|
|
|
|
|
|
if(not defined $name) {
|
|
|
|
Carp::croak("Missing name parameter to Commands::unregister");
|
|
|
|
}
|
|
|
|
|
|
|
|
$name = lc $name;
|
|
|
|
|
|
|
|
@{ $self->{handlers} } = grep { $_->{name} ne $name } @{ $self->{handlers} };
|
|
|
|
}
|
|
|
|
|
2015-04-04 00:33:19 +02:00
|
|
|
sub exists {
|
|
|
|
my $self = shift;
|
|
|
|
my ($keyword) = @_;
|
|
|
|
|
|
|
|
foreach my $ref (@{ $self->{handlers} }) {
|
2017-08-03 22:30:18 +02:00
|
|
|
return 1 if $ref->{name} eq lc $keyword;
|
2015-04-04 00:33:19 +02:00
|
|
|
}
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
sub interpreter {
|
|
|
|
my $self = shift;
|
2015-09-04 05:56:44 +02:00
|
|
|
my ($from, $nick, $user, $host, $depth, $keyword, $arguments, $tonick, $unused, $referenced) = @_;
|
2010-03-22 08:33:44 +01:00
|
|
|
my $result;
|
|
|
|
|
|
|
|
my $pbot = $self->{pbot};
|
|
|
|
|
2014-05-18 22:09:05 +02:00
|
|
|
my $admin = $pbot->{admins}->loggedin($from, "$nick!$user\@$host");
|
2010-03-22 08:33:44 +01:00
|
|
|
|
|
|
|
my $level = defined $admin ? $admin->{level} : 0;
|
|
|
|
|
2017-08-03 22:30:18 +02:00
|
|
|
my $keyword = lc $keyword;
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
foreach my $ref (@{ $self->{handlers} }) {
|
|
|
|
if($ref->{name} eq $keyword) {
|
|
|
|
if($level >= $ref->{level}) {
|
2015-09-04 05:56:44 +02:00
|
|
|
my $result = &{ $ref->{subref} }($from, $nick, $user, $host, $arguments);
|
|
|
|
if ($referenced) {
|
|
|
|
return undef if $result =~ m/(?:usage:|no results)/i;
|
|
|
|
}
|
|
|
|
return $result;
|
2010-03-22 08:33:44 +01:00
|
|
|
} else {
|
2015-09-04 05:56:44 +02:00
|
|
|
return undef if $referenced;
|
2010-03-22 08:33:44 +01:00
|
|
|
if($level == 0) {
|
|
|
|
return "/msg $nick You must login to use this command.";
|
|
|
|
} else {
|
|
|
|
return "/msg $nick You are not authorized to use this command.";
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
|
2014-05-22 03:24:14 +02:00
|
|
|
sub parse_arguments {
|
|
|
|
my ($self, $arguments) = @_;
|
|
|
|
return shellwords($arguments);
|
|
|
|
}
|
|
|
|
|
2010-03-22 08:33:44 +01:00
|
|
|
1;
|