ood-ports-lbsd/infrastructure/bin/portbump

#!/usr/bin/perl

# $OpenBSD: portbump,v 1.19 2016/11/06 21:37:55 zhuk 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;

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;

# 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
	REVISION
	V
	VERSION
);
my $_rev_neighbors_plain = join('|', @_REV_NEIGHBORS);

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 = {
		dir => $dir,
		modules => [],
		noarch => {},
		shlibs => {},
		tweak_wantlib => $tweak_wantlib,
		wantlib_mod => {},
		verbose => 0,
	};

	#
	# Get actual information about subpackages (including their
	# REVISIONs) and shared libraries.
	#
	open (my $dumpvars, '-|', "make", "SUBDIR=$dir", "dump-vars") or
		die "cannot run make dump-vars: $!";
	while (<$dumpvars>) {
		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) ];
		}
	}
	close $dumpvars;

	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.
		#
		open ($dumpvars, '-|', "make", "SUBDIR=$dir", "show=WANTLIB") or
			die "cannot run make show=WANTLIB: $!";
		while (<$dumpvars>) {
			chomp;
			next if /^===>/;
			$_ =~ s/^\s*//;
			$self->{wantlib_resolved}->{""} =
			    { map { $_ => 1 } split(/\s+/, $_) };
		}
		close $dumpvars;
	}
	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') {
			open ($dumpvars, '-|', qw(make show=PKGFILES)) or
				die "cannot run make show=PKGFILES: $!";
			my @missing;
			while (<$dumpvars>) {
				chomp;
				unless (-e $_) {
					$_ =~ s,.*/,,;
					push(@missing, $_);
				}
			}
			close $dumpvars;
			if (scalar(@missing)) {
				print STDERR "cannot tweak WANTLIB$dirref,"
				    . "missing packages: "
				    . join(", ", @missing) . "\n";
				return undef;
			}
		} else {
			open ($dumpvars, '-|', qw(make show=_FAKE_COOKIE)) or
				die "cannot run make show=_FAKE_COOKIE: $!";
			my $cookie = <$dumpvars>;
			close $dumpvars;
			chomp $cookie;
			unless (-e $cookie) {
				print STDERR "cannot tweak WANTLIB$dirref,"
				    . " run 'make fake' first\n";
				return undef;
			}
		}

		$self->{wantlib_extra} = { "" => [] };
		$self->{wantlib_missing} = { "" => [] };
		open ($dumpvars, '-|', "make", "SUBDIR=$dir", $lib_depends_tgt) or
			die "cannot run make $lib_depends_tgt: $!";
		my $subpkg = "";
		my %not_reachable;
		while (<$dumpvars>) {
			chomp;
			if (/^[^\s\(]+\([^\)]+,(-[^\)]+)\):$/) {
				$subpkg = $1;
				$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";
			}
		}
		close $dumpvars;
		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 bless($self, $class);
}

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 ($self->{has_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,
			    "0",
			    $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 $wantlib_auto = exists $self->{wantlib_extra};
	my %wl_del_hash;
	if ($wantlib_auto) {
		# 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}}) {
				$self->{wantlib_resolved}->{$subpkg}->{$w} = 1;
			}
		}
		for my $subpkg (keys %{$self->{wantlib_extra}}) {
			next unless exists $self->{wantlib_resolved}->{$subpkg};
			for my $w (@{$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;
		}
	}

	$self->_init_wantlib("");
	# TODO
	#my $common_created = 0;
	#if (scalar @{$self->{wantlib}->{""}->{libs}} == 0) {
	#	$common_created = 1;
	#	$self->{wantlib}->{""}->{libs} = [ keys %wl_common ];
	#}

	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;
				$empty_line = 0;
				print $out "WANTLIB${subpkg} = # no-arch package\n";
				$nlines++;
			}
			next;
		}

		$self->{wantlib}->{$subpkg}->{wssample} =~ /^ *WANTLIB(?:-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=/;
		my $ws = $1;

		my @libs;
		if ($wantlib_auto) {
			$self->{wantlib}->{$subpkg}->{inherits_global} = 1
			    if $self->_init_wantlib($subpkg);
			@libs = keys(%{$self->{wantlib_resolved}->{$subpkg}});
			if ($self->{wantlib}->{$subpkg}->{inherits_global}) {
				@libs = grep { !exists $wl_common{$_} } @libs;
				unshift(@libs, '${WANTLIB}');
			}
		} else {
			@libs = grep {
				!exists $wl_del_hash{Util::w_stem($_)}
			    } @{$self->{wantlib}->{$subpkg}->{libs}};
		}

		# find the difference between resolved and found in Makefile
		# items; that should be inherited from ${MOD*} and thus
		# do not go into WANTLIB explicitly.
		@libs = $self->_unexpand_mod_wantlib(@libs);
		my %libs_inherited = map { $_ => 1 } @libs;
		for my $w ($self->_unexpand_mod_wantlib(@{$self->{wantlib}->{$subpkg}->{libs}})) {
			delete $libs_inherited{$w};
		}
		@libs = grep { !exists $libs_inherited{$_} } @libs;

		if ($wantlib_auto) {
			for my $w (@{$self->{wantlib_extra}->{$subpkg} // [] }) {
				@libs = grep { $_ !~ m,^(?:.*/)?\Q$w\E(?:[<>=].*)?$, } @libs;
			}
			push(@libs, @{$self->{wantlib_missing}->{$subpkg} // [] });
		}

		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}';
		}
		if ($subpkg eq "" or !$defpkgchanged or
		    !$self->{wantlib}->{$subpkg}->{inherits_global}) {
			push(@libs, @$wl_add);
		}

		@libs = sort $self->_unexpand_mod_wantlib(@libs);

		print $out "\n" unless $empty_line;
		$empty_line = 0;
		$nlines++;
		my $line = "WANTLIB${subpkg}${ws}= ";
		my $expanded = 0;
		for my $w (@libs) {
			if ($w =~ /^\$/ and $w !~ /^\$[\{\(]WANTLIB/) {
				$expanded = 1;
			} else {
				if ($expanded) {
					print $out $line."\n";
					$nlines++;
					$line = "WANTLIB${subpkg}${ws}+=";
				}
				$expanded = 0;
			}
			if (length($line) + 1 + length($w) > 72) {
				print $out $line."\n";
				$nlines++;
				$line = "WANTLIB${subpkg}${ws}+=";
			}
			$line .= " ".$w;
		}
		print $out $line."\n";
		$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 => 0,
		}
	}
	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
	# }
	$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;
	$self->{has_global_rev} = 0;
	while (<$in>) {
		chomp;

		if (/^ *REVISION(\s*)[\+\?\!]*=/) {
			$self->{has_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})(-[A-Za-z0-9_+]*)?(\s*)[\+\?\!]*=(\s*)(.*)$/o) {
			my $var = $1;
			my $subpkg = $2 // "";
			$self->{newrevplace}->{$subpkg} //= {};
			$self->{newrevplace}->{$subpkg}->{line} = $in->input_line_number();
			$self->{newrevplace}->{$subpkg}->{wssample} = $_;
			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 ($self->{has_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)) {
		my $show = 'show='.join(' ', @mod_wantlib_seen);
		open (my $makeh, '-|', 'make', $show)
		    or die "cannot run make $show: $!";
		while (<$makeh>) {
			chomp;
			my $m = shift @mod_wantlib_seen;
			$self->{wantlib_mod}->{$m} = { map {
				Util::w_stem($_) => $_
			    } split(/\s+/, $_) };
		}
		close $makeh;
	}
}

{ 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;