| Index: third_party/dpkg-dev/scripts/Dpkg/Substvars.pm
 | 
| diff --git a/third_party/dpkg-dev/scripts/Dpkg/Substvars.pm b/third_party/dpkg-dev/scripts/Dpkg/Substvars.pm
 | 
| new file mode 100644
 | 
| index 0000000000000000000000000000000000000000..e287dc9f8ccdba56f1e525df532d735bc6190ab8
 | 
| --- /dev/null
 | 
| +++ b/third_party/dpkg-dev/scripts/Dpkg/Substvars.pm
 | 
| @@ -0,0 +1,337 @@
 | 
| +# Copyright © 2006-2009,2012 Guillem Jover <guillem@debian.org>
 | 
| +# Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
 | 
| +#
 | 
| +# This program is free software; you can redistribute it and/or modify
 | 
| +# it under the terms of the GNU General Public License as published by
 | 
| +# the Free Software Foundation; either version 2 of the License, or
 | 
| +# (at your option) any later version.
 | 
| +#
 | 
| +# This program is distributed in the hope that it will be useful,
 | 
| +# but WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
| +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
| +# GNU General Public License for more details.
 | 
| +#
 | 
| +# You should have received a copy of the GNU General Public License
 | 
| +# along with this program.  If not, see <https://www.gnu.org/licenses/>.
 | 
| +
 | 
| +package Dpkg::Substvars;
 | 
| +
 | 
| +use strict;
 | 
| +use warnings;
 | 
| +
 | 
| +our $VERSION = '1.02';
 | 
| +
 | 
| +use Dpkg ();
 | 
| +use Dpkg::Arch qw(get_host_arch);
 | 
| +use Dpkg::ErrorHandling;
 | 
| +use Dpkg::Gettext;
 | 
| +
 | 
| +use Carp;
 | 
| +use POSIX qw(:errno_h);
 | 
| +
 | 
| +use parent qw(Dpkg::Interface::Storable);
 | 
| +
 | 
| +my $maxsubsts = 50;
 | 
| +
 | 
| +=encoding utf8
 | 
| +
 | 
| +=head1 NAME
 | 
| +
 | 
| +Dpkg::Substvars - handle variable substitution in strings
 | 
| +
 | 
| +=head1 DESCRIPTION
 | 
| +
 | 
| +It provides some an object which is able to substitute variables in
 | 
| +strings.
 | 
| +
 | 
| +=head1 METHODS
 | 
| +
 | 
| +=over 8
 | 
| +
 | 
| +=item my $s = Dpkg::Substvars->new($file)
 | 
| +
 | 
| +Create a new object that can do substitutions. By default it contains
 | 
| +generic substitutions like ${Newline}, ${Space}, ${Tab}, ${dpkg:Version}
 | 
| +and ${dpkg:Upstream-Version}.
 | 
| +
 | 
| +Additional substitutions will be read from the $file passed as parameter.
 | 
| +
 | 
| +It keeps track of which substitutions were actually used (only counting
 | 
| +substvars(), not get()), and warns about unused substvars when asked to. The
 | 
| +substitutions that are always present are not included in these warnings.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub new {
 | 
| +    my ($this, $arg) = @_;
 | 
| +    my $class = ref($this) || $this;
 | 
| +    my $self = {
 | 
| +        vars => {
 | 
| +            'Newline' => "\n",
 | 
| +            'Space' => ' ',
 | 
| +            'Tab' => "\t",
 | 
| +            'dpkg:Version' => $Dpkg::PROGVERSION,
 | 
| +            'dpkg:Upstream-Version' => $Dpkg::PROGVERSION,
 | 
| +            },
 | 
| +        used => {},
 | 
| +	msg_prefix => '',
 | 
| +    };
 | 
| +    $self->{vars}{'dpkg:Upstream-Version'} =~ s/-[^-]+$//;
 | 
| +    bless $self, $class;
 | 
| +    $self->mark_as_used($_) foreach keys %{$self->{vars}};
 | 
| +    if ($arg) {
 | 
| +        $self->load($arg) if -e $arg;
 | 
| +    }
 | 
| +    return $self;
 | 
| +}
 | 
| +
 | 
| +=item $s->set($key, $value)
 | 
| +
 | 
| +Add/replace a substitution.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub set {
 | 
| +    my ($self, $key, $value) = @_;
 | 
| +    $self->{vars}{$key} = $value;
 | 
| +}
 | 
| +
 | 
| +=item $s->set_as_used($key, $value)
 | 
