mirror of
				https://github.com/pragma-/pbot.git
				synced 2025-11-04 08:37:24 +01:00 
			
		
		
		
	Rename FuncCommands.pm to Functions.pm; Functions can now be registered
This commit is contained in:
		
							parent
							
								
									d3a2e6c40a
								
							
						
					
					
						commit
						232546f807
					
				@ -1,236 +0,0 @@
 | 
			
		||||
 | 
			
		||||
# File: FuncCommand.pm
 | 
			
		||||
# Author: pragma_
 | 
			
		||||
#
 | 
			
		||||
# Purpose: Special `func` command that executes built-in functions with
 | 
			
		||||
# optional arguments. Usage: func <identifier> [arguments].
 | 
			
		||||
#
 | 
			
		||||
# Intended usage is with command-substitution (&{}) or pipes (|{}).
 | 
			
		||||
#
 | 
			
		||||
# For example:
 | 
			
		||||
#
 | 
			
		||||
# factadd img /call echo https://google.com/search?q=&{func uri_escape $args}&tbm=isch
 | 
			
		||||
#
 | 
			
		||||
# The above would invoke the function 'uri_escape' on $args and then replace
 | 
			
		||||
# the command-substitution with the result, thus escaping $args to be safely
 | 
			
		||||
# used in the URL of this simple Google Image Search factoid command.
 | 
			
		||||
 | 
			
		||||
# 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::FuncCommand;
 | 
			
		||||
use parent 'PBot::Class';
 | 
			
		||||
 | 
			
		||||
use warnings; use strict;
 | 
			
		||||
use feature 'unicode_strings';
 | 
			
		||||
 | 
			
		||||
