[Debpool-commits] [SCM] Debpool Project Repository branch, master, updated. debian/0.3.10-6-g7620ef5
Andres Mejia
mcitadel at gmail.com
Fri Oct 24 18:15:29 UTC 2008
The following commit has been merged in the master branch:
commit 7620ef563f227f0907938ea7423ac140a66867f6
Author: Andres Mejia <mcitadel at gmail.com>
Date: Fri Oct 24 14:15:20 2008 -0400
Revert to using reference for hashes and arrays as appropriate
diff --git a/bin/debpool b/bin/debpool
index ed4f8ce..cbc28ba 100755
--- a/bin/debpool
+++ b/bin/debpool
@@ -191,19 +191,20 @@ if ($Options{'rebuild-files'}) {
foreach my $changefile (@changefiles) {
Log_Message("Processing changefile '$changefile'", LOG_GENERAL, LOG_INFO);
- my %changes_data = Parse_File("$Options{'incoming_dir'}/$changefile");
- if (!%changes_data) {
+ # $changes_data will be a hash reference
+ my $changes_data = Parse_File("$Options{'incoming_dir'}/$changefile");
+ if (!%{$changes_data}) {
Log_Message("Failure parsing changes file '$changefile': " .
$DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR);
next;
}
# Name of the source package
- my($package) = $changes_data{'Source'};
+ my($package) = $changes_data->{'Source'};
# Version of the package
- my $version = $changes_data{'Version'};
- my $source_version = $changes_data{'Source-Version'};
+ my $version = $changes_data->{'Version'};
+ my $source_version = $changes_data->{'Source-Version'};
# The .dsc file will be either $package_$version.dsc or
# $package_$source_version.dsc dependending if a binNMU was uploaded or not.
@@ -219,7 +220,7 @@ foreach my $changefile (@changefiles) {
my($with_source) = undef; # Upload with or without source?
- for my $temp (@{$changes_data{'Architecture'}}) {
+ for my $temp (@{$changes_data->{'Architecture'}}) {
if ('source' eq $temp) {
$with_source = 1;
}
@@ -227,16 +228,17 @@ foreach my $changefile (@changefiles) {
my($has_orig) = undef; # Has an orig tarball?
- foreach my $filehr (keys %{$changes_data{'Files'}}) {
+ foreach my $filehr (keys %{$changes_data->{'Files'}}) {
if ($filehr =~ m/\Qorig.tar.gz\E$/) {
$has_orig = 1;
}
}
- my %dsc_data;
+ my $dsc_data;
if ($with_source) {
- %dsc_data = Parse_File("$Options{'incoming_dir'}/$dscfile");
- if ($with_source && !%dsc_data) {
+ # $dsc_data will be a hash reference
+ $dsc_data = Parse_File("$Options{'incoming_dir'}/$dscfile");
+ if ($with_source && !%{$dsc_data}) {
Log_Message("Failure parsing dsc file '$dscfile': " .
$DebPool::Packages::Error, LOG_GENERAL, LOG_ERROR);
next;
@@ -247,7 +249,7 @@ foreach my $changefile (@changefiles) {
# First, check the changefile signature
if (!Check_Signature("$Options{'incoming_dir'}/$changefile")) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
Log_Message("GPG signature failure in changes file '$changefile'",
LOG_REJECT, LOG_ERROR);
next;
@@ -259,7 +261,7 @@ foreach my $changefile (@changefiles) {
# Now check the dscfile signature
if ($with_source && !Check_Signature("$Options{'incoming_dir'}/$dscfile")) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
Log_Message("GPG signature failure in dsc file '$dscfile'",
LOG_REJECT, LOG_ERROR);
next;
@@ -273,15 +275,15 @@ foreach my $changefile (@changefiles) {
my($valid) = 1;
- foreach my $filehr (keys %{$changes_data{'Files'}}) {
+ foreach my $filehr (keys %{$changes_data->{'Files'}}) {
if (!(Verify_MD5("$Options{'incoming_dir'}/$filehr",
- $changes_data{'Files'}{$filehr}[0]))) {
+ $changes_data->{'Files'}{$filehr}[0]))) {
$valid = undef;
}
}
if (!$valid) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "MD5 checksum failure in changes file '$changefile'";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
@@ -292,7 +294,7 @@ foreach my $changefile (@changefiles) {
my($rejected) = undef;
if ($with_source) {
- foreach my $file (keys %{$dsc_data{'Files'}}) {
+ foreach my $file (keys %{$dsc_data->{'Files'}}) {
# A bit of a special case here; if the Changes file lists an
# orig tarball, we must *not* have one for that version in the
# pool. If it doesn't, then we *must* have one. In either case,
@@ -301,14 +303,14 @@ foreach my $changefile (@changefiles) {
my $filekey = $file; # Save the key value for later use
if ($file =~ /\Qorig.tar.gz\E$/) {
- my($section) = Guess_Section(%changes_data);
+ my($section) = Guess_Section($changes_data);
my($pkg_pooldir) = join('/',
($Options{'pool_dir'}, PoolDir($package, $section),
$package));
if ($has_orig) { # Orig tarball uploaded
if ((!$Options{'rollback'}) && (-e "$pkg_pooldir/$file")) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "Duplicate orig tarball '$file'";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
@@ -316,7 +318,7 @@ foreach my $changefile (@changefiles) {
$rejected = 1;
last; # Don't check other files, we just rejected
} elsif (!(-e "$Options{'incoming_dir'}/$file")) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "Missing orig tarball '$file'";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
@@ -328,7 +330,7 @@ foreach my $changefile (@changefiles) {
}
} else { # Orig tarball in pool - we hope
if (!(-e "$pkg_pooldir/$file")) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "Missing orig tarball '$file'";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
@@ -345,20 +347,20 @@ foreach my $changefile (@changefiles) {
# Whatever it is, it must also pass the MD5 checksum test.
- if (!(Verify_MD5($file, $dsc_data{'Files'}{$filekey}[0]))) {
+ if (!(Verify_MD5($file, $dsc_data->{'Files'}{$filekey}[0]))) {
$valid = undef;
last; # Don't check other files, we already failed
}
}
} else { # Assuming a binary only upload
# The dsc file should be uploaded
- my($section) = Guess_Section(%changes_data);
+ my($section) = Guess_Section($changes_data);
my($pkg_pooldir) = join('/',
($Options{'pool_dir'}, PoolDir($package, $section),
$package));
my $dsc_check = "$pkg_pooldir/$dscfile";
if ( ! -e $dsc_check ) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "Attempted to do a binary only upload but the ";
$msg .= "source information for this package has not been ";
@@ -368,9 +370,9 @@ foreach my $changefile (@changefiles) {
$rejected = 1;
last; # Don't check other files, we just rejected
}
- foreach my $filehr (keys %{$changes_data{'Files'}}) {
+ foreach my $filehr (keys %{$changes_data->{'Files'}}) {
my($file) = $filehr;
- if (!(Verify_MD5($file, $changes_data{'Files'}{$filehr}[0]))) {
+ if (!(Verify_MD5($file, $changes_data->{'Files'}{$filehr}[0]))) {
$valid = undef;
last; # Don't check other files, we failed
}
@@ -380,7 +382,7 @@ foreach my $changefile (@changefiles) {
next if ($rejected); # Reject message already logged, go to next package.
if (!$valid) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "MD5 checksum failure in dsc file '$dscfile'";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
@@ -391,11 +393,11 @@ foreach my $changefile (@changefiles) {
# is configured for that arch.
$rejected = undef;
- my @chg_archs = grep(!/^(source|all)$/, @{$changes_data{'Architecture'}});
+ my @chg_archs = grep(!/^(source|all)$/, @{$changes_data->{'Architecture'}});
foreach my $chg_arch (@chg_archs) {
unless ( grep /^\Q$chg_arch\E$/, @{$Options{'archs'}} ) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
my($msg) = "The archive isn't configured for '$chg_arch' type packages.";
Log_Message($msg, LOG_REJECT, LOG_ERROR);
$rejected = 1;
@@ -410,7 +412,7 @@ foreach my $changefile (@changefiles) {
my(@valid_dists);
- foreach my $distribution (@{$changes_data{'Distribution'}}) {
+ foreach my $distribution (@{$changes_data->{'Distribution'}}) {
my $realdist = undef;
if (defined($Options{'virtual_dists'}->{$distribution})) {
@@ -427,7 +429,7 @@ foreach my $changefile (@changefiles) {
next;
}
- my($allow) = Allow_Version($package, $version, $realdist, $changes_data{'Architecture'});
+ my($allow) = Allow_Version($package, $version, $realdist, $changes_data->{'Architecture'});
if (!defined($allow)) {
Log_Message("Version check for $version failed: " .
@@ -447,15 +449,15 @@ foreach my $changefile (@changefiles) {
}
if (-1 == $#valid_dists) {
- Reject_Package($changefile, %changes_data);
+ Reject_Package($changefile, $changes_data);
Log_Message("No valid distributions for version $version of $package",
LOG_REJECT, LOG_ERROR);
next;
}
# Install the package
-
- if (Install_Package($changefile, %changes_data, $dscfile, %dsc_data, \@valid_dists)) {
+ if (Install_Package($changefile, $dscfile, \@valid_dists, $changes_data,
+ $dsc_data)) {
foreach my $dist (@valid_dists) {
$rebuild{$dist} = 1;
}
@@ -475,7 +477,7 @@ foreach my $changefile (@changefiles) {
# And, now that that's done, audit the package area in the pool to get
# rid of crufty, obsolete versions.
- Audit_Package($package, $changefile, %changes_data);
+ Audit_Package($package, $changefile, $changes_data);
}
# Regenerate {Packages,Sources}{,.gz} for distributions which need it. Also
@@ -528,7 +530,7 @@ ARCH_LOOP:
# Install {Packages,Sources}{,.gz}
- if (!Install_List(@triple, $file, @zfiles)) {
+ if (!Install_List(@triple, $file, \@zfiles)) {
my($msg) = "Couldn't install distribution files for ";
$msg .= "$dist/$section/${arch}: " . $DebPool::Packages::Error;
diff --git a/lib/DebPool/DB.pm b/lib/DebPool/DB.pm
index 109a257..e7f2f6b 100644
--- a/lib/DebPool/DB.pm
+++ b/lib/DebPool/DB.pm
@@ -212,7 +212,7 @@ sub Get_Archs {
# Set_Versions($dist, $source, $file_hashref)
sub Set_Versions {
- my($dist, $source, $meta_version, %file_hashref) = @_;
+ my($dist, $source, $meta_version, $file_hashref) = @_;
my (%entries, %archs);
my($oldversion, $oldbinlist, $archlist);
($oldversion, $oldbinlist, $archlist) =
@@ -243,7 +243,7 @@ sub Set_Versions {
#
# FIXME: Do udeb files have different versions from deb files?
- my(@files) = (keys %file_hashref);
+ my(@files) = (keys %{$file_hashref});
foreach my $filename (@files) {
if ($filename =~ m/^([^_]+)_([^_]+)_(.+)\.u?deb/) {
diff --git a/lib/DebPool/Packages.pm b/lib/DebPool/Packages.pm
index 835ec8f..d0b092d 100644
--- a/lib/DebPool/Packages.pm
+++ b/lib/DebPool/Packages.pm
@@ -309,7 +309,8 @@ sub Generate_List {
return $tmpfile_name;
}
-# Install_Package($changes, $changes_data, $DSC, $DSC_hashref, \@distributions)
+# Install_Package($changes, $dsc, $distributions, $changes_data, $dsc_data)
+# Parameter data types (string, string, array_ref, hash_ref, hash_ref)
#
# Install all of the package files for $changes_data into the pool directory,
# and install the file in $changes to the installed directory. Also generates
@@ -323,18 +324,18 @@ sub Install_Package {
use DebPool::DB qw(:functions :vars);
use DebPool::Util qw(:functions);
- my($changes, %changes_data, $dsc, %dsc_data, $distributions) = @_;
+ my($changes, $dsc, $distributions, $changes_data, $dsc_data) = @_;
my $incoming_dir = $Options{'incoming_dir'};
my $installed_dir = $Options{'installed_dir'};
my $pool_dir = $Options{'pool_dir'};
- my $pkg_name = $changes_data{'Source'};
+ my $pkg_name = $changes_data->{'Source'};
- my $pkg_ver = $changes_data{'Version'};
- my $source_version = $changes_data{'Source-Version'};
+ my $pkg_ver = $changes_data->{'Version'};
+ my $source_version = $changes_data->{'Source-Version'};
- my $guess_section = Guess_Section(%changes_data);
+ my $guess_section = Guess_Section($changes_data);
my $pkg_pool_subdir = join('/',
($pool_dir, PoolDir($pkg_name, $guess_section)));
my $pkg_dir = join('/', ($pkg_pool_subdir, $pkg_name));
@@ -351,7 +352,7 @@ sub Install_Package {
# Walk the File Hash, trying to install each listed file into the
# pool directory.
- foreach my $file (keys %{$changes_data{'Files'}}) {
+ foreach my $file (keys %{$changes_data->{'Files'}}) {
if (!Move_File("${incoming_dir}/${file}", "${pkg_dir}/${file}",
$Options{'pool_file_mode'})) {
$Error = "Failed to move '${incoming_dir}/${file}' ";
@@ -362,12 +363,12 @@ sub Install_Package {
# Generate and install .package and .source metadata files.
- my @pkg_archs = @{$changes_data{'Architecture'}};
+ my @pkg_archs = @{$changes_data->{'Architecture'}};
@pkg_archs = grep(!/source/, @pkg_archs); # Source is on it's own.
my $target;
foreach my $pkg_arch (@pkg_archs) {
- my $pkg_file = Generate_Package(%changes_data, $pkg_arch);
+ my $pkg_file = Generate_Package($changes_data, $pkg_arch);
if (!defined($pkg_file)) {
$Error = "Failed to generate .package file: $Error";
@@ -383,8 +384,8 @@ sub Install_Package {
}
}
- if ($dsc && %dsc_data) {
- my $src_file = Generate_Source($dsc, %dsc_data, %changes_data);
+ if ($dsc && %{$dsc_data}) {
+ my $src_file = Generate_Source($dsc, $dsc_data, $changes_data);
if (!defined($src_file)) {
$Error = "Failed to generate .source file: $Error";
@@ -410,20 +411,17 @@ sub Install_Package {
}
# Update the various databases.
-
- my $distribution;
-
# This whole block is just to calculate the component. What a stupid
# setup - it should be in the changes file. Oh well.
- my @filearray = (keys %{$changes_data{'Files'}});
+ my @filearray = (keys %{$changes_data->{'Files'}});
my $fileref = $filearray[0];
- my $section = $changes_data{'Files'}{$fileref}[2];
+ my $section = $changes_data->{'Files'}{$fileref}[2];
my $component = Strip_Subsection($section);
foreach my $distribution (@{$distributions}) {
Set_Versions($distribution, $pkg_name, $pkg_ver,
- $changes_data{'Files'});
+ $changes_data->{'Files'});
$ComponentDB{$distribution}->{$pkg_name} = $component;
}
if ( $section eq 'debian-installer' ) {
@@ -434,6 +432,7 @@ sub Install_Package {
}
# Reject_Package($changes, $changes_data)
+# Parameter data types (string, hash_ref)
#
# Move all of the package files for $changes_data (which should be a
# Parse_Changes result hash) into the rejected directory, as well as the
@@ -444,7 +443,7 @@ sub Reject_Package {
use DebPool::DB qw(:functions);
use DebPool::Util qw(:functions);
- my($changes, %changes_data) = @_;
+ my($changes, $changes_data) = @_;
my $incoming_dir = $Options{'incoming_dir'};
my $reject_dir = $Options{'reject_dir'};
@@ -452,7 +451,7 @@ sub Reject_Package {
# Walk the File Hash, moving each file to the rejected directory.
- foreach my $file (keys %{$changes_data{'Files'}}) {
+ foreach my $file (keys %{$changes_data->{'Files'}}) {
if (!Move_File("$incoming_dir/$file", "$reject_dir/$file",
$reject_file_mode)) {
$Error = "Failed to move '$incoming_dir/$file' ";
@@ -514,6 +513,7 @@ sub Verify_MD5 {
}
# Audit_Package($package, $changes_data)
+# Parameter data types (string, hash_ref)
#
# Delete a package and changes files for the named (source) package which
# are not referenced by any version currently found in the various release
@@ -525,20 +525,20 @@ sub Audit_Package {
use DebPool::Dirs qw(:functions);
use DebPool::Logging qw(:functions :facility :level);
- my($package, $changefile, %changes_data) = @_;
+ my($package, $changefile, $changes_data) = @_;
# Checking for version of package being installed
- my $changes_version = $changes_data{'Version'};
+ my $changes_version = $changes_data->{'Version'};
my $installed_dir = $Options{'installed_dir'};
my $pool_dir = $Options{'pool_dir'};
- my $section = Guess_Section(%changes_data);
+ my $section = Guess_Section($changes_data);
my $package_dir = join('/',
($pool_dir, PoolDir($package, $section), $package));
my @changes = grep(/${package}_/, Scan_Changes($installed_dir));
- my @changes_arch = @{$changes_data{'Architecture'}};
+ my @changes_arch = @{$changes_data->{'Architecture'}};
my $pool_scan = Scan_All($package_dir);
if (!defined($pool_scan)) {
@@ -669,7 +669,8 @@ sub Audit_Package {
return $unlinked;
}
-# Generate_Package($changes_data)
+# Generate_Package($changes_data, $arch)
+# Parameter data types (hash_ref, string)
#
# Generates a .package metadata file (Packages entries for each binary
# package) in the tempfile area, and returns the filename. Returns undef
@@ -680,18 +681,18 @@ sub Generate_Package {
use DebPool::Dirs qw(:functions);
use DebPool::Logging qw(:functions :facility :level);
- my(%changes_data, $arch) = @_;
- my $source = $changes_data{'Source'};
- my $source_version = $changes_data{'Source-Version'};
+ my($changes_data, $arch) = @_;
+ my $source = $changes_data->{'Source'};
+ my $source_version = $changes_data->{'Source-Version'};
- my @files = (keys %{$changes_data{'Files'}});
+ my @files = (keys %{$changes_data->{'Files'}});
my $pool_base = PoolBasePath();
# Grab a temporary file.
my($tmpfile_handle, $tmpfile_name) = tempfile();
- my @packages = @{$changes_data{'Binary'}};
+ my @packages = @{$changes_data->{'Binary'}};
my $package;
@@ -704,7 +705,7 @@ sub Generate_Package {
# without the epoch" -- it is more or less arbitrary, as long
# as it is a well-formed version number).
my $filepat = qr/^\Q${package}_\E.*\Q_${arch}.\Eu?deb/;
- my $section = Guess_Section(%changes_data);
+ my $section = Guess_Section($changes_data);
my $pool = join('/', (PoolDir($source, $section), $source));
my $marker = -1;
@@ -748,14 +749,14 @@ sub Generate_Package {
print $tmpfile_handle "Installed-Size: $info->{'Installed-Size'}\n";
- print $tmpfile_handle "Maintainer: $changes_data{'Maintainer'}\n";
+ print $tmpfile_handle "Maintainer: $changes_data->{'Maintainer'}\n";
print $tmpfile_handle "Architecture: $arch\n";
if ($source_version) {
print $tmpfile_handle "Source: $source" . "_($source_version)\n";
} else {
print $tmpfile_handle "Source: $source\n";
}
- print $tmpfile_handle "Version: $changes_data{'Version'}\n";
+ print $tmpfile_handle "Version: $changes_data->{'Version'}\n";
# All of the inter-package relationships go together, and any
# one of them can potentially be empty (and omitted).
@@ -772,9 +773,9 @@ sub Generate_Package {
print $tmpfile_handle "Filename: $pool_base/$pool/$file\n";
print $tmpfile_handle "Size: " .
- $changes_data{'Files'}{$files[$marker]}[1] . "\n";
+ $changes_data->{'Files'}{$files[$marker]}[1] . "\n";
print $tmpfile_handle "MD5sum: " .
- $changes_data{'Files'}{$files[$marker]}[0] . "\n";
+ $changes_data->{'Files'}{$files[$marker]}[0] . "\n";
print $tmpfile_handle "Description: $info->{'Description'}";
@@ -788,6 +789,7 @@ sub Generate_Package {
}
# Generate_Source($dsc, $dsc_data, $changes_data)
+# Parameter data types (string, hash_ref, hash_ref)
#
# Generates a .source metadata file (Sources entries for the source
# package) in the tempfile area, and returns the filename. Returns undef
@@ -797,18 +799,18 @@ sub Generate_Source {
use DebPool::Dirs qw(:functions);
use DebPool::Logging qw(:functions :facility :level);
- my($dsc, %dsc_data, %changes_data) = @_;
- my $source = $dsc_data{'Source'};
- my @files = (keys %{$dsc_data{'Files'}});
+ my($dsc, $dsc_data, $changes_data) = @_;
+ my $source = $dsc_data->{'Source'};
+ my @files = (keys %{$dsc_data->{'Files'}});
# Figure out the priority and section, using the DSC filename and
# the Changes file data.
my ($section, $priority);
- foreach my $filehr (keys %{$changes_data{'Files'}}) {
+ foreach my $filehr (keys %{$changes_data->{'Files'}}) {
if ($filehr eq $dsc) {
- $section = $changes_data{'Files'}{$filehr}[2];
- $priority = $changes_data{'Files'}{$filehr}[3];
+ $section = $changes_data->{'Files'}{$filehr}[2];
+ $priority = $changes_data->{'Files'}{$filehr}[3];
}
}
@@ -819,36 +821,36 @@ sub Generate_Source {
# Dump out various metadata.
print $tmpfile_handle "Package: $source\n";
- print $tmpfile_handle "Binary: " . join(', ', @{$dsc_data{'Binary'}}) . "\n";
- print $tmpfile_handle "Version: $dsc_data{'Version'}\n";
+ print $tmpfile_handle "Binary: " . join(', ', @{$dsc_data->{'Binary'}}) . "\n";
+ print $tmpfile_handle "Version: $dsc_data->{'Version'}\n";
print $tmpfile_handle "Priority: $priority\n";
print $tmpfile_handle "Section: $section\n";
- print $tmpfile_handle "Maintainer: $dsc_data{'Maintainer'}\n";
+ print $tmpfile_handle "Maintainer: $dsc_data->{'Maintainer'}\n";
- if (defined($dsc_data{'Build-Depends'})) {
+ if (defined($dsc_data->{'Build-Depends'})) {
print $tmpfile_handle 'Build-Depends: ';
- print $tmpfile_handle join(', ', @{$dsc_data{'Build-Depends'}}) . "\n";
+ print $tmpfile_handle join(', ', @{$dsc_data->{'Build-Depends'}}) . "\n";
}
- if (defined($dsc_data{'Build-Depends-Indep'})) {
+ if (defined($dsc_data->{'Build-Depends-Indep'})) {
print $tmpfile_handle 'Build-Depends-Indep: ';
- print $tmpfile_handle join(', ', @{$dsc_data{'Build-Depends-Indep'}}) . "\n";
+ print $tmpfile_handle join(', ', @{$dsc_data->{'Build-Depends-Indep'}}) . "\n";
}
print $tmpfile_handle 'Architecture: ';
- print $tmpfile_handle join(' ', @{$dsc_data{'Architecture'}}) . "\n";
+ print $tmpfile_handle join(' ', @{$dsc_data->{'Architecture'}}) . "\n";
- print $tmpfile_handle "Standards-Version: $dsc_data{'Standards-Version'}\n"
- if exists $dsc_data{'Standards-Version'};
- print $tmpfile_handle "Format: $dsc_data{'Format'}\n";
+ print $tmpfile_handle "Standards-Version: $dsc_data->{'Standards-Version'}\n"
+ if exists $dsc_data->{'Standards-Version'};
+ print $tmpfile_handle "Format: $dsc_data->{'Format'}\n";
print $tmpfile_handle "Directory: " . join('/',
(PoolBasePath(), PoolDir($source, $section), $source)) . "\n";
print $tmpfile_handle "Files:\n";
foreach my $fileref (@files) {
- print $tmpfile_handle " " . $dsc_data{'Files'}{$fileref}[0];
- print $tmpfile_handle " " . $dsc_data{'Files'}{$fileref}[1];
+ print $tmpfile_handle " " . $dsc_data->{'Files'}{$fileref}[0];
+ print $tmpfile_handle " " . $dsc_data->{'Files'}{$fileref}[1];
print $tmpfile_handle " $fileref\n";
}
@@ -900,7 +902,8 @@ sub Dpkg_Info {
return \%result;
}
-# Install_List($archive, $component, $architecture, $listfile, @zfiles)
+# Install_List($archive, $component, $architecture, $listfile, $zfiles)
+# Parameter data types (string, string, string, string, array_ref)
#
# Installs a distribution list file (from Generate_List), along with an
# optional gzipped version of the same file (if $gzfile is defined).
@@ -910,7 +913,7 @@ sub Install_List {
use DebPool::Config qw(:vars);
use DebPool::Dirs qw(:functions);
- my($archive, $component, $architecture, $listfile, @zfiles) = @_;
+ my($archive, $component, $architecture, $listfile, $zfiles) = @_;
my $dists_file_mode = $Options{'dists_file_mode'};
my $inst_file = "$Options{'dists_dir'}/";
@@ -924,7 +927,7 @@ sub Install_List {
return 0;
}
- foreach my $zfile (@zfiles) {
+ foreach my $zfile (@{$zfiles}) {
my ($ext) = $zfile =~ m{\.([^/]+)$};
if (!Move_File($zfile, "${inst_file}.${ext}",
$dists_file_mode)) {
@@ -938,6 +941,7 @@ sub Install_List {
}
# Guess_Section($changes_data)
+# Parameter data types (hash_ref)
#
# Attempt to guess the freeness section of a package based on the data
# for the first file listed in the changes.
@@ -948,10 +952,10 @@ sub Guess_Section {
# section, which is based solely on freeness-sections (main, contrib,
# non-free).
- my(%changes_data) = @_;
+ my($changes_data) = @_;
- my @changes_files = (keys %{$changes_data{'Files'}});
- return $changes_data{'Files'}{$changes_files[0]}[2];
+ my @changes_files = (keys %{$changes_data->{'Files'}});
+ return $changes_data->{'Files'}{$changes_files[0]}[2];
}
# Strip_Epoch($version)
diff --git a/lib/DebPool/Parser.pm b/lib/DebPool/Parser.pm
index 98cbd0f..ac7e965 100644
--- a/lib/DebPool/Parser.pm
+++ b/lib/DebPool/Parser.pm
@@ -120,9 +120,9 @@ my %Field_Types = (
# Parse_File($file)
#
-# Parses a changes or dsc file. This method returns a hash of the different
-# types of data we want from each field. We use an internal method to help us
-# in placing an appropriate data type for each field (key) of our hash.
+# Parses a changes or dsc file. This method returns a hash reference of the
+# different types of data we want from each field. We use an internal method to
+# help us in placing an appropriate data type for each field (key) of our hash.
sub Parse_File {
my ($file) = @_;
@@ -154,7 +154,7 @@ sub Parse_File {
# have a field to process. This is the usual case during the first
# loop.
if ($field) {
- $fields{$field} = Process_Type($field, $file, @values);
+ $fields{$field} = Process_Type($field, $file, \@values);
}
@values = ();
$field = $1;
@@ -168,7 +168,7 @@ sub Parse_File {
# Once we're done with the for loop, we still have to process the last
# field.
if ($field) {
- $fields{$field} = Process_Type($field, $file, @values);
+ $fields{$field} = Process_Type($field, $file, \@values);
}
# In case a valid binNMU is detected, Source will be written as
@@ -180,16 +180,17 @@ sub Parse_File {
$fields{'Source-Version'} =~ s/^\(|\)$//g;
}
- return %fields;
+ return \%fields;
}
-# Process_Type($field, $file, @values)
-
+# Process_Type($field, $file, $values)
+# Parameter data types (string, string, array_ref)
+#
# This method will return a string, an array, or a hash depending on the field
# we are processing.
sub Process_Type {
- my ($field, $file, @values) = @_;
+ my ($field, $file, $values) = @_;
# Change the Files field type to appropriate type dependending on file
# being parsed.
@@ -214,22 +215,22 @@ sub Process_Type {
}
if ($Field_Types{$field} eq 'string') {
- return $values[0];
+ return ${$values}[0];
} elsif ($Field_Types{$field} eq 'space_array') {
- my @data = split /\s+/, $values[0];
+ my @data = split /\s+/, ${$values}[0];
return \@data;
} elsif ($Field_Types{$field} eq 'comma_array') {
- my @data = split /,\s+/, $values[0];
+ my @data = split /,\s+/, ${$values}[0];
return \@data;
} elsif ($Field_Types{$field} eq 'multiline_array') {
- return \@values;
+ return $values;
} elsif ($Field_Types{$field} eq 'checksums') {
# Checksum types are a special case. We return a hash where the
# filenames are the keys, each containing the value of the checksum and
# size inside an array, the first element being the checksum and the
# second element being the size.
my %data;
- foreach my $value (@values) {
+ foreach my $value (@{$values}) {
my ($checksum, $size, $file) = split /\s+/, $value;
$data{$file} = [ $checksum, $size ];
}
@@ -240,14 +241,14 @@ sub Process_Type {
# So the first element is the checksum, the second is the size, the
# third is the section and the fourth is the priority.
my %data;
- foreach my $value (@values) {
+ foreach my $value (@{$values}) {
my ($checksum, $size, $section, $priority, $file) =
split /\s+/, $value;
$data{$file} = [ $checksum, $size, $section, $priority ];
}
return \%data;
} else { # Treat all unknown fields as multiline_arrays for now
- return \@values;
+ return $values;
}
}
--
Debpool Project Repository
More information about the Debpool-commits
mailing list