File 70.patch of Package perl-MooseX-App
From a3b9c8ec9b59c5eebf6fe078692a19aad3a47410 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 8 Aug 2023 13:24:02 +0200
Subject: [PATCH] Remove given, when, and smartmatch operators
Perl 5.38.0 deprecated smartmatch. New warning messages caused tests
to fail:
given is deprecated at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Meta/Role/Class/Base.pm line 572.
when is deprecated at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Meta/Role/Class/Base.pm line 573.
when is deprecated at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Meta/Role/Class/Base.pm line 576.
Smartmatch is deprecated at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Meta/Role/Class/Base.pm line 741.
# Failed test 'no warnings'
# at /usr/share/perl5/Test/Builder.pm line 193.
# There were 24 warning(s)
# Previous test 0 ''
# given is deprecated at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Utils.pm line 237.
# at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Utils.pm line 237.
# require MooseX/App/Utils.pm called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Exporter.pm line 11
# MooseX::App::Exporter::BEGIN() called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Exporter.pm line 11
# eval {...} called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App/Exporter.pm line 11
# require MooseX/App/Exporter.pm called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App.pm line 14
# MooseX::App::BEGIN() called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App.pm line 14
# eval {...} called at /builddir/build/BUILD/MooseX-App-1.42/blib/lib/MooseX/App.pm line 14
# require MooseX/App.pm called at t/testlib/Test01.pm line 4
# Test01::BEGIN() called at t/testlib/Test01.pm line 4
# eval {...} called at t/testlib/Test01.pm line 4
# require Test01.pm called at t/01_basic.t line 11
# main::BEGIN() called at t/01_basic.t line 11
# eval {...} called at t/01_basic.t line 11
#
# ----------
Since smartmatch will be removed from Perl 5.42, this patch fixes the
test failures by replacing given, when, and ~~ operator with a plain,
old Perl.
<https://github.com/maros/MooseX-App/issues/69>
---
lib/MooseX/App/Message/BlockColor.pm | 24 ++-
lib/MooseX/App/Meta/Role/Class/Base.pm | 95 +++++-----
lib/MooseX/App/ParsedArgv.pm | 186 +++++++++----------
lib/MooseX/App/Plugin/Term/Meta/Attribute.pm | 90 +++++----
lib/MooseX/App/Utils.pm | 52 +++---
5 files changed, 215 insertions(+), 232 deletions(-)
diff --git a/lib/MooseX/App/Message/BlockColor.pm b/lib/MooseX/App/Message/BlockColor.pm
index 8343308..04554cb 100644
--- a/lib/MooseX/App/Message/BlockColor.pm
+++ b/lib/MooseX/App/Message/BlockColor.pm
@@ -8,7 +8,6 @@ use utf8;
use namespace::autoclean;
use Moose;
extends qw(MooseX::App::Message::Block);
-no if $] >= 5.018000, warnings => qw(experimental::smartmatch);
use Term::ANSIColor qw();
use IO::Interactive qw(is_interactive);
@@ -24,17 +23,16 @@ sub stringify {
my $header_color;
my $body_color;
- given ($self->type) {
- when('error') {
- $header_color = 'bright_red bold';
- $body_color = 'bright_red';
- }
- when('default') {
- $header_color = 'bold';
- }
- default {
- $header_color = $_;
- }
+ my $type = $self->type;
+ if($type eq 'error') {
+ $header_color = 'bright_red bold';
+ $body_color = 'bright_red';
+ }
+ elsif($type eq 'default') {
+ $header_color = 'bold';
+ }
+ else {
+ $header_color = $type;
}
my $message = '';
@@ -62,4 +60,4 @@ sub _wrap_color {
}
__PACKAGE__->meta->make_immutable;
-1;
\ No newline at end of file
+1;
diff --git a/lib/MooseX/App/Meta/Role/Class/Base.pm b/lib/MooseX/App/Meta/Role/Class/Base.pm
index b1c263e..7fcecf4 100644
--- a/lib/MooseX/App/Meta/Role/Class/Base.pm
+++ b/lib/MooseX/App/Meta/Role/Class/Base.pm
@@ -13,7 +13,6 @@ use Moose::Role;
use MooseX::App::Utils;
use Module::Pluggable::Object;
use File::Basename qw();
-no if $] >= 5.018000, warnings => qw(experimental::smartmatch);
has 'app_messageclass' => (
is => 'rw',
@@ -357,32 +356,30 @@ sub command_parse_options {
}
# Process matches
- given (scalar @{$match_attributes}) {
- # No match
- when(0) {}
- # One match
- when(1) {
- my $attribute = $match_attributes->[0];
- $option->consume();
- $match->{$attribute->name} ||= [];
- push(@{$match->{$attribute->name}},$option);
- }
- # Multiple matches
- default {
- $option->consume();
- push(@errors,
- $self->command_message(
- header => "Ambiguous option '".$option->key."'", # LOCALIZE
- type => "error",
- body => "Could be\n".MooseX::App::Utils::format_list( # LOCALIZE
- map { [ $_ ] }
- sort
- map { $_->cmd_name_primary }
- @{$match_attributes}
- ),
- )
- );
- }
+ # No match
+ if(@{$match_attributes} == 0) {}
+ # One match
+ elsif(@{$match_attributes} == 1) {
+ my $attribute = $match_attributes->[0];
+ $option->consume();
+ $match->{$attribute->name} ||= [];
+ push(@{$match->{$attribute->name}},$option);
+ }
+ # Multiple matches
+ else {
+ $option->consume();
+ push(@errors,
+ $self->command_message(
+ header => "Ambiguous option '".$option->key."'", # LOCALIZE
+ type => "error",
+ body => "Could be\n".MooseX::App::Utils::format_list( # LOCALIZE
+ map { [ $_ ] }
+ sort
+ map { $_->cmd_name_primary }
+ @{$match_attributes}
+ ),
+ )
+ );
}
}
}
@@ -569,31 +566,29 @@ sub command_find {
$parsed_argv->shift_argv;
return $candidate;
}
- given (scalar @{$candidate}) {
- when (0) {
- next;
- }
- when (1) {
- if ($self->app_fuzzy) {
- $parsed_argv->shift_argv;
- return $candidate->[0];
- } else {
- return $self->command_message(
- header => "Unknown command '$command'", # LOCALIZE
- type => "error",
- body => "Did you mean '".$candidate->[0]."'?", # LOCALIZE
- );
- }
- }
- default {
+ if (@{$candidate} == 0) {
+ next;
+ }
+ elsif (@{$candidate} == 1) {
+ if ($self->app_fuzzy) {
+ $parsed_argv->shift_argv;
+ return $candidate->[0];
+ } else {
return $self->command_message(
- header => "Ambiguous command '$command'", # LOCALIZE
+ header => "Unknown command '$command'", # LOCALIZE
type => "error",
- body => "Which command did you mean?\n". # LOCALIZE
- MooseX::App::Utils::format_list(map { [ $_ ] } sort @{$candidate}),
+ body => "Did you mean '".$candidate->[0]."'?", # LOCALIZE
);
}
}
+ else {
+ return $self->command_message(
+ header => "Ambiguous command '$command'", # LOCALIZE
+ type => "error",
+ body => "Which command did you mean?\n". # LOCALIZE
+ MooseX::App::Utils::format_list(map { [ $_ ] } sort @{$candidate}),
+ );
+ }
}
my $command = $command_parts[0];
@@ -725,6 +720,9 @@ sub command_usage_attributes {
$metaclass ||= $self;
$types ||= [qw(option proto)];
+ if ('' eq ref $types) {
+ $types = [$types];
+ }
unless ($metaclass->does_role('MooseX::App::Role::Common')) {
Moose->throw_error('Class '.$metaclass->name.' is not a proper MooseX::App::Command class. You either need to use MooseX::App::Command or exclude this class via app_exclude')
@@ -737,8 +735,7 @@ sub command_usage_attributes {
&& $attribute->has_cmd_type;
next
- unless $types eq 'all'
- || $attribute->cmd_type ~~ $types;
+ unless map {($attribute->cmd_type eq $_ or 'all' eq $_) ? (1) : ()} @$types;
push(@return,$attribute);
}
diff --git a/lib/MooseX/App/ParsedArgv.pm b/lib/MooseX/App/ParsedArgv.pm
index 9c4f8db..7b9d4d3 100644
--- a/lib/MooseX/App/ParsedArgv.pm
+++ b/lib/MooseX/App/ParsedArgv.pm
@@ -11,8 +11,6 @@ use Encode qw(decode);
use MooseX::App::ParsedArgv::Element;
use MooseX::App::ParsedArgv::Value;
-no if $] >= 5.018000, warnings => qw(experimental::smartmatch);
-
my $SINGLETON;
has 'argv' => (
@@ -131,112 +129,110 @@ sub _build_elements {
));
# Process element
} else {
- given ($element) {
- # Flags with only one leading dash (-h or -vh)
- when (m/^-([^-][[:alnum:]]*)$/) {
- undef $lastkey;
- undef $lastelement;
- $expecting = 0;
- # Split into single letter flags
- foreach my $flag (split(//,$1)) {
- unless (defined $options{$flag}) {
- $options{$flag} = MooseX::App::ParsedArgv::Element->new(
- key => $flag,
- type => 'option',
- raw => $element,
- );
- push(@elements,$options{$flag});
- }
- $options{$flag}->add_value(
- 1,
- $position,
- $element,
- );
- $lastkey = $options{$flag};
- $lastelement = $element;
- }
- }
- # Key-value combined (--key=value)
- when (m/^--([^-=][^=]+)=(.+)$/) {
- undef $lastkey;
- undef $lastelement;
- $expecting = 0;
- my ($key,$value) = ($1,$2);
- unless (defined $options{$key}) {
- $options{$key} = MooseX::App::ParsedArgv::Element->new(
- key => $key,
+ # Flags with only one leading dash (-h or -vh)
+ if ($element =~ m/^-([^-][[:alnum:]]*)$/) {
+ undef $lastkey;
+ undef $lastelement;
+ $expecting = 0;
+ # Split into single letter flags
+ foreach my $flag (split(//,$1)) {
+ unless (defined $options{$flag}) {
+ $options{$flag} = MooseX::App::ParsedArgv::Element->new(
+ key => $flag,
type => 'option',
raw => $element,
);
- push(@elements,$options{$key});
+ push(@elements,$options{$flag});
}
- $options{$key}->add_value(
- $value,
+ $options{$flag}->add_value(
+ 1,
$position,
$element,
);
+ $lastkey = $options{$flag};
+ $lastelement = $element;
}
- # Ordinary key
- when (m/^--?([^-].+)/) {
- my $key = $1;
-
- unless (defined $options{$key} ) {
- $options{$key} = MooseX::App::ParsedArgv::Element->new(
- key => $key,
- type => 'option',
- raw => $element,
- );
- push(@elements,$options{$key});
- }
- # This is a boolean or counter key that does not expect a value
- if ($key ~~ $self->hints_novalue) {
- $options{$key}->add_value(
- ($self->hints_fixedvalue->{$key} // 1),
- $position,
- $element
- );
- $expecting = 0;
- # We are expecting a value
- } else {
- $expecting = 1;
- $lastelement = $element;
- $lastkey = $options{$key};
- }
+ }
+ # Key-value combined (--key=value)
+ elsif ($element =~ m/^--([^-=][^=]+)=(.+)$/) {
+ undef $lastkey;
+ undef $lastelement;
+ $expecting = 0;
+ my ($key,$value) = ($1,$2);
+ unless (defined $options{$key}) {
+ $options{$key} = MooseX::App::ParsedArgv::Element->new(
+ key => $key,
+ type => 'option',
+ raw => $element,
+ );
+ push(@elements,$options{$key});
+ }
+ $options{$key}->add_value(
+ $value,
+ $position,
+ $element,
+ );
+ }
+ # Ordinary key
+ elsif ($element =~ m/^--?([^-].+)/) {
+ my $key = $1;
+
+ unless (defined $options{$key} ) {
+ $options{$key} = MooseX::App::ParsedArgv::Element->new(
+ key => $key,
+ type => 'option',
+ raw => $element,
+ );
+ push(@elements,$options{$key});
}
- # Extra values - stop processing after this token
- when ('--') {
- undef $lastkey;
- undef $lastelement;
- $stopprocessing = 1;
+ # This is a boolean or counter key that does not expect a value
+ if (map {$key eq $_ ? (1) : ()} @{$self->hints_novalue}) {
+ $options{$key}->add_value(
+ ($self->hints_fixedvalue->{$key} // 1),
+ $position,
+ $element
+ );
$expecting = 0;
+ # We are expecting a value
+ } else {
+ $expecting = 1;
+ $lastelement = $element;
+ $lastkey = $options{$key};
}
- # Value
- default {
- if (defined $lastkey) {
- # This is a parameter - last key was a flag
- if ($lastkey->key ~~ $self->hints_novalue) {
- push(@elements,MooseX::App::ParsedArgv::Element->new( key => $element, type => 'parameter' ));
- undef $lastkey;
- undef $lastelement;
- $expecting = 0;
- # Permute values
- } elsif ($lastkey->key ~~ $self->hints_permute) {
- $expecting = 0;
- $lastkey->add_value(
- $element,
- $position,
- $lastelement
- );
- # Has value
- } else {
- $expecting = 0;
- $lastkey->add_value($element,$position);
- undef $lastkey;
- undef $lastelement;
- }
- } else {
+ }
+ # Extra values - stop processing after this token
+ elsif ($element eq '--') {
+ undef $lastkey;
+ undef $lastelement;
+ $stopprocessing = 1;
+ $expecting = 0;
+ }
+ # Value
+ else {
+ if (defined $lastkey) {
+ # This is a parameter - last key was a flag
+ if (map {$lastkey->key eq $_ ? (1) : ()} @{$self->hints_novalue}) {
push(@elements,MooseX::App::ParsedArgv::Element->new( key => $element, type => 'parameter' ));
+ undef $lastkey;
+ undef $lastelement;
+ $expecting = 0;
+ # Permute values
+ } elsif (map {$lastkey->key eq $_ ? (1) : ()} @{$self->hints_permute}) {
+ $expecting = 0;
+ $lastkey->add_value(
+ $element,
+ $position,
+ $lastelement
+ );
+ # Has value
+ } else {
+ $expecting = 0;
+ $lastkey->add_value($element,$position);
+ undef $lastkey;
+ undef $lastelement;
}
+ } else {
+ push(@elements,MooseX::App::ParsedArgv::Element->new( key => $element, type => 'parameter' ));
}
}
}
diff --git a/lib/MooseX/App/Plugin/Term/Meta/Attribute.pm b/lib/MooseX/App/Plugin/Term/Meta/Attribute.pm
index 5ae2070..f573efa 100644
--- a/lib/MooseX/App/Plugin/Term/Meta/Attribute.pm
+++ b/lib/MooseX/App/Plugin/Term/Meta/Attribute.pm
@@ -8,8 +8,6 @@ use 5.010;
use namespace::autoclean;
use Moose::Role;
-no if $] >= 5.018000, warnings => qw(experimental::smartmatch);
-
use Term::ReadKey;
has 'cmd_term' => (
@@ -106,7 +104,7 @@ sub cmd_term_read_string {
if (! $history_disable
&& defined $entry
&& $entry !~ m/^\s*$/
- && ! ($entry ~~ \@history)) {
+ && ! (map {$entry eq $_ ? (1) : ()} @history)) {
push(@history,$entry);
}
};
@@ -167,55 +165,53 @@ sub cmd_term_read_string {
$escape .= $code;
}
if (defined $escape) {
- given ($escape) {
- when ('[D') { # Cursor left
- if ($cursor > 0) {
- print "\b";
- $cursor--;
- }
- }
- when ($escape eq '[C') { # Cursor right
- if ($cursor < length($return)) {
- print substr $return,$cursor,1;
- $cursor++;
- }
- }
- when ($escape eq '[A') { # Cursor up
- $history_add->($return);
- print "\b" x $cursor;
- print " " x length($return);
- print "\b" x length($return);
-
- $history_index ++
- if defined $history[$history_index]
- && $history[$history_index] eq $return;
- $history_index = 0
- unless defined $history[$history_index];
-
- $return = $history[$history_index];
- $cursor = length($return);
- print $return;
- $history_index++;
+ if ($escape eq '[D') { # Cursor left
+ if ($cursor > 0) {
+ print "\b";
+ $cursor--;
}
- when ($escape eq '[3~') { # Del
- if ($cursor != length($return)) {
- substr $return,$cursor,1,'';
- print substr $return,$cursor;
- print " ".(("\b") x (length($return) - $cursor + 1));
- }
- }
- when ($escape eq 'OH') { # Pos 1
- print (("\b") x $cursor);
- $cursor = 0;
+ }
+ elsif ($escape eq '[C') { # Cursor right
+ if ($cursor < length($return)) {
+ print substr $return,$cursor,1;
+ $cursor++;
}
- when ($escape eq 'OF') { # End
+ }
+ elsif ($escape eq '[A') { # Cursor up
+ $history_add->($return);
+ print "\b" x $cursor;
+ print " " x length($return);
+ print "\b" x length($return);
+
+ $history_index ++
+ if defined $history[$history_index]
+ && $history[$history_index] eq $return;
+ $history_index = 0
+ unless defined $history[$history_index];
+
+ $return = $history[$history_index];
+ $cursor = length($return);
+ print $return;
+ $history_index++;
+ }
+ elsif ($escape eq '[3~') { # Del
+ if ($cursor != length($return)) {
+ substr $return,$cursor,1,'';
print substr $return,$cursor;
- $cursor = length($return);
+ print " ".(("\b") x (length($return) - $cursor + 1));
}
- #default {
- # print $escape;
- #}
}
+ elsif ($escape eq 'OH') { # Pos 1
+ print (("\b") x $cursor);
+ $cursor = 0;
+ }
+ elsif ($escape eq 'OF') { # End
+ print substr $return,$cursor;
+ $cursor = length($return);
+ }
+ #else {
+ # print $escape;
+ #}
} else {
$history_add->($return);
next TRY_STRING;
diff --git a/lib/MooseX/App/Utils.pm b/lib/MooseX/App/Utils.pm
index 6ca6d05..fa0f5e3 100644
--- a/lib/MooseX/App/Utils.pm
+++ b/lib/MooseX/App/Utils.pm
@@ -48,8 +48,6 @@ coerce 'MooseX::App::Types::IdentifierList'
no Moose::Util::TypeConstraints;
-no if $] >= 5.018000, warnings => qw/ experimental::smartmatch /;
-
# Default package name to command name translation function
sub class_to_command {
my ($class) = @_;
@@ -234,34 +232,32 @@ sub _pod_node_to_text {
}
} else {
- given (ref($node)) {
- when ('Pod::Elemental::Element::Pod5::Ordinary') {
- my $content = $node->content;
- return
- if $content =~ m/^=cut/;
- $content =~ s/\n/ /g;
- $content =~ s/\s+/ /g;
- push (@lines,$content."\n");
+ my $class = ref($node);
+ if ($class eq 'Pod::Elemental::Element::Pod5::Ordinary') {
+ my $content = $node->content;
+ return
+ if $content =~ m/^=cut/;
+ $content =~ s/\n/ /g;
+ $content =~ s/\s+/ /g;
+ push (@lines,$content."\n");
+ }
+ elsif ($class eq 'Pod::Elemental::Element::Pod5::Verbatim') {
+ push (@lines,$node->content."\n");
+ }
+ elsif ($class eq 'Pod::Elemental::Element::Pod5::Command') {
+ my $command = $node->command;
+ if ($command eq 'over') {
+ ${$indent}++;
}
- when ('Pod::Elemental::Element::Pod5::Verbatim') {
- push (@lines,$node->content."\n");
+ elsif ($command eq 'item') {
+ push (@lines,(' ' x ($$indent-1)) . $node->content);
}
- when ('Pod::Elemental::Element::Pod5::Command') {
- given ($node->command) {
- when ('over') {
- ${$indent}++;
- }
- when ('item') {
- push (@lines,(' ' x ($$indent-1)) . $node->content);
- }
- when ('back') {
- push (@lines,"\n");
- ${$indent}--;
- }
- when (qr/head\d/) {
- push (@lines,"\n",$node->content,"\n");
- }
- }
+ elsif ($command eq 'back') {
+ push (@lines,"\n");
+ ${$indent}--;
+ }
+ elsif ($command =~ qr/head\d/) {
+ push (@lines,"\n",$node->content,"\n");
}
}
}
