FuncCommand: improve listing and add uc, lc, etc

This commit is contained in:
Pragmatic Software 2020-01-21 21:15:44 -08:00
parent d61b1217bb
commit 3086d96fdc
1 changed files with 51 additions and 3 deletions

View File

@ -67,6 +67,26 @@ sub init_funcs {
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',
@ -107,7 +127,7 @@ 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";
return "func: invoke built-in functions; usage: func <keyword> [arguments]; to list available functions: func list [regex]";
}
if (not exists $self->{funcs}->{$func}) {
@ -127,10 +147,12 @@ sub func_list {
foreach my $func (sort keys %{$self->{funcs}}) {
if ($func =~ m/$regex/i or $self->{funcs}->{$func}->{desc} =~ m/$regex/i) {
$text .= "$func: $self->{funcs}->{$func}->{desc}.\n";
$text .= "$func, ";
}
}
$text =~ s/,\s+$//;
if (not length $text) {
if ($regex eq '.*') {
$text = "No funcs yet.";
@ -139,7 +161,7 @@ sub func_list {
}
}
return $text;
return "Available funcs: $text; see also: func help <keyword>";
};
if ($@) {
@ -168,6 +190,32 @@ sub func_uri_escape {
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 {