mirror of
https://github.com/perlbot/perlbuut
synced 2025-06-07 10:35:41 -04:00
Update core and get plugins for a little functionality. Also update Bot::BB3::* to allow for addressless messages to be sent from plugins. Also redo how handlers work so that they can output text and interrupt the process of other plugins being handled. This enables the badfacts plugin to function while being unaddressed in channels if configured.
This commit is contained in:
parent
45c556a3bd
commit
7447126de6
8 changed files with 107 additions and 17 deletions
|
@ -68,6 +68,9 @@ requires 'Cpanel::JSON::XS' => 0;
|
|||
requires 'JavaScript::V8::Context' => 0;
|
||||
requires 'LWP::Protocol::https' => 0;
|
||||
requires 'Text::Soundex' => 0;
|
||||
|
||||
requires 'Mojo::DOM' => 0;
|
||||
requires 'Mojo::DOM::CSS' => 0;
|
||||
requires 'Mojo::Collection' => 0;
|
||||
requires 'YAPE::Regex::Explain' => 0;
|
||||
|
||||
WriteAll;
|
||||
|
|
|
@ -22,6 +22,7 @@ server "*" {
|
|||
channel "#perlbot" {
|
||||
plugin "eval" {addressed: false; }
|
||||
plugin "deparse" {addressed: false; }
|
||||
plugin "badfacts" {addressed: false; }
|
||||
}
|
||||
channel "#buubot" {
|
||||
plugin "eval" {addressed: false; }
|
||||
|
|
|
@ -303,8 +303,7 @@ sub _start_plugin_child {
|
|||
|
||||
# Only add the default if we're being addressed
|
||||
if( $said->{addressed} ) {
|
||||
push @{ $chain->[1] }, @{ $self->{default_plugin_chain} }; # Append default plugins to the command section
|
||||
# of the plugin chain
|
||||
push @{ $chain->[4] }, @{ $self->{default_plugin_chain} }; # Append default plugins to the command section
|
||||
}
|
||||
|
||||
my $results = $self->_execute_plugin_chain( $said, $chain );
|
||||
|
@ -406,13 +405,30 @@ sub _filter_plugin_list {
|
|||
|
||||
sub _execute_plugin_chain {
|
||||
my( $self, $said, $chain ) = @_;
|
||||
my( $pre, $commands, $handlers, $post ) = @$chain;
|
||||
my( $pre, $commands, $handlers, $post, $default ) = @$chain;
|
||||
|
||||
for( @$pre ) {
|
||||
$_->pre_process( $said, $self );
|
||||
}
|
||||
|
||||
my $total_output = [];
|
||||
for( @$handlers ) {
|
||||
warn "HANDLE => " . ref($_);
|
||||
local $@;
|
||||
my( $output, $stop ) = eval { $_->handle( $said, $self ) };
|
||||
|
||||
if( $@ ) { push @$total_output, "Error: $@"; next; }
|
||||
|
||||
push @$total_output, $output if $output;
|
||||
|
||||
last if $stop;
|
||||
}
|
||||
|
||||
# only put default in if the handlers did nothing
|
||||
unless (@$total_output) {
|
||||
push @$commands, @$default if (ref $default eq 'ARRAY');
|
||||
}
|
||||
|
||||
for( @$commands ) {
|
||||
local $@;
|
||||
my( $return, $output ) = eval { $_->command( $said, $self ) };
|
||||
|
@ -428,15 +444,6 @@ sub _execute_plugin_chain {
|
|||
}
|
||||
}
|
||||
|
||||
for( @$handlers ) {
|
||||
local $@;
|
||||
my( $output ) = eval { $_->handle( $said, $self ) };
|
||||
|
||||
if( $@ ) { push @$total_output, "Error: $@"; next; }
|
||||
|
||||
push @$total_output, $output;
|
||||
}
|
||||
|
||||
my $output = join " ", @$total_output;
|
||||
|
||||
for( @$post ) {
|
||||
|
|
|
@ -522,7 +522,7 @@ sub plugin_output {
|
|||
utf8::decode( $text );
|
||||
|
||||
return unless $text =~ /\S/;
|
||||
$text =~ s/\0/\\0/g; # Replace nulls to prevent them truncating strings we attempt to output.
|
||||
$text =~ s/.\K\0/\\0/g; # Replace nulls to prevent them truncating strings we attempt to output.
|
||||
|
||||
if ($text =~ /DCC\s+SEND\s+/)
|
||||
{
|
||||
|
@ -578,7 +578,13 @@ sub plugin_output {
|
|||
}
|
||||
else {
|
||||
$text =~ s/\r?\n/ /g;
|
||||
$pci->yield( privmsg => $said->{channel} => "$said->{name}: $text" );
|
||||
if ($text =~ /^\x00/) {
|
||||
$text =~ s/^\x00//;
|
||||
|
||||
$pci->yield( privmsg => $said->{channel} => $text );
|
||||
} else {
|
||||
$pci->yield( privmsg => $said->{channel} => "$said->{name}: $text" );
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
|
|
@ -27,6 +27,11 @@ use Time::HiRes;
|
|||
use URI;
|
||||
use URI::Encode;
|
||||
use Rand::MersenneTwister;
|
||||
use Mojo::DOM;
|
||||
use Mojo::DOM::HTML;
|
||||
use Mojo::DOM::CSS;
|
||||
use Mojo::Collection;
|
||||
use YAPE::Regex::Explain;
|
||||
|
||||
require Function::Parameters;
|
||||
require experimental;
|
||||
|
@ -282,7 +287,7 @@ use Storable qw/nfreeze/; nfreeze([]); #Preload Nfreeze since it's loaded on dem
|
|||
|
||||
my $ret;
|
||||
|
||||
my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin VMS vos os390 os400 posix-bc riscos amigaos/;
|
||||
my @os = qw/aix bsdos darwin dynixptx freebsd haiku linux hpux irix next openbsd dec_osf svr4 sco_sv unicos unicosmk solaris sunos MSWin32 MSWin16 MSWin63 dos os2 cygwin VMS vos os390 os400 posix-bc riscos amigaos xenix/;
|
||||
|
||||
{
|
||||
local $^O = $os[rand()*@os];
|
||||
|
|
62
plugins/badfacts.pm
Normal file
62
plugins/badfacts.pm
Normal file
|
@ -0,0 +1,62 @@
|
|||
package Bot::BB3::Plugin::Badfacts;
|
||||
use strict;
|
||||
no warnings 'void';
|
||||
|
||||
use Data::Dumper;
|
||||
|
||||
sub new {
|
||||
my( $class ) = @_;
|
||||
my $self = bless {}, $class;
|
||||
$self->{name} = 'badfacts';
|
||||
$self->{opts} = {
|
||||
handler => 1,
|
||||
};
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub handle {
|
||||
my ($self, $said, $pm) = @_;
|
||||
|
||||
if ($said->{body} =~ /^!(?<fact>[^@].*?)(?:\s@\s*(?<user>\S*))?$/ ||
|
||||
$said->{body} =~ /^!@(?<user>\S+)\s+(?<fact>.+)$/) {
|
||||
my $fact = $+{fact};
|
||||
my $user = $+{user};
|
||||
|
||||
my ($s, $r) = runfacts($fact, $said, $pm);
|
||||
if ($s) {
|
||||
$r = "$user: $r" if $user;
|
||||
$r = "\0".$r;
|
||||
return ($r, 'handled');
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub runfacts {
|
||||
my( $body, $_said, $pm ) = @_;
|
||||
|
||||
my $said = {%$_said};
|
||||
|
||||
my $plugin = $pm->get_plugin( 'fact' );
|
||||
|
||||
$said->{body} = $body;
|
||||
$said->{recommended_args} = [ split /\s+/, $body ];
|
||||
$said->{command_match} = 'fact';
|
||||
$said->{addressed} = 1;
|
||||
|
||||
local $@;
|
||||
my( $status, $results ) = eval { $plugin->command( $said, $pm ) };
|
||||
my $err = $@;
|
||||
|
||||
warn $err if $err;
|
||||
|
||||
if( $err ) { return( 0, "Failed to execute plugin: facts because $err" ); }
|
||||
else { return( 1, $results ) }
|
||||
}
|
||||
|
||||
"Bot::BB3::Plugin::Badfacts";
|
||||
|
||||
__DATA__
|
||||
Supports calling factoids outside of addressed commands using special syntax. Contact simcop2387 to ask about having it enabled for your channel.
|
|
@ -21,6 +21,10 @@ sub {
|
|||
my $rev = Module::CoreList->first_release($module);
|
||||
if ($rev) {
|
||||
print "Added to perl core as of $rev";
|
||||
if ( Module::CoreList->can('deprecated_in') ) {
|
||||
my $dep = Module::CoreList->deprecated_in($module);
|
||||
print " and deprecated in $dep" if $dep;
|
||||
}
|
||||
if ( Module::CoreList->can('removed_from') ) {
|
||||
my $rem = Module::CoreList->removed_from($module);
|
||||
print " and removed from $rem" if $rem;
|
||||
|
|
|
@ -33,7 +33,9 @@ sub {
|
|||
print "Could not parsinate that page!";
|
||||
}
|
||||
# just the xpath left
|
||||
if ($said->{body}) {
|
||||
if ($said->{body} =~ /^\s*\.\*\s*$/) {
|
||||
print $resp->content;
|
||||
} elsif ($said->{body}) {
|
||||
@text = eval{
|
||||
$document->findvalues( $said->{body} );
|
||||
};
|
||||
|
|
Loading…
Add table
Reference in a new issue