Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
script to do purging and little cleanup of Fastly
  • Loading branch information
ranguard committed Jun 5, 2015
1 parent 4174be8 commit b427329
Show file tree
Hide file tree
Showing 3 changed files with 151 additions and 29 deletions.
56 changes: 56 additions & 0 deletions 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
}
);

}
1 change: 1 addition & 0 deletions cpanfile
Expand Up @@ -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';
Expand Down
123 changes: 94 additions & 29 deletions lib/MetaCPAN/Web/Role/Fastly.pm
Expand Up @@ -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
Expand Down Expand Up @@ -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;

Expand All @@ -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
Expand All @@ -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 );

Expand All @@ -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;

0 comments on commit b427329

Please sign in to comment.