-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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;
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);
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;
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";
-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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} && "};
}
}
}
-sub shell
+sub shell($self, @cmds)
{
- my ($self, @cmds) = @_;
# create an object "on the run"
if (!ref($self)) {
$self = $self->new;
$performed++;
}
-sub command
+sub command($self, $mode, @l)
{
- my ($self, $mode, @l) = @_;
# create an object "on the run"
if (!ref($self)) {
$self = $self->new;
-# $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 <espie@openbsd.org>
#
# 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/^(.)\:$/) {
}
}
-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;
}
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;
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;
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;
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);
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;
}
}
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;
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}}) {
# 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);
}
}
-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]); });
};
}
}
- 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:
}
}
-sub handle_permuted_options
+sub handle_permuted_options($self, @l)
{
- my ($self, @l) = @_;
-
my @options = $self->create_options(@l);
$self->{kept} = [];
@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;
}
-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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);
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;
}
}
-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');
;
}
-sub write_shared_libs_log
+sub write_shared_libs_log($self, $origv)
{
- my ($self, $origv) = @_;
if (!defined $ENV{SHARED_LIBS_LOG}) {
return;
}
# 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) {
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;
}
}
-sub parse
+sub parse($class, $filename)
{
- my ($class, $filename) = @_;
-
my $info = $class->SUPER::parse($filename);
$info->{deplib_list} //= LT::UList->new;
-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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;
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>) {
return $info;
}
-sub parse
+sub parse($class, $filename)
{
- my ($class, $filename) = @_;
-
tprint {"parsing $filename"};
if (defined $cache_by_fullname->{$filename}) {
$class->read($filename);
}
-sub new
+sub new($class)
{
- my $class = shift;
bless {}, $class;
}
-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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);
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');
;
}
-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;
-# $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 <steven@openbsd.org>
# Copyright (c) 2012 Marc Espie <espie@openbsd.org>
# 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());
}
}
projects / openbsd / commitdiff