From 22699815920b1cb8550e06dcf2ffe1442b0ee890 Mon Sep 17 00:00:00 2001 From: Raphaël Hertzog Date: Sun, 13 Sep 2009 21:32:30 +0200 Subject: Drop unused code that has been merged in Dpkg::Control --- scripts/Dpkg/Control.pm | 81 +---------------- scripts/Dpkg/Fields.pm | 224 ------------------------------------------------ 2 files changed, 1 insertion(+), 304 deletions(-) (limited to 'scripts') diff --git a/scripts/Dpkg/Control.pm b/scripts/Dpkg/Control.pm index 55944400d..c4a8852f6 100644 --- a/scripts/Dpkg/Control.pm +++ b/scripts/Dpkg/Control.pm @@ -26,7 +26,7 @@ use Dpkg::Control::Types; use Dpkg::Control::Hash; use base qw(Dpkg::Control::Hash Exporter); -our @EXPORT = qw(parsecdata CTRL_UNKNOWN CTRL_INFO_SRC CTRL_INFO_PKG CTRL_APT_SRC +our @EXPORT = qw(CTRL_UNKNOWN CTRL_INFO_SRC CTRL_INFO_PKG CTRL_APT_SRC CTRL_APT_PKG CTRL_PKG_SRC CTRL_PKG_DEB CTRL_FILE_CHANGES CTRL_FILE_VENDOR CTRL_FILE_STATUS CTRL_CHANGELOG); @@ -105,85 +105,6 @@ are either new or overriden with a different behaviour. =over 4 -=item $obj = Dpkg::Control::parsecdata($input, $file, %options) - -$input is a filehandle, $file is the name of the file corresponding to -$input. %options can contain two parameters: allow_pgp=>1 allows the parser -to extrac the block of a data in a PGP-signed message (defaults to 0), -and allow_duplicate=>1 ask the parser to not fail when it detects -duplicate fields. - -The return value is a reference to a tied hash (Dpkg::Fields::Object) that -can be used to access the various fields. - -=cut - -sub parsecdata { - my ($input, $file, %options) = @_; - - $options{allow_pgp} = 0 unless exists $options{allow_pgp}; - $options{allow_duplicate} = 0 unless exists $options{allow_duplicate}; - - my $paraborder = 1; - my $fields = undef; - my $cf = ''; # Current field - my $expect_pgp_sig = 0; - while (<$input>) { - s/\s*\n$//; - next if (m/^$/ and $paraborder); - next if (m/^#/); - $paraborder = 0; - if (m/^(\S+?)\s*:\s*(.*)$/) { - unless (defined $fields) { - my %f; - tie %f, "Dpkg::Fields::Object"; - $fields = \%f; - } - if (exists $fields->{$1}) { - unless ($options{allow_duplicate}) { - syntaxerr($file, sprintf(_g("duplicate field %s found"), capit($1))); - } - } - $fields->{$1} = $2; - $cf = $1; - } elsif (m/^\s+\S/) { - length($cf) || syntaxerr($file, _g("continued value line not in field")); - $fields->{$cf} .= "\n$_"; - } elsif (m/^-----BEGIN PGP SIGNED MESSAGE/) { - $expect_pgp_sig = 1; - if ($options{allow_pgp}) { - # Skip PGP headers - while (<$input>) { - last if m/^$/; - } - } else { - syntaxerr($file, _g("PGP signature not allowed here")); - } - } elsif (m/^$/) { - if ($expect_pgp_sig) { - # Skip empty lines - $_ = <$input> while defined($_) && $_ =~ /^\s*$/; - length($_) || - syntaxerr($file, _g("expected PGP signature, found EOF after blank line")); - s/\n$//; - m/^-----BEGIN PGP SIGNATURE/ || - syntaxerr($file, - sprintf(_g("expected PGP signature, found something else \`%s'"), $_)); - # Skip PGP signature - while (<$input>) { - last if m/^-----END PGP SIGNATURE/; - } - length($_) || - syntaxerr($file, _g("unfinished PGP signature")); - } - last; # Finished parsing one block - } else { - syntaxerr($file, _g("line with unknown format (not field-colon-value)")); - } - } - return $fields; -} - =item my $c = Dpkg::Control->new(%opts) If the "type" option is given, it's used to setup default values diff --git a/scripts/Dpkg/Fields.pm b/scripts/Dpkg/Fields.pm index c6a37fbc0..658a5b334 100644 --- a/scripts/Dpkg/Fields.pm +++ b/scripts/Dpkg/Fields.pm @@ -43,228 +43,4 @@ sub unknown($$) $field, $desc); } -package Dpkg::Fields::Object; - -=head1 OTHER OBJECTS - -=head2 Dpkg::Fields::Object - -This object is used to tie a hash. It implements hash-like functions by -normalizing the name of fields received in keys (using -Dpkg::Fields::capit). It also stores the order in which fields have been -added in order to be able to dump them in the same order. - -=cut - -use Tie::Hash; -our @ISA = qw(Tie::ExtraHash Tie::Hash); - -use Dpkg::ErrorHandling; -use Dpkg::Gettext; - -# Import capit -Dpkg::Fields->import('capit'); - -# $self->[0] is the real hash -# $self->[1] is an array containing the ordered list of keys -# $self->[2] is an hash describing the relative importance of each field -# (used to sort the output). - -=head2 Dpkg::Fields::Object->new() - -Return a reference to a tied hash implementing storage of simple -"field: value" mapping as used in many Debian-specific files. - -=cut - -sub new { - my $hash = {}; - tie %{$hash}, 'Dpkg::Fields::Object'; - return $hash; -} - -sub TIEHASH { - my $class = shift; - return bless [{}, [], {}], $class; -} - -sub FETCH { - my ($self, $key) = @_; - $key = capit($key); - return $self->[0]->{$key} if exists $self->[0]->{$key}; - return undef; -} - -sub STORE { - my ($self, $key, $value) = @_; - $key = capit($key); - if (not exists $self->[0]->{$key}) { - push @{$self->[1]}, $key; - } - $self->[0]->{$key} = $value; -} - -sub EXISTS { - my ($self, $key) = @_; - $key = capit($key); - return exists $self->[0]->{$key}; -} - -sub DELETE { - my ($self, $key) = @_; - $key = capit($key); - if (exists $self->[0]->{$key}) { - delete $self->[0]->{$key}; - @{$self->[1]} = grep { $_ ne $key } @{$self->[1]}; - return 1; - } else { - return 0; - } -} - -sub FIRSTKEY { - my $self = shift; - foreach (@{$self->[1]}) { - return $_ if exists $self->[0]->{$_}; - } -} - -sub NEXTKEY { - my ($self, $last) = @_; - my $found = 0; - foreach (@{$self->[1]}) { - if ($found) { - return $_ if exists $self->[0]->{$_}; - } else { - $found = 1 if $_ eq $last; - } - } - return undef; -} - -=head2 tied(%hash)->find_custom_field($name) - -Scan the fields and look for a user specific field whose name matches the -following regex: /X[SBC]+-$name/i. Return the name of the field found or -undef if nothing has been found. - -=cut - -sub find_custom_field { - my ($self, $name) = @_; - foreach my $key (keys %{$self->[0]}) { - return $key if $key =~ /^X[SBC]*-\Q$name\E$/i; - } - return undef; -} - -=head2 tied(%hash)->get_custom_field($name) - -Identify a user field and retrieve its value. - -=cut - -sub get_custom_field { - my ($self, $name) = @_; - my $key = $self->find_custom_field($name); - return $self->[0]->{$key} if defined $key; - return undef; -} - -=head2 my $str = tied(%hash)->dump() -=head2 tied(%hash)->dump($fh) - -Dump the raw content of the hash either as a string or to a filehandle. - -=cut - -sub dump { - my ($self, $fh) = @_; - my $str = ""; - foreach (@{$self->[1]}) { - if (exists $self->[0]->{$_}) { - print $fh "$_: " . $self->[0]->{$_} . "\n" if $fh; - $str .= "$_: " . $self->[0]->{$_} . "\n" if defined wantarray; - } - } - return $str; -} - -=head2 tied(%hash)->set_field_importance(@fields) - -Define the order in which fields will be displayed in the output() method. - -=cut - -sub set_field_importance { - my ($self, @fields) = @_; - my $i = 1; - - $self->[2] = {}; - $self->[2]{$_} = $i++ foreach (@fields); -} - -=head2 tied(%hash)->output($fh, $substvars) - -If $fh is defined, print the fields on the $fh filehandle after -substitution of variables defined in the Dpkg::Substvars object. - -Also returns the string of what would printed on the filehandle. - -=cut - -sub output { - my ($self, $fh, $substvars) = @_; - my $str = ""; - my $imp = $self->[2]; # Hash of relative importance - - # Add substvars to refer to other fields - if (defined($substvars)) { - foreach my $f (keys %{$self->[0]}) { - $substvars->set("F:$f", $self->[0]->{$f}); - $substvars->no_warn("F:$f"); - } - } - - my @keys = sort { - if (defined $imp->{$a} && defined $imp->{$b}) { - $imp->{$a} <=> $imp->{$b}; - } elsif (defined($imp->{$a})) { - -1; - } elsif (defined($imp->{$b})) { - 1; - } else { - $a cmp $b; - } - } keys %{$self->[0]}; - - foreach my $f (@keys) { - my $v = $self->[0]->{$f}; - if (defined($substvars)) { - $v = $substvars->substvars($v); - } - $v =~ m/\S/ || next; # delete whitespace-only fields - $v =~ m/\n\S/ && - internerr("field %s has newline then non whitespace >%s<", - $f, $v); - $v =~ m/\n[ \t]*\n/ && - internerr("field %s has blank lines >%s<", $f, $v); - $v =~ m/\n$/ && - internerr("field %s has trailing newline >%s<", $f, $v); - if (defined($substvars)) { - $v =~ s/,[\s,]*,/,/g; - $v =~ s/^\s*,\s*//; - $v =~ s/\s*,\s*$//; - } - $v =~ s/\$\{\}/\$/g; - if ($fh) { - print $fh "$f: $v\n" || syserr(_g("write error on control data")); - } - if (defined wantarray) { - $str .= "$f: $v\n"; - } - } - return $str; -} - 1; -- cgit v1.2.3