From f41ccc36c98bb70900c901ba8385dbb26f3cea97 Mon Sep 17 00:00:00 2001 From: espie Date: Thu, 6 Jul 2023 08:29:26 +0000 Subject: [PATCH] start moving a few files to use v5.36; (this went through a full bulk) --- usr.bin/libtool/LT/Archive.pm | 17 ++----- usr.bin/libtool/LT/Exec.pm | 43 +++++++----------- usr.bin/libtool/LT/Getopt.pm | 83 +++++++++++++--------------------- usr.bin/libtool/LT/LaFile.pm | 32 ++++--------- usr.bin/libtool/LT/LaLoFile.pm | 23 +++------- usr.bin/libtool/LT/LoFile.pm | 13 ++---- usr.bin/libtool/LT/Trace.pm | 32 ++++--------- 7 files changed, 82 insertions(+), 161 deletions(-) diff --git a/usr.bin/libtool/LT/Archive.pm b/usr.bin/libtool/LT/Archive.pm index 736a29c4853..7bc2c373beb 100644 --- a/usr.bin/libtool/LT/Archive.pm +++ b/usr.bin/libtool/LT/Archive.pm @@ -1,4 +1,4 @@ -# $OpenBSD: Archive.pm,v 1.7 2014/04/20 17:34:26 zhuk Exp $ +# $OpenBSD: Archive.pm,v 1.8 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,9 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say switch state); +use v5.36; package LT::Archive; use LT::Trace; @@ -26,10 +24,8 @@ use LT::UList; use LT::Util; use File::Path; -sub extract +sub extract($self, $dir, $archive) { - my ($self, $dir, $archive) = @_; - if (! -d $dir) { tsay {"mkdir -p $dir"}; File::Path::mkpath($dir); @@ -37,10 +33,8 @@ sub extract LT::Exec->chdir($dir)->link('ar', 'x', $archive); } -sub get_objlist +sub get_objlist($self, $a) { - my ($self, $a) = @_; - open(my $arh, '-|', 'ar', 't', $a); my @o = <$arh>; close $arh; @@ -48,9 +42,8 @@ sub get_objlist return @o; } -sub get_symbollist +sub get_symbollist($self, $filepath, $regex, $objlist) { - my ($self, $filepath, $regex, $objlist) = @_; if (@$objlist == 0) { die "get_symbollist: object list is empty\n"; diff --git a/usr.bin/libtool/LT/Exec.pm b/usr.bin/libtool/LT/Exec.pm index 71cd738b83b..54ed32c0e7f 100644 --- a/usr.bin/libtool/LT/Exec.pm +++ b/usr.bin/libtool/LT/Exec.pm @@ -1,4 +1,4 @@ -# $OpenBSD: Exec.pm,v 1.5 2018/08/26 19:09:55 naddy Exp $ +# $OpenBSD: Exec.pm,v 1.6 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,79 +15,70 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say switch state); +use v5.36; package LT::Exec; use LT::Trace; use LT::Util; +# OO singleton my $dry = 0; my $verbose = 0; my $performed = 0; -sub performed +sub performed($) { return $performed; } -sub dry_run +sub dry_run($) { $dry = 1; } -sub verbose_run +sub verbose_run($) { $verbose = 1; } -sub silent_run +sub silent_run($) { $verbose = 0; } -sub new +sub new($class) { - my $class = shift; bless {}, $class; } -sub chdir +sub chdir($self, $dir) { - my ($self, $dir) = @_; my $class = ref($self) || $self; bless {dir => $dir}, $class; } -sub compile +sub compile($self, @l) { - my ($self, @l) = @_; $self->command("compile", @l); } -sub execute +sub execute($self, @l) { - my ($self, @l) = @_; $self->command("execute", @l); } -sub install +sub install($self, @l) { - my ($self, @l) = @_; $self->command("install", @l); } -sub link +sub link($self, @l) { - my ($self, @l) = @_; $self->command("link", @l); } -sub command_run +sub command_run($self, @l) { - my ($self, @l) = @_; - if ($self->{dir}) { tprint {"cd $self->{dir} && "}; } @@ -110,9 +101,8 @@ sub command_run } } -sub shell +sub shell($self, @cmds) { - my ($self, @cmds) = @_; # create an object "on the run" if (!ref($self)) { $self = $self->new; @@ -126,9 +116,8 @@ sub shell $performed++; } -sub command +sub command($self, $mode, @l) { - my ($self, $mode, @l) = @_; # create an object "on the run" if (!ref($self)) { $self = $self->new; diff --git a/usr.bin/libtool/LT/Getopt.pm b/usr.bin/libtool/LT/Getopt.pm index 1798518bf6c..7aaf599c35a 100644 --- a/usr.bin/libtool/LT/Getopt.pm +++ b/usr.bin/libtool/LT/Getopt.pm @@ -1,4 +1,4 @@ -# $OpenBSD: Getopt.pm,v 1.13 2017/05/27 10:35:41 zhuk Exp $ +# $OpenBSD: Getopt.pm,v 1.14 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2012 Marc Espie # @@ -15,13 +15,11 @@ # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. # -use strict; -use warnings; +use v5.36; package Option; -sub factory +sub factory($class, $o) { - my ($class, $o) = @_; if ($o =~ m/^(.)$/) { return Option::Short->new($1); } elsif ($o =~ m/^(.)\:$/) { @@ -39,15 +37,13 @@ sub factory } } -sub new +sub new($class, $v) { - my ($class, $v) = @_; bless \$v, $class; } -sub setup +sub setup($self, $opts, $isarray) { - my ($self, $opts, $isarray) = @_; $opts->add_option_accessor($$self, $isarray); return $self; } @@ -55,9 +51,8 @@ sub setup package Option::Short; our @ISA = qw(Option); -sub match +sub match($self, $arg, $opts, $canonical, $code) { - my ($self, $arg, $opts, $canonical, $code) = @_; if ($arg =~ m/^\-\Q$$self\E$/) { &$code($opts, $canonical, 1, $arg); return 1; @@ -73,9 +68,8 @@ sub match package Option::ShortArg; our @ISA = qw(Option::Short); -sub match +sub match($self, $arg, $opts, $canonical, $code) { - my ($self, $arg, $opts, $canonical, $code) = @_; if ($arg =~ m/^\-\Q$$self\E$/) { &$code($opts, $canonical, (shift @main::ARGV), $arg); return 1; @@ -90,9 +84,8 @@ sub match package Option::Long; our @ISA = qw(Option); -sub match +sub match($self, $arg, $opts, $canonical, $code) { - my ($self, $arg, $opts, $canonical, $code) = @_; if ($arg =~ m/^\-\Q$$self\E$/) { &$code($opts, $canonical, 1, $arg); return 1; @@ -102,9 +95,8 @@ sub match package Option::LongArg0; our @ISA = qw(Option::Long); -sub match +sub match($self, $arg, $opts, $canonical, $code) { - my ($self, $arg, $opts, $canonical, $code) = @_; if ($arg =~ m/^\-\Q$$self\E$/) { if (@main::ARGV > 0) { &$code($opts, $canonical, (shift @main::ARGV), $arg); @@ -119,9 +111,8 @@ sub match package Option::LongArg; our @ISA = qw(Option::LongArg0); -sub match +sub match($self, $arg, $opts, $canonical, $code) { - my ($self, $arg, $opts, $canonical, $code) = @_; if ($self->SUPER::match($arg, $opts, $canonical, $code)) { return 1; } @@ -133,20 +124,18 @@ sub match } package Option::Regexp; -sub new +sub new($class, $re, $code) { - my ($class, $re, $code) = @_; bless {re => $re, code => $code}, $class; } -sub setup +sub setup($self, $, $) { - return shift; + return $self; } -sub match +sub match($self, $arg, $opts) { - my ($self, $arg, $opts) = @_; if (my @l = ($arg =~ m/^$self->{re}$/)) { &{$self->{code}}(@l); return 1; @@ -157,28 +146,27 @@ sub match package Options; -sub new +sub new($class, $string, $code) { - my ($class, $string, $code) = @_; - if (ref($string) eq 'Regexp') { return Option::Regexp->new($string, $code); } my @alternates = split(/\|/, $string); - bless {alt => [map { Option->factory($_); } @alternates], code => $code}, $class; + bless { + alt => [map { Option->factory($_); } @alternates], + code => $code + }, $class; } -sub setup +sub setup($self, $allopts, $isarray) { - my ($self, $allopts, $isarray) = @_; $self->{alt}[0]->setup($allopts, $isarray); return $self; } -sub match +sub match($self, $arg, $opts) { - my ($self, $arg, $opts) = @_; my $canonical = ${$self->{alt}[0]}; for my $s (@{$self->{alt}}) { @@ -197,23 +185,20 @@ use LT::Util; # parsing an option 'all-static' will automatically add an # accessor $self->all_static that maps to the option. -sub add_option_accessor +sub add_option_accessor($self, $option, $isarray) { - my ($self, $option, $isarray) = @_; my $access = $option; $access =~ s/^\-//; $access =~ s/-/_/g; my $actual = $isarray ? - sub { - my $self = shift; + sub($self) { $self->{opt}{$option} //= []; if (wantarray) { return @{$self->{opt}{$option}}; } else { return scalar @{$self->{opt}{$option}}; } - } : sub { - my $self = shift; + } : sub($self) { return $self->{opt}{$option}; }; my $callpkg = ref($self); @@ -223,9 +208,8 @@ sub add_option_accessor } } -sub create_options +sub create_options($self, @l) { - my ($self, @l) = @_; my @options = (); # first pass creates accessors push(@l, '-tag=', sub { $self->add_tag($_[2]); }); @@ -248,15 +232,14 @@ sub create_options }; } } - push(@options, Options->new($opt, $code)->setup($self, $isarray)); + push(@options, + Options->new($opt, $code)->setup($self, $isarray)); } return @options; } -sub handle_options +sub handle_options($self, @l) { - my ($self, @l) = @_; - my @options = $self->create_options(@l); MAINLOOP: @@ -279,10 +262,8 @@ MAINLOOP: } } -sub handle_permuted_options +sub handle_permuted_options($self, @l) { - my ($self, @l) = @_; - my @options = $self->create_options(@l); $self->{kept} = []; @@ -305,15 +286,13 @@ MAINLOOP2: @main::ARGV = @{$self->{kept}}; } -sub keep_for_later +sub keep_for_later($self, @args) { - my ($self, @args) = @_; push(@{$self->{kept}}, @args); } -sub new +sub new($class) { - my $class = shift; bless {}, $class; } diff --git a/usr.bin/libtool/LT/LaFile.pm b/usr.bin/libtool/LT/LaFile.pm index 6c930f24706..e89d9ce1755 100644 --- a/usr.bin/libtool/LT/LaFile.pm +++ b/usr.bin/libtool/LT/LaFile.pm @@ -1,4 +1,4 @@ -# $OpenBSD: LaFile.pm,v 1.24 2019/09/28 06:25:57 semarie Exp $ +# $OpenBSD: LaFile.pm,v 1.25 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,9 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say switch state); +use v5.36; package LT::LaFile; use parent qw(LT::LaLoFile); @@ -27,10 +25,8 @@ use LT::Util; use LT::Trace; # allows special treatment for some keywords -sub set +sub set($self, $k, $v) { - my ($self, $k, $v) = @_; - $self->SUPER::set($k, $v); if ($k eq 'dependency_libs') { my @l = split /\s+/, $v; @@ -38,17 +34,14 @@ sub set } } -sub deplib_list +sub deplib_list($self) { - my $self = shift; return $self->{deplib_list} } # XXX not sure how much of this cruft we need -sub write +sub write($lainfo, $filename, $name) { - my ($lainfo, $filename, $name) = @_; - my $libname = $lainfo->stringize('libname'); my $sharedlibname = $lainfo->stringize('dlname'); my $staticlibname = $lainfo->stringize('old_library'); @@ -103,9 +96,8 @@ EOF ; } -sub write_shared_libs_log +sub write_shared_libs_log($self, $origv) { - my ($self, $origv) = @_; if (!defined $ENV{SHARED_LIBS_LOG}) { return; } @@ -124,10 +116,8 @@ sub write_shared_libs_log # find .la file associated with a -llib flag # XXX pick the right one if multiple are found! -sub find +sub find($self, $l, $sd) { - my ($self, $l, $sd) = @_; - tsay {"searching .la for $l in $sd"}; foreach my $la_candidate ("$sd/lib$l.la", "$sd/$l.la") { if (-f $la_candidate) { @@ -139,10 +129,8 @@ sub find return undef; } -sub install +sub install($class, $src, $dstdir, $instprog, $instopts, $strip) { - my ($class, $src, $dstdir, $instprog, $instopts, $strip) = @_; - my $srcdir = dirname($src); my $srcfile = basename($src); my $dstfile = $srcfile; @@ -188,10 +176,8 @@ sub install } } -sub parse +sub parse($class, $filename) { - my ($class, $filename) = @_; - my $info = $class->SUPER::parse($filename); $info->{deplib_list} //= LT::UList->new; diff --git a/usr.bin/libtool/LT/LaLoFile.pm b/usr.bin/libtool/LT/LaLoFile.pm index 493ec67ed39..7a5e315d443 100644 --- a/usr.bin/libtool/LT/LaLoFile.pm +++ b/usr.bin/libtool/LT/LaLoFile.pm @@ -1,4 +1,4 @@ -# $OpenBSD: LaLoFile.pm,v 1.4 2014/03/19 02:16:22 afresh1 Exp $ +# $OpenBSD: LaLoFile.pm,v 1.5 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,9 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say switch state); +use v5.36; package LT::LaLoFile; use LT::Trace; @@ -27,25 +25,21 @@ my $cache_by_fullname = {}; my $cache_by_inode = {}; # allows special treatment for some keywords -sub set +sub set($self, $k, $v) { - my ($self, $k, $v) = @_; - $self->{$k} = $v; } -sub stringize +sub stringize($self, $k) { - my ($self, $k) = @_; if (defined $self->{$k}) { return $self->{$k}; } return ''; } -sub read +sub read($class, $filename) { - my ($class, $filename) = @_; my $info = $class->new; open(my $fh, '<', $filename) or die "Cannot read $filename: $!\n"; while (my $line = <$fh>) { @@ -61,10 +55,8 @@ sub read return $info; } -sub parse +sub parse($class, $filename) { - my ($class, $filename) = @_; - tprint {"parsing $filename"}; if (defined $cache_by_fullname->{$filename}) { @@ -81,9 +73,8 @@ sub parse $class->read($filename); } -sub new +sub new($class) { - my $class = shift; bless {}, $class; } diff --git a/usr.bin/libtool/LT/LoFile.pm b/usr.bin/libtool/LT/LoFile.pm index 5b2f3ee0f23..c0b595935bf 100644 --- a/usr.bin/libtool/LT/LoFile.pm +++ b/usr.bin/libtool/LT/LoFile.pm @@ -1,4 +1,4 @@ -# $OpenBSD: LoFile.pm,v 1.5 2012/07/10 11:41:10 espie Exp $ +# $OpenBSD: LoFile.pm,v 1.6 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,9 +15,7 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say switch state); +use v5.36; package LT::LoFile; use parent qw(LT::LaLoFile); @@ -25,9 +23,8 @@ use File::Basename; use LT::Util; # write a libtool object file -sub write +sub write($self, $filename) { - my ($self, $filename) = @_; my $picobj = $self->stringize('picobj'); my $nonpicobj = $self->stringize('nonpicobj'); @@ -45,10 +42,8 @@ EOF ; } -sub compile +sub compile($self, $compiler, $odir, $args) { - my ($self, $compiler, $odir, $args) = @_; - mkdir "$odir/$ltdir" unless -d "$odir/$ltdir"; if (defined $self->{picobj}) { my @cmd = @$compiler; diff --git a/usr.bin/libtool/LT/Trace.pm b/usr.bin/libtool/LT/Trace.pm index 2073b3ca74b..46e9a726d3f 100644 --- a/usr.bin/libtool/LT/Trace.pm +++ b/usr.bin/libtool/LT/Trace.pm @@ -1,4 +1,4 @@ -# $OpenBSD: Trace.pm,v 1.4 2012/07/08 09:36:40 jasper Exp $ +# $OpenBSD: Trace.pm,v 1.5 2023/07/06 08:29:26 espie Exp $ # Copyright (c) 2007-2010 Steven Mestdagh # Copyright (c) 2012 Marc Espie @@ -15,55 +15,43 @@ # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -use strict; -use warnings; -use feature qw(say state); +use v5.36; package LT::Trace; use Exporter 'import'; our @EXPORT = qw(tprint tsay); -sub print(&) +sub print :prototype(&)($val) { - my $val = shift; if (defined $ENV{TRACE_LIBTOOL}) { state $trace_file; if (!defined $trace_file) { open $trace_file, '>>', $ENV{TRACE_LIBTOOL}; } if (defined $trace_file) { - print $trace_file (&$val); + print $trace_file (&$val()); } } } my $trace_level = 0; -sub set +sub set($, $t) { - my $class = shift; - $trace_level = shift; + $trace_level = $t; } -sub tprint(&;$) +sub tprint :prototype(&;$)($args, $level = 1) { - my ($args, $level) = @_; - - $level = 1 if !defined $level; - if ($trace_level >= $level) { - print (&$args); + print (&$args()); } } -sub tsay(&;$) +sub tsay :prototype(&;$)($args, $level = 1) { - my ($args, $level) = @_; - - $level = 1 if !defined $level; - if ($trace_level >= $level) { - say (&$args); + say (&$args()); } } -- 2.20.1