The following commit has been merged in the master branch:
commit 6ebc6bf02e1807ec55c1e7e1c52f7240acb3f1d2
Author: Raphaël Hertzog <[email protected]>
Date: Sun Sep 13 21:30:19 2009 +0200
Use the new Dpkg::Control interface everywhere
Update all scripts and module to use Dpkg::Control instead
of parsecdata and Dpkg::Fields::Object.
diff --git a/scripts/Dpkg/Changelog.pm b/scripts/Dpkg/Changelog.pm
index 8caf37d..46b961c 100644
--- a/scripts/Dpkg/Changelog.pm
+++ b/scripts/Dpkg/Changelog.pm
@@ -42,7 +42,6 @@ use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(:DEFAULT report);
use Dpkg::Control;
-use Dpkg::Fields;
use Dpkg::Version qw(compare_versions);
use base qw(Exporter);
@@ -494,15 +493,15 @@ See L<dpkg>.
=cut
-our ( @CHANGELOG_FIELDS, %CHANGELOG_FIELDS );
+our ( @CHANGELOG_FIELDS, $CHANGELOG_FIELDS );
our ( @URGENCIES, %URGENCIES );
BEGIN {
@CHANGELOG_FIELDS = qw(Source Version Distribution
Urgency Maintainer Date Closes Changes
Timestamp Header Items Trailer
Urgency_comment Urgency_lc);
- tie %CHANGELOG_FIELDS, 'Dpkg::Fields::Object';
- %CHANGELOG_FIELDS = map { $_ => 1 } @CHANGELOG_FIELDS;
+ $CHANGELOG_FIELDS = Dpkg::Control->new(type => CTRL_CHANGELOG);
+ %$CHANGELOG_FIELDS = map { $_ => 1 } @CHANGELOG_FIELDS;
@URGENCIES = qw(low medium high critical emergency);
my $i = 1;
%URGENCIES = map { $_ => $i++ } @URGENCIES;
@@ -523,7 +522,7 @@ sub dpkg {
}
# handle unknown fields
foreach my $field (keys %{$data->[0]}) {
- next if $CHANGELOG_FIELDS{$field};
+ next if $CHANGELOG_FIELDS->{$field};
$f->{$field} = $data->[0]{$field};
}
@@ -546,7 +545,7 @@ sub dpkg {
# handle unknown fields
foreach my $field (keys %$entry) {
- next if $CHANGELOG_FIELDS{$field};
+ next if $CHANGELOG_FIELDS->{$field};
next if exists $f->{$field};
$f->{$field} = $entry->{$field};
}
@@ -608,7 +607,7 @@ sub rfc822 {
# handle unknown fields
foreach my $field (keys %$entry) {
- next if $CHANGELOG_FIELDS{$field};
+ next if $CHANGELOG_FIELDS->{$field};
$f->{$field} = $entry->{$field};
}
@@ -779,7 +778,7 @@ sub get_dpkg_changes {
=head3 my $fields = parse_changelog(%opt)
This function will parse a changelog. In list context, it return as many
-Dpkg::Fields::Object as the parser did output. In scalar context, it will
+Dpkg::Control object as the parser did output. In scalar context, it will
return only the first one. If the parser didn't return any data, it will
return an empty in list context or undef on scalar context. If the parser
failed, it will die.
@@ -883,9 +882,11 @@ sub parse_changelog {
exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser);
}
- # Get the output into several Dpkg::Fields::Object
+ # Get the output into several Dpkg::Control objects
my (@res, $fields);
- while ($fields = parsecdata(\*P, _g("output of changelog parser"))) {
+ while (1) {
+ $fields = Dpkg::Control->new(type => CTRL_CHANGELOG);
+ last unless $fields->parse_fh(\*P, _g("output of changelog parser"));
push @res, $fields;
}
close(P) or subprocerr(_g("changelog parser %s"), $parser);
@@ -911,12 +912,14 @@ FIXME: to be written
package Dpkg::Changelog::Entry;
+use Dpkg::Control;
+use base qw(Dpkg::Control);
+
sub new {
my ($classname) = @_;
- tie my %entry, 'Dpkg::Fields::Object';
- tied(%entry)->set_field_importance(@CHANGELOG_FIELDS);
- my $entry = \%entry;
+ my $entry = Dpkg::Control->new(type => CTRL_CHANGELOG);
+ $entry->set_output_order(@CHANGELOG_FIELDS);
bless $entry, $classname;
}
@@ -930,11 +933,6 @@ sub is_empty {
|| $self->{Date});
}
-sub output {
- my $self = shift;
- return tied(%$self)->output(@_);
-}
-
1;
__END__
diff --git a/scripts/Dpkg/Changelog/Debian.pm b/scripts/Dpkg/Changelog/Debian.pm
index c702b79..f891f79 100644
--- a/scripts/Dpkg/Changelog/Debian.pm
+++ b/scripts/Dpkg/Changelog/Debian.pm
@@ -267,12 +267,13 @@ sub parse {
$expect), "$_" ];
}
};
- $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Changes'} .= ($entry->{'Changes'} ? "\n" : "") .
+ (" .\n" x $blanklines) . " $_";
if (!$entry->{'Items'} || ($1 eq '*')) {
$entry->{'Items'} ||= [];
push @{$entry->{'Items'}}, "$_\n";
} else {
- $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Items'}[-1] .= (" .\n" x $blanklines)." $_\n";
}
$blanklines = 0;
$expect = 'more change data or trailer';
@@ -291,12 +292,13 @@ sub parse {
|| $expect eq 'more change data or trailer')
&& do {
# lets assume change data if we expected it
- $entry->{'Changes'} .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Changes'} .= ($entry->{'Changes'} ? "\n" : "") .
+ (" .\n" x $blanklines) . " $_";
if (!$entry->{'Items'}) {
$entry->{'Items'} ||= [];
push @{$entry->{'Items'}}, "$_\n";
} else {
- $entry->{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+ $entry->{'Items'}[-1] .= (" .\n" x $blanklines)." $_\n";
}
$blanklines = 0;
$expect = 'more change data or trailer';
@@ -327,7 +329,7 @@ sub parse {
}
# use Data::Dumper;
-# print Dumper( $self );
+# print STDERR Dumper( $self );
return $self;
}
diff --git a/scripts/Dpkg/Control/Info.pm b/scripts/Dpkg/Control/Info.pm
index 0ada49f..ada7e05 100644
--- a/scripts/Dpkg/Control/Info.pm
+++ b/scripts/Dpkg/Control/Info.pm
@@ -100,15 +100,15 @@ messages.
sub parse_fh {
my ($self, $fh, $desc) = @_;
$self->reset();
- my $cdata = parsecdata($fh, $desc);
- return if not defined $cdata;
+ my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
+ return if not $cdata->parse_fh($fh, $desc);
$self->{source} = $cdata;
unless (exists $cdata->{Source}) {
syntaxerr($desc, _g("first block lacks a source field"));
}
while (1) {
- $cdata = parsecdata($fh, $desc);
- last if not defined $cdata;
+ $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
+ last if not $cdata->parse_fh($fh, $desc);
push @{$self->{packages}}, $cdata;
unless (exists $cdata->{Package}) {
syntaxerr($desc, _g("block lacks a package field"));
@@ -118,8 +118,8 @@ sub parse_fh {
=item $c->get_source()
-Returns a reference to a hash containing the fields concerning the
-source package. The hash is tied to Dpkg::Fields::Object.
+Returns a Dpkg::Control object containing the fields concerning the
+source package.
=cut
@@ -130,9 +130,8 @@ sub get_source {
=item $c->get_pkg_by_idx($idx)
-Returns a reference to a hash containing the fields concerning the binary
-package numbered $idx (starting at 1). The hash is tied to
-Dpkg::Fields::Object.
+Returns a Dpkg::Control object containing the fields concerning the binary
+package numbered $idx (starting at 1).
=cut
@@ -143,8 +142,8 @@ sub get_pkg_by_idx {
=item $c->get_pkg_by_name($name)
-Returns a reference to a hash containing the fields concerning the binary
-package named $name. The hash is tied to Dpkg::Fields::Object.
+Returns a Dpkg::Control object containing the fields concerning the binary
+package named $name.
=cut
@@ -159,7 +158,7 @@ sub get_pkg_by_name {
=item $c->get_packages()
-Returns a list containing the hashes for all binary packages.
+Returns a list containing the Dpkg::Control objects for all binary packages.
=cut
@@ -176,10 +175,10 @@ Dump the content into a filehandle.
sub dump {
my ($self, $fh) = @_;
- tied(%{$self->{source}})->dump($fh);
+ $self->{source}->output($fh);
foreach my $pkg (@{$self->{packages}}) {
print $fh "\n";
- tied(%{$pkg})->dump($fh);
+ $pkg->output($fh);
}
}
diff --git a/scripts/Dpkg/Source/Package.pm b/scripts/Dpkg/Source/Package.pm
index 6821ff1..b934f83 100644
--- a/scripts/Dpkg/Source/Package.pm
+++ b/scripts/Dpkg/Source/Package.pm
@@ -21,7 +21,6 @@ use warnings;
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
-use Dpkg::Fields;
use Dpkg::Control;
use Dpkg::Checksums;
use Dpkg::Version qw(parseversion check_version);
@@ -101,7 +100,7 @@ sub new {
my ($this, %args) = @_;
my $class = ref($this) || $this;
my $self = {
- 'fields' => Dpkg::Fields::Object->new(),
+ 'fields' => Dpkg::Control->new(type => CTRL_PKG_SRC),
'options' => {},
};
bless $self, $class;
@@ -149,9 +148,8 @@ sub initialize {
close(DSC);
# Read the fields
open(CDATA, "<", $filename) || syserr(_g("cannot open %s"), $filename);
- my $fields = parsecdata(\*CDATA,
- sprintf(_g("source control file %s"), $filename),
- allow_pgp => 1);
+ my $fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
+ $fields->parse_fh(\*CDATA, sprintf(_g("source control file %s"),
$filename));
close(CDATA);
$self->{'fields'} = $fields;
@@ -464,8 +462,9 @@ sub write_dsc {
open(DSC, ">", $filename) || syserr(_g("cannot write %s"), $filename);
delete $fields->{'Checksums-Md5'}; # identical with Files field
- tied(%{$fields})->set_field_importance(@dsc_fields);
- tied(%{$fields})->output(\*DSC, $opts{'substvars'});
+ $fields->set_output_order(@dsc_fields);
+ $fields->apply_substvars($opts{'substvars'});
+ $fields->output(\*DSC);
close(DSC);
}
diff --git a/scripts/Dpkg/Vendor.pm b/scripts/Dpkg/Vendor.pm
index 5120654..fa967f5 100644
--- a/scripts/Dpkg/Vendor.pm
+++ b/scripts/Dpkg/Vendor.pm
@@ -49,7 +49,7 @@ The file should be named according to the vendor name.
=item $fields = Dpkg::Vendor::get_vendor_info($name)
-Returns a Dpkg::Fields object with the information parsed from the
+Returns a Dpkg::Control object with the information parsed from the
corresponding vendor file in /etc/dpkg/origins/. If $name is omitted,
it will use /etc/dpkg/origins/default which is supposed to be a symlink
to the vendor of the currently installed operating system. Returns undef
@@ -62,7 +62,8 @@ sub get_vendor_info(;$) {
my $file = get_vendor_file($vendor);
return undef unless $file;
open(my $fh, "<", $file) || syserr(_g("cannot read %s"), $file);
- my $fields = parsecdata($fh, $file);
+ my $fields = Dpkg::Control->new(type => CTRL_FILE_VENDOR);
+ $fields->parse_fh($fh, $file) || error(_g("%s is empty"), $file);
close($fh);
return $fields;
}
diff --git a/scripts/Dpkg/Vendor/Default.pm b/scripts/Dpkg/Vendor/Default.pm
index 43d40cd..a33b32f 100644
--- a/scripts/Dpkg/Vendor/Default.pm
+++ b/scripts/Dpkg/Vendor/Default.pm
@@ -76,7 +76,7 @@ just before the execution of $srcpkg->build().
=item before-changes-creation ($fields)
The hook is called just before the content of .changes file is output
-by dpkg-genchanges. The first parameter is a Dpkg::Fields::Object
+by dpkg-genchanges. The first parameter is a Dpkg::Control object
representing all the fields that are going to be output.
=item keyrings ()
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index 97a66cf..997c390 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -203,7 +203,7 @@ eval { # Do not fail if parser failed due to unsupported
options
$bad_parser = 1 if ($@);
# Other initializations
my $control = Dpkg::Control::Info->new($controlfile);
-my $fields = Dpkg::Fields::Object->new();
+my $fields = Dpkg::Control->new(type => CTRL_FILE_CHANGES);
$substvars->set_version_substvars($changelog->{"Version"});
$substvars->set_arch_substvars();
$substvars->parse($varlistfile) if -e $varlistfile;
@@ -281,7 +281,7 @@ foreach my $pkg ($control->get_packages()) {
my $d = $pkg->{"Description"} || "no description available";
$d = $1 if $d =~ /^(.*)\n/;
my $pkg_type = $pkg->{"Package-Type"} ||
- tied(%$pkg)->get_custom_field("Package-Type") || "deb";
+ $pkg->get_custom_field("Package-Type") || "deb";
my @f; # List of files for this binary package
push @f, @{$p2f{$p}} if defined $p2f{$p};
@@ -406,8 +406,9 @@ if (!is_binaryonly) {
open(CDATA, "<", $dsc) || syserr(_g("cannot open .dsc file %s"), $dsc);
push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
- my $dsc_fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"),
$dsc),
- allow_pgp => 1);
+ my $dsc_fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
+ $dsc_fields->parse_fh(\*CDATA, sprintf(_g("source control file %s"),
$dsc)) ||
+ error(_g("%s is empty", $dsc));
readallchecksums($dsc_fields, \%checksum, \%size);
@@ -540,7 +541,7 @@ for my $f (keys %remove) {
delete $fields->{$f};
}
-tied(%{$fields})->set_field_importance(@changes_fields);
+$fields->set_output_order(@changes_fields);
run_vendor_hook('before-changes-creation', $fields);
-tied(%{$fields})->output(\*STDOUT); # Note: no substitution of variables
+$fields->output(\*STDOUT); # Note: no substitution of variables
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index a385e80..13ae423 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -10,7 +10,8 @@ use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
use Dpkg::Deps qw(@pkg_dep_fields %dep_field_type);
-use Dpkg::Fields qw(:list capit unknown);
+use Dpkg::Fields qw(:list unknown);
+use Dpkg::Control;
use Dpkg::Control::Info;
use Dpkg::Substvars;
use Dpkg::Vars;
@@ -130,7 +131,7 @@ $substvars->set_arch_substvars();
$substvars->parse($varlistfile) if -e $varlistfile;
$substvars->set("binary:Version", $forceversion) if defined $forceversion;
my $control = Dpkg::Control::Info->new($controlfile);
-my $fields = Dpkg::Fields::Object->new();
+my $fields = Dpkg::Control->new(type => CTRL_PKG_DEB);
my $pkg;
@@ -270,7 +271,7 @@ for my $f (qw(Maintainer Description Architecture)) {
$oppackage = $fields->{'Package'};
my $pkg_type = $pkg->{'Package-Type'} ||
- tied(%$pkg)->get_custom_field('Package-Type') || 'deb';
+ $pkg->get_custom_field('Package-Type') || 'deb';
if ($pkg_type eq 'udeb') {
delete $fields->{'Homepage'};
@@ -362,8 +363,9 @@ if (!$stdout) {
$fh_output = \*STDOUT;
}
-tied(%{$fields})->set_field_importance(@control_fields);
-tied(%{$fields})->output($fh_output, $substvars);
+$fields->set_output_order(@control_fields);
+$fields->apply_substvars($substvars);
+$fields->output($fh_output);
if (!$stdout) {
close($fh_output);
diff --git a/scripts/dpkg-name.pl b/scripts/dpkg-name.pl
index 0df15d2..1c89853 100755
--- a/scripts/dpkg-name.pl
+++ b/scripts/dpkg-name.pl
@@ -96,8 +96,8 @@ sub getfields($)
# Read the fields
open(CDATA, '-|', "dpkg-deb", "-f", "--", $filename) ||
syserr(_g("cannot open %s"), $filename);
- my $fields = parsecdata(\*CDATA,
- sprintf(_g("binary control file %s"), $filename));
+ my $fields = Dpkg::Control->new(type => CTRL_PKG_DEB);
+ $fields->parse_fh(\*CDATA, sprintf(_g("binary control file %s"),
$filename));
close(CDATA);
return $fields;
diff --git a/scripts/dpkg-parsechangelog.pl b/scripts/dpkg-parsechangelog.pl
index f214e69..f813139 100755
--- a/scripts/dpkg-parsechangelog.pl
+++ b/scripts/dpkg-parsechangelog.pl
@@ -108,6 +108,6 @@ my $count = 0;
my @fields = parse_changelog(%options);
foreach my $f (@fields) {
print "\n" if $count++;
- print tied(%$f)->dump();
+ print $f->output();
}
diff --git a/scripts/dpkg-scansources.pl b/scripts/dpkg-scansources.pl
index ad4483d..cf1e000 100755
--- a/scripts/dpkg-scansources.pl
+++ b/scripts/dpkg-scansources.pl
@@ -250,10 +250,9 @@ sub process_dsc {
# Parse ‘.dsc’ file.
open(CDATA, '<', $file) || syserr(_g("cannot open %s"), $file);
- my $fields = parsecdata(\*CDATA,
- sprintf(_g("source control file %s"), $file),
- allow_pgp => 1);
- error(_g("parsing an empty file %s"), $file) unless (defined $fields);
+ my $fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
+ $fields->parse_fh(\*CDATA, sprintf(_g("source control file %s"), $file)) ||
+ error(_g("parsing an empty file %s"), $file);
close(CDATA) || syserr(_g("cannot close %s"), $file);
# Get checksums
@@ -372,9 +371,9 @@ sub main {
next;
}
- tied(%{$fields})->set_field_importance(@src_fields);
+ $fields->set_output_order(@src_fields);
if ($No_sort) {
- tied(%{$fields})->output(\*STDOUT);
+ $fields->output(\*STDOUT);
print "\n";
}
else {
@@ -385,7 +384,7 @@ sub main {
if (@out) {
map {
- tied(%{$_})->output(\*STDOUT);
+ $_->output(\*STDOUT);
print "\n";
} sort {
$a->{Package} cmp $b->{Package}
diff --git a/scripts/t/700_Dpkg_Control.t b/scripts/t/700_Dpkg_Control.t
index 7d80756..a659c7a 100644
--- a/scripts/t/700_Dpkg_Control.t
+++ b/scripts/t/700_Dpkg_Control.t
@@ -54,7 +54,7 @@ is($pkg->{Depends}, 'hello', 'Name of third package');
$pkg = $c->get_pkg_by_idx(2);
$io = IO::String->new();
-tied(%{$pkg})->dump($io);
+$pkg->output($io);
is(${$io->string_ref()},
'Package: mypackage2
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [email protected]
with a subject of "unsubscribe". Trouble? Contact [email protected]
