# File: Plugins.pm # Author: pragma- # # Purpose: Loads and manages plugins. # 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::Plugins; use warnings; use strict; use feature 'unicode_strings'; use File::Basename; use Carp (); sub new { if (ref($_[1]) eq 'HASH') { Carp::croak("Options to " . __FILE__ . " 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->{pbot} = delete $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__); $self->{plugins} = {}; $self->{pbot}->{commands}->register(sub { $self->load_cmd(@_) }, "plug", 90); $self->{pbot}->{commands}->register(sub { $self->unload_cmd(@_) }, "unplug", 90); $self->{pbot}->{commands}->register(sub { $self->reload_cmd(@_) }, "replug", 90); $self->{pbot}->{commands}->register(sub { $self->list_cmd(@_) }, "pluglist", 0); } sub autoload { my ($self, %conf) = @_; return if $self->{pbot}->{registry}->get_value('plugins', 'noautoload'); my $path = $self->{pbot}->{registry}->get_value('general', 'plugin_dir') // 'Plugins'; $self->{pbot}->{logger}->log("Loading plugins ...\n"); my $plugin_count = 0; my $fh; if (not open $fh, "<$path/autoload") { $self->{pbot}->{logger}->log("warning: file $path/autoload does not exist; skipping autoloading of Plugins\n"); return; } chomp(my @plugins = <$fh>); close $fh; foreach my $plugin (sort @plugins) { $plugin = basename $plugin; $plugin =~ s/.pm$//; # do not load plugins that begin with an underscore next if $plugin =~ m/^_/; $plugin_count++ if $self->load($plugin, %conf) } $self->{pbot}->{logger}->log("$plugin_count plugin" . ($plugin_count == 1 ? '' : 's') . " loaded.\n"); } sub load { my ($self, $plugin, %conf) = @_; $self->unload($plugin); return if $self->{pbot}->{registry}->get_value('plugins', 'disabled'); my $path = $self->{pbot}->{registry}->get_value('general', 'plugin_dir') // 'Plugins'; if (not grep { $_ eq $path } @INC) { unshift @INC, $path; } my $class = $path . "/$plugin"; $class =~ s,[/\\],::,g; $self->{pbot}->{refresher}->{refresher}->refresh_module("$path/$plugin.pm"); my $ret = eval { eval "require $class"; if ($@) { chomp $@; $self->{pbot}->{logger}->log("Error loading $plugin: $@\n"); return 0; } $self->{pbot}->{logger}->log("Loading $plugin\n"); my $mod = $class->new(pbot => $self->{pbot}, %conf); $self->{plugins}->{$plugin} = $mod; $self->{pbot}->{refresher}->{refresher}->update_cache("$path/$plugin.pm"); return 1; }; if ($@) { chomp $@; $self->{pbot}->{logger}->log("Error loading $plugin: $@\n"); return 0; } return $ret; } sub unload { my ($self, $plugin) = @_; if (exists $self->{plugins}->{$plugin}) { eval { $self->{plugins}->{$plugin}->unload; delete $self->{plugins}->{$plugin}; }; if ($@) { chomp $@; $self->{pbot}->{logger}->log("Warning: got error unloading plugin $plugin: $@\n"); } my $path = $self->{pbot}->{registry}->get_value('general', 'plugin_dir') // 'Plugins'; my $class = $path; $class =~ s,[/\\],::,g; $self->{pbot}->{refresher}->{refresher}->unload_module($class . '::' . $plugin); $self->{pbot}->{refresher}->{refresher}->unload_subs("$path/$plugin.pm"); $self->{pbot}->{logger}->log("Plugin $plugin unloaded.\n"); return 1; } else { return 0; } } sub reload_cmd { my ($self, $from, $nick, $user, $host, $arguments) = @_; if (not length $arguments) { return "Usage: replug "; } my $unload_result = $self->unload_cmd($from, $nick, $user, $host, $arguments); my $load_result = $self->load_cmd($from, $nick, $user, $host, $arguments); my $result = ""; $result .= "$unload_result " if $unload_result =~ m/^Unloaded/; $result .= $load_result; return $result; } sub load_cmd { my ($self, $from, $nick, $user, $host, $arguments) = @_; if (not length $arguments) { return "Usage: plug "; } if ($self->load($arguments)) { return "Loaded $arguments plugin."; } else { return "Plugin $arguments failed to load."; } } sub unload_cmd { my ($self, $from, $nick, $user, $host, $arguments) = @_; if (not length $arguments) { return "Usage: unplug "; } if ($self->unload($arguments)) { return "Unloaded $arguments plugin."; } else { return "Plugin $arguments not found."; } } sub list_cmd { my ($self, $from, $nick, $user, $host, $arguments) = @_; my $result = "Loaded plugins: "; my $count = 0; my $comma = ''; foreach my $plugin (sort keys %{ $self->{plugins} }) { $result .= $comma . $plugin; $count++; $comma = ', '; } $result .= 'none' if $count == 0; return $result; } 1;