Kaynağa Gözat

Drop unused code that has been merged in Dpkg::Control

Raphaël Hertzog 17 yıl önce
ebeveyn
işleme
2269981592
2 değiştirilmiş dosya ile 1 ekleme ve 304 silme
  1. 1 80
      scripts/Dpkg/Control.pm
  2. 0 224
      scripts/Dpkg/Fields.pm

+ 1 - 80
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

+ 0 - 224
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;