# 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. # 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/. package PBot::Commands; use warnings; use strict; use base 'PBot::Registerable'; use Carp (); use Text::ParseWords qw(shellwords); 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 { my ($self, $subref, $name, $level) = @_; 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; } sub unregister { 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} }; } sub exists { my $self = shift; my ($keyword) = @_; foreach my $ref (@{ $self->{handlers} }) { return 1 if $ref->{name} eq lc $keyword; } return 0; } sub interpreter { my $self = shift; my ($from, $nick, $user, $host, $depth, $keyword, $arguments, $tonick, $unused, $referenced) = @_; my $result; my $pbot = $self->{pbot}; my $admin = $pbot->{admins}->loggedin($from, "$nick!$user\@$host"); my $level = defined $admin ? $admin->{level} : 0; my $keyword = lc $keyword; foreach my $ref (@{ $self->{handlers} }) { if($ref->{name} eq $keyword) { if($level >= $ref->{level}) { my $result = &{ $ref->{subref} }($from, $nick, $user, $host, $arguments); if ($referenced) { return undef if $result =~ m/(?:usage:|no results)/i; } return $result; } else { return undef if $referenced; 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; } sub parse_arguments { my ($self, $arguments) = @_; return shellwords($arguments); } 1;