diff --git a/bin/purge.pl b/bin/purge.pl index e69de29bb2..8613490534 100644 --- a/bin/purge.pl +++ b/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 ', + [ '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 + } + ); + +} diff --git a/cpanfile b/cpanfile index 14e0dbac4b..2e674688e9 100644 --- a/cpanfile +++ b/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'; diff --git a/lib/MetaCPAN/Web/Role/Fastly.pm b/lib/MetaCPAN/Web/Role/Fastly.pm index 65828b5b2a..239ca9c38a 100644 --- a/lib/MetaCPAN/Web/Role/Fastly.pm +++ b/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, 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;