Allow archive file args to pgxn_maint reindex.

Add the ability to pass the path to a zip archive to `pgxn_maint index`. Previously, you had to pass a distribution name and release version (and you still can), but that required that one manually place the archive where the existing one is, first. This is cleaner, as now `pgxn_maint` will process the file from wherever you have it and put it where it belongs.
pgxn · Aug 29, 2015 · d3d1891 · d3d1891
1 parent 0f19719
commit d3d1891
Show file tree

Hide file tree

Showing 6 changed files with 119 additions and 24 deletions.
diff --git a/Changes b/Changes
@@ -13,6 +13,12 @@ Revision history for Perl extension PGXN::Manager
        - Fixed pgxn_maint so that reindexing failures are reported on the
          command- line and the exit value set to the number of failures.
          Previously it would fail silently.
+       - Added the ability to pass the path to a zip archive to `pgxn_maint
+         index`. Previously, you had to pass a distribution name and release
+         version (and you still can), but that required that one manually
+         place the archive where the existing one is, first. This is cleaner,
+         as now `pgxn_maint` will process the file from wherever you have it
+         and put it where it belongs.
 
 0.15.0  2013-06-19T06:18:45Z
        - Silenced Net::Twitter::Lite warnings by disabling the legacy lists

diff --git a/bin/pgxn_maint b/bin/pgxn_maint
@@ -64,12 +64,13 @@ configuration file.
 =head3 C<reindex>
 
   pgxn_maint reindex pair 0.1.1
+  pgxn_maint reindex /tmp/pair-0.1.1.zip
 
-Reindexes one or more releases of distributions. Specify distribution name and
-version pairs. Most useful if you need to reindex a specific version of a
-distribution or three, like so:
+Reindexes one or more releases of distributions. Specify paths to archive
+files or distribution name and version pairs. Most useful if you need to
+reindex a specific version of a distribution or three, like so:
 
-  pgxn_maint reindex pair 0.1.1 pair 0.1.2 pgTAP 0.25.0
+  pgxn_maint reindex pair 0.1.1 pair 0.1.2 /tmp/pgTAP-0.25.0.zip
 
 If you need to reindex all versions of a given distribution, or all
 distributions (yikes!), use C<reindex-all>, instead.

diff --git a/lib/PGXN/Manager/Distribution.pm b/lib/PGXN/Manager/Distribution.pm
@@ -35,7 +35,7 @@ Archive::Zip::setErrorHandler(\&_zip_error_handler);
 
 has archive  => (is => 'ro', required => 1, isa => 'Str');
 has basename => (is => 'ro', required => 1, isa => 'Str');
-has creator  => (is => 'ro', required => 1, isa => 'Str');
+has creator  => (is => 'rw', required => 1, isa => 'Str');
 has error    => (is => 'rw', required => 0, isa => 'ArrayRef', auto_deref => 1);
 has zip      => (is => 'rw', required => 0, isa => 'Archive::Zip');
 has metamemb => (is => 'rw', required => 0, isa => 'Archive::Zip::FileMember');
@@ -77,8 +77,19 @@ sub reindex {
     return $self->reindexit;
 }
 
