* scripts/t/600_Dpkg_Control.t,
scripts/t/600_Dpkg_Control/control-1: Add non-regression tests for
Dpkg::Control and Dpkg::Cdata.
+ * scripts/dpkg-checkbuilddeps.pl, scripts/dpkg-genchanges.pl,
+ scripts/dpkg-gencontrol.pl, scripts/dpkg-gensymbols.pl,
+ scripts/dpkg-shlibdeps.pl, scripts/dpkg-source.pl: Update scripts
+ to use the new modules Dpkg::Cdata, Dpkg::Control,
+ Dpkg::Fields::Object and Dpkg::Substvars.
2007-12-28 Raphael Hertzog <hertzog@debian.org>
use Dpkg::ErrorHandling qw(error);
use Dpkg::Arch qw(get_host_arch);
use Dpkg::Deps;
+use Dpkg::Control;
push(@INC,$dpkglibdir);
require 'controllib.pl';
-our %fi;
-
textdomain("dpkg-dev");
sub usage {
my $controlfile = shift || "debian/control";
-parsecontrolfile($controlfile);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = $control->get_source();
my $facts = parse_status("$admindir/status");
my (@unmet, @conflicts);
my $dep_regex=qr/[ \t]*(([^\n]+|\n[ \t])*)\s/; # allow multi-line
-if (defined($fi{"C Build-Depends"})) {
+if (defined($fields->{"Build-Depends"})) {
push @unmet, build_depends('Build-Depends',
- Dpkg::Deps::parse($fi{"C Build-Depends"},
+ Dpkg::Deps::parse($fields->{"Build-Depends"},
reduce_arch => 1), $facts);
}
-if (defined($fi{"C Build-Conflicts"})) {
+if (defined($fields->{"C Build-Conflicts"})) {
push @conflicts, build_conflicts('Build-Conflicts',
- Dpkg::Deps::parse($fi{"C Build-Conflicts"},
+ Dpkg::Deps::parse($fields->{"Build-Conflicts"},
reduce_arch => 1, union => 1), $facts);
}
-if (! $binary_only && defined($fi{"C Build-Depends-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Depends-Indep"})) {
push @unmet, build_depends('Build-Depends-Indep',
- Dpkg::Deps::parse($fi{"C Build-Depends-Indep"},
+ Dpkg::Deps::parse($fields->{"Build-Depends-Indep"},
reduce_arch => 1), $facts);
}
-if (! $binary_only && defined($fi{"C Build-Conflicts-Indep"})) {
+if (! $binary_only && defined($fields->{"Build-Conflicts-Indep"})) {
push @conflicts, build_conflicts('Build-Conflicts-Indep',
- Dpkg::Deps::parse($fi{"C Build-Conflicts-Indep"},
+ Dpkg::Deps::parse($fields->{"Build-Conflicts-Indep"},
reduce_arch => 1, union => 1), $facts);
}
use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
use Dpkg::Fields qw(capit set_field_importance sort_field_by_importance);
use Dpkg::Compression;
+use Dpkg::Control;
+use Dpkg::Cdata;
+use Dpkg::Substvars;
push(@INC,$dpkglibdir);
require 'controllib.pl';
-our (%f, %fi);
-our %p2i;
-our %substvar;
+our (%fi);
our $sourcepackage;
textdomain("dpkg-dev");
my $uploadfilesdir = '..';
my $sourcestyle = 'i';
my $quiet = 0;
+my $host_arch = get_host_arch();
+my $changes_format = "1.7";
my %f2p; # - file to package map
my %p2f; # - package to file map, has entries for "packagename"
my $forcechangedby;
my $since;
+my $substvars = Dpkg::Substvars->new();
+
use constant SOURCE => 1;
use constant ARCH_DEP => 2;
use constant ARCH_INDEP => 4;
} elsif (m/^-U([^\=:]+)$/) {
$remove{$1}= 1;
} elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
- $substvar{$1}= $POSTMATCH;
+ $substvars->set($1, $POSTMATCH);
} elsif (m/^-(h|-help)$/) {
&usage; exit(0);
} elsif (m/^--version$/) {
}
parsechangelog($changelogfile, $changelogformat, $since);
-parsecontrolfile($controlfile);
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
+$substvars->set_version_substvars($fi{"L Version"});
if (not is_sourceonly) {
open(FL,"<",$fileslistfile) || &syserr(_g("cannot read files list file"));
close(FL);
}
-for $_ (keys %fi) {
- my $v = $fi{$_};
-
- if (s/^C //) {
- if (m/^Source$/) {
- setsourcepackage($v);
- }
- elsif (m/^Section$|^Priority$/i) { $sourcedefault{$_}= $v; }
- elsif (m/^Maintainer$/i) { $f{$_}= $v; }
- elsif (s/^X[BS]*C[BS]*-//i) { $f{$_}= $v; }
- elsif (m/^X[BS]+-/i ||
- m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
- m/^(Standards-Version|Uploaders|Homepage|Origin|Bugs)$/i ||
- m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
- }
- else { &unknown(_g('general section of control info file')); }
- } elsif (s/^C(\d+) //) {
- my $i = $1;
- my $p = $fi{"C$i Package"};
- my $a = $fi{"C$i Architecture"};
- my $host_arch = get_host_arch();
+# Scan control info of source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+ my $v = $src_fields->{$_};
+ if (m/^Source$/) {
+ setsourcepackage($v);
+ }
+ elsif (m/^Section$|^Priority$/i) { $sourcedefault{$_}= $v; }
+ elsif (m/^Maintainer$/i) { $fields->{$_} = $v; }
+ elsif (s/^X[BS]*C[BS]*-//i) { $fields->{$_} = $v; }
+ elsif (m/^X[BS]+-/i ||
+ m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
+ m/^(Standards-Version|Uploaders|Homepage|Origin|Bugs)$/i ||
+ m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+ }
+ else { &unknown(_g('general section of control info file')); }
+}
+# Scan control info of all binary packages
+foreach my $pkg ($control->get_packages()) {
+ my $p = $pkg->{"Package"};
+ my $a = $pkg->{"Architecture"};
+ foreach $_ (keys %{$pkg}) {
+ my $v = $pkg->{$_};
if (!defined($p2f{$p}) && not is_sourceonly) {
if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
(grep(debarch_is($host_arch, $_), split(/\s+/, $a))
} elsif (m/^Priority$/) {
$f2pricf{$_} = $v foreach (@f);
} elsif (s/^X[BS]*C[BS]*-//i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (m/^Architecture$/) {
if (not is_sourceonly) {
if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
and ($include & ARCH_DEP)) {
$v = $host_arch;
} elsif (!debarch_eq('all', $v)) {
- $v= '';
+ $v = '';
}
} else {
$v = '';
&unknown(_g("package's section of control info file"));
}
}
- } elsif (s/^L //) {
+ }
+}
+
+for $_ (keys %fi) {
+ my $v = $fi{$_};
+
+ if (s/^L //) {
if (m/^Source$/i) {
setsourcepackage($v);
} elsif (m/^Maintainer$/i) {
- $f{"Changed-By"}=$v;
+ $fields->{"Changed-By"} = $v;
} elsif (m/^(Version|Changes|Urgency|Distribution|Date|Closes)$/i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (s/^X[BS]*C[BS]*-//i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (!m/^X[BS]+-/i) {
&unknown(_g("parsed version of changelog"));
}
- } elsif (m/^o:.*/) {
- } else {
- internerr("value from nowhere, with key >%s< and value >%s<",
- $_, $v);
}
}
if ($changesdescription) {
- $f{'Changes'}= '';
+ $fields->{'Changes'} = '';
open(X,"<",$changesdescription) || &syserr(_g("read changesdescription"));
while(<X>) {
s/\s*\n$//;
$_= '.' unless m/\S/;
- $f{'Changes'}.= "\n $_";
+ $fields->{'Changes'}.= "\n $_";
}
}
for my $pa (keys %pa2f) {
my ($pp, $aa) = (split / /, $pa);
- defined($p2i{"C $pp"}) ||
+ defined($control->get_pkg_by_name($pp)) ||
warning(_g("package %s listed in files list but not in control info"),
$pp);
}
}
}
-&init_substvars;
-init_substvar_arch();
-
my $origsrcmsg;
if (!is_binaryonly) {
warning(_g("missing Priority for source files"));
}
- (my $sversion = $substvar{'source:Version'}) =~ s/^\d+://;
+ (my $sversion = $substvars->get('source:Version')) =~ s/^\d+://;
$dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
open(CDATA, "<", $dsc) || syserr(_g("cannot open .dsc file %s"), $dsc);
push(@sourcefiles,"${sourcepackage}_${sversion}.dsc");
- parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+ my $dsc_fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+ allow_pgp => 1);
- my $files = $fi{'S Files'};
+ my $files = $dsc_fields->{'Files'};
for my $file (split(/\n /, $files)) {
next if $file eq '';
$file =~ m/^([0-9a-f]{32})[ \t]+\d+[ \t]+([0-9a-zA-Z][-+:.,=0-9a-zA-Z_~]+)$/
print(STDERR "$progname: $origsrcmsg\n") ||
&syserr(_g("write original source message")) unless $quiet;
-$f{'Format'}= $substvar{'Format'};
+$fields->{'Format'} = $changes_format;
-if (!defined($f{'Date'})) {
+if (!defined($fields->{'Date'})) {
chomp(my $date822 = `date -R`);
$? && subprocerr("date -R");
- $f{'Date'}= $date822;
+ $fields->{'Date'}= $date822;
}
-$f{'Binary'}= join(' ',grep(s/C //,keys %p2i));
+$fields->{'Binary'} = join(' ', map { $_->{'Package'} } $control->get_packages());
unshift(@archvalues,'source') unless is_binaryonly;
@archvalues = ('all') if $include == ARCH_INDEP;
@archvalues = grep {!debarch_eq('all',$_)} @archvalues
unless $include & ARCH_INDEP;
-$f{'Architecture'}= join(' ',@archvalues);
+$fields->{'Architecture'} = join(' ',@archvalues);
-$f{'Description'}= "\n ".join("\n ",sort @descriptions);
+$fields->{'Description'} = "\n ".join("\n ",sort @descriptions);
-$f{'Files'}= '';
+$fields->{'Files'} = '';
my %filedone;
defined($md5sum{$f}) && $md5sum{$f} ne $md5sum &&
error(_g("md5sum of source file %s (%s) is different from md5sum " .
"in %s (%s)"), $uf, $md5sum, $dsc, $md5sum{$f});
- $f{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
+ $fields->{'Files'}.= "\n $md5sum $size $f2sec{$f} $f2pri{$f} $f";
}
-$f{'Source'}= $sourcepackage;
-if ($f{'Version'} ne $substvar{'source:Version'}) {
- $f{'Source'} .= " ($substvar{'source:Version'})";
+$fields->{'Source'}= $sourcepackage;
+if ($fields->{'Version'} ne $substvars->get('source:Version')) {
+ $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";
}
-$f{'Maintainer'} = $forcemaint if defined($forcemaint);
-$f{'Changed-By'} = $forcechangedby if defined($forcechangedby);
+$fields->{'Maintainer'} = $forcemaint if defined($forcemaint);
+$fields->{'Changed-By'} = $forcechangedby if defined($forcechangedby);
for my $f (qw(Version Distribution Maintainer Changes)) {
- defined($f{$f}) ||
+ defined($fields->{$f}) ||
error(_g("missing information for critical output field %s"), $f);
}
for my $f (qw(Urgency)) {
- defined($f{$f}) ||
+ defined($fields->{$f}) ||
warning(_g("missing information for output field %s"), $f);
}
for my $f (keys %override) {
- $f{capit($f)} = $override{$f};
+ $fields->{$f} = $override{$f};
}
for my $f (keys %remove) {
- delete $f{capit($f)};
+ delete $fields->{$f};
}
set_field_importance(@changes_fields);
-outputclose();
+$substvars->parse($varlistfile) if -e $varlistfile;
+tied(%{$fields})->output(\*STDOUT, $substvars);
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(capit set_field_importance);
+use Dpkg::Control;
+use Dpkg::Substvars;
push(@INC,$dpkglibdir);
require 'controllib.pl';
-our %substvar;
-our (%f, %fi);
-our %p2i;
+our %fi;
our $sourcepackage;
textdomain("dpkg-dev");
my %override;
my $oppackage;
my $package_type = 'deb';
+my $substvars = Dpkg::Substvars->new();
sub version {
"), $progname;
}
-sub spfileslistvalue($)
-{
- return $f{$_[0]} || '-';
-}
-
-
while (@ARGV) {
$_=shift(@ARGV);
if (m/^-p([-+0-9a-z.]+)$/) {
} elsif (m/^-U([^\=:]+)$/) {
$remove{$1}= 1;
} elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
- $substvar{$1}= $';
+ $substvars->set($1, $');
} elsif (m/^-T/) {
$varlistfile= $';
} elsif (m/^-n/) {
}
parsechangelog($changelogfile, $changelogformat);
-parsesubstvars($varlistfile);
-parsecontrolfile($controlfile);
+$substvars->set_version_substvars($fi{"L Version"});
+$substvars->parse($varlistfile) if -e $varlistfile;
+my $control = Dpkg::Control->new($controlfile);
+my $fields = Dpkg::Fields::Object->new();
-my $myindex;
+my $pkg;
if (defined($oppackage)) {
- defined($p2i{"C $oppackage"}) ||
- error(_g("package %s not in control info"), $oppackage);
- $myindex= $p2i{"C $oppackage"};
+ $pkg = $control->get_pkg_by_name($oppackage);
+ defined($pkg) || error(_g("package %s not in control info"), $oppackage);
} else {
- my @packages = grep(m/^C /, keys %p2i);
+ my @packages = map { $_->{'Package'} } $control->get_packages();
@packages==1 ||
error(_g("must specify package since control info has many (%s)"),
"@packages");
- $myindex=1;
+ $pkg = $control->get_pkg_by_idx(1);
}
-#print STDERR "myindex $myindex\n";
-
my %pkg_dep_fields = map { $_ => 1 } @pkg_dep_fields;
+# Scan source package
+my $src_fields = $control->get_source();
+foreach $_ (keys %{$src_fields}) {
+ my $v = $src_fields->{$_};
+ if (m/^(Origin|Bugs|Maintainer)$/) {
+ $fields->{$_} = $v;
+ } elsif (m/^(Section|Priority|Homepage)$/) {
+ $fields->{$_} = $v;
+ } elsif (m/^Source$/) {
+ setsourcepackage($v);
+ }
+ elsif (s/^X[CS]*B[CS]*-//i) { $fields->{$_} = $v; }
+ elsif (m/^X[CS]+-/i ||
+ m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
+ m/^(Standards-Version|Uploaders)$/i ||
+ m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+ }
+ else { &unknown(_g('general section of control info file')); }
+}
+
+# Scan binary package
+foreach $_ (keys %{$pkg}) {
+ my $v = $pkg->{$_};
+ if (m/^(Package|Package-Type|Description|Homepage|Tag|Essential)$/ ||
+ m/^(Section$|Priority)$/ ||
+ m/^(Subarchitecture|Kernel-Version|Installer-Menu-Item)$/) {
+ $fields->{$_} = $v;
+ } elsif (exists($pkg_dep_fields{$_})) {
+ # Delay the parsing until later
+ } elsif (m/^Architecture$/) {
+ my $host_arch = get_host_arch();
+
+ if (debarch_eq('all', $v)) {
+ $fields->{$_} = $v;
+ } else {
+ my @archlist = split(/\s+/, $v);
+ my @invalid_archs = grep m/[^\w-]/, @archlist;
+ warning(ngettext("`%s' is not a legal architecture string.",
+ "`%s' are not legal architecture strings.",
+ scalar(@invalid_archs)),
+ join("' `", @invalid_archs))
+ if @invalid_archs >= 1;
+ grep(debarch_is($host_arch, $_), @archlist) ||
+ error(_g("current host architecture '%s' does not " .
+ "appear in package's architecture list (%s)"),
+ $host_arch, "@archlist");
+ $fields->{$_} = $host_arch;
+ }
+ } elsif (s/^X[CS]*B[CS]*-//i) {
+ $fields->{$_}= $v;
+ } elsif (!m/^X[CS]+-/i) {
+ &unknown(_g("package's section of control info file"));
+ }
+}
+
for $_ (keys %fi) {
my $v = $fi{$_};
- if (s/^C //) {
-#print STDERR "G key >$_< value >$v<\n";
- if (m/^(Origin|Bugs|Maintainer)$/) {
- $f{$_} = $v;
- } elsif (m/^(Section|Priority|Homepage)$/) {
- # Binary package stanzas can override these fields
- $f{$_} ||= $v;
- } elsif (m/^Source$/) {
- setsourcepackage($v);
- }
- elsif (s/^X[CS]*B[CS]*-//i) { $f{$_}= $v; }
- elsif (m/^X[CS]+-/i ||
- m/^Build-(Depends|Conflicts)(-Indep)?$/i ||
- m/^(Standards-Version|Uploaders)$/i ||
- m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
- }
- else { $_ = "C $_"; &unknown(_g('general section of control info file')); }
- } elsif (s/^C$myindex //) {
-#print STDERR "P key >$_< value >$v<\n";
- if (m/^(Package|Package-Type|Description|Homepage|Tag|Essential)$/ ||
- m/^(Section$|Priority)$/ ||
- m/^(Subarchitecture|Kernel-Version|Installer-Menu-Item)$/) {
- $f{$_}= $v;
- } elsif (exists($pkg_dep_fields{$_})) {
- # Delay the parsing until later
- } elsif (m/^Architecture$/) {
- my $host_arch = get_host_arch();
-
- if (debarch_eq('all', $v)) {
- $f{$_}= $v;
- } else {
- my @archlist = split(/\s+/, $v);
- my @invalid_archs = grep m/[^\w-]/, @archlist;
- warning(ngettext("`%s' is not a legal architecture string.",
- "`%s' are not legal architecture strings.",
- scalar(@invalid_archs)),
- join("' `", @invalid_archs))
- if @invalid_archs >= 1;
- grep(debarch_is($host_arch, $_), @archlist) ||
- error(_g("current host architecture '%s' does not " .
- "appear in package's architecture list (%s)"),
- $host_arch, "@archlist");
- $f{$_} = $host_arch;
- }
- } elsif (s/^X[CS]*B[CS]*-//i) {
- $f{$_}= $v;
- } elsif (!m/^X[CS]+-/i) {
- $_ = "C$myindex $_"; &unknown(_g("package's section of control info file"));
- }
- } elsif (m/^C\d+ /) {
-#print STDERR "X key >$_< value not shown<\n";
- } elsif (s/^L //) {
-#print STDERR "L key >$_< value >$v<\n";
+ if (s/^L //) {
if (m/^Source$/) {
setsourcepackage($v);
} elsif (m/^Version$/) {
- $sourceversion= $v;
- $f{$_} = $v unless defined($forceversion);
+ $sourceversion = $v;
+ $fields->{$_} = $v unless defined($forceversion);
} elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/) {
} elsif (s/^X[CS]*B[CS]*-//i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (!m/^X[CS]+-/i) {
$_ = "L $_"; &unknown(_g("parsed version of changelog"));
}
- } elsif (m/o:/) {
- } else {
- internerr(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v);
}
}
-$f{'Version'} = $forceversion if defined($forceversion);
-
-&init_substvars;
-init_substvar_arch();
+$fields->{'Version'} = $forceversion if defined($forceversion);
# Process dependency fields in a second pass, now that substvars have been
# initialized.
my $facts = Dpkg::Deps::KnownFacts->new();
-$facts->add_installed_package($f{'Package'}, $f{'Version'});
-if (exists $fi{"C$myindex Provides"}) {
- my $provides = Dpkg::Deps::parse(substvars($fi{"C$myindex Provides"}),
+$facts->add_installed_package($fields->{'Package'}, $fields->{'Version'});
+if (exists $pkg->{"Provides"}) {
+ my $provides = Dpkg::Deps::parse($substvars->substvars($pkg->{"Provides"}),
reduce_arch => 1, union => 1);
if (defined $provides) {
foreach my $subdep ($provides->get_deps()) {
if ($subdep->isa('Dpkg::Deps::Simple')) {
$facts->add_provided_package($subdep->{package},
$subdep->{relation}, $subdep->{version},
- $f{'Package'});
+ $fields->{'Package'});
}
}
}
my (@seen_deps);
foreach my $field (@pkg_dep_fields) {
- my $key = "C$myindex $field";
- if (exists $fi{$key}) {
+ if (exists $pkg->{$field}) {
my $dep;
- my $field_value = substvars($fi{$key});
+ my $field_value = $substvars->substvars($pkg->{$field});
if ($dep_field_type{$field} eq 'normal') {
$dep = Dpkg::Deps::parse($field_value, use_arch => 1,
reduce_arch => 1);
$dep->simplify_deps($facts);
}
$dep->sort();
- $f{$field} = $dep->dump();
- delete $f{$field} unless $f{$field}; # Delete empty field
+ $fields->{$field} = $dep->dump();
+ delete $fields->{$field} unless $fields->{$field}; # Delete empty field
}
}
for my $f (qw(Package Version)) {
- defined($f{$f}) || error(_g("missing information for output field %s"), $f);
+ defined($fields->{$f}) || error(_g("missing information for output field %s"), $f);
}
for my $f (qw(Maintainer Description Architecture)) {
- defined($f{$f}) || warning(_g("missing information for output field %s"), $f);
+ defined($fields->{$f}) || warning(_g("missing information for output field %s"), $f);
}
-$oppackage= $f{'Package'};
+$oppackage = $fields->{'Package'};
-$package_type = $f{'Package-Type'} if (defined($f{'Package-Type'}));
+$package_type = $fields->{'Package-Type'} if (defined($fields->{'Package-Type'}));
if ($package_type ne 'udeb') {
for my $f (qw(Subarchitecture Kernel-Version Installer-Menu-Item)) {
warning(_g("%s package with udeb specific field %s"), $package_type, $f)
- if defined($f{$f});
+ if defined($fields->{$f});
}
}
-my $verdiff = $f{'Version'} ne $substvar{'source:Version'} ||
- $f{'Version'} ne $sourceversion;
+my $verdiff = $fields->{'Version'} ne $substvars->get('source:Version') ||
+ $fields->{'Version'} ne $sourceversion;
if ($oppackage ne $sourcepackage || $verdiff) {
- $f{'Source'}= $sourcepackage;
- $f{'Source'}.= " ($substvar{'source:Version'})" if $verdiff;
+ $fields->{'Source'} = $sourcepackage;
+ $fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")" if $verdiff;
}
-if (!defined($substvar{'Installed-Size'})) {
+if (!defined($substvars->get('Installed-Size'))) {
defined(my $c = open(DU, "-|")) || syserr(_g("fork for du"));
if (!$c) {
chdir("$packagebuilddir") ||
$? && subprocerr(_g("du in \`%s'"), $packagebuilddir);
$duo =~ m/^(\d+)\s+\.$/ ||
failure(_g("du gave unexpected output \`%s'"), $duo);
- $substvar{'Installed-Size'}= $1;
+ $substvars->set('Installed-Size', $1);
}
-if (defined($substvar{'Extra-Size'})) {
- $substvar{'Installed-Size'} += $substvar{'Extra-Size'};
+if (defined($substvars->get('Extra-Size'))) {
+ my $size = $substvars->get('Extra-Size') + $substvars->get('Installed-Size');
+ $substvars->set('Installed-Size', $size);
}
-if (defined($substvar{'Installed-Size'})) {
- $f{'Installed-Size'}= $substvar{'Installed-Size'};
+if (defined($substvars->get('Installed-Size'))) {
+ $fields->{'Installed-Size'} = $substvars->get('Installed-Size');
}
for my $f (keys %override) {
- $f{capit($f)} = $override{$f};
+ $fields->{$f} = $override{$f};
}
for my $f (keys %remove) {
- delete $f{capit($f)};
+ delete $fields->{$f};
}
$fileslistfile="./$fileslistfile" if $fileslistfile =~ m/^\s/;
next if m/^([-+0-9a-z.]+)_[^_]+_([\w-]+)\.(a-z+) /
&& ($1 eq $oppackage)
&& ($3 eq $package_type)
- && (debarch_eq($2, $f{'Architecture'})
+ && (debarch_eq($2, $fields->{'Architecture'})
|| debarch_eq($2, 'all'));
print(Y "$_\n") || &syserr(_g("copy old entry to new files list file"));
}
} elsif ($! != ENOENT) {
&syserr(_g("read old files list file"));
}
-my $sversion = $f{'Version'};
+my $sversion = $fields->{'Version'};
$sversion =~ s/^\d+://;
-$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $f{'Architecture'},
+$forcefilename = sprintf("%s_%s_%s.%s", $oppackage, $sversion, $fields->{'Architecture'},
$package_type)
unless ($forcefilename);
-print(Y &substvars(sprintf("%s %s %s\n", $forcefilename,
- &spfileslistvalue('Section'), &spfileslistvalue('Priority'))))
+print(Y $substvars->substvars(sprintf("%s %s %s\n", $forcefilename,
+ $fields->{'Section'} || '-',
+ $fields->{'Priority'} || '-')))
|| &syserr(_g("write new entry to new files list file"));
close(Y) || &syserr(_g("close new files list file"));
rename("$fileslistfile.new",$fileslistfile) || &syserr(_g("install new files list file"));
}
set_field_importance(@control_fields);
-outputclose($varlistfile);
+tied(%{$fields})->output(\*STDOUT, $substvars);
if (!$stdout) {
rename("$cf.new", "$cf") ||
syserr(_g("cannot install output control file \`%s'"), $cf);
}
+
use Dpkg::Shlibs::SymbolFile;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error syserr usageerr);
+use Dpkg::Control;
textdomain("dpkg-dev");
push(@INC, $dpkglibdir);
require 'controllib.pl';
-our (%f, %fi);
+our %fi;
our %p2i;
-my $controlfile = 'debian/control';
my $changelogfile = 'debian/changelog';
my $packagebuilddir = 'debian/tmp';
$sourceversion = $fi{"L Version"};
}
if (not defined($oppackage)) {
- parsecontrolfile($controlfile);
- my @packages = grep(m/^C /, keys %p2i);
+ my $control = Dpkg::Control->new();
+ my @packages = map { $_->{'Package'} } $control->get_packages();
@packages == 1 ||
error(_g("must specify package since control info has many (%s)"),
"@packages");
$oppackage = $packages[0];
- $oppackage =~ s/^C //;
}
my $symfile = Dpkg::Shlibs::SymbolFile->new();
use Dpkg::Arch qw(get_host_arch);
use Dpkg::Fields qw(capit);
use Dpkg::Deps;
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Control;
# By increasing importance
my @depfields = qw(Suggests Recommends Depends Pre-Depends);
scalar keys %exec || usageerr(_g("need at least one executable"));
-our %fi;
-parsecontrolfile("debian/control");
-my $build_depends = defined($fi{"C Build-Depends"}) ?
- $fi{"C Build-Depends"} : "";
+my $control = Dpkg::Control->new();
+my $fields = $control->get_source();
+my $build_depends = defined($fields->{"Build-Depends"}) ?
+ $fields->{"Build-Depends"} : "";
my $build_deps = Dpkg::Deps::parse($build_depends, reduce_arch => 1);
my %dependencies;
use Dpkg::Deps qw(@src_dep_fields %dep_field_type);
use Dpkg::Fields qw(capit set_field_importance);
use Dpkg::Compression;
+use Dpkg::Cdata;
+use Dpkg::Control;
+use Dpkg::Substvars;
my @filesinarchive;
my %dirincluded;
my $fn;
my $ur;
-my $varlistfile;
+my $varlistfile = "debian/substvars";
my $controlfile;
my $changelogfile;
my $changelogformat;
my @tar_ignore;
+my $substvars = Dpkg::Substvars->new();
+
use POSIX;
use Fcntl qw (:mode);
use English;
push (@INC, $dpkglibdir);
require 'controllib.pl';
-our (%f, %fi);
+our (%fi);
our $sourcepackage;
-our %substvar;
our @src_dep_fields;
textdomain("dpkg-dev");
$tar_ignore_default_pattern_done = 1;
}
} elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:]/) {
- $substvar{$1}= $POSTMATCH;
+ $substvars->set($1, $POSTMATCH);
} elsif (m/^-T/) {
- $varlistfile= $POSTMATCH;
+ $varlistfile = $POSTMATCH;
} elsif (m/^-(h|-help)$/) {
&usage; exit(0);
} elsif (m/^--version$/) {
$controlfile= "$dir/debian/control" unless defined($controlfile);
parsechangelog($changelogfile, $changelogformat);
- parsecontrolfile($controlfile);
- $f{"Format"}= $compression eq 'gzip' ? $def_dscformat : '2.0';
- &init_substvars;
+ my $control = Dpkg::Control->new($controlfile);
+ my $fields = Dpkg::Fields::Object->new();
+
+ $fields->{"Format"} = $compression eq 'gzip' ? $def_dscformat : '2.0';
my @sourcearch;
my %archadded;
my $archspecific = 0; # XXX: Not used?!
- my %packageadded;
my @binarypackages;
- for $_ (keys %fi) {
- my $v = $fi{$_};
+ # Scan control info of source package
+ my $src_fields = $control->get_source();
+ foreach $_ (keys %{$src_fields}) {
+ my $v = $src_fields->{$_};
+ if (m/^Source$/i) {
+ setsourcepackage($v);
+ } elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
+ m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
+ $fields->{$_} = $v;
+ }
+ elsif (m/^Uploaders$/i) { ($fields->{$_} = $v) =~ s/[\r\n]//g; }
+ elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
+ my $dep;
+ my $type = $dep_field_type{capit($_)};
+ $dep = Dpkg::Deps::parse($v, union => $type eq 'union');
+ error(_g("error occurred while parsing %s"), $_) unless defined $dep;
+ my $facts = Dpkg::Deps::KnownFacts->new();
+ $dep->simplify_deps($facts);
+ $dep->sort();
+ $fields->{$_} = $dep->dump();
+ }
+ elsif (s/^X[BC]*S[BC]*-//i) { $fields->{$_} = $v; }
+ elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
+ else { &unknown(_g('general section of control info file')); }
+ }
- if (s/^C //) {
- if (m/^Source$/i) {
- setsourcepackage($v);
- } elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i ||
- m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) {
- $f{$_}= $v;
- }
- elsif (m/^Uploaders$/i) { ($f{$_}= $v) =~ s/[\r\n]//g; }
- elsif (m/^Build-(Depends|Conflicts)(-Indep)?$/i) {
- my $dep;
- my $type = $dep_field_type{capit($_)};
- $dep = Dpkg::Deps::parse($v, union => $type eq 'union');
- error(_g("error occurred while parsing %s"), $_) unless defined $dep;
- my $facts = Dpkg::Deps::KnownFacts->new();
- $dep->simplify_deps($facts);
- $dep->sort();
- $f{$_}= $dep->dump();
- }
- elsif (s/^X[BC]*S[BC]*-//i) { $f{$_}= $v; }
- elsif (m/^(Section|Priority|Files|Bugs)$/i || m/^X[BC]+-/i) { }
- else { &unknown(_g('general section of control info file')); }
- } elsif (s/^C(\d+) //) {
- my $i = $1;
- my $p = $fi{"C$i Package"};
- push(@binarypackages,$p) unless $packageadded{$p}++;
+ # Scan control info of binary packages
+ foreach my $pkg ($control->get_packages()) {
+ my $p = $pkg->{'Package'};
+ push(@binarypackages,$p);
+ foreach $_ (keys %{$pkg}) {
+ my $v = $pkg->{$_};
if (m/^Architecture$/) {
if (debarch_eq($v, 'any')) {
@sourcearch= ('any');
}
}
}
- $f{'Architecture'}= join(' ',@sourcearch);
+ $fields->{'Architecture'}= join(' ',@sourcearch);
} elsif (s/^X[BC]*S[BC]*-//i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (m/^(Package|Package-Type|Essential|Kernel-Version)$/ ||
m/^(Subarchitecture|Installer-Menu-Item)$/i ||
m/^(Pre-Depends|Depends|Provides)$/i ||
} else {
&unknown(_g("package's section of control info file"));
}
- } elsif (s/^L //) {
+ }
+ }
+
+ for $_ (keys %fi) {
+ my $v = $fi{$_};
+
+ if (s/^L //) {
if (m/^Source$/) {
setsourcepackage($v);
} elsif (m/^Version$/) {
checkversion( $v );
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (s/^X[BS]*C[BS]*-//i) {
- $f{$_}= $v;
+ $fields->{$_} = $v;
} elsif (m/^(Maintainer|Changes|Urgency|Distribution|Date|Closes)$/i ||
m/^X[BS]+-/i) {
} else {
&unknown(_g("parsed version of changelog"));
}
- } elsif (m/^o:.*/) {
- } else {
- internerr(_g("value from nowhere, with key >%s< and value >%s<"),
- $_, $v);
- }
+ }
}
- $f{'Binary'}= join(', ',@binarypackages);
- for my $f (keys %override) {
- $f{capit($f)} = $override{$f};
+ $fields->{'Binary'}= join(', ', @binarypackages);
+ foreach my $f (keys %override) {
+ $fields->{$f} = $override{$f};
}
for my $f (qw(Version)) {
- defined($f{$f}) ||
+ defined($fields->{$f}) ||
error(_g("missing information for critical output field %s"), $f);
}
for my $f (qw(Maintainer Architecture Standards-Version)) {
- defined($f{$f}) ||
+ defined($fields->{$f}) ||
warning(_g("missing information for output field %s"), $f);
}
defined($sourcepackage) || &error(_g("unable to determine source package name !"));
- $f{'Source'}= $sourcepackage;
+ $fields->{'Source'} = $sourcepackage;
for my $f (keys %remove) {
- delete $f{capit($f)};
+ delete $fields->{$f};
}
- my $version = $f{'Version'};
+ my $version = $fields->{'Version'};
$version =~ s/^\d+://;
my $upstreamversion = $version;
$upstreamversion =~ s/-[^-]*$//;
$tarname= $origtargz || "$basename.orig.tar.$comp_ext";
if ($tarname =~ /\Q$basename\E\.orig\.tar\.($comp_regex)/) {
- if (($1 ne 'gz') && ($f{'Format'} < 2)) { $f{'Format'} = '2.0' };
+ if (($1 ne 'gz') && ($fields->{'Format'} < 2)) { $fields->{'Format'} = '2.0' };
} else {
warning(_g(".orig.tar name %s is not <package>_<upstreamversion>" .
".orig.tar (wanted %s)"),
}
- addfile("$tarname");
+ addfile($fields, "$tarname");
if ($sourcestyle =~ m/[kpKP]/) {
}
close(FIND); $? && subprocerr("find on $dirname");
- &addfile($diffname);
+ addfile($fields, $diffname);
}
syserr(_g("create %s"), "$basenamerev.dsc");
set_field_importance(@dsc_fields);
- outputclose($varlistfile);
+ $substvars->parse($varlistfile) if -e $varlistfile;
+ tied(%{$fields})->output(\*STDOUT, $substvars);
if ($ur) {
printf(STDERR _g("%s: unrepresentable changes to source")."\n",
warning(_g("extracting unsigned source package (%s)"), $dsc);
}
- open(CDATA, "< $dsc") || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
- parsecdata(\*CDATA, 'S', -1, sprintf(_g("source control file %s"), $dsc));
+ open(CDATA, "<", $dsc) || error(_g("cannot open .dsc file %s: %s"), $dsc, $!);
+ my $fields = parsecdata(\*CDATA, sprintf(_g("source control file %s"), $dsc),
+ allow_pgp => 1);
close(CDATA);
for my $f (qw(Source Version Files)) {
- defined($fi{"S $f"}) ||
+ defined($fields->{$f}) ||
error(_g("missing critical source control field %s"), $f);
}
my $dscformat = $def_dscformat;
- if (defined $fi{'S Format'}) {
- if (not handleformat($fi{'S Format'})) {
- error(_g("Unsupported format of .dsc file (%s)"), $fi{'S Format'});
+ if (defined $fields->{'Format'}) {
+ if (not handleformat($fields->{'Format'})) {
+ error(_g("Unsupported format of .dsc file (%s)"), $fields->{'Format'});
}
- $dscformat=$fi{'S Format'};
+ $dscformat=$fields->{'Format'};
}
- $sourcepackage = $fi{'S Source'}; # XXX: should use setsourcepackage??
+ $sourcepackage = $fields->{'Source'}; # XXX: should use setsourcepackage??
checkpackagename( $sourcepackage );
- my $version = $fi{'S Version'};
+ my $version = $fields->{'Version'};
my $baseversion;
my $revision;
$baseversion= $version; $revision= '';
}
- my $files = $fi{'S Files'};
+ my $files = $fields->{'Files'};
my @tarfiles;
my $difffile;
my $debianfile;
my %added_files;
sub addfile {
- my ($filename)= @_;
+ my ($fields, $filename)= @_;
$added_files{$filename}++ &&
internerr(_g("tried to add file `%s' twice"), $filename);
stat($filename) || syserr(_g("could not stat output file `%s'"), $filename);
my $md5sum= `md5sum <$filename`;
$? && &subprocerr("md5sum $filename");
$md5sum = readmd5sum( $md5sum );
- $f{'Files'}.= "\n $md5sum $size $filename";
+ $fields->{'Files'}.= "\n $md5sum $size $filename";
}
# replace \ddd with their corresponding character, refuse \ddd > \377
projects / dpkg / commitdiff