Here's a revised patch that will now write package and/or log entries depending on whether the package is installed for an arch. Again, the patch contains fixes for other problems so the relevant fixes for this bug are with hunks 2, 3, 4, and 6.
I'm wondering if a .package file or .source file is even necessary, aside from it's current use in debpool. I don't see them installed in the public debian repositories. I think it would be better to generate a Packages/Sources list without relying on these .package/.source files.
--- debpool_released/share/DebPool/Packages.pm 2007-12-03 14:10:49.000000000 -0500 +++ debpool/share/DebPool/Packages.pm 2007-12-04 11:39:36.000000000 -0500 @@ -488,7 +488,7 @@ for $count (0..$#dsc) { if ($found) { - if ($dsc[$count] =~ m/^\s*$/) { # Blank line + if ($dsc[$count] =~ m/^(\s*$|\S)/) { # End of Files entry $found = 0; # No longer in Files } elsif ($dsc[$count] =~ m/\s*([[:xdigit:]]+)\s+(\d+)\s+(\S+)/) { my($md5, $size, $file) = ($1, $2, $3); @@ -567,31 +567,37 @@ ($Options{'pool_dir'}, PoolDir($source, $section), $source)); my($version) = Get_Version($distribution, $source, 'meta'); my($target) = "$pool/${source}_" . Strip_Epoch($version); - $target .= '.package'; + $target .= "_$arch\.package"; - if (!open(PKG, '<', "$target")) { - my($msg) = "Skipping package entry for all packages from "; - $msg .= "${source}: couldn't open '$target' for reading: $!"; + # Check if package for arch is installed and write entries if + # found + my($check_changes) = "$Options{'installed_dir'}/${source}_"; + $check_changes .= Strip_Epoch($version) . "_$arch\.changes"; + if (-e $check_changes) { + if (!open(PKG, '<', "$target")) { + my($msg) = "Skipping package entry for all packages from "; + $msg .= "${source}: couldn't open '$target' for reading: $!"; - Log_Message($msg, LOG_GENERAL, LOG_ERROR); - next; - } + Log_Message($msg, LOG_GENERAL, LOG_ERROR); + next; + } - # Playing around with the record separator ($/) to make this - # easier. + # Playing around with the record separator ($/) to make this + # easier. - my($backup_RS) = $/; - $/ = ""; + my($backup_RS) = $/; + $/ = ""; - my(@entries) = <PKG>; - close(PKG); + my(@entries) = <PKG>; + close(PKG); - $/ = $backup_RS; + $/ = $backup_RS; - # Pare it down to the relevant entries, and print those out. + # Pare it down to the relevant entries, and print those out. - @entries = grep(/\nArchitecture: ($arch|all)\n/, @entries); - print $tmpfile_handle @entries; + @entries = grep(/\nArchitecture: ($arch|all)\n/, @entries); + print $tmpfile_handle @entries; + } } } @@ -624,6 +630,16 @@ my($pkg_name) = $chg_hashref->{'Source'}; my($pkg_ver) = $chg_hashref->{'Version'}; + # determine arch for packages being installed based on set archs from + # options + my($options_archs); + my($pkg_arch); + foreach $options_archs (@{$Options{'archs'}}) { + if ($changes =~ m/.*\Q_${options_archs}.changes\E/) { + $pkg_arch = $options_archs; + } + } + my($guess_section) = Guess_Section($chg_hashref); my($pkg_dir) = join('/', ($pool_dir, PoolDir($pkg_name, $guess_section), $pkg_name)); @@ -668,7 +684,7 @@ return undef; } - my($target) = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . '.package'; + my($target) = "$pkg_dir/${pkg_name}_" . Strip_Epoch($pkg_ver) . "_$pkg_arch" . '.package'; if (!Move_File($pkg_file, $target, $Options{'pool_file_mode'})) { $Error = "Failed to move '$pkg_file' to '$target': "; @@ -719,6 +735,9 @@ $chg_hashref->{'Files'}); $ComponentDB{$distribution}->{$pkg_name} = $component; } + if ( $section eq 'debian-installer' ) { + $component .= '/debian-installer'; + } return 1; } @@ -872,7 +891,7 @@ $bin_package = $1; $version = $2; $deb = 1; - } elsif ($file =~ m/^([^_]+)_([^_]+)\.package$/) { # package metadata + } elsif ($file =~ m/^([^_]+)_([^_]+)_.+\.package$/) { # package metadata $bin_package = $1; $version = $2; } elsif ($file =~ m/^([^_]+)_([^_]+)\.source$/) { # source metadata @@ -981,8 +1000,7 @@ # without the epoch" -- it is more or less arbitrary, as long # as it is a well-formed version number). - my($filepat) = "${package}_.*_${arch}\\.deb"; - $filepat =~ s/\+/\\\+/; + my($filepat) = qr/^\Q${package}_\E.*\Q_${arch}.\Eu?deb/; my($section) = Guess_Section($changes_data); my($pool) = join('/', (PoolDir($source, $section), $source)); @@ -1054,9 +1072,9 @@ print $tmpfile_handle "MD5sum: $files[$marker]->{'MD5Sum'}\n"; print $tmpfile_handle "Description: $info->{'Description'}"; - } - print $tmpfile_handle "\n"; + print $tmpfile_handle "\n"; + } } # All done @@ -1117,7 +1135,8 @@ print $tmpfile_handle 'Architecture: '; print $tmpfile_handle join(' ', @{$dsc_data->{'Architecture'}}) . "\n"; - print $tmpfile_handle "Standards-Version: $dsc_data->{'Standards-Version'}\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";