From 292de10927788a6e7be6f80f15b36a36e2d3c828 Mon Sep 17 00:00:00 2001 From: espie Date: Tue, 8 May 2018 11:48:01 +0000 Subject: [PATCH] move reversesubst into its own package this part is bound to grow --- infrastructure/bin/update-plist | 175 +------------------ infrastructure/lib/OpenBSD/ReverseSubst.pm | 189 +++++++++++++++++++++ 2 files changed, 192 insertions(+), 172 deletions(-) create mode 100644 infrastructure/lib/OpenBSD/ReverseSubst.pm diff --git a/infrastructure/bin/update-plist b/infrastructure/bin/update-plist index fe21660e68d..83080ee073a 100755 --- a/infrastructure/bin/update-plist +++ b/infrastructure/bin/update-plist @@ -1,5 +1,5 @@ #! /usr/bin/perl -# $OpenBSD: update-plist,v 1.114 2018/05/08 11:34:44 espie Exp $ +# $OpenBSD: update-plist,v 1.115 2018/05/08 11:48:01 espie Exp $ # Copyright (c) 2018 Marc Espie # # Permission to use, copy, modify, and distribute this software for any @@ -46,6 +46,7 @@ BEGIN { use lib "$ports1/infrastructure/lib"; use OpenBSD::PkgCreate; use OpenBSD::FS2; +use OpenBSD::ReverseSubst; package TrackedFile; sub new @@ -135,176 +136,6 @@ sub write_all } } -package Forwarder; -# perfect forwarding -sub AUTOLOAD -{ - our $AUTOLOAD; - my $fullsub = $AUTOLOAD; - (my $sub = $fullsub) =~ s/.*:://o; - return if $sub eq 'DESTROY'; # special case - no strict "refs"; - *$fullsub = sub { - my $self = shift; - $self->{delegate}->$sub(@_); - }; - goto &$fullsub; -} - -package ReverseSubst; -our @ISA = qw(Forwarder); -sub new -{ - bless {delegate => OpenBSD::Subst->new, - # count the number of times we see each value. More than once, - # hard to figure out WHICH one to backsubst - count => {}, - # record that a variable is actually used. Then if we see the - # string and no backsubst, it's probably intentional - used => {}, - # special variables we won't add in substitutions - special => { - FULLPKGNAME => 1, - FULLPKGPATH => 1, - MACHINE_ARCH => 1, - ARCH => 1, - BASE_PKGPATH => 1, - LOCALSTATEDIR => 1, - }, - # list of actual variables we care about, e.g., ignored stuff - # and whatnot - l => [], - # variables that expand to nothing have specific handling - lempty => [], - }, shift; -} - -my $ignore = { - COMMENT => 1, - MAINTAINER => 1, - PERMIT_PACKAGE_CDROM => 1, - PERMIT_PACKAGE_FTP => 1, - HOMEPAGE => 1, - REVISION => 1, - EPOCH => 1, -}; - - - -sub add -{ - my ($self, $k, $v) = @_; - # XXX whatever is before FLAVORS is internal pkg_create options - # so ignore them - if ($k eq 'FLAVORS') { - $self->{l} = []; - $self->{count} = {}; - $self->{lempty} = []; - } - if ($ignore->{$k} || $k =~ m/^LIB\S+_VERSION$/) { - } else { - # any variable that expands to @comment should never get - # added where it wasn't already - if ($v =~ m/^\@comment\s*$/) { - my $k2 = $k; - $k2 =~ s/\^//; - $self->{special}{$k2} = 1; - } - if ($v eq '') { - unshift(@{$self->{lempty}}, $k); - } else { - unshift(@{$self->{l}}, $k); - } - $self->{count}{$v}++; - } - $self->{delegate}->add($k, $v); -} - -sub value -{ - my ($self, $k) = @_; - $k =~ s/\^//; - return $self->{delegate}->value($k); -} - -sub never_add -{ - my ($self, $k) = @_; - if ($self->{count}{$self->value($k)} > 1) { - return 1; - } else { - return $self->{special}{$k}; - } -} - -# this has to call self's add in order for reverse_subst to work properly -sub parse_option -{ - &OpenBSD::Subst::parse_option; -} - -sub do_backsubst -{ - my ($subst, $string, $unsubst) = @_; - - # sort non empty variables by reverse length - $subst->{vars} //= [sort - {length($subst->value($b)) <=> length($subst->value($a))} - @{$subst->{l}}]; - for my $k (@{$subst->{vars}}) { - my $k2 = $k; - $k2 =~ s/^\^//; - # don't add subst on THOSE variables - # TODO ARCH, MACHINE_ARCH could happen, but only with word - # boundary contexts - if ($subst->never_add($k2)) { - unless (defined $unsubst && - $unsubst =~ m/\$\{\Q$k2\E\}/) { - # add a magical location for FULLPKGNAME - next unless $k2 eq 'FULLPKGNAME' && - $string =~ m,^share/doc/pkg-readmes/,; - } - } else { - # Heuristics: if the variable is already known AND was - # not used already, then we don't try to use it - next if defined $unsubst && - $subst->{used}{$k2} && - $unsubst !~ m/\$\{$k2\}/; - } - - if ($k =~ m/^\^(.*)$/) { - my $v = $subst->value($k2); - $string =~ s/^\Q$v\E/\$\{$k2\}/; - $string =~ s/([\s:=])\Q$v\E/$1\$\{$k2\}/g; - } else { - # TODO on the other hand, numeric and version-like - # variables shouldn't substitute partial numbers - my $v = $subst->value($k); - $string =~ s/\Q$v\E/\$\{$k2\}/g; - } - } - - # we can't do empty subst without an unsubst; - return $string unless defined $unsubst; - - # this part will be done repeatedly - my $old; - do { - $old = $string; - for my $k (@{$subst->{lempty}}) { - my $k2 = $k; - $k2 =~ s/^\^//; - if ($unsubst =~ m/^(.*)\$\{$k2\}/) { - my $prefix = $1; - # XXX avoid infinite loop - next if $string =~ m/\Q$prefix\E\$\{\Q$k2\E\}/; - $string =~ s/^\Q$prefix\E/$prefix\$\{$k2\}/; - } - } - } while ($old ne $string); - return $string; -} - package PlistReader; our @ISA = qw(OpenBSD::PkgCreate); @@ -429,7 +260,7 @@ our @ISA = qw(OpenBSD::PkgCreate::State); sub init { my ($self, $realstate) = @_; - $self->{subst} = ReverseSubst->new; + $self->{subst} = OpenBSD::ReverseSubst->new; $self->{progressmeter} = $realstate->{progressmeter}; $self->{bad} = 0; $self->{repo} = $realstate->{repo}; diff --git a/infrastructure/lib/OpenBSD/ReverseSubst.pm b/infrastructure/lib/OpenBSD/ReverseSubst.pm new file mode 100644 index 00000000000..9cd01dcfcb5 --- /dev/null +++ b/infrastructure/lib/OpenBSD/ReverseSubst.pm @@ -0,0 +1,189 @@ +# $OpenBSD: ReverseSubst.pm,v 1.1 2018/05/08 11:48:01 espie Exp $ +# Copyright (c) 2018 Marc Espie +# +# 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. + +use strict; +use warnings; + +package Forwarder; +# perfect forwarding +sub AUTOLOAD +{ + our $AUTOLOAD; + my $fullsub = $AUTOLOAD; + (my $sub = $fullsub) =~ s/.*:://o; + return if $sub eq 'DESTROY'; # special case + no strict "refs"; + *$fullsub = sub { + my $self = shift; + $self->{delegate}->$sub(@_); + }; + goto &$fullsub; +} + +package OpenBSD::ReverseSubst; +our @ISA = qw(Forwarder); +sub new +{ + bless {delegate => OpenBSD::Subst->new, + # count the number of times we see each value. More than once, + # hard to figure out WHICH one to backsubst + count => {}, + # record that a variable is actually used. Then if we see the + # string and no backsubst, it's probably intentional + used => {}, + # special variables we won't add in substitutions + special => { + FULLPKGNAME => 1, + FULLPKGPATH => 1, + MACHINE_ARCH => 1, + ARCH => 1, + BASE_PKGPATH => 1, + LOCALSTATEDIR => 1, + }, + # list of actual variables we care about, e.g., ignored stuff + # and whatnot + l => [], + # variables that expand to nothing have specific handling + lempty => [], + }, shift; +} + +my $ignore = { + COMMENT => 1, + MAINTAINER => 1, + PERMIT_PACKAGE_CDROM => 1, + PERMIT_PACKAGE_FTP => 1, + HOMEPAGE => 1, + REVISION => 1, + EPOCH => 1, +}; + + + +sub add +{ + my ($self, $k, $v) = @_; + # XXX whatever is before FLAVORS is internal pkg_create options + # so ignore them + if ($k eq 'FLAVORS') { + $self->{l} = []; + $self->{count} = {}; + $self->{lempty} = []; + } + if ($ignore->{$k} || $k =~ m/^LIB\S+_VERSION$/) { + } else { + # any variable that expands to @comment should never get + # added where it wasn't already + if ($v =~ m/^\@comment\s*$/) { + my $k2 = $k; + $k2 =~ s/\^//; + $self->{special}{$k2} = 1; + } + if ($v eq '') { + unshift(@{$self->{lempty}}, $k); + } else { + unshift(@{$self->{l}}, $k); + } + $self->{count}{$v}++; + } + $self->{delegate}->add($k, $v); +} + +sub value +{ + my ($self, $k) = @_; + $k =~ s/\^//; + return $self->{delegate}->value($k); +} + +sub never_add +{ + my ($self, $k) = @_; + if ($self->{count}{$self->value($k)} > 1) { + return 1; + } else { + return $self->{special}{$k}; + } +} + +# this has to call self's add in order for reverse_subst to work properly +sub parse_option +{ + &OpenBSD::Subst::parse_option; +} + +sub do_backsubst +{ + my ($subst, $string, $unsubst) = @_; + + # sort non empty variables by reverse length + $subst->{vars} //= [sort + {length($subst->value($b)) <=> length($subst->value($a))} + @{$subst->{l}}]; + for my $k (@{$subst->{vars}}) { + my $k2 = $k; + $k2 =~ s/^\^//; + # don't add subst on THOSE variables + # TODO ARCH, MACHINE_ARCH could happen, but only with word + # boundary contexts + if ($subst->never_add($k2)) { + unless (defined $unsubst && + $unsubst =~ m/\$\{\Q$k2\E\}/) { + # add a magical location for FULLPKGNAME + next unless $k2 eq 'FULLPKGNAME' && + $string =~ m,^share/doc/pkg-readmes/,; + } + } else { + # Heuristics: if the variable is already known AND was + # not used already, then we don't try to use it + next if defined $unsubst && + $subst->{used}{$k2} && + $unsubst !~ m/\$\{$k2\}/; + } + + if ($k =~ m/^\^(.*)$/) { + my $v = $subst->value($k2); + $string =~ s/^\Q$v\E/\$\{$k2\}/; + $string =~ s/([\s:=])\Q$v\E/$1\$\{$k2\}/g; + } else { + # TODO on the other hand, numeric and version-like + # variables shouldn't substitute partial numbers + my $v = $subst->value($k); + $string =~ s/\Q$v\E/\$\{$k2\}/g; + } + } + + # we can't do empty subst without an unsubst; + return $string unless defined $unsubst; + + # this part will be done repeatedly + my $old; + do { + $old = $string; + for my $k (@{$subst->{lempty}}) { + my $k2 = $k; + $k2 =~ s/^\^//; + if ($unsubst =~ m/^(.*)\$\{$k2\}/) { + my $prefix = $1; + # XXX avoid infinite loop + next if $string =~ m/\Q$prefix\E\$\{\Q$k2\E\}/; + $string =~ s/^\Q$prefix\E/$prefix\$\{$k2\}/; + } + } + } while ($old ne $string); + return $string; +} + +1;