Intergrate purging on [re]indexing

metacpan · Nov 10, 2015 · af08377 · af08377
1 parent 1ebe941
commit af08377
Show file tree

Hide file tree

Showing 4 changed files with 46 additions and 6 deletions.
diff --git a/lib/MetaCPAN/Role/Fastly.pm b/lib/MetaCPAN/Role/Fastly.pm
@@ -144,11 +144,7 @@ sub fastly_magic {
             uc $_            #
         } $c->surrogate_keys_to_purge();
 
-        $c->cdn_purge_now(
-            {
-                keys => \@keys,
-            }
-        );
+        $c->cdn_purge_now( { keys => \@keys, } );
     }
 
     # Surrogate key caching and purging
@@ -196,6 +192,23 @@ sub _cdn_get_service {
 
 }
 
+sub cdn_purge_cpan_distnameinfos {
+    my ( $c, $dist_list ) = @_;
+
+    my @purge_keys;
+    foreach my $dist ( @{$dist_list} ) {
+
+        # $dist should be CPAN::DistnameInfo
+        push @purge_keys, $dist->cpanid;    # "GBARR"
+        push @purge_keys, $dist->dist;      # "CPAN-DistnameInfo"
+
+    }
+
+    # Now run with this list
+    $c->cdn_purge_now( { keys => \@purge_keys } );
+
+}
+
 =head2 cdn_purge_now
 
   $c->cdn_purge_now({

diff --git a/lib/MetaCPAN/Role/Script.pm b/lib/MetaCPAN/Role/Script.pm
@@ -12,6 +12,7 @@ use MetaCPAN::Types qw(:all);
 use Moose::Role;
 
 with 'MetaCPAN::Role::Logger';
+with 'MetaCPAN::Role::Fastly';
 
 has 'cpan' => (
     is         => 'rw',

diff --git a/lib/MetaCPAN/Script/Latest.pm b/lib/MetaCPAN/Script/Latest.pm
@@ -96,6 +96,8 @@ sub run {
 
     my $i = 0;
 
+    my @modules_to_purge;
+
     # For each file...
     while ( my $file = $scroll->next ) {
         $i++;
@@ -111,6 +113,8 @@ sub run {
             eval { $p->package($_) }
         } @modules;
 
+        push @modules_to_purge, @modules;
+
         # For each of the packages in this file...
         foreach my $module (@modules) {
 
@@ -165,6 +169,17 @@ sub run {
         $self->reindex( $data, 'cpan' );
     }
     $self->index->refresh;
+
+    # We just want the CPAN::DistnameInfo
+    my @module_to_purge_dists = map { $_->distribution } @modules_to_purge;
+
+    # Call Fastly to purge
+    $self->cdn_purge_cpan_distnameinfos(
+        {
+            keys => \@module_to_purge_dists
+        }
+    );
+
 }
 
 # Update the status for the release and all the files.

diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm
@@ -95,7 +95,8 @@ sub run {
         elsif ( -f $_ ) {
             push( @files, $_ );
         }
-        elsif ( $_ =~ /^https?:\/\// && CPAN::DistnameInfo->new($_)->cpanid )
+        elsif ( $_ =~ /^https?:\/\//
+            && CPAN::DistnameInfo->new($_)->cpanid )
         {
             my $d    = CPAN::DistnameInfo->new($_);
             my $file = $self->home->file(
@@ -126,6 +127,11 @@ sub run {
     log_info { scalar @files, " archives found" } if ( @files > 1 );
 
     # build here before we fork
+
+    # Going to purge everything as not sure about the 'skip' or fork
+    # logic - feel free to clean up so the CP::DistInfo isn't
+    my @module_to_purge_dists = map { CPAN::DistnameInfo->new($_) } @files;
+
     $self->index;
     $self->backpan_index if ( $self->detect_backpan );
     $self->perms;
@@ -169,6 +175,11 @@ sub run {
     }
     waitpid( -1, 0 ) for (@pid);
     $self->index->refresh;
+
+    # Call Fastly to purge
+    $self->cdn_purge_cpan_distnameinfos(
+        { keys => \@module_to_purge_dists } );
+
 }
 
 sub import_archive {