[Debpool-commits] [SCM] Debpool Project Repository branch, master, updated. debian/0.4.0-8-g8c7f04c

Andres Mejia mcitadel at gmail.com
Mon Oct 27 20:41:46 UTC 2008


The following commit has been merged in the master branch:
commit 8c7f04cdc96ba9e1a463405956a3eda2530d17ee
Author: Andres Mejia <mcitadel at gmail.com>
Date:   Mon Oct 27 16:41:41 2008 -0400

    Fix issue where Packages and Sources files were not being generated for
    binary only uploads.

diff --git a/bin/debpool b/bin/debpool
index 175e085..4bd95b3 100755
--- a/bin/debpool
+++ b/bin/debpool
@@ -500,24 +500,13 @@ foreach my $changefile (@changefiles) {
 # rebuild Release files that need it, if we're doing them.
 
 foreach my $dist (keys(%rebuild)) {
-    my(@rel_filelist) = ();
+    my @rel_filelist;
     foreach my $section (@{$Options{'sections'}}) {
-        my(@archs) = @{$Options{'archs'}};
-        @archs = grep(!/^all$/, @archs); # We don't build binary-all files.
-
-        my($arch);
 
 ARCH_LOOP:
-        foreach $arch (@{$Options{'archs'}}) {
-            # We cheat, and use @triple for dist/section/arch inputs.
-            # Perl lets us get away with this. I'd care, except that Perl
-            # prototyping isn't, so it's useless to not do this.
-
-            my(@triple) = ($dist, $section, $arch);
-
+        foreach my $arch (grep(!/^all$/, @{$Options{'archs'}})) {
             # Generate a Packages/Sources file.
-
-            my($file) = Generate_List(@triple);
+            my($file) = Generate_List($dist, $section, $arch);
 
             if (!defined($file)) {
                 my($msg) = "Couldn't create list for $dist/$section/${arch}: ";
@@ -546,7 +535,7 @@ ARCH_LOOP:
 
             # Install {Packages,Sources}{,.gz}
 
-            if (!Install_List(@triple, $file, \@zfiles)) {
+            if (!Install_List($dist, $section, $arch, $file, \@zfiles)) {
 
                 my($msg) = "Couldn't install distribution files for ";
                 $msg .= "$dist/$section/${arch}: " . $DebPool::Packages::Error;
@@ -575,7 +564,7 @@ ARCH_LOOP:
 
                 my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime());
                 $relfile = DebPool::Release::Generate_Release_Triple(
-                    @triple, $release_version);
+                    $dist, $section, $arch, $release_version);
 
                 if (!defined($relfile)) {
                     my($msg) = "Couldn't create Release file: ";
@@ -608,7 +597,7 @@ ARCH_LOOP:
             # Install Release{,.gpg}
 
             if (defined($relfile) &&
-                !DebPool::Release::Install_Release(@triple, $relfile, $sigfile)) {
+                !DebPool::Release::Install_Release($dist, $section, $arch, $relfile, $sigfile)) {
 
                 my($msg) = "Couldn't install release files for ";
                 $msg .= "$dist/$section/${arch}: " . $DebPool::Release::Error;
@@ -625,7 +614,7 @@ ARCH_LOOP:
                 next;
             }
 
-            my($pushfile) = Archfile(@triple, 0);
+            my($pushfile) = Archfile($dist, $section, $arch, 0);
             $pushfile =~ s/${dist}\///;
             push(@rel_filelist, $pushfile);
 
@@ -635,7 +624,7 @@ ARCH_LOOP:
             }
 
             if (defined($relfile)) {
-                $pushfile = Archfile(@triple, 1);
+                $pushfile = Archfile($dist, $section, $arch, 1);
                 $pushfile =~ s/${dist}\///;
                 $pushfile .= '/Release';
                 push(@rel_filelist, $pushfile);
@@ -648,7 +637,6 @@ ARCH_LOOP:
     }
 
     # If we're doing Release files, now is the time for the general dist one.
-
     my($relfile);
     my($sigfile);
 
@@ -656,7 +644,6 @@ ARCH_LOOP:
         require DebPool::Release;
 
         # Release versions are YYYY.MM.DD.HH.MM.SS (GMT) by default.
-
         my($release_version) = strftime('%Y.%m.%d.%H.%M.%S', gmtime());
         $relfile = DebPool::Release::Generate_Release_Dist(
             $dist, $release_version, @rel_filelist);
@@ -681,7 +668,6 @@ ARCH_LOOP:
     }
 
     # Install Release{,.gpg}
-
     if (defined($relfile) &&
         !DebPool::Release::Install_Release($dist, undef, undef,
             $relfile, $sigfile)) {
diff --git a/debian/changelog b/debian/changelog
index 07d1601..78e3619 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -11,8 +11,10 @@ debpool (0.5.0) experimental; urgency=low
   * Grab dsc information from dsc file already in pool in case of binary only
     uploads.
   * Allow Generate_Source() to handle binary only uploads.
+  * Fix issue where Packages and Sources files were not being generated for
+    binary only uploads.
 
- -- Andres Mejia <mcitadel at gmail.com>  Mon, 27 Oct 2008 01:39:00 -0400
+ -- Andres Mejia <mcitadel at gmail.com>  Mon, 27 Oct 2008 16:38:15 -0400
 
 debpool (0.4.1) experimental; urgency=low
 
diff --git a/lib/DebPool/Packages.pm b/lib/DebPool/Packages.pm
index c4a3fd0..7aaf1ce 100644
--- a/lib/DebPool/Packages.pm
+++ b/lib/DebPool/Packages.pm
@@ -72,13 +72,14 @@ BEGIN {
         &Reject_Package
         &Verify_MD5
         &Strip_Epoch
+        &Get_Package_Files
     );
 
     %EXPORT_TAGS = (
         'functions' => [qw(&Allow_Version &Audit_Package &Generate_List
                         &Generate_Package &Generate_Source &Guess_Section
                         &Install_List &Install_Package &Reject_Package
-                        &Verify_MD5 &Strip_Epoch)],
+                        &Verify_MD5 &Strip_Epoch &Get_Package_Files)],
         'vars' => [qw()],
     );
 }
@@ -183,8 +184,6 @@ sub Allow_Version {
 sub Generate_List {
     my($distribution, $section, $arch) = @_;
 
-    my %packages;
-
     if ('all' eq $arch) {
         $Error = "No point in generating Packages file for binary-all";
         return;
@@ -218,15 +217,19 @@ sub Generate_List {
             my $pool = join('/',
                 ($Options{'pool_dir'}, PoolDir($source, $section), $source));
             my $version = Get_Version($distribution, $source, 'meta');
-            my $target = "$pool/${source}_" . Strip_Epoch($version);
-            $target .= "_$arch\.package";
-            my $target_all = "$pool/${source}_" . Strip_Epoch($version);
-            $target_all .= "_all\.package";
 
-        my ($pkg_arch_fh, $pkg_all_fh);
+            my $archpackagefiles =
+                Get_Package_Files($source, $version, $section, $arch);
+            my $archallpackagefiles =
+                Get_Package_Files($source, $version, $section, 'all');
+
+            my $target = @{$archpackagefiles}[0];
+            my $target_all = @{$archallpackagefiles}[0];
+
+            my ($pkg_arch_fh, $pkg_all_fh);
 
             # Check for any binary-arch packages
-            if (-e $target) {
+            if (($target) and (-e $target)) {
                 if (!open($pkg_arch_fh, '<', "$target")) {
                     my $msg = "Skipping package entry for all packages from ";
                     $msg .=
@@ -238,7 +241,7 @@ sub Generate_List {
             }
 
             # Check for any binary-all packages
-            if (-e $target_all) {
+            if (($target_all) and (-e $target_all)) {
                 if (!open($pkg_all_fh, '<', "$target_all")) {
                     my $msg = "Skipping package entry for all packages ";
                     $msg .= "from ${source}: couldn't open '$target_all' for";
@@ -262,7 +265,8 @@ sub Generate_List {
             }
 
             my @all_entries;
-            if (-e $target_all) { # Write entries from all packages
+            if (($target_all) and (-e $target_all)) {
+                # Write entries from all packages
                 @all_entries = <$pkg_all_fh>;
                 close($pkg_all_fh);
             }
@@ -760,16 +764,18 @@ sub Generate_Source {
             my $tmpsection = $changes_data->{'Files'}{$filehr}[2];
             $poolpath = join('/',
                 (PoolBasePath(), PoolDir($source, $tmpsection), $source));
+            my $poolfullpath = "$Options{'archive_dir'}/$poolpath";
             my $sourcedata;
-            my $pattern = $source . "_" . Strip_Epoch($source_version);
-            opendir(my $dh, "$Options{'archive_dir'}/$poolpath");
+            my $pattern = "$poolfullpath/$source" . "_" .
+                Strip_Epoch($source_version);
+            my @testlist = grep(/^\Q$pattern\E(\+b\d+|)\.source$/,
+                glob($poolfullpath . '/*'));
             foreach my $tmp (grep(/^\Q$pattern\E(\+b\d+|)\.source$/,
-                readdir($dh))) {
+                glob($poolfullpath . '/*'))) {
                 $sourcedata =
-                    Parse_File("$Options{'archive_dir'}/$poolpath/$tmp");
+                    Parse_File($tmp);
                 last if ($sourcedata);
             }
-            closedir $dh;
             $section = $sourcedata->{'Section'};
             $priority = $sourcedata->{'Priority'};
             last if (($section) and ($priority));
@@ -922,6 +928,31 @@ sub Strip_Epoch {
     return $version;
 }
 
+# Package_Files($source, $version, $arch)
+# Parameter data types (string, string, string)
+#
+# Finds the .package files in a pool area and returns an array ref with the
+# list of .package files.
+
+sub Get_Package_Files {
+    my ($source, $version, $section, $arch) = @_;
+
+    my $pool = join('/',
+        ($Options{'pool_dir'}, PoolDir($source, $section), $source));
+    my $tmpversion = Strip_Epoch($version);
+    $tmpversion =~ s/(\+b\d+)$//; # in case of binary only uploads
+
+    my $pattern = "$pool/" . "${source}_$tmpversion";
+    my @packagefiles = grep(/^\Q${pattern}_$arch.package\E$/,
+        glob($pool. '/*'));
+    if (!@packagefiles) { # try looking for binary only uploads
+        @packagefiles = grep(/^\Q$pattern\E(\+b\d+|)_$arch\.package$/,
+            glob($pool. '/*'));
+    }
+
+    return \@packagefiles;
+}
+
 END {}
 
 1;

-- 
Debpool Project Repository



More information about the Debpool-commits mailing list