From 120ecd5161f4cf468d611b3dea05ac8a43313a75 Mon Sep 17 00:00:00 2001 From: Raphael Hertzog Date: Mon, 31 Dec 2007 17:29:00 +0100 Subject: [PATCH] Update all scripts to use Dpkg::Substvars, Dpkg::Cdata, Dpkg::Control and Dpkg::Fields::Object --- ChangeLog | 5 + scripts/dpkg-checkbuilddeps.pl | 22 ++-- scripts/dpkg-genchanges.pl | 136 ++++++++++---------- scripts/dpkg-gencontrol.pl | 223 ++++++++++++++++----------------- scripts/dpkg-gensymbols.pl | 9 +- scripts/dpkg-shlibdeps.pl | 12 +- scripts/dpkg-source.pl | 152 +++++++++++----------- 7 files changed, 288 insertions(+), 271 deletions(-) diff --git a/ChangeLog b/ChangeLog index 5a71bec4..deaa9252 100644 --- a/ChangeLog +++ b/ChangeLog @@ -30,6 +30,11 @@ * 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 diff --git a/scripts/dpkg-checkbuilddeps.pl b/scripts/dpkg-checkbuilddeps.pl index 57c1a300..eea28fe2 100755 --- a/scripts/dpkg-checkbuilddeps.pl +++ b/scripts/dpkg-checkbuilddeps.pl @@ -10,12 +10,11 @@ use Dpkg::Gettext; 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 { @@ -46,30 +45,31 @@ if ($want_help) { 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); } diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl index c194ffb9..972a288b 100755 --- a/scripts/dpkg-genchanges.pl +++ b/scripts/dpkg-genchanges.pl @@ -13,13 +13,14 @@ use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr 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"); @@ -36,6 +37,8 @@ my $varlistfile = 'debian/substvars'; 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" @@ -64,6 +67,8 @@ my $forcemaint; my $forcechangedby; my $since; +my $substvars = Dpkg::Substvars->new(); + use constant SOURCE => 1; use constant ARCH_DEP => 2; use constant ARCH_INDEP => 4; @@ -169,7 +174,7 @@ while (@ARGV) { } 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$/) { @@ -180,7 +185,9 @@ while (@ARGV) { } 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")); @@ -221,28 +228,30 @@ if (not is_sourceonly) { 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)) @@ -271,14 +280,14 @@ for $_ (keys %fi) { } 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 = ''; @@ -293,38 +302,40 @@ for $_ (keys %fi) { &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() { 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); } @@ -354,9 +365,6 @@ for my $p (keys %p2f) { } } -&init_substvars; -init_substvar_arch(); - my $origsrcmsg; if (!is_binaryonly) { @@ -371,14 +379,15 @@ 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_~]+)$/ @@ -410,25 +419,25 @@ if (!is_binaryonly) { 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; @@ -451,34 +460,35 @@ for my $f (@sourcefiles, @fileslistfiles) { 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); diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl index 61949081..a86baa84 100755 --- a/scripts/dpkg-gencontrol.pl +++ b/scripts/dpkg-gencontrol.pl @@ -12,13 +12,13 @@ use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr 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"); @@ -44,6 +44,7 @@ my %remove; my %override; my $oppackage; my $package_type = 'deb'; +my $substvars = Dpkg::Substvars->new(); sub version { @@ -83,12 +84,6 @@ Options: "), $progname; } -sub spfileslistvalue($) -{ - return $f{$_[0]} || '-'; -} - - while (@ARGV) { $_=shift(@ARGV); if (m/^-p([-+0-9a-z.]+)$/) { @@ -116,7 +111,7 @@ while (@ARGV) { } 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/) { @@ -131,119 +126,115 @@ while (@ARGV) { } 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'}); } } } @@ -251,10 +242,9 @@ if (exists $fi{"C$myindex Provides"}) { 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); @@ -269,36 +259,36 @@ foreach my $field (@pkg_dep_fields) { $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") || @@ -313,20 +303,21 @@ if (!defined($substvar{'Installed-Size'})) { $? && 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/; @@ -341,7 +332,7 @@ if (open(X,"< $fileslistfile")) { 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")); } @@ -349,13 +340,14 @@ if (open(X,"< $fileslistfile")) { } 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")); @@ -370,10 +362,11 @@ if (!$stdout) { } 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); } + diff --git a/scripts/dpkg-gensymbols.pl b/scripts/dpkg-gensymbols.pl index 77d11d29..309950fb 100755 --- a/scripts/dpkg-gensymbols.pl +++ b/scripts/dpkg-gensymbols.pl @@ -10,16 +10,16 @@ use Dpkg::Shlibs::Objdump; 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'; @@ -118,13 +118,12 @@ if (not defined($sourceversion)) { $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(); diff --git a/scripts/dpkg-shlibdeps.pl b/scripts/dpkg-shlibdeps.pl index 07d84581..eefec12c 100755 --- a/scripts/dpkg-shlibdeps.pl +++ b/scripts/dpkg-shlibdeps.pl @@ -18,9 +18,7 @@ use Dpkg::Shlibs::SymbolFile; 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); @@ -87,10 +85,10 @@ foreach (@ARGV) { 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; diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index 0acf61ff..142c94c5 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -12,6 +12,9 @@ use Dpkg::Arch qw(debarch_eq); 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; @@ -19,7 +22,7 @@ my %notfileobject; my $fn; my $ur; -my $varlistfile; +my $varlistfile = "debian/substvars"; my $controlfile; my $changelogfile; my $changelogformat; @@ -100,6 +103,8 @@ my %dirtocreate; # used by checkdiff my @tar_ignore; +my $substvars = Dpkg::Substvars->new(); + use POSIX; use Fcntl qw (:mode); use English; @@ -109,9 +114,8 @@ use Cwd; push (@INC, $dpkglibdir); require 'controllib.pl'; -our (%f, %fi); +our (%fi); our $sourcepackage; -our %substvar; our @src_dep_fields; textdomain("dpkg-dev"); @@ -250,9 +254,9 @@ while (@ARGV && $ARGV[0] =~ m/^-/) { $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$/) { @@ -292,44 +296,48 @@ if ($opmode eq 'build') { $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'); @@ -355,9 +363,9 @@ if ($opmode eq 'build') { } } } - $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 || @@ -367,46 +375,48 @@ if ($opmode eq 'build') { } 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/-[^-]*$//; @@ -507,7 +517,7 @@ if ($opmode eq 'build') { $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 _" . ".orig.tar (wanted %s)"), @@ -560,7 +570,7 @@ if ($opmode eq 'build') { } - addfile("$tarname"); + addfile($fields, "$tarname"); if ($sourcestyle =~ m/[kpKP]/) { @@ -750,7 +760,7 @@ if ($opmode eq 'build') { } close(FIND); $? && subprocerr("find on $dirname"); - &addfile($diffname); + addfile($fields, $diffname); } @@ -765,7 +775,8 @@ if ($opmode eq 'build') { 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", @@ -829,27 +840,28 @@ if ($opmode eq 'build') { 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; @@ -861,7 +873,7 @@ if ($opmode eq 'build') { $baseversion= $version; $revision= ''; } - my $files = $fi{'S Files'}; + my $files = $fields->{'Files'}; my @tarfiles; my $difffile; my $debianfile; @@ -1625,7 +1637,7 @@ sub reapgzip { 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); @@ -1633,7 +1645,7 @@ sub addfile { 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 -- 2.39.5