xref: /openbsd-src/usr.sbin/pkg_add/OpenBSD/Subst.pm (revision 77679933cb537a572105552695ac86b5d4efd3a1)
108aa43f2Sespie# ex:ts=8 sw=4:
2*77679933Sespie# $OpenBSD: Subst.pm,v 1.26 2023/10/25 11:14:42 espie Exp $
308aa43f2Sespie#
408aa43f2Sespie# Copyright (c) 2008 Marc Espie <espie@openbsd.org>
508aa43f2Sespie#
608aa43f2Sespie# Permission to use, copy, modify, and distribute this software for any
708aa43f2Sespie# purpose with or without fee is hereby granted, provided that the above
808aa43f2Sespie# copyright notice and this permission notice appear in all copies.
908aa43f2Sespie#
1008aa43f2Sespie# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
1108aa43f2Sespie# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
1208aa43f2Sespie# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
1308aa43f2Sespie# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
1408aa43f2Sespie# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
1508aa43f2Sespie# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
1608aa43f2Sespie# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
170fbefeddSespie
18039cbdaaSespieuse v5.36;
1908aa43f2Sespie
2008aa43f2Sespie# very simple package, just holds everything needed for substitution
2108aa43f2Sespie# according to package rules.
2208aa43f2Sespie
2308aa43f2Sespiepackage OpenBSD::Subst;
2408aa43f2Sespie
25039cbdaaSespie# XXX ReverseSubst takes a state as an extra parameter
26039cbdaaSespiesub new($class, @)
2708aa43f2Sespie{
28039cbdaaSespie	bless {}, $class;
2908aa43f2Sespie}
3008aa43f2Sespie
31039cbdaaSespiesub hash($self)
32faf968f3Sespie{
33039cbdaaSespie	return $self;
34faf968f3Sespie}
35faf968f3Sespie
36039cbdaaSespiesub add($self, $k, $v)
3708aa43f2Sespie{
380dcd5f0cSespie	$k =~ s/^\^//;
3908aa43f2Sespie	$self->{$k} = $v;
4008aa43f2Sespie}
4108aa43f2Sespie
42039cbdaaSespiesub value($self, $k)
4386895186Sespie{
4486895186Sespie	return $self->{$k};
4586895186Sespie}
4686895186Sespie
47039cbdaaSespiesub parse_option($self, $opt)
4808aa43f2Sespie{
497e7e7ff7Snaddy	if ($opt =~ m/^([^=]+)\=(.*)$/o) {
507e7e7ff7Snaddy		my ($k, $v) = ($1, $2);
5108aa43f2Sespie		$v =~ s/^\'(.*)\'$/$1/;
5208aa43f2Sespie		$v =~ s/^\"(.*)\"$/$1/;
53*77679933Sespie		# variable name can't end with a '+',
54*77679933Sespie		# recognize this as '+=' instead
55*77679933Sespie		if ($k =~ s/\+$//) {
56*77679933Sespie			if (defined $self->{$k}) {
57*77679933Sespie				return $self->{$k} .= " $v";
58*77679933Sespie			}
59*77679933Sespie		}
6086895186Sespie		$self->add($k, $v);
6108aa43f2Sespie	} else {
6286895186Sespie		$self->add($opt, 1);
6308aa43f2Sespie	}
6408aa43f2Sespie}
6508aa43f2Sespie
66039cbdaaSespiesub do($self, $s)
6708aa43f2Sespie{
68ba1b5d7eSespie	return $s unless $s =~ m/\$/o;	# no need to subst if no $
69b62674ebSespie	while ( my $k = ($s =~ m/\$\{([A-Za-z_][^\}]*)\}/o)[0] ) {
70ce5a451eSnigel		my $v = $self->{$k};
71ce5a451eSnigel		unless ( defined $v ) { $v = "\$\\\{$k\}"; }
72b62674ebSespie		$s =~ s/\$\{\Q$k\E\}/$v/g;
7308aa43f2Sespie	}
74b62674ebSespie	$s =~ s/\$\\\{([A-Za-z_])/\$\{$1/go;
75b62674ebSespie	return $s;
7608aa43f2Sespie}
7708aa43f2Sespie
78039cbdaaSespiesub copy_fh2($self, $src, $dest)
7908aa43f2Sespie{
80b62674ebSespie	my $contents = do { local $/; <$src> };
81ce5a451eSnigel	while (my ($k, $v) = each %{$self}) {
82b62674ebSespie		$contents =~ s/\$\{\Q$k\E\}/$v/g;
8308aa43f2Sespie	}
84b62674ebSespie	$contents =~ s/\$\\\{([A-Za-z_])/\$\{$1/go;
85b62674ebSespie	print $dest $contents;
8608aa43f2Sespie}
8708aa43f2Sespie
88039cbdaaSespiesub copy_fh($self, $srcname, $dest)
8919bafd84Sespie{
9037530f25Sespie	open my $src, '<', $srcname or die "can't open $srcname: $!";
9119bafd84Sespie	$self->copy_fh2($src, $dest);
9219bafd84Sespie}
9319bafd84Sespie
94039cbdaaSespiesub copy($self, $srcname, $destname)
9508aa43f2Sespie{
9637530f25Sespie	open my $dest, '>', $destname or die "can't open $destname: $!";
9708aa43f2Sespie	$self->copy_fh($srcname, $dest);
98e9a45af2Sespie	return $dest;
9908aa43f2Sespie}
10008aa43f2Sespie
101a67807eaSespiesub has_fragment($self, $state, $def, $frag, $location)
10208aa43f2Sespie{
1035f85e236Sespie	my $v = $self->value($def);
10486895186Sespie
10586895186Sespie	if (!defined $v) {
106a67807eaSespie		$state->fatal("Unknown fragment #1 in #2",
107a67807eaSespie		    $frag, $location);
10886895186Sespie	} elsif ($v == 1) {
10908aa43f2Sespie		return 1;
11086895186Sespie	} elsif ($v == 0) {
11108aa43f2Sespie		return 0;
11208aa43f2Sespie	} else {
113a67807eaSespie		$state->fatal("Invalid fragment define #1=#2", $frag, $v);
11408aa43f2Sespie	}
11508aa43f2Sespie}
11608aa43f2Sespie
117039cbdaaSespiesub empty($self, $k)
11808aa43f2Sespie{
11986895186Sespie	my $v = $self->value($k);
12086895186Sespie	if (defined $v && $v) {
12108aa43f2Sespie		return 0;
12208aa43f2Sespie	} else {
12308aa43f2Sespie		return 1;
12408aa43f2Sespie	}
12508aa43f2Sespie}
12608aa43f2Sespie
12708aa43f2Sespie1;
128