script to do purging and little cleanup of Fastly

bin/purge.pl

@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use strict;
+
+# Purge stuff
+
+=head1 NAME
+
+  purge.pl
+
+=head1 SYNOPSIS
+
+  purge.pl --all
+  purge.pl --tag foo --tag bar
+  purge.pl --url '/about/'
+
+=head1 DESCRIPTION
+
+Script to purge things from Fastly CDN.
+
+=cut
+
+use MetaCPAN::Web;
+use Getopt::Long::Descriptive;
+use List::MoreUtils qw(any);
+
+my ( $opt, $usage ) = describe_options(
+    'purge.pl %o <some-arg>',
+    [ 'all=s',    "purge all", ],
+    [ 'tag|t=s@', "tag(s) to purge", ],
+    [ 'url|t=s@', "url(s) to purge", ],
+    [],
+    [ 'help', "print usage message and exit" ],
+);
+
+print( $usage->text ), exit if $opt->help;
+
+my $c = MetaCPAN::Web->new();
+
+if ( $opt->all ) {
+    $c->cdn_purge_all();
+
+}
+else {
+
+    my $tags = $opt->tag;
+    my $urls = $opt->url;
+
+    $c->cdn_purge_now(
+        {
+            tags => $tags,
+            urls => $urls
+        }
+    );
+
+}

cpanfile

@@ -31,6 +31,7 @@ requires 'Encode', '2.51';
 requires 'Exporter';
 requires 'Format::Human::Bytes';
 requires 'File::Path';
+requires 'Getopt::Long::Descriptive';
 requires 'Gravatar::URL';
 requires 'HTML::Escape';
 requires 'HTML::Restrict', '2.2.2';

lib/MetaCPAN/Web/Role/Fastly.pm

@@ -9,6 +9,27 @@ use MetaCPAN::Web::Types qw( ArrayRef Str );
 
 MetaCPAN::Web::Role::Fastly - Methods for fastly intergration
 
+=head1 METHODS
+
+The following:
+
+=head2 $c->add_surrogate_key('foo');
+
+=head2 $c->purge_surrogate_key('bar');
+
+=head2 $c->cdn_cache_ttl(3600);
+
+Are applied when:
+
+=head2 $c->fastly_magic()
+
+   is run in the L<end>, however if
+
+=head2 $c->cdn_never_cache(1)
+
+Is set fastly is forced to NOT cache, no matter
+what other options have been set
+
 =cut
 
 ## Stuff for working with Fastly CDN
@@ -39,6 +60,21 @@ has '_surrogate_keys_to_purge' => (
     },
 );
 
+# How long should the CDN cache, irrespective of
+# other cache headers
+has 'cdn_cache_ttl' => (
+    is      => 'rw',
+    isa     => 'Int',
+    default => sub {0},
+);
+
+# Make sure the CDN NEVER caches, ignore any other cdn_cache_ttl settings
+has 'cdn_never_cache' => (
+    is      => 'rw',
+    isa     => 'Bool',
+    default => sub {0},
+);
+
 sub _net_fastly {
     my $c = shift;
 
@@ -55,28 +91,24 @@ sub _net_fastly {
 sub fastly_magic {
     my $c = shift;
 
-    # Surrogate key caching and purging
-    if ( $c->has_surrogate_keys ) {
-
-        # See http://www.fastly.com/blog/surrogate-keys-part-1/
-        $c->res->header( 'Surrogate-Key' => $c->join_surrogate_keys(' ') );
-    }
-
+    # Some action must have triffered a purge
     if ( $c->has_surrogate_keys_to_purge ) {
 
         # Something changed, means we need to purge some keys
+        my @tags = $c->surrogate_keys_to_purge();
 
-        my $net_fastly = $c->_net_fastly();
-        return unless $net_fastly;
-
-        my $fsi = $c->config->{fastly_service_id};
+        $c->cdn_purge_now(
+            {
+                tags => \@tags,
+            }
+        );
+    }
 
-        foreach my $purge_key ( $c->surrogate_keys_to_purge() ) {
-            my $purge_string
-                = "https://metacpan.org/${fsi}/purge/${purge_key}";
+    # Surrogate key caching and purging
+    if ( $c->has_surrogate_keys ) {
 
-            $net_fastly->purge($purge_string);
-        }
+        # See http://www.fastly.com/blog/surrogate-keys-part-1/
+        $c->res->header( 'Surrogate-Key' => $c->join_surrogate_keys(' ') );
     }
 
     # Set the caching at CDN, seperate to what the user's browser does
@@ -89,6 +121,7 @@ sub fastly_magic {
     }
     elsif ( my $ttl = $c->cdn_cache_ttl ) {
 
+        # TODO: https://www.fastly.com/blog/stale-while-revalidate/
         # Use this value
         $c->res->header( 'Surrogate-Control' => 'max-age=' . $ttl );
 
@@ -101,19 +134,51 @@ sub fastly_magic {
     }
 }
 
-# How long should the CDN cache, irrespective of
-# other cache headers
-has 'cdn_cache_ttl' => (
-    is      => 'rw',
-    isa     => 'Int',
-    default => sub {0},
-);
+=head2 cdn_purge_now
 
-# Make sure the CDN NEVER caches, ignore any other cdn_cache_ttl settings
-has 'cdn_never_cache' => (
-    is      => 'rw',
-    isa     => 'Bool',
-    default => sub {0},
-);
+  $c->cdn_purge_now({
+    tags => [ 'foo', 'bar' ]
+    urls => [ 'this', 'and/that' ],
+  });
+
+=cut
+
+sub cdn_purge_now {
+    my ( $c, $args ) = @_;
+
+    my $net_fastly = $c->_net_fastly();
+    return unless $net_fastly;
+
+    my $fsi = $c->config->{fastly_service_id};
+
+    foreach my $tag ( @{ $args->{tags} || [] } ) {
+        my $purge_string = "https://metacpan.org/${fsi}/purge/${tag}";
+        $net_fastly->purge($purge_string);
+    }
+
+    foreach my $url ( @{ $args->{urls} || [] } ) {
+        my $purge_string = "https://metacpan.org/${url}";
+        $net_fastly->purge($purge_string);
+    }
+}
+
+=head2 cdn_purge_all
+
+  $c->cdn_purge_all()
+
+=cut
+
+sub cdn_purge_all {
+    my $c          = shift;
+    my $net_fastly = $c->_net_fastly();
+
+    die "No access" unless $net_fastly;
+
+    my $fsi = $c->config->{fastly_service_id};
+
+    my $purge_string = "/service/${fsi}/purge_all";
+
+    $net_fastly->purge($purge_string);
+}
 
 1;