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 |
deleted file mode 100644 |
index e287dc9f8ccdba56f1e525df532d735bc6190ab8..0000000000000000000000000000000000000000 |
--- a/third_party/dpkg-dev/scripts/Dpkg/Substvars.pm |
+++ /dev/null |
@@ -1,337 +0,0 @@ |
-# 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; |