sub initialize {
 | 
			
		||||
  my ($self, %conf) = @_;
 | 
			
		||||
  $self->{pbot}->{commands}->register(sub { $self->do_func(@_) }, 'func', 0);
 | 
			
		||||
  $self->init_funcs;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# this is a subroutine so PBot::AdminCommands::reload() can reload
 | 
			
		||||
# the funcs without requiring a bot restart.
 | 
			
		||||
sub init_funcs {
 | 
			
		||||
  my ($self) = @_;
 | 
			
		||||
 | 
			
		||||
  $self->{funcs} = {
 | 
			
		||||
    help => {
 | 
			
		||||
      desc   => 'provides help about a func',
 | 
			
		||||
      usage  => 'help [func]',
 | 
			
		||||
      subref => sub { $self->func_help(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    list => {
 | 
			
		||||
      desc   => 'lists available funcs',
 | 
			
		||||
      usage  => 'list [regex]',
 | 
			
		||||
      subref => sub { $self->func_list(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    uri_escape => {
 | 
			
		||||
      desc   => 'percent-encode unsafe URI characters',
 | 
			
		||||
      usage  => 'uri_escape <text>',
 | 
			
		||||
      subref => sub { $self->func_uri_escape(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    title => {
 | 
			
		||||
      desc   => 'Title-cases text',
 | 
			
		||||
      usage  => 'title <text>',
 | 
			
		||||
      subref => sub { $self->func_title(@_) }
 | 
			
		||||
    },
 | 
			
		||||
     ucfirst => {
 | 
			
		||||
      desc   => 'Uppercases first character',
 | 
			
		||||
      usage  => 'ucfirst <text>',
 | 
			
		||||
      subref => sub { $self->func_ucfirst(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    uc => {
 | 
			
		||||
      desc   => 'Uppercases all characters',
 | 
			
		||||
      usage  => 'uc <text>',
 | 
			
		||||
      subref => sub { $self->func_uc(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    lc => {
 | 
			
		||||
      desc   => 'Lowercases all characters',
 | 
			
		||||
      usage  => 'lc <text>',
 | 
			
		||||
      subref => sub { $self->func_lc(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    sed => {
 | 
			
		||||
      desc   => 'a sed-like stream editor',
 | 
			
		||||
      usage  => 'sed s/<regex>/<replacement>/[Pig]; P preserve case; i ignore case; g replace all',
 | 
			
		||||
      subref => sub { $self->func_sed(@_) }
 | 
			
		||||
    },
 | 
			
		||||
    unquote => {
 | 
			
		||||
      desc   => 'removes unescaped surrounding quotes and strips escapes from escaped quotes',
 | 
			
		||||
      usage  => 'unquote <text>',
 | 
			
		||||
      subref => sub { $self->func_unquote(@_) }
 | 
			
		||||
    },
 | 
			
		||||
  };
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub do_func {
 | 
			
		||||
  my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
 | 
			
		||||
 | 
			
		||||
  my $func = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
 | 
			
		||||
 | 
			
		||||
  if (not defined $func) {
 | 
			
		||||
    return "Usage: func <keyword> [arguments]; see also: func help";
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  if (not exists $self->{funcs}->{$func}) {
 | 
			
		||||
    return "[No such func '$func']";
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  my @params;
 | 
			
		||||
  while (my $param = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist})) {
 | 
			
		||||
    push @params, $param;
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  my $result = $self->{funcs}->{$func}->{subref}->(@params);
 | 
			
		||||
  $result =~ s/\x1/1/g;
 | 
			
		||||
  return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_help {
 | 
			
		||||
  my ($self, $func) = @_;
 | 
			
		||||
 | 
			
		||||
  if (not length $func) {
 | 
			
		||||
    return "func: invoke built-in functions; usage: func <keyword> [arguments]; to list available functions: func list [regex]";
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  if (not exists $self->{funcs}->{$func}) {
 | 
			
		||||
    return "No such func '$func'.";
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  return "$func: $self->{funcs}->{$func}->{desc}; usage: $self->{funcs}->{$func}->{usage}";
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_list {
 | 
			
		||||
  my ($self, $regex) = @_;
 | 
			
		||||
 | 
			
		||||
  $regex = '.*' if not defined $regex;
 | 
			
		||||
 | 
			
		||||
  my $result = eval {
 | 
			
		||||
    my $text = '';
 | 
			
		||||
 | 
			
		||||
    foreach my $func (sort keys %{$self->{funcs}}) {
 | 
			
		||||
      if ($func =~ m/$regex/i or $self->{funcs}->{$func}->{desc} =~ m/$regex/i) {
 | 
			
		||||
        $text .=  "$func, ";
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $text =~ s/,\s+$//;
 | 
			
		||||
 | 
			
		||||
    if (not length $text) {
 | 
			
		||||
      if ($regex eq '.*') {
 | 
			
		||||
        $text = "No funcs yet.";
 | 
			
		||||
      } else {
 | 
			
		||||
        $text = "No matching func.";
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    return "Available funcs: $text; see also: func help <keyword>";
 | 
			
		||||
  };
 | 
			
		||||
 | 
			
		||||
  if ($@) {
 | 
			
		||||
    my $error = $@;
 | 
			
		||||
    $error =~ s/at PBot.FuncCommand.*$//;
 | 
			
		||||
    return "Error: $error\n";
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_unquote {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  $text =~ s/^"(.*?)(?<!\\)"$/$1/ || $text =~ s/^'(.*?)(?<!\\)'$/$1/;
 | 
			
		||||
  $text =~ s/(?<!\\)\\'/'/g;
 | 
			
		||||
  $text =~ s/(?<!\\)\\"/"/g;
 | 
			
		||||
  return $text;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
use URI::Escape qw/uri_escape_utf8/;
 | 
			
		||||
 | 
			
		||||
sub func_uri_escape {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  return uri_escape_utf8($text);
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_title {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  $text = ucfirst lc $text;
 | 
			
		||||
  $text =~ s/ (\w)/' ' . uc $1/ge;
 | 
			
		||||
  return $text;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_ucfirst {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  return ucfirst $text;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_uc {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  return uc $text;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_lc {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
  return lc $text;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
# near-verbatim insertion of krok's `sed` factoid
 | 
			
		||||
no warnings;
 | 
			
		||||
sub func_sed {
 | 
			
		||||
  my $self = shift;
 | 
			
		||||
  my $text = "@_";
 | 
			
		||||
 | 
			
		||||
  if ($text =~ /^s(.)(.*?)(?<!\\)\1(.*?)(?<!\\)\1(\S*)\s+(.*)/p) {
 | 
			
		||||
    my ($a, $r, $g, $m, $t) = ($5,"'\"$3\"'", index($4,"g") != -1, $4, $2);
 | 
			
		||||
 | 
			
		||||
    if ($m=~/P/) {
 | 
			
		||||
      $r =~ s/^'"(.*)"'$/$1/;
 | 
			
		||||
      $m=~s/P//g;
 | 
			
		||||
 | 
			
		||||
      if($g) {
 | 
			
		||||
        $a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|gie;
 | 
			
		||||
      } else {
 | 
			
		||||
        $a =~ s|(?$m)($t)|$1=~/^[A-Z][^A-Z]/?ucfirst$r:($1=~/^[A-Z]+$/?uc$r:$r)|ie;
 | 
			
		||||
      }
 | 
			
		||||
    } else {
 | 
			
		||||
      if ($g) {
 | 
			
		||||
        $a =~ s/(?$m)$t/$r/geee;
 | 
			
		||||
      } else {
 | 
			
		||||
        $a=~s/(?$m)$t/$r/eee;
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
    return $a;
 | 
			
		||||
  } else {
 | 
			
		||||
    return "sed: syntax error";
 | 
			
		||||
  }
 | 
			
		||||
}
 | 
			
		||||
use warnings;
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
							
								
								
									
										114
									
								
								PBot/Functions.pm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										114
									
								
								PBot/Functions.pm
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,114 @@
 | 
			
		||||
 | 
			
		||||
# File: Functions.pm
 | 
			
		||||
# Author: pragma_
 | 
			
		||||
#
 | 
			
		||||
# Purpose: Special `func` command that executes built-in functions with
 | 
			
		||||
# optional arguments. Usage: func <identifier> [arguments].
 | 
			
		||||
#
 | 
			
		||||
# Intended usage is with command-substitution (&{}) or pipes (|{}).
 | 
			
		||||
#
 | 
			
		||||
# For example:
 | 
			
		||||
#
 | 
			
		||||
# factadd img /call echo https://google.com/search?q=&{func uri_escape $args}&tbm=isch
 | 
			
		||||
#
 | 
			
		||||
# The above would invoke the function 'uri_escape' on $args and then replace
 | 
			
		||||
# the command-substitution with the result, thus escaping $args to be safely
 | 
			
		||||
# used in the URL of this simple Google Image Search factoid command.
 | 
			
		||||
 | 
			
		||||
# 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::Functions;
 | 
			
		||||
use parent 'PBot::Class';
 | 
			
		||||
 | 
			
		||||
use warnings; use strict;
 | 
			
		||||
use feature 'unicode_strings';
 | 
			
		||||
 | 
			
		||||
sub initialize {
 | 
			
		||||
  my ($self, %conf) = @_;
 | 
			
		||||
  $self->{pbot}->{commands}->register(sub { $self->do_func(@_) }, 'func', 0);
 | 
			
		||||
 | 
			
		||||
  $self->register(
 | 
			
		||||
    'help',
 | 
			
		||||
    {
 | 
			
		||||
      desc   => 'provides help about a func',
 | 
			
		||||
      usage  => 'help [func]',
 | 
			
		||||
      subref => sub { $self->func_help(@_) }
 | 
			
		||||
    }
 | 
			
		||||
  );
 | 
			
		||||
 | 
			
		||||
  $self->register(
 | 
			
		||||
    'list',
 | 
			
		||||
    {
 | 
			
		||||
      desc   => 'lists available funcs',
 | 
			
		||||
      usage  => 'list [regex]',
 | 
			
		||||
      subref => sub { $self->func_list(@_) }
 | 
			
		||||
    }
 | 
			
		||||
  );
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub register {
 | 
			
		||||
  my ($self, $func, $data) = @_;
 | 
			
		||||
  $self->{funcs}->{$func} = $data;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub unregister {
 | 
			
		||||
  my ($self, $func) = @_;
 | 
			
		||||
  delete $self->{funcs}->{$func};
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub do_func {
 | 
			
		||||
  my ($self, $from, $nick, $user, $host, $arguments, $stuff) = @_;
 | 
			
		||||
  my $func = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist});
 | 
			
		||||
  return "Usage: func <keyword> [arguments]; see also: func help" if not defined $func;
 | 
			
		||||
  return "[No such func '$func']" if not exists $self->{funcs}->{$func};
 | 
			
		||||
 | 
			
		||||
  my @params;
 | 
			
		||||
  while (my $param = $self->{pbot}->{interpreter}->shift_arg($stuff->{arglist})) {
 | 
			
		||||
    push @params, $param;
 | 
			
		||||
  }
 | 
			
		||||
 | 
			
		||||
  my $result = $self->{funcs}->{$func}->{subref}->(@params);
 | 
			
		||||
  $result =~ s/\x1/1/g;
 | 
			
		||||
  return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_help {
 | 
			
		||||
  my ($self, $func) = @_;
 | 
			
		||||
  return "func: invoke built-in functions; usage: func <keyword> [arguments]; to list available functions: func list [regex]" if not length $func;
 | 
			
		||||
  return "No such func '$func'." if not exists $self->{funcs}->{$func};
 | 
			
		||||
  return "$func: $self->{funcs}->{$func}->{desc}; usage: $self->{funcs}->{$func}->{usage}";
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
sub func_list {
 | 
			
		||||
  my ($self, $regex) = @_;
 | 
			
		||||
  $regex = '.*' if not defined $regex;
 | 
			
		||||
  my $result = eval {
 | 
			
		||||
    my $text = '';
 | 
			
		||||
    foreach my $func (sort keys %{$self->{funcs}}) {
 | 
			
		||||
      if ($func =~ m/$regex/i or $self->{funcs}->{$func}->{desc} =~ m/$regex/i) {
 | 
			
		||||
        $text .=  "$func, ";
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
 | 
			
		||||
    $text =~ s/,\s+$//;
 | 
			
		||||
    if (not length $text) {
 | 
			
		||||
      if ($regex eq '.*') {
 | 
			
		||||
        $text = "No funcs yet.";
 | 
			
		||||
      } else {
 | 
			
		||||
        $text = "No matching func.";
 | 
			
		||||
      }
 | 
			
		||||
    }
 | 
			
		||||
    return "Available funcs: $text; see also: func help <keyword>";
 | 
			
		||||
  };
 | 
			
		||||
 | 
			
		||||
  if ($@) {
 | 
			
		||||
    my $error = $@;
 | 
			
		||||
    $error =~ s/at PBot.Functions.*$//;
 | 
			
		||||
    return "Error: $error\n";
 | 
			
		||||
  }
 | 
			
		||||
  return $result;
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
1;
 | 
			
		||||
@ -46,7 +46,7 @@ use PBot::Refresher;
 | 
			
		||||
use PBot::Plugins;
 | 
			
		||||
use PBot::WebPaste;
 | 
			
		||||
use PBot::Utils::ParseDate;
 | 
			
		||||
use PBot::FuncCommand;
 | 
			
		||||
use PBot::Functions;
 | 
			
		||||
 | 
			
		||||
sub new {
 | 
			
		||||
  my ($proto, %conf) = @_;
 | 
			
		||||
@ -125,7 +125,7 @@ sub initialize {
 | 
			
		||||
  $self->{logger}->log("plugin_dir: $plugin_dir\n");
 | 
			
		||||
 | 
			
		||||
  $self->{timer}     = PBot::Timer->new(pbot => $self, timeout => 10, %conf);
 | 
			
		||||
  $self->{func_cmd}  = PBot::FuncCommand->new(pbot => $self, %conf);
 | 
			
		||||
  $self->{functions} = PBot::Functions->new(pbot => $self, %conf);
 | 
			
		||||
  $self->{refresher} = PBot::Refresher->new(pbot => $self);
 | 
			
		||||
 | 
			
		||||
  # create registry and set some defaults
 | 
			
		||||
@ -475,11 +475,6 @@ sub reload {
 | 
			
		||||
      $self->{factoids}->{factoids}->clear;
 | 
			
		||||
      $self->{factoids}->load_factoids;
 | 
			
		||||
      return "Factoids reloaded.";
 | 
			
		||||
    },
 | 
			
		||||
 | 
			
		||||
    'funcs' => sub {
 | 
			
		||||
      $self->{func_cmd}->init_funcs;
 | 
			
		||||
      return "Funcs reloaded.";
 | 
			
		||||
    }
 | 
			
		||||
  );
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
		Loading…
	
	
			
			x
			
			
		
	
		Reference in New Issue
	
	Block a user