3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-23 19:22:40 +01:00
pbot/lib/PBot/Plugin/FuncBuiltins.pm
2021-07-13 19:45:56 -07:00

119 lines
2.8 KiB
Perl

# File: FuncBuiltins.pm
#
# Purpose: Registers the basic built-in Functions
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
package PBot::Plugin::FuncBuiltins;
use parent 'PBot::Plugin::Base';
use PBot::Imports;
sub initialize {
my ($self, %conf) = @_;
$self->{pbot}->{functions}->register(
'title',
{
desc => 'Title-cases text',
usage => 'title <text>',
subref => sub { $self->func_title(@_) }
}
);
$self->{pbot}->{functions}->register(
'ucfirst',
{
desc => 'Uppercases first character',
usage => 'ucfirst <text>',
subref => sub { $self->func_ucfirst(@_) }
}
);
$self->{pbot}->{functions}->register(
'uc',
{
desc => 'Uppercases all characters',
usage => 'uc <text>',
subref => sub { $self->func_uc(@_) }
}
);
$self->{pbot}->{functions}->register(
'lc',
{
desc => 'Lowercases all characters',
usage => 'lc <text>',
subref => sub { $self->func_lc(@_) }
}
);
$self->{pbot}->{functions}->register(
'unquote',
{
desc => 'removes unescaped surrounding quotes and strips escapes from escaped quotes',
usage => 'unquote <text>',
subref => sub { $self->func_unquote(@_) }
}
);
$self->{pbot}->{functions}->register(
'uri_escape',
{
desc => 'percent-encode unsafe URI characters',
usage => 'uri_escape <text>',
subref => sub { $self->func_uri_escape(@_) }
}
);
}
sub unload {
my $self = shift;
$self->{pbot}->{functions}->unregister('title');
$self->{pbot}->{functions}->unregister('ucfirst');
$self->{pbot}->{functions}->unregister('uc');
$self->{pbot}->{functions}->unregister('lc');
$self->{pbot}->{functions}->unregister('unquote');
$self->{pbot}->{functions}->unregister('uri_escape');
}
sub func_unquote {
my $self = shift;
my $text = "@_";
$text =~ s/^"(.*?)(?<!\\)"$/$1/ || $text =~ s/^'(.*?)(?<!\\)'$/$1/;
$text =~ s/(?<!\\)\\'/'/g;
$text =~ s/(?<!\\)\\"/"/g;
return $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;
}
use URI::Escape qw/uri_escape_utf8/;
sub func_uri_escape {
my $self = shift;
my $text = "@_";
return uri_escape_utf8($text);
}
1;