The following commit has been merged in the master branch:
commit 22699815920b1cb8550e06dcf2ffe1442b0ee890
Author: Raphaël Hertzog <[email protected]>
Date: Sun Sep 13 21:32:30 2009 +0200
Drop unused code that has been merged in Dpkg::Control
diff --git a/scripts/Dpkg/Control.pm b/scripts/Dpkg/Control.pm
index 5594440..c4a8852 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 c6a37fb..658a5b3 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;
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
