1# ex:ts=8 sw=4: 2# $OpenBSD: Subst.pm,v 1.18 2019/07/05 06:02:29 espie Exp $ 3# 4# Copyright (c) 2008 Marc Espie <espie@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use strict; 19use warnings; 20 21# very simple package, just holds everything needed for substitution 22# according to package rules. 23 24package OpenBSD::Subst; 25 26sub new 27{ 28 bless {}, shift; 29} 30 31sub hash 32{ 33 shift; 34} 35 36sub add 37{ 38 my ($self, $k, $v) = @_; 39 $k =~ s/^\^//; 40 $self->{$k} = $v; 41} 42 43sub value 44{ 45 my ($self, $k) = @_; 46 return $self->{$k}; 47} 48 49sub parse_option 50{ 51 my ($self, $opt) = @_; 52 if ($opt =~ m/^([^=]+)\=(.*)$/o) { 53 my ($k, $v) = ($1, $2); 54 $v =~ s/^\'(.*)\'$/$1/; 55 $v =~ s/^\"(.*)\"$/$1/; 56 $self->add($k, $v); 57 } else { 58 $self->add($opt, 1); 59 } 60} 61 62sub do 63{ 64 my $self = shift; 65 my $s = shift; 66 return $s unless $s =~ m/\$/o; # optimization 67 while ( my $k = ($s =~ m/\$\{([A-Za-z_][^\}]*)\}/o)[0] ) { 68 my $v = $self->{$k}; 69 unless ( defined $v ) { $v = "\$\\\{$k\}"; } 70 $s =~ s/\$\{\Q$k\E\}/$v/g; 71 } 72 $s =~ s/\$\\\{([A-Za-z_])/\$\{$1/go; 73 return $s; 74} 75 76sub copy_fh2 77{ 78 my ($self, $src, $dest) = @_; 79 my $contents = do { local $/; <$src> }; 80 while (my ($k, $v) = each %{$self}) { 81 $contents =~ s/\$\{\Q$k\E\}/$v/g; 82 } 83 $contents =~ s/\$\\\{([A-Za-z_])/\$\{$1/go; 84 print $dest $contents; 85} 86 87sub copy_fh 88{ 89 my ($self, $srcname, $dest) = @_; 90 open my $src, '<', $srcname or die "can't open $srcname: $!"; 91 $self->copy_fh2($src, $dest); 92} 93 94sub copy 95{ 96 my ($self, $srcname, $destname) = @_; 97 open my $dest, '>', $destname or die "can't open $destname: $!"; 98 $self->copy_fh($srcname, $dest); 99 return $dest; 100} 101 102sub has_fragment 103{ 104 my ($self, $def, $frag, $msg) = @_; 105 106 my $v = $self->value($def); 107 108 if (!defined $v) { 109 die "Error: unknown fragment $frag in $msg"; 110 } elsif ($v == 1) { 111 return 1; 112 } elsif ($v == 0) { 113 return 0; 114 } else { 115 die "Incorrect define for $frag in $msg"; 116 } 117} 118 119sub empty 120{ 121 my ($self, $k) = @_; 122 123 my $v = $self->value($k); 124 if (defined $v && $v) { 125 return 0; 126 } else { 127 return 1; 128 } 129} 130 1311; 132