Merge pull request #1544 from CPAN-API/leo/purge_script

script to do purging and little cleanup of Fastly

Author: ranguard

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;