+sub extract_meta {
+    my $self = shift;
+
+    # 1. Unpack distro.
+    $self->extract or return;
+
+    # 2. Process its META.json.
+    return $self->read_meta;
+}
+
 sub extract {
-    my $self   = shift;
+    my $self = shift;
+    return $self if $self->zip;
 
     # Set up the working directory.
     my $workdir = $self->workdir;
@@ -122,8 +133,10 @@ sub extract {
 }
 
 sub read_meta {
-    my $self    = shift;
-    my $zip     = $self->zip;
+    my $self = shift;
+    return $self if $self->distmeta;
+
+    my $zip  = $self->zip;
 
     my ($member) = $zip->membersMatching($META_RE);
     unless ($member) {
@@ -519,6 +532,17 @@ Loads and parses the archive's C<META.json> file. If the file does not exist
 or cannot be parsed, C<read_meta> stores an error message in C<erro> and
 returns false.
 
+=head3 C<extract_meta>
+
+Extract the archive and reads its C<META.json> file. Basically just a
+convenience method for:
+
+  $dist->extract;
+  $dist->read_meta;
+
+In the event of an error, C<extract_meta> stores the error message in C<error>
+and returns false.
+
 =head3 C<normalize>
 
   $dist->normalize or die $dist->localized_error;

diff --git a/lib/PGXN/Manager/Maint.pm b/lib/PGXN/Manager/Maint.pm
@@ -110,21 +110,46 @@ sub reindex {
             'SELECT creator FROM distributions WHERE name = ? AND version = ?'
         );
         while (@args) {
-            my ($name, $version) = (lc shift @args, lc shift @args);
+            my ($dist, $fn, $name, $version);
+            if (-e $args[0]) {
+                # It's likely a file name. Parse for dist name and version.
+                $fn = shift @args;
+                $dist = PGXN::Manager::Distribution->new(
+                    archive  => $fn,
+                    basename => basename($fn),
+                    creator  => '',
+                );
+                unless ($dist->extract_meta) {
+                    warn $dist->error;
+                    $self->exitval( $self->exitval + 1 );
+                    next;
+                }
+
+                my $meta = $dist->distmeta;
+                $name    = $meta->{name};
+                $version = $meta->{version};
+            } else {
+                # Mostly likely name and version.
+                ($name, $version) = (lc shift @args, lc shift @args);
+                my $uri = $tmpl->process( dist => $name, version => $version );
+                $fn = File::Spec->catfile($root, $uri->path_segments);
+                $dist = PGXN::Manager::Distribution->new(
+                    archive  => $fn,
+                    basename => basename($fn),
+                    creator  => '',
+                );
+            }
+
+            # Find the user who uploaded it.
             my ($user) = $dbh->selectrow_array($sth, undef, $name, $version);
             unless ($user) {
                 warn "$name $version is not a known release\n";
                 $self->exitval( $self->exitval + 1 );
                 next;
             }
 
-            my $uri = $tmpl->process( dist => $name, version => $version );
-            my $fn  = File::Spec->catfile($root, $uri->path_segments);
-            my $dist = PGXN::Manager::Distribution->new(
-                archive  => $fn,
-                basename => basename($fn),
-                creator  => $user,
-            );
+            # Do the work.
+            $dist->creator($user);
             unless ($dist->reindex) {
                 warn $dist->error;
                 $self->exitval( $self->exitval + 1 );
@@ -332,12 +357,13 @@ configuration file.
 =head3 C<reindex>
 
   $maint->reindex(@dists_and_versions)
+  $maint->reindex(@archives)
 
 Reindexes one or more releases of distributions. Pass in distribution name and
-version pairs. Most useful if you need to reindex a specific version of a
-distribution or three, like so:
+version pairs or paths to archives. Most useful if you need to reindex a
+specific version of a distribution or three, like so:
 
-  $maint->reindex(pair => '0.1.1', pair => '0.1.2', pgTAP => '0.25.0');
+  $maint->reindex(pair => '0.1.1', pair => '0.1.2', '/tmp/pgTAP-0.25.0.zip');
 
 If you need to reindex all versions of a given distribution, or all
 distributions (yikes!), use C<reindex_all>, instead.

diff --git a/t/maint.t b/t/maint.t
@@ -2,14 +2,15 @@
 
 use 5.10.0;
 use utf8;
-use Test::More tests => 103;
+use Test::More tests => 113;
 #use Test::More 'no_plan';
 use Test::File;
 use File::Path qw(remove_tree);
 use File::Basename qw(basename);
 use Test::MockModule;
 use Test::File::Contents;
 use JSON::XS;
+use Archive::Zip qw(:ERROR_CODES);
 use lib 't/lib';
 use TxnTest;
 
@@ -36,10 +37,18 @@ can_ok $CLASS => qw(
     _config
 );
 
-my $tmpdir = File::Spec->catdir(File::Spec->tmpdir, 'pgxn');
-my $root   = PGXN::Manager->new->config->{mirror_root};
+my $tmpdir  = File::Spec->catdir(File::Spec->tmpdir, 'pgxn');
+my $root    = PGXN::Manager->new->config->{mirror_root};
+my $distdir = File::Spec->catdir(qw(t dist widget));
+my $distzip = File::Spec->catdir(qw(t dist widget-0.2.5.zip));
+
+# Create a distribution.
+my $dzip = Archive::Zip->new;
+$dzip->addTree($distdir, 'widget-0.2.5') == AZ_OK or die 'tree error';
+$dzip->writeToFileNamed($distzip) == AZ_OK or die 'write error';
 
 END {
+    unlink $distzip;
     remove_tree $tmpdir, $root;
 }
 
@@ -206,6 +215,23 @@ PGXN::Manager->instance->conn->run(sub {
         "provides": { "bar": { "version": "0.3.2", "abstract": "whatever", "file": "bar.sql" } }
     }'
     );
+
+    $dbh->do(
+        'SELECT * FROM add_distribution(?, ?, ?)',
+        undef, $user, 'widget',
+        '{
+        "name":        "widget",
+        "version":     "0.2.5",
+        "license":     "postgresql",
+        "maintainer":  "freddy",
+        "abstract":    "widgets and sprockets",
+        "meta-spec": {
+           "version": "1.0.0",
+           "url": "http://pgxn.org/meta/spec.txt"
+        },
+        "provides": { "widget": { "version": "0.2.5", "abstract": "widgety", "file": "widget.sql" } }
+    }'
+    );
 });
 
 ##############################################################################
@@ -239,6 +265,17 @@ REINDEX: {
     ok $maint->reindex('pair', '0.0.1'), 'Reindex pair 0.0.1';
     is $maint->exitval, 0, 'Exit val should be 0';
 
+    # Try indexing with file.
+    $mocker->mock(reindex => sub {
+        my $dist = shift;
+        pass 'Distribution->reindex should be called again';
+        is $dist->archive, $distzip, 'Dist should have specified archive';
+        is $dist->basename, 'widget-0.2.5.zip', 'Dist basename should be "widget-0.2.5"';
+        is $dist->creator, $user, 'Dist should have user as creator';
+    });
+    ok $maint->reindex($distzip), 'Reindex widget 0.2.5';
+    is $maint->exitval, 0, 'Exit val should be 0';
+
     # Reindex two different distributions.
     my $zip2 = File::Spec->catfile($root, qw(dist foo 0.0.2 foo-0.0.2.zip));
     my @exp = ($zip, $zip2);
@@ -290,10 +327,11 @@ REINDEX: {
     my $zip2 = File::Spec->catfile($root, qw(dist foo 0.0.2 foo-0.0.2.zip));
     my $zip3 = File::Spec->catfile($root, qw(dist pair 0.0.2 pair-0.0.2.zip));
     my $zip4 = File::Spec->catfile($root, qw(dist pair 0.0.1 pair-0.0.1.zip));
+    my $zip5 = File::Spec->catfile($root, qw(dist widget 0.2.5 widget-0.2.5.zip));
 
     # Reindex *everything*.
     my $mocker = Test::MockModule->new('PGXN::Manager::Distribution');
-    my @exp = ($zip1, $zip2, $zip3, $zip4);
+    my @exp = ($zip1, $zip2, $zip3, $zip4, $zip5);
     $mocker->mock(reindex => sub {
         my $dist = shift;
         pass 'Distribution->reindex should be called';

diff --git a/t/moderate.t b/t/moderate.t
@@ -680,7 +680,7 @@ test_psgi +PGXN::Manager::Router->app => sub {
         'To header should be set';
     is $email->get_body, q{I'm sorry to report that your request for a PGXN account has been
 rejected. If you think there has been an error, please reply to this
-message
+message.
 
 Best,