| +
 | 
| +Add/replace a substitution and mark it as used (no warnings will be produced
 | 
| +even if unused).
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub set_as_used {
 | 
| +    my ($self, $key, $value) = @_;
 | 
| +    $self->set($key, $value);
 | 
| +    $self->mark_as_used($key);
 | 
| +}
 | 
| +
 | 
| +=item $s->get($key)
 | 
| +
 | 
| +Get the value of a given substitution.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub get {
 | 
| +    my ($self, $key) = @_;
 | 
| +    return $self->{vars}{$key};
 | 
| +}
 | 
| +
 | 
| +=item $s->delete($key)
 | 
| +
 | 
| +Remove a given substitution.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub delete {
 | 
| +    my ($self, $key) = @_;
 | 
| +    delete $self->{used}{$key};
 | 
| +    return delete $self->{vars}{$key};
 | 
| +}
 | 
| +
 | 
| +=item $s->mark_as_used($key)
 | 
| +
 | 
| +Prevents warnings about a unused substitution, for example if it is provided by
 | 
| +default.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub mark_as_used {
 | 
| +    my ($self, $key) = @_;
 | 
| +    $self->{used}{$key}++;
 | 
| +}
 | 
| +
 | 
| +=item $s->no_warn($key)
 | 
| +
 | 
| +Obsolete function, use mark_as_used() instead.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub no_warn {
 | 
| +    my ($self, $key) = @_;
 | 
| +    carp 'obsolete no_warn() function, use mark_as_used() instead';
 | 
| +    $self->mark_as_used($key);
 | 
| +}
 | 
| +
 | 
| +=item $s->load($file)
 | 
| +
 | 
| +Add new substitutions read from $file.
 | 
| +
 | 
| +=item $s->parse($fh, $desc)
 | 
| +
 | 
| +Add new substitutions read from the filehandle. $desc is used to identify
 | 
| +the filehandle in error messages.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub parse {
 | 
| +    my ($self, $fh, $varlistfile) = @_;
 | 
| +    binmode($fh);
 | 
| +    while (<$fh>) {
 | 
| +	next if m/^\s*\#/ || !m/\S/;
 | 
| +	s/\s*\n$//;
 | 
| +	if (! m/^(\w[-:0-9A-Za-z]*)\=(.*)$/) {
 | 
| +	    error(_g('bad line in substvars file %s at line %d'),
 | 
| +		  $varlistfile, $.);
 | 
| +	}
 | 
| +	$self->{vars}{$1} = $2;
 | 
| +    }
 | 
| +}
 | 
| +
 | 
| +=item $s->set_version_substvars($sourceversion, $binaryversion)
 | 
| +
 | 
| +Defines ${binary:Version}, ${source:Version} and
 | 
| +${source:Upstream-Version} based on the given version strings.
 | 
| +
 | 
| +These will never be warned about when unused.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub set_version_substvars {
 | 
| +    my ($self, $sourceversion, $binaryversion) = @_;
 | 
| +
 | 
| +    # Handle old function signature taking only one argument.
 | 
| +    $binaryversion ||= $sourceversion;
 | 
| +
 | 
| +    # For backwards compatibility on binNMUs that do not use the Binary-Only
 | 
| +    # field on the changelog, always fix up the source version.
 | 
| +    $sourceversion =~ s/\+b[0-9]+$//;
 | 
| +
 | 
| +    $self->{vars}{'binary:Version'} = $binaryversion;
 | 
| +    $self->{vars}{'source:Version'} = $sourceversion;
 | 
| +    $self->{vars}{'source:Upstream-Version'} = $sourceversion;
 | 
| +    $self->{vars}{'source:Upstream-Version'} =~ s/-[^-]*$//;
 | 
| +
 | 
| +    # XXX: Source-Version is now deprecated, remove in the future.
 | 
| +    $self->{vars}{'Source-Version'} = $binaryversion;
 | 
| +
 | 
| +    $self->mark_as_used($_) foreach qw/binary:Version source:Version source:Upstream-Version Source-Version/;
 | 
| +}
 | 
| +
 | 
| +=item $s->set_arch_substvars()
 | 
| +
 | 
| +Defines architecture variables: ${Arch}.
 | 
| +
 | 
| +This will never be warned about when unused.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub set_arch_substvars {
 | 
| +    my ($self) = @_;
 | 
| +
 | 
| +    $self->set_as_used('Arch', get_host_arch());
 | 
| +}
 | 
