cpet/openbsd-ports
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
openbsd-ports/infrastructure/bin/portbump
espie 2497dfc0ac write a proper pipe handling for running make, with actual error handling 
return the full output of make as an array each time.

mainly done because SUBDIR should be passed in the environment, otherwise
some really funky things happen (ask kn@)

naddy@ approves the direction
2020-02-26 15:25:47 +00:00

1120 lines
31 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl
# $OpenBSD: portbump,v 1.23 2020/02/26 15:25:47 espie Exp $
#
# Copyright (c) 2014-2016 Vadim Zhukov <zhuk@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
package Util;
use strict;
use warnings;
BEGIN {
require Exporter;
our @EXPORT = qw(plibs phash w_stem);
}
sub plibs {
my $prefix = shift;
print STDERR "$prefix: ".join(", ", @_)."\n";
}
# prints hash in compact form, for debugging purposes
sub phash {
my $h = shift;
"{ ".join (", ", map {
$_."=>".(ref($h->{$_}) eq 'HASH' ? phash($h->{$_}) : $h->{$_})
} (sort keys %{$h})) . " }";
}
sub spc_per_tab { 8 }
sub expand_tabs {
my $line = shift;
while ($line =~ /\t/) {
my $pos = $-[0] + spc_per_tab - 1;
$pos -= $pos % spc_per_tab;
$line = $` . (' ' x (($pos - $-[0]) || spc_per_tab)) . $';
}
return $line;
}
sub w_stem {
my @v = @_;
for (@v) {
s,^.*/,,;
s,^([^/<>=]+)(?:[<>=].*)$,$1,;
}
return wantarray ? @v : $v[0];
}
#################################################################
package PortHandler;
use strict;
use warnings;
BEGIN { 'Util'->import(qw(w_stem)); }
# Here is a list of variables that REVISION's are usually placed
# near to. Update if you see the "can't find a suitable place for
# REVISION mark" message
my @_REV_NEIGHBORS = qw(
DISTNAME
FULLPKGNAME
GNOME_PROJECT
PKGNAME
QT5NAME
XFCE_VERSION
MOZILLA_VERSION
MODPY_EGG_VERSION
REVISION
V
VERSION
);
my $_rev_neighbors_plain = join('|', @_REV_NEIGHBORS);
# If any of _REV_NEIGHBORS was not found, items from
#_REV_NEIGHBORS_WEAK will be used instead.
my @_REV_NEIGHBORS_WEAK = qw(
GH_ACCOUNT
GH_COMMIT
GH_PROJECT
GH_TAGNAME
COMMENT
);
my $_rev_neighbors_plain_all = join('|', @_REV_NEIGHBORS, @_REV_NEIGHBORS_WEAK);
sub run_make_in
{
my $self = shift;
my $dir = shift;
my $pid = open(my $pipe, "-|");
if (!defined $pid) {
die "Couldn't start pipe: $!";
}
if ($pid == 0) {
$ENV{SUBDIR}=$dir if defined $dir;
exec {'make'} ('make', @_);
exit(1);
}
my @lines = <$pipe>;
close($pipe);
if ($? != 0) {
die "Pipe errored out with $?";
}
return @lines;
}
sub run_make
{
my $self = shift;
return $self->run_make_in(undef, @_);
}
sub new {
my ($class, $dir, $tweak_wantlib, $lib_depends_tgt) = @_;
die "lib depends target specified without WANTLIB tweaking"
if !$tweak_wantlib and defined($lib_depends_tgt);
my $self = bless {
dir => $dir,
modules => [],
noarch => {},
shlibs => {},
tweak_wantlib => $tweak_wantlib,
wantlib_mod => {},
verbose => 0,
}, $class;
#
# Get actual information about subpackages (including their
# REVISIONs) and shared libraries.
#
for ($self->run_make_in($dir, 'dump-vars')) {
chomp;
next unless /^[^,]*(?:,[^.-]*(-[^.]+)?)?\.([^=.]+)=(.*)$/;
my ($subpkg, $var, $value) = ($1, $2, $3);
$subpkg //= "";
if ($var eq "MULTI_PACKAGES") {
$self->{mpkgs} = { map { $_ => 1 } split(/\s+/, $value) };
} elsif ($var eq "SHARED_LIBS") {
# perhaps direct " = split (...)" would be enough?
$self->{shlibs} = { %{$self->{shlibs}}, split(/\s+/, $value) };
} elsif ($var eq "SUBPACKAGE") {
$self->{defsubpkg} = $value;
} elsif ($var eq "PKG_ARCH") {
$self->{noarch}->{$subpkg} = 1 if $value eq "*";
} elsif ($var eq "WANTLIB") {
$self->{wantlib_resolved} //= {};
$self->{wantlib_resolved}->{$subpkg} =
{ map { $_ => 1 } split(/\s+/, $value) };
} elsif ($var eq "MODULES") {
$self->{modules} = [ split(/\s+/, $value) ];
}
}
if (scalar(keys %{$self->{mpkgs}}) == 1 and exists($self->{mpkgs}->{"-"})) {
$self->{mpkgs} = { "" => 1 };
}
if ($tweak_wantlib and _is_mpkg_port($self)) {
$self->{wantlib_resolved} //= {};
#
# Get actual value of WANTLIB (not the one of WANTLIB-foo or WANTLIB-),
# to be used to avoid extra WANTLIB-* lines.
#
for ($self->run_make_in($dir, 'show=WANTLIB')) {
chomp;
next if /^===>/;
$_ =~ s/^\s*//;
$self->{wantlib_resolved}->{""} =
{ map { $_ => 1 } split(/\s+/, $_) };
}
}
if (defined $lib_depends_tgt) {
my $dirref = ($dir eq ".") ? "" : " in $dir";
# first, make sure we don't have to build/install anything
if ($lib_depends_tgt eq 'lib-depends-check') {
my @missing;
for ($self->run_make('show=PKGFILES')) {
chomp;
unless (-e $_) {
$_ =~ s,.*/,,;
push(@missing, $_);
}
}
if (scalar(@missing)) {
print STDERR "cannot tweak WANTLIB$dirref"
. " due to missing packages: "
. join(", ", @missing) . "\n";
return undef;
}
} else {
my $cookie = ($self->run_make('show=_FAKE_COOKIE'))[0];
chomp $cookie;
unless (-e $cookie) {
print STDERR "cannot tweak WANTLIB$dirref,"
. " run 'make fake' first\n";
return undef;
}
}
$self->{wantlib_extra} = { "" => [] };
$self->{wantlib_missing} = { "" => [] };
my $subpkg;
my %not_reachable;
for ($self->run_make_in($dir, $lib_depends_tgt)) {
chomp;
if (/^\s*$/) {
# ignore empty lines
} elsif (/^Missing:/) {
# we don't use "Missing" lines
} elsif (/Error 1 in target '$lib_depends_tgt' \(ignored\)/) {
# that's normal when something is missing or extra
} elsif (/^[^\s\(]+\([^\)]+,(-[^\)]+)\):$/) {
$subpkg = $1;
$self->{wantlib_extra}->{$subpkg} = [];
$self->{wantlib_missing}->{$subpkg} = [];
} elsif (/^[^\s\(]+\([^\),]+\):$/) {
$subpkg = "";
$self->{wantlib_extra}->{$subpkg} = [];
$self->{wantlib_missing}->{$subpkg} = [];
} elsif (/^WANTLIB.* \+= (.+)/) {
push(@{$self->{wantlib_missing}->{$subpkg}},
split(/\s+/, $1));
} elsif (/^Extra:\s*(\S+)/) {
push(@{$self->{wantlib_extra}->{$subpkg}},
map { s/\.[0-9]+$//; $_ } split(/\s+/, $1));
} elsif (/^Bogus WANTLIB:\s*(\S+).*NOT REACHABLE/) {
$not_reachable{$1} = 1;
} elsif (/^Asking ports for dependency/) {
print STDERR "$_\n";
} else {
}
}
# for $subpkg (keys %{$self->{mpkgs}}) {
# print STDERR "wantlib_extra->{$subpkg} = ".join(', ', @{$self->{wantlib_extra}->{$subpkg}})."\n";
# print STDERR "wantlib_missing->{$subpkg} = ".join(', ', @{$self->{wantlib_missing}->{$subpkg}})."\n";
# }
if (scalar(keys %not_reachable)) {
print STDERR "cannot tweak WANTLIB$dirref,"
. " not reachable missing libraries detected: "
. join(", ", sort keys %not_reachable) . "\n";
return undef;
}
}
return $self;
}
sub verbose {
my $self = shift;
my $rv = $self->{verbose};
$self->{verbose} = $_[0] if defined $_[0];
return $rv;
}
# Formats and returns string of "var = value" with whitespace adjustment
# done like in the sample given line.
sub _adj_whitespace {
my ($self, $var, $value, $wssample) = @_;
unless (defined($wssample) and
$wssample =~ /^( *)([A-Za-z0-9_+-]+)(\s*)[\+\?\!]*=(\s*)/) {
return "$var =\t$value";
}
my $start_ws = $1 // "";
my $before_eq_ws = $3 // "";
my $after_eq_ws = $4 // "";
my $svalue_pos = $+[4];
my $line = $start_ws.$var.$before_eq_ws."=";
my $line_exp = Util::expand_tabs($line);
my $wssample_exp = Util::expand_tabs($wssample);
my $svalue_pos_exp = $svalue_pos +
(length($wssample_exp) - length($wssample));
my $elen = length($line_exp);
if ($elen > $svalue_pos_exp) {
# too long anyway, just add a tab and be done with it
$line .= "\t";
} elsif ($elen < $svalue_pos_exp) {
if ($after_eq_ws =~ /^\t*$/) {
# tab-based separation
while ($elen < $svalue_pos_exp) {
my $n_spc_to_add = ($svalue_pos_exp - $elen);
$n_spc_to_add %= Util::spc_per_tab;
$n_spc_to_add ||= Util::spc_per_tab;
$elen += $n_spc_to_add;
$line .= "\t";
}
} else {
# space-based separation
$line .= ' ' x ($svalue_pos_exp - length($line_exp));
}
}
return $line.$value;
}
sub _is_mpkg_port {
my $self = shift;
for my $subpkg (keys %{$self->{mpkgs}}) {
next if $subpkg eq "";
next if $subpkg eq "-";
return 1;
}
return 0;
}
sub _add_new_revs {
my ($self, $out, $lineno, $bumppkgs) = (shift, shift, shift, shift);
# Note: $lineno is the input file's line number, not output's one.
if ($self->{maxrevsin}->{count} > 1) {
return 0 unless $lineno == $self->{maxrevsin}->{blockend};
}
if (defined $self->{global_rev}) {
return 0 unless $self->_is_mpkg_port;
}
my $nchanges = 0;
for my $subpkg(sort keys %{$bumppkgs}) {
# if no place found, error will be reported by update()
if ($self->{maxrevsin}->{count} > 1 or
(defined $self->{newrevplace}->{$subpkg}->{blockend} and
$lineno == $self->{newrevplace}->{$subpkg}->{blockend})) {
my $line = $self->_adj_whitespace(
"REVISION" . $subpkg,
($self->{global_rev} // -1) + 1,
$self->{newrevplace}->{$subpkg}->{wssample});
print $out $line, "\n";
$nchanges++;
}
}
return $nchanges;
}
# un-expand ${MOD*}
sub _unexpand_mod_wantlib {
my $self = shift;
my @libs = @_;
for my $m (keys %{$self->{wantlib_mod}}) {
my $nlibs = keys %{$self->{wantlib_mod}->{$m}};
if ($nlibs == 0) {
print STDERR "warning: empty $m is used in ".
$self->{dir}.", it may don't get somewhere\n"
if $self->{verbose};
next;
}
my @compacted = grep { !exists $self->{wantlib_mod}->{$m}->{Util::w_stem($_)} } @libs;
if (scalar(@libs) - scalar(@compacted) == $nlibs) {
@libs = ("\${$m}", @compacted);
}
}
return @libs;
}
sub _put_wantlib_lines {
my ($self, $out, $bumppkgs, $wl_add, $wl_del, $empty_line)
= @_;
my $recreate = exists $self->{wantlib_extra};
my %wl_del_hash;
if ($recreate) {
# adjust wantlib_resolved according to wantlib_missing
for my $subpkg (keys %{$self->{wantlib_missing}}) {
$self->{wantlib_resolved}->{$subpkg} //= {};
for my $w (@{$self->{wantlib_missing}->{$subpkg}}) {
my $found = 0;
for my $w2 (keys %{$self->{wantlib_resolved}->{$subpkg}}) {
if (Util::w_stem($w) eq Util::w_stem($w2)) {
print STDERR "INTERNAL ERROR: library dependency check told we miss $w in '$subpkg' subpackage, but it's there: $w2\n";
$found = 1;
last;
}
}
$self->{wantlib_resolved}->{$subpkg}->{$w} = 1
unless $found;
}
}
for my $subpkg (keys %{$self->{wantlib_extra}}) {
next unless exists $self->{wantlib_resolved}->{$subpkg};
for my $w (Util::w_stem(@{$self->{wantlib_extra}->{$subpkg}})) {
for my $w2 (keys %{$self->{wantlib_resolved}->{$subpkg}}) {
my $w_short = Util::w_stem($w2);
delete $self->{wantlib_resolved}->{$subpkg}->{$w2}
if $w_short eq $w;
}
}
}
} else {
%wl_del_hash = map { Util::w_stem($_) => 1; }
@$wl_add, @$wl_del;
}
# build list of WANTLIB items common to all subpackages;
# also used to populate WANTLIB in case there is only
# WANTLIB declaration used.
my %wl_common = map { $_ => 1 } (@{$wl_add // []});
for my $subpkg (keys %{$self->{wantlib_resolved}}) {
next if exists $self->{noarch}->{$subpkg};
%wl_common = (%wl_common, %{$self->{wantlib_resolved}->{$subpkg}});
}
for my $w (keys %wl_common) {
WLC_REMOVAL: for my $subpkg (keys %{$self->{wantlib_resolved}}) {
next if $subpkg eq "";
next if exists $self->{noarch}->{$subpkg};
next if exists $self->{wantlib_resolved}->{$subpkg}->{$w};
if (exists $bumppkgs->{$subpkg} and defined $wl_add) {
for my $w2 (@$wl_add) {
next WLC_REMOVAL if $w2 eq $w;
}
}
delete $wl_common{$w};
last;
}
}
#print STDERR "common WANTLIB items: ".join(", ", keys %wl_common)."\n";
$self->_init_wantlib("");
for my $w (sort keys %wl_common) {
next if exists $self->{wantlib_resolved}->{""}->{$w};
$self->{wantlib_resolved}->{""}->{$w} = 1;
}
my %all_subpkgs_hash = map { $_ => 1 }
keys(%{$self->{wantlib}}), keys(%{$self->{noarch}});
my @sorted_subpkgs = sort {
return -1 if $a eq "";
return 1 if $b eq "";
return -1 if $a eq $self->{defsubpkg};
return 1 if $b eq $self->{defsubpkg};
$a cmp $b;
} keys %all_subpkgs_hash;
my $defpkgchanged = 0;
my $nlines = 0;
for my $subpkg (@sorted_subpkgs) {
if (exists $self->{noarch}->{$subpkg}) {
#
# Catch both situations when WANTLIB is populated from
# outside and when some ${MOD*} inside ${WANTLIB}
# could be empty in default case.
#
if (keys(%{$self->{wantlib_resolved}->{""}}) > 0 or
scalar(@{$self->{wantlib}->{""}->{libs}}) > 0) {
print $out "\n" unless $empty_line;
print STDERR "\n" unless $empty_line or !$self->{verbose};
$empty_line = 0;
print $out "WANTLIB${subpkg} = # no-arch package\n";
print STDERR "WANTLIB${subpkg} = # no-arch package\n" if $self->{verbose};
$nlines++;
}
next;
}
$self->{wantlib}->{$subpkg}->{wssample} =~ /^ *WANTLIB(?:-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=/;
my $ws = $1;
my @libs;
if ($recreate) {
$self->{wantlib}->{$subpkg}->{inherits_global} = 1
if $self->_init_wantlib($subpkg) and $self->_is_mpkg_port();
@libs = keys(%{$self->{wantlib_resolved}->{$subpkg}});
if ($self->{wantlib}->{$subpkg}->{inherits_global} and $subpkg ne "") {
@libs = grep { !exists $wl_common{$_} } @libs;
unshift(@libs, '${WANTLIB}');
}
} else {
@libs = grep {
!exists $wl_del_hash{Util::w_stem($_)}
} @{$self->{wantlib}->{$subpkg}->{libs}};
}
if ($subpkg eq "" or !$defpkgchanged or
!$self->{wantlib}->{$subpkg}->{inherits_global}) {
push(@libs, @$wl_add);
}
# find the difference between resolved and found in Makefile
# items; that should be inherited from ${MOD*} and thus
# do not go into WANTLIB explicitly.
#print STDERR "Before MOD-unexpand of $subpkg: ".join(", ", @libs)."\n";
@libs = $self->_unexpand_mod_wantlib(@libs);
#print STDERR "After MOD-unexpand of $subpkg: ".join(", ", @libs)."\n";
if ($self->{wantlib}->{$subpkg}->{inherits_global}) {
my %libs_inherited = map { $_ => 1 } (grep { $subpkg ne "" or /^\$[\{\(]MOD[A-Z].*_WANTLIB[\}\)]$/ } @libs);
for my $w ($self->_unexpand_mod_wantlib(@{$self->{wantlib}->{$subpkg}->{libs}})) {
delete $libs_inherited{$w};
}
@libs = grep { !exists $libs_inherited{$_} } @libs;
}
if ($subpkg eq "") {
next if scalar(@libs) == 0;
} else {
next if $self->{wantlib}->{$subpkg}->{inherits_global}
and scalar(@libs) == 1
and $libs[0] eq '${WANTLIB}';
}
print $out "\n" unless $empty_line;
print STDERR "\n" unless $empty_line or !$self->{verbose};
$empty_line = 0;
$nlines++;
my $line = "WANTLIB${subpkg}${ws}= ";
my $expanded = 0;
for my $w (sort @libs) {
if ($w =~ /^\$/ and $w !~ /^\$[\{\(]WANTLIB/) {
$expanded = 1;
} else {
if ($expanded) {
print $out $line."\n";
print STDERR $line."\n" if $self->{verbose};
$nlines++;
$line = "WANTLIB${subpkg}${ws}+=";
}
$expanded = 0;
}
if (length($line) + 1 + length($w) > 72) {
print $out $line."\n";
print STDERR $line."\n" if $self->{verbose};
$nlines++;
$line = "WANTLIB${subpkg}${ws}+=";
}
$line .= " ".$w;
}
print $out $line."\n";
print STDERR $line."\n" if $self->{verbose};
$nlines++;
$defpkgchanged = 1 if $subpkg eq "";
}
return $nlines;
}
sub _init_wantlib {
my ($self, $subpkg) = @_;
my $rv = 0;
if (!exists $self->{wantlib}->{$subpkg}) {
$rv = 1;
$self->{wantlib}->{$subpkg} = {
libs => [],
wssample => "WANTLIB += foo",
permitline => -1,
reqmanual => 0,
wantlibline => 0,
inherits_global => ($subpkg eq "" and $self->_is_mpkg_port()),
}
}
return $rv;
}
#
# Search for places where new REVISION and WANTLIB marks should be added,
# in given makefile, and with what whitespace.
#
sub process_makefile {
my ($self, $in) = (shift, shift);
# subpkg => {
# line => number of line where subpackage is mentioned
# wssample => a line from block to look for whitespace sample in
# blockend => block ending line number
# }
$self->{newrevplace} = {};
$self->{maxrevsin} = { blockend => 0, count => 0 };
my $revsincurblock = 0;
my ($block1begin, $block1end) = (0, 0);
# subpkg => {
# libs => [ wantlib items ... ]
# wssample => a line to look for whitespace sample in
# permitline => number of last line where PERMIT_* variable was set + 1
# reqmanual => 1 if WANTLIB-foo requires manual intervention
# wantlibline => number of last line where WANTLIB$subpkg is mentioned
# inherits_global => 1 if WANTLIB-foo inherits WANTLIB,
# and for WANTLIB itself
# }
$self->{wantlib} = {};
# indicator if we're in .if or .for block
my $looplevel = 0;
# list of PERMIT_* variables assigned inside .if/.for,
# used to set permitline at the end of .if/.for block.
my @permits_in_loop = ();
# indicator if last non-empty line was a PERMIT_* one
my $last_was_permit = 0;
# indicator if we're continuing WANTLIB line
my $wantlib_block = 0;
# used for wantlib_blocks to track initial subpackage and whole
# WANTLIB$w_subpkg value
my ($w_subpkg, $w_value);
# list of ${MOD*} variables mentioned in WANTLIBs
my @mod_wantlib_seen;
my @mentionedsubpkgs;
while (<$in>) {
chomp;
if (/^ *REVISION\s*[\+\?\!]*=\s*([0-9]+)/) {
$self->{global_rev} = $1;
}
if (/^ *PERMIT_(?:PACKAGE_(?:CDROM|FTP)|DISTFILES_FTP)(-[A-Za-z0-9_+]*)?\b/) {
$last_was_permit = 1;
for my $subpkg(keys %{$self->{wantlib}}) {
$self->{wantlib}->{$subpkg}->{permitline}++
if $self->{wantlib}->{$subpkg}->{permitline}
== $in->input_line_number();
}
} elsif (/^ *(?:#.*)?#/) {
for my $subpkg(keys %{$self->{wantlib}}) {
$self->{wantlib}->{$subpkg}->{permitline}++
if $self->{wantlib}->{$subpkg}->{permitline}
== $in->input_line_number();
}
} else {
$last_was_permit = 0;
}
if (/^\. *(if|for)/) {
$looplevel++;
} elsif (/^\. *end(if|for)/) {
$looplevel--;
while (scalar @permits_in_loop) {
my $subpkg = shift @permits_in_loop;
$self->_init_wantlib($subpkg);
$self->{wantlib}->{$subpkg}->{permitline} = $in->input_line_number();
}
} elsif (/^ *(${_rev_neighbors_plain_all})(-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=(\s*)(.*)$/o) {
my $var = $1;
my $subpkg = $2 // "";
$self->{newrevplace}->{$subpkg} //= {};
$self->{newrevplace}->{$subpkg}->{wssample} = $_;
$self->{newrevplace}->{$subpkg}->{strong} //= 0;
if ($var =~ /^(?:${_rev_neighbors_plain})$/o) {
$self->{newrevplace}->{$subpkg}->{strong} = 1;
$self->{newrevplace}->{$subpkg}->{line} = $in->input_line_number();
} elsif (!$self->{newrevplace}->{$subpkg}->{strong}) {
$self->{newrevplace}->{$subpkg}->{line} = $in->input_line_number();
} else {
# weak neighbor when strong one was already seen, ignore
next;
}
delete $self->{newrevplace}->{$subpkg}->{blockend};
push(@mentionedsubpkgs, $subpkg);
if ($var eq "REVISION") {
if (++$revsincurblock > $self->{maxrevsin}->{count}) {
$self->{maxrevsin}->{blockend} = 0;
$self->{maxrevsin}->{count} = $revsincurblock;
}
}
$block1begin = $in->input_line_number() if !$block1begin;
} elsif ($wantlib_block or /^ *WANTLIB(-[A-Za-z0-9_+]*)?\s*[\+\?\!]*=\s*(.*)$/) {
if ($wantlib_block) {
$_ =~ s/#.*$//;
$w_value .= " ".$_;
} else {
$w_subpkg = $1 // "";
$w_value = $2;
$self->_init_wantlib($w_subpkg);
$self->{wantlib}->{$w_subpkg}->{wssample} = $_;
$self->{wantlib}->{$w_subpkg}->{reqmanual} = 1
if !exists $self->{mpkgs}->{$w_subpkg};
}
$wantlib_block = $w_value =~ s/\s*\\$//;
next if $wantlib_block;
$w_value =~ s/\s*#.*$//;
if ($looplevel) {
$self->{wantlib}->{$w_subpkg}->{reqmanual} = 1;
} else {
$self->{wantlib}->{$w_subpkg}->{line} = $in->input_line_number();
next if $self->{wantlib}->{$w_subpkg}->{reqmanual};
while ($w_value =~ /(\S+)/g) {
my $w = $1;
if ($w !~ /^\$[\{\(].*[\}\)]$/) {
# no problems
} elsif ($w =~ /^\$[\{\(]WANTLIB[\}\)]$/) {
$self->{wantlib}->{$w_subpkg}->{inherits_global} = 1;
} elsif ($w =~ /^\$[\{\(](MOD.+)[\}\)]$/) {
push(@mod_wantlib_seen, $1);
} else {
$self->{wantlib}->{$w_subpkg}->{reqmanual} = 1;
}
push @{$self->{wantlib}->{$w_subpkg}->{libs}}, $w;
}
delete $self->{wantlib}->{$w_subpkg}->{blockend};
}
} elsif (/^ *PERMIT_(?:PACKAGE_(?:CDROM|FTP)|DISTFILES_FTP)(-[A-Za-z0-9_+]*)?\b/) {
my $subpkg = $1 // "";
$self->_init_wantlib($subpkg);
$self->{wantlib}->{$subpkg}->{permitline} = $in->input_line_number();
push(@permits_in_loop, $subpkg) if $looplevel;
} elsif (/^\s*$/) {
for my $subpkg(@mentionedsubpkgs) {
$self->{newrevplace}->{$subpkg}->{blockend} = $in->input_line_number();
}
$self->{maxrevsin}->{blockend} = $in->input_line_number()
if $self->{maxrevsin}->{blockend} == 0;
@mentionedsubpkgs = ();
$revsincurblock = 0;
$block1end = $in->input_line_number()
if $block1begin && !$block1end;
} elsif (!/^ *(\#|BROKEN|COMES_WITH|IGNORE|NOT_FOR_ARCHS|ONLY_FOR_ARCHS)/) {
$block1begin = $in->input_line_number() if !$block1begin;
}
}
for my $subpkg(@mentionedsubpkgs) {
$self->{newrevplace}->{$subpkg}->{blockend} = $in->input_line_number();
}
if ($self->{maxrevsin}->{blockend} == 0) {
$self->{maxrevsin}->{blockend} = $block1end ? $block1end :
$in->input_line_number();
}
# make sure new REVISION-foo won't arise when bumping REVISION
if (defined($self->{global_rev}) and $self->{maxrevsin}->{blockend} <
$self->{newrevplace}->{""}->{blockend}) {
$self->{maxrevsin}->{blockend} = $self->{newrevplace}->{""}->{blockend};
$self->{maxrevsin}->{count} = 2; # see _add_new_revs for >1 check
}
return unless $self->{tweak_wantlib};
my $wstart = -1;
# first, try to find a place for WANTLIB after PERMIT_* lines
for my $subpkg(keys %{$self->{wantlib}}) {
if ($self->{wantlib}->{$subpkg}->{permitline} > $wstart) {
$wstart = $self->{wantlib}->{$subpkg}->{permitline};
}
}
# next, find first WANTLIB line and use it
if ($wstart == -1) {
$wstart = $in->input_line_number();
for my $subpkg(keys %{$self->{wantlib}}) {
if ($self->{wantlib}->{$subpkg}->{line} < $wstart) {
$wstart = $self->{wantlib}->{$subpkg}->{line};
}
}
}
# finally, try to anchor to @_REV_NEIGHBORS* items
if ($wstart == $in->input_line_number()) {
$wstart = -1;
for my $subpkg(keys %{$self->{newrevplace}}) {
if ($self->{newrevplace}->{$subpkg}->{line} > $wstart) {
$wstart = $self->{newrevplace}->{$subpkg}->{line};
}
}
if ($wstart == -1) {
$self->_init_wantlib("");
$self->{wantlib}->{""}->{reqmanual} = 1;
} else {
$wstart++;
}
}
$self->{wantlib_start} = $wstart;
my $gcc4_seen = 0;
push(@mod_wantlib_seen, map {
$gcc4_seen = 1 if $_ eq "gcc4";
my $v = uc($_);
$v =~ s,.*/,,g;
$v =~ s,^PYTHON$,PY,g;
"MOD${v}_WANTLIB"
} @{$self->{modules}});
push(@mod_wantlib_seen, "MODGCC4_CPPWANTLIB", "MODGCC4_GCJWANTLIB")
if $gcc4_seen;
if (scalar(@mod_wantlib_seen)) {
for ($self->run_make('show='.join(' ', @mod_wantlib_seen))) {
chomp;
my $m = shift @mod_wantlib_seen;
$self->{wantlib_mod}->{$m} = { map {
Util::w_stem($_) => $_
} split(/\s+/, $_) };
}
}
}
{ my %manual_noticed;
sub _update_shlibs {
my ($self, $shline) = @_;
my @splitres = split(/\s+/, $shline);
my $nchanges = 0;
if (scalar(@splitres) % 2 != 0) {
# avoid pointless error message from Perl
if (!defined $manual_noticed{$self->{dir}}) {
printf STDERR $self->{dir} .
" may need manual intervention\n";
$manual_noticed{$self->{dir}} = 1;
}
} else {
my %lineshlibs = @splitres;
for my $lib (keys %lineshlibs) {
my $v = $self->{shlibs}->{$lib} // next;
printf STDERR "%-30s: changing shared library ".
"%s version to %s\n",
$self->{dir}, $lib, $v
if $self->{verbose};
$nchanges++ if s/($lib\s+)[0-9]+\.[0-9]+/$1$v/g;
}
}
return $nchanges;
} }
sub update {
my ($self, $in, $out, $bumppkgs, $bumprevs, $removerevs, $bumpshlibs,
$wl_add, $wl_del) = @_;
if ($self->{tweak_wantlib}) {
for my $subpkg (keys %$bumppkgs) {
next unless exists $bumppkgs->{$subpkg};
next unless exists $self->{wantlib}->{$subpkg};
next unless $self->{wantlib}->{$subpkg}->{reqmanual};
printf STDERR "%s requires manual WANTLIB handling\n",
$self->{dir};
return -1;
}
}
my $defbumped = 0;
my ($shlib_block, $wantlib_block) = (0, 0);
my $nchanges = 0;
my $wl_ws_removal;
my ($empty_line, $prev_line_was_empty) = (1, 1);
while (<$in>) {
chomp;
$prev_line_was_empty = $empty_line;
$empty_line = 0;
if ($shlib_block or /^ *SHARED_LIBS/) {
$wl_ws_removal = undef;
my $shline = $_;
# N.B.: Some ports define SHARED_LIBS in subpackage-
# dependant way, i.e., add them only if
# the corresponding subpackage should be built,
# or use subpackage-specific lists of shared libs
# for additional tasks.
$shlib_block or $shline =~ s/^ *SHARED_LIBS(?:\S+)?\s*\+?=\s*//;
$shlib_block = $shline =~ s/\s*\\$//;
if ($bumpshlibs) {
# XXX will misbehave after "<...> # \"
$shline =~ s/\\s*#.*//;
$shline =~ s/^\s*//;
$nchanges += $self->_update_shlibs($shline);
}
} elsif ($wantlib_block or /^ *WANTLIB(?:-[A-Za-z0-9_+]*)?\s*[\+\?\!]*=/) {
my $line = $_;
$wantlib_block = $line =~ s/\s*\\$//;
if ($self->{tweak_wantlib}) {
$_ = undef;
$empty_line = $prev_line_was_empty;
$wl_ws_removal = 0 unless defined $wl_ws_removal;
}
} elsif (/^ *REVISION(-[A-Za-z0-9_+]+)?.*=\s*([0-9]*)$/) {
$wl_ws_removal = undef;
my $subpkg = $1 // "";
if ($removerevs) {
$nchanges++;
$_ = undef;
$empty_line = $prev_line_was_empty;
} elsif (!$bumprevs) {
# do nothing
} elsif (exists $bumppkgs->{$subpkg} or
($subpkg eq "" and scalar(keys %{$self->{mpkgs}}) ==
scalar(keys %{$bumppkgs}))) {
my $rev = $2 // -1;
my $newrev = $rev + 1;
printf STDERR "%-30s: changing %s to %d\n",
$self->{dir}, $_, $newrev
if $self->{verbose};
$nchanges++ if s/[0-9]*$/$newrev/;
delete $bumppkgs->{$subpkg};
$defbumped = 1 if $subpkg eq "";
}
} elsif (/^\s*$/) {
$empty_line = 1;
if (defined $wl_ws_removal) {
$_ = undef if $wl_ws_removal > 0;
$wl_ws_removal++;
}
} elsif (defined($wl_ws_removal) and $wl_ws_removal != -1) {
$wl_ws_removal = undef;
}
if (!$empty_line and defined($wl_ws_removal) and $wl_ws_removal == -1) {
print $out "\n";
$wl_ws_removal = undef;
}
if ($bumprevs and !$defbumped) {
my $n = $self->_add_new_revs($out,
$in->input_line_number(), $bumppkgs);
$wl_ws_removal = undef if $n;
$nchanges += $n;
}
if (defined $_) {
print $out "$_\n";
print STDERR "$_\n" if $self->{verbose};
} elsif ($self->{verbose}) {
print STDERR "<skipping line>\n";
}
if ($self->{tweak_wantlib} and
$in->input_line_number() == $self->{wantlib_start}) {
print STDERR "putting new WANTLIB lines at $self->{wantlib_start}\n" if $self->{verbose};
$nchanges += $self->_put_wantlib_lines($out, $bumppkgs,
$wl_add, $wl_del, $empty_line);
$wl_ws_removal = 0;
}
}
if ($bumprevs) {
for my $subpkg(sort keys %{$bumppkgs}) {
next if defined $self->{newrevplace}->{$subpkg}->{blockend};
print STDERR "can't find a suitable place for ".
"REVISION${subpkg} mark in ".$self->{dir}."\n";
return -1;
}
}
return $nchanges;
}
#################################################################
package main;
use strict;
use warnings;
use v5.14;
use OpenBSD::Getopt;
sub usage {
print join("\n", @_) if scalar @_;
print STDERR
"usage: portbump [-dMmrnv] [-o outfile] [-W lib] [-w lib] [dir ...]\n";
exit 1;
}
our ($opt_d, $opt_l, $opt_M, $opt_m, $opt_n, $opt_o, $opt_r, $opt_v) =
(0, 0, 0, 0, 0, undef, undef, 0);
my (@wl_add, @wl_del);
eval { getopts('dlMmno:rW:w:v', {
'd' => sub { $opt_d++; },
'l' => sub { $opt_l++; },
'M' => sub { $opt_M++; },
'm' => sub { $opt_m++; },
'n' => sub { $opt_n++; },
'o' => sub { $opt_o = shift; },
'v' => sub { $opt_v++; },
'r' => sub { $opt_r++; },
'W' => sub { push(@wl_add, shift); },
'w' => sub { push(@wl_del, shift); },
}) } // usage $@;
$opt_d && $opt_r and usage "cannot mix -d and -r options";
$opt_m && $opt_M and usage "cannot mix -M and -m options";
scalar(@wl_add) || scalar(@wl_del) and $opt_l = 1;
!defined($opt_r) && !$opt_M && !$opt_m && !$opt_d && !$opt_l
and $opt_r = 1;
my %allpkgs; # dir => { subpkg => 1, ... };
my %newrevplace;
scalar(@ARGV) or @ARGV = (".");
for (@ARGV) {
# zap any FLAVOR information to make it easier to feed from of sqlports
s/,+[^,-]*/,/g;
# Allow simple "-subpkg" instead of ugly ",-subpkg"
s/^-/,-/;
if (/^(.*),(-.+)$/) {
my $subdir = $1 || ".";
if (defined $allpkgs{$subdir}) {
if (scalar($allpkgs{$subdir}) == 0) {
die "mixed non-subpackaged and subpackaged for $subdir";
} elsif (exists $allpkgs{$subdir}->{$2}) {
# XXX maybe just ignore?
$opt_v and print STDERR "double bump of \"$_\" requested, ignoring";
}
} else {
$allpkgs{$subdir} = {};
}
$allpkgs{$subdir}->{$2} = 1;
} else {
if (defined $allpkgs{$_}) {
die "mixed non-subpackaged and subpackaged for $_";
}
$allpkgs{$_} = {};
}
}
if (defined($opt_o) and scalar(keys %allpkgs) > 1) {
usage "cannot use -o if more than one port is being processed";
}
if ($opt_v) {
print STDERR "port directories to visit:\n";
for my $dir (keys %allpkgs) {
print STDERR "\t$dir\n";
}
}
my $exitstatus = 0;
for my $dir (keys %allpkgs) {
my $scan_lib_depends = $opt_l;
$scan_lib_depends = 0 if scalar(@wl_add) || scalar(@wl_del);
my $lib_depends_tgt;
if ($scan_lib_depends) {
$lib_depends_tgt = ($scan_lib_depends == 1) ?
'port-lib-depends-check' : 'lib-depends-check';
}
my $port = PortHandler->new($dir, $opt_l, $lib_depends_tgt);
if (!defined $port) {
$exitstatus = 1;
next;
}
$port->verbose(1) if $opt_v;
#
# Bump library versions, if requested.
#
if ($opt_M or $opt_m) {
for my $lib (keys %{$port->{shlibs}}) {
my ($major, $minor) = split(/\./, $port->{shlibs}->{$lib});
if ($opt_M) {
$major++;
$minor = 0;
} else {
$minor++;
}
$port->{shlibs}->{$lib} = "${major}.${minor}";
}
}
#
# Read port information, choose what subpackages to bump.
#
open (my $in, '<', "$dir/Makefile") or
die "cannot open input file $dir/Makefile: $!";
$port->process_makefile($in);
my $bumppkgs;
if (scalar(keys %{$allpkgs{$dir}}) != 0) {
for my $subpkg (keys %{$allpkgs{$dir}}) {
next if exists $port->{mpkgs}->{$subpkg};
die "there is no $dir,$subpkg package";
}
$bumppkgs = $allpkgs{$dir};
} else {
$bumppkgs = $port->{mpkgs};
}
#
# Actual update process.
#
my $outpath = $opt_o // "$dir/Makefile.bump";
open (my $out, '>', $outpath) or
die "cannot open output file $outpath: $!";
seek($in, 0, 0);
$in->input_line_number(0);
my $nchanges = $port->update($in, $out, $bumppkgs, $opt_r, $opt_d,
$opt_m|$opt_M, \@wl_add, \@wl_del);
close($in);
close($out);
if ($nchanges == -1) {
# warning message should be printed already
unlink $outpath;
$exitstatus = 1;
} elsif (!defined $opt_o) {
if (!$nchanges) {
print STDERR "nothing to do in $dir\n" if $opt_v;
unlink $outpath;
} elsif (!$opt_n) {
rename($outpath, "$dir/Makefile") or
die "cannot move $outpath to $dir/Makefile: $!"
}
}
}
exit $exitstatus;
Reference in New Issue View Git Blame Copy Permalink