forked from pool/perl-MooseX-App
Accepting request 1103148 from home:dimstar:Factory
- Add 70.patch: Remove given, when, and smartmatch operators; fix build with Perl 5.38. OBS-URL: https://build.opensuse.org/request/show/1103148 OBS-URL: https://build.opensuse.org/package/show/devel:languages:perl/perl-MooseX-App?expand=0&rev=15
This commit is contained in:
642
70.patch
Normal file
642
70.patch
Normal file
@@ -0,0 +1,642 @@
|
|||||||
|
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");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
@@ -7,7 +7,8 @@ description_paragraphs: 1
|
|||||||
#sources:
|
#sources:
|
||||||
# - source1
|
# - source1
|
||||||
# - source2
|
# - source2
|
||||||
#patches:
|
patches:
|
||||||
|
https://patch-diff.githubusercontent.com/raw/maros/MooseX-App/pull/70.patch: -p1
|
||||||
# bar.patch:
|
# bar.patch:
|
||||||
preamble: |-
|
preamble: |-
|
||||||
BuildRequires: perl(Config::Any)
|
BuildRequires: perl(Config::Any)
|
||||||
|
@@ -1,3 +1,9 @@
|
|||||||
|
-------------------------------------------------------------------
|
||||||
|
Wed Aug 9 12:24:00 UTC 2023 - Dominique Leuenberger <dimstar@opensuse.org>
|
||||||
|
|
||||||
|
- Add 70.patch: Remove given, when, and smartmatch operators; fix
|
||||||
|
build with Perl 5.38.
|
||||||
|
|
||||||
-------------------------------------------------------------------
|
-------------------------------------------------------------------
|
||||||
Tue Aug 17 10:56:35 UTC 2021 - Frank Schreiner <FSchreiner@suse.com>
|
Tue Aug 17 10:56:35 UTC 2021 - Frank Schreiner <FSchreiner@suse.com>
|
||||||
|
|
||||||
|
@@ -1,7 +1,7 @@
|
|||||||
#
|
#
|
||||||
# spec file for package perl-MooseX-App
|
# spec file for package perl-MooseX-App
|
||||||
#
|
#
|
||||||
# Copyright (c) 2021 SUSE LLC
|
# Copyright (c) 2023 SUSE LLC
|
||||||
#
|
#
|
||||||
# All modifications and additions to the file contributed by third parties
|
# All modifications and additions to the file contributed by third parties
|
||||||
# remain the property of their copyright owners, unless otherwise agreed
|
# remain the property of their copyright owners, unless otherwise agreed
|
||||||
@@ -25,6 +25,7 @@ Summary: Write user-friendly command line apps with even less suffering
|
|||||||
URL: https://metacpan.org/release/%{cpan_name}
|
URL: https://metacpan.org/release/%{cpan_name}
|
||||||
Source0: MooseX-App-1.42.tar.gz
|
Source0: MooseX-App-1.42.tar.gz
|
||||||
Source1: cpanspec.yml
|
Source1: cpanspec.yml
|
||||||
|
Patch0: https://patch-diff.githubusercontent.com/raw/maros/MooseX-App/pull/70.patch
|
||||||
BuildArch: noarch
|
BuildArch: noarch
|
||||||
BuildRequires: perl
|
BuildRequires: perl
|
||||||
BuildRequires: perl-macros
|
BuildRequires: perl-macros
|
||||||
@@ -55,8 +56,9 @@ be defined as simple Moose accessors using the 'option' and 'parameter'
|
|||||||
keywords respectively.
|
keywords respectively.
|
||||||
|
|
||||||
%prep
|
%prep
|
||||||
%autosetup -n %{cpan_name}-%{version}
|
%autosetup -n %{cpan_name}-%{version} -p1
|
||||||
find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644
|
|
||||||
|
find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path "*/script/*" ! -path "*/scripts/*" ! -name "configure" -print0 | xargs -0 chmod 644
|
||||||
|
|
||||||
%build
|
%build
|
||||||
perl Makefile.PL INSTALLDIRS=vendor
|
perl Makefile.PL INSTALLDIRS=vendor
|
||||||
|
Reference in New Issue
Block a user