1#!/usr/bin/perl 2# 3# This program is free software; you can redistribute it and/or modify 4# it under the terms of the GNU General Public License as published by 5# the Free Software Foundation; either version 2 of the License, or 6# (at your option) any later version. 7# 8# This program is distributed in the hope that it will be useful, 9# but WITHOUT ANY WARRANTY; without even the implied warranty of 10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11# GNU General Public License for more details. 12# 13# You should have received a copy of the GNU General Public License 14# along with this program. If not, see <https://www.gnu.org/licenses/>. 15 16use strict; 17use warnings; 18 19use Test::More tests => 47; 20use Test::Dpkg qw(:paths); 21 22use Dpkg (); 23use Dpkg::Arch qw(get_host_arch); 24 25use_ok('Dpkg::Substvars'); 26 27my $datadir = test_get_data_path(); 28 29my $expected; 30 31my $s = Dpkg::Substvars->new(); 32 33$s->load("$datadir/substvars1"); 34 35# simple value tests 36is($s->get('var1'), 'Some value', 'var1'); 37is($s->get('var2'), 'Some other value', 'var2'); 38is($s->get('var3'), 'Yet another value', 'var3'); 39is($s->get('var4'), undef, 'no var4'); 40 41# Set automatic variable 42$s->set_as_auto('var_auto', 'auto'); 43is($s->get('var_auto'), 'auto', 'get var_auto'); 44 45$expected = <<'VARS'; 46var1=Some value 47var2=Some other value 48var3=Yet another value 49VARS 50is($s->output(), $expected, 'No automatic variables output'); 51 52# overriding 53$s->set('var1', 'New value'); 54is($s->get('var1'), 'New value', 'var1 updated'); 55 56# deleting 57$s->delete('var3'); 58is($s->get('var3'), undef, 'var3 deleted'); 59 60# default variables 61is($s->get('Newline'), "\n", 'newline'); 62is($s->get('Space'), ' ', 'space'); 63is($s->get('Tab'), "\t", 'tab'); 64is($s->get('dpkg:Version'), $Dpkg::PROGVERSION, 'dpkg version 1'); 65 66# special variables 67is($s->get('Arch'), undef, 'no arch'); 68$s->set_arch_substvars(); 69is($s->get('Arch'), get_host_arch(), 'arch'); 70 71is($s->get($_), undef, 'no ' . $_) for qw/binary:Version source:Version source:Upstream-Version/; 72$s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9', '1:2.3.4~5-6.7.8~nmu9+bin0'); 73is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+bin0', 'binary:Version'); 74is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version'); 75is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version'); 76$s->set_version_substvars('2.3.4~5-6.7.8~nmu9+b1', '1:2.3.4~5-6.7.8~nmu9+b1'); 77is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b1', 'binary:Version'); 78is($s->get('source:Version'), '2.3.4~5-6.7.8~nmu9', 'source:Version'); 79is($s->get('source:Upstream-Version'), '2.3.4~5', 'source:Upstream-Version'); 80$s->set_version_substvars('1:2.3.4~5-6.7.8~nmu9+b0'); 81is($s->get('binary:Version'), '1:2.3.4~5-6.7.8~nmu9+b0', 'binary:Version'); 82is($s->get('source:Version'), '1:2.3.4~5-6.7.8~nmu9', 'source:Version'); 83is($s->get('source:Upstream-Version'), '1:2.3.4~5', 'source:Upstream-Version'); 84 85is($s->get($_), undef, 'no ' . $_) foreach qw(source:Synopsis source:Extended-Description); 86$s->set_desc_substvars("short synopsis\nthis is the long\nextended text\n"); 87is($s->get('source:Synopsis'), 'short synopsis', 'contents of source:Synopsis'); 88is($s->get('source:Extended-Description'), "this is the long\nextended text\n", 89 'contents of source:Extended-Description'); 90 91my %ctrl_fields = ( 92 'Some-Field' => 'some-value', 93 'Other-Field' => 'other-value', 94 'Alter-Field' => 'alter-value', 95); 96is($s->get($_), undef, 'no ' . $_) foreach sort keys %ctrl_fields; 97$s->set_field_substvars(\%ctrl_fields, 'ctrl'); 98is($s->get('ctrl:Some-Field'), 'some-value', 'contents of ctrl:Some-Field'); 99is($s->get('ctrl:Other-Field'), 'other-value', 'contents of ctrl:Other-Field'); 100is($s->get('ctrl:Alter-Field'), 'alter-value', 'contents of ctrl:Alter-Field'); 101 102# Replace stuff 103is($s->substvars('This is a string ${var1} with variables ${binary:Version}'), 104 'This is a string New value with variables 1:2.3.4~5-6.7.8~nmu9+b0', 105 'substvars simple'); 106 107# Add a test prefix to error and warning messages. 108$s->set_msg_prefix('test '); 109 110my $output; 111$SIG{__WARN__} = sub { $output .= $_[0] }; 112is($s->substvars('This is a string with unknown variable ${blubb}'), 113 'This is a string with unknown variable ', 114 'substvars missing'); 115delete $SIG{__WARN__}; 116is($output, 117 'Dpkg_Substvars.t: warning: test substitution variable ${blubb} used, but is not defined' . "\n", 118 'missing variables warning'); 119 120# Recursive replace 121$s->set('rvar', 'recursive ${var1}'); 122is($s->substvars('This is a string with ${rvar}'), 123 'This is a string with recursive New value', 124 'substvars recursive'); 125 126# Strange input 127is($s->substvars('Nothing to $ ${substitute here}, is it ${}?, it ${is'), 128 'Nothing to $ ${substitute here}, is it ${}?, it ${is', 129 'substvars strange'); 130 131# Warnings about unused variables 132$output = ''; 133$SIG{__WARN__} = sub { $output .= $_[0] }; 134$s->warn_about_unused(); 135delete $SIG{__WARN__}; 136is($output, 137 'Dpkg_Substvars.t: warning: test substitution variable ${var2} unused, but is defined' . "\n", 138 'unused variables warnings'); 139 140# Disable warnings for a certain variable 141$s->set_as_used('var_used', 'used'); 142$s->mark_as_used('var2'); 143$output = ''; 144$SIG{__WARN__} = sub { $output .= $_[0] }; 145$s->warn_about_unused(); 146delete $SIG{__WARN__}; 147is($output, '', 'disabled unused variables warnings'); 148 149$s->delete('var_used'); 150 151# Variable filters 152my $sf; 153 154$expected = <<'VARS'; 155name3=Yet another value 156name4=Name value 157otherprefix:var7=Quux 158var1=Some value 159var2=Some other value 160VARS 161$sf = Dpkg::Substvars->new("$datadir/substvars2"); 162$sf->filter(remove => sub { $_[0] =~ m/^prefix:/ }); 163is($sf->output(), $expected, 'Filter remove variables'); 164 165$expected = <<'VARS'; 166otherprefix:var7=Quux 167prefix:var5=Foo 168var1=Some value 169var2=Some other value 170VARS 171$sf = Dpkg::Substvars->new("$datadir/substvars2"); 172$sf->filter(keep => sub { $_[0] =~ m/var/ }); 173is($sf->output(), $expected, 'Filter keep variables'); 174 175$expected = <<'VARS'; 176prefix:name6=Bar 177VARS 178$sf = Dpkg::Substvars->new("$datadir/substvars2"); 179$sf->filter(remove => sub { $_[0] =~ m/var/ }, 180 keep => sub { $_[0] =~ m/^prefix:/ }); 181is($sf->output(), $expected, 'Filter keep and remove variables'); 182