| +
 | 
| +=item $newstring = $s->substvars($string)
 | 
| +
 | 
| +Substitutes variables in $string and return the result in $newstring.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub substvars {
 | 
| +    my ($self, $v, %opts) = @_;
 | 
| +    my $lhs;
 | 
| +    my $vn;
 | 
| +    my $rhs = '';
 | 
| +    my $count = 0;
 | 
| +    $opts{msg_prefix} = $self->{msg_prefix} unless exists $opts{msg_prefix};
 | 
| +    $opts{no_warn} = 0 unless exists $opts{no_warn};
 | 
| +
 | 
| +    while ($v =~ m/^(.*?)\$\{([-:0-9a-z]+)\}(.*)$/si) {
 | 
| +        # If we have consumed more from the leftover data, then
 | 
| +        # reset the recursive counter.
 | 
| +        $count = 0 if (length($3) < length($rhs));
 | 
| +
 | 
| +        if ($count >= $maxsubsts) {
 | 
| +            error($opts{msg_prefix} .
 | 
| +	          _g("too many substitutions - recursive ? - in \`%s'"), $v);
 | 
| +        }
 | 
| +        $lhs = $1; $vn = $2; $rhs = $3;
 | 
| +        if (defined($self->{vars}{$vn})) {
 | 
| +            $v = $lhs . $self->{vars}{$vn} . $rhs;
 | 
| +            $self->mark_as_used($vn);
 | 
| +            $count++;
 | 
| +        } else {
 | 
| +            warning($opts{msg_prefix} . _g('unknown substitution variable ${%s}'),
 | 
| +	            $vn) unless $opts{no_warn};
 | 
| +            $v = $lhs . $rhs;
 | 
| +        }
 | 
| +    }
 | 
| +    return $v;
 | 
| +}
 | 
| +
 | 
| +=item $s->warn_about_unused()
 | 
| +
 | 
| +Issues warning about any variables that were set, but not used
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub warn_about_unused {
 | 
| +    my ($self, %opts) = @_;
 | 
| +    $opts{msg_prefix} = $self->{msg_prefix} unless exists $opts{msg_prefix};
 | 
| +
 | 
| +    foreach my $vn (keys %{$self->{vars}}) {
 | 
| +        next if $self->{used}{$vn};
 | 
| +        # Empty substitutions variables are ignored on the basis
 | 
| +        # that they are not required in the current situation
 | 
| +        # (example: debhelper's misc:Depends in many cases)
 | 
| +        next if $self->{vars}{$vn} eq '';
 | 
| +        warning($opts{msg_prefix} . _g('unused substitution variable ${%s}'),
 | 
| +                $vn);
 | 
| +    }
 | 
| +}
 | 
| +
 | 
| +=item $s->set_msg_prefix($prefix)
 | 
| +
 | 
| +Define a prefix displayed before all warnings/error messages output
 | 
| +by the module.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub set_msg_prefix {
 | 
| +    my ($self, $prefix) = @_;
 | 
| +    $self->{msg_prefix} = $prefix;
 | 
| +}
 | 
| +
 | 
| +=item $s->save($file)
 | 
| +
 | 
| +Store all substitutions variables except the automatic ones in the
 | 
| +indicated file.
 | 
| +
 | 
| +=item "$s"
 | 
| +
 | 
| +Return a string representation of all substitutions variables except the
 | 
| +automatic ones.
 | 
| +
 | 
| +=item $str = $s->output($fh)
 | 
| +
 | 
| +Print all substitutions variables except the automatic ones in the
 | 
| +filehandle and return the content written.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub output {
 | 
| +    my ($self, $fh) = @_;
 | 
| +    my $str = '';
 | 
| +    # Store all non-automatic substitutions only
 | 
| +    foreach my $vn (sort keys %{$self->{vars}}) {
 | 
| +	next if /^(?:(?:dpkg|source|binary):(?:Source-)?Version|Space|Tab|Newline|Arch|Source-Version|F:.+)$/;
 | 
| +	my $line = "$vn=" . $self->{vars}{$vn} . "\n";
 | 
| +	print { $fh } $line if defined $fh;
 | 
| +	$str .= $line;
 | 
| +    }
 | 
| +    return $str;
 | 
| +}
 | 
| +
 | 
| +=back
 | 
| +
 | 
| +=head1 AUTHOR
 | 
| +
 | 
| +Raphaël Hertzog <hertzog@debian.org>.
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +1;
 | 
| 
 |