File Coverage

blib/lib/MetaCPAN/Role/Fastly.pm
Criterion Covered Total %
statement 12 45 26.6
branch 0 6 0.0
condition n/a
subroutine 4 11 36.3
pod 4 5 80.0
total 20 67 29.8


line stmt bran cond sub pod time code
1             package MetaCPAN::Role::Fastly;
2             $MetaCPAN::Role::Fastly::VERSION = '0.04';
3             # COPY BELOW HERE INTO MetaCPAN::Role::Fastly
4              
5 1     1   976 use Moose::Role;
  1         371784  
  1         4  
6 1     1   5334 use Net::Fastly 1.05;
  1         152924  
  1         32  
7 1     1   9 use Carp;
  1         14  
  1         62  
8              
9             # For dzil [AutoPreq]
10 1     1   516 use MooseX::Fastly::Role 0.01;
  1         15808  
  1         493  
11              
12             with 'MooseX::Fastly::Role';
13              
14             =head1 NAME
15              
16             MetaCPAN::Role::Fastly - Methods for fastly API intergration
17              
18             =head1 SYNOPSIS
19              
20             use MetaCPAN::Role::Fastly;
21              
22             =head1 DESCRIPTION
23              
24             This role includes L<MooseX::Fastly::Role>.
25              
26             It also adds some purge related methods, you need to call
27             L</perform_purge> to actually do the purges.
28              
29             =head1 METHODS
30              
31             =head2 $self->purge_surrogate_key('BAR');
32              
33             Try to use on of the more specific methods below if possible.
34              
35             =cut
36              
37             =head2 $self->purge_author_key('Ether');
38              
39             =cut
40              
41             sub purge_author_key {
42 0     0 1   my ( $self, $author ) = @_;
43              
44 0           $self->purge_surrogate_key( $self->_format_auth_key($author) );
45             }
46              
47              
48             =head2 $self->purge_dist_key('Moose');
49              
50             =cut
51              
52             sub purge_dist_key {
53 0     0 1   my ( $self, $dist ) = @_;
54              
55 0           $self->purge_surrogate_key( $self->_format_dist_key($dist) );
56             }
57              
58             =head2 $self->purge_cpan_distnameinfos(\@list_of_distnameinfo_objects);
59              
60             Using this array reference of L<CPAN::DistnameInfo> objects,
61             the cpanid and dist name are extracted and used to build a list
62             of keys to purge, the purge happens from within this method.
63              
64             An purge of B<DIST_UPDATES> also happens when this method is called.
65              
66             All other purging requires `finalize` to be implimented so it
67             can be wrapped with a I<before> and called.
68              
69             =cut
70              
71             #cdn_purge_cpan_distnameinfos
72             sub purge_cpan_distnameinfos {
73 0     0 1   my ( $self, $dist_list ) = @_;
74              
75 0           my %purge_keys;
76 0           foreach my $dist ( @{$dist_list} ) {
  0            
77              
78 0 0         croak "Must be CPAN::DistnameInfo"
79             unless $dist->isa('CPAN::DistnameInfo');
80              
81 0           $purge_keys{ $self->_format_auth_key( $dist->cpanid ) } = 1; # "GBARR"
82 0           $purge_keys{ $self->_format_dist_key( $dist->dist ) }
83             = 1; # "CPAN-DistnameInfo"
84              
85             }
86              
87 0           my @unique_to_purge = keys %purge_keys;
88 0           push @unique_to_purge, 'DIST_UPDATES'; # as we have updates some dists!
89              
90 0           $self->purge_surrogate_key(@unique_to_purge);
91              
92 0           $self->perform_purges;
93              
94             }
95              
96             has _surrogate_keys_to_purge => (
97             traits => ['Array'],
98             is => 'ro',
99             isa => 'ArrayRef[Str]',
100             default => sub { [] },
101             handles => {
102             purge_surrogate_key => 'push',
103             has_surrogate_keys_to_purge => 'count',
104             surrogate_keys_to_purge => 'elements',
105             join_surrogate_keys_to_purge => 'join',
106             reset_surrogate_keys => 'clear',
107             },
108             );
109              
110             sub perform_purges {
111 0     0 0   my ($self) = @_;
112              
113             # Some action must have triggered a purge
114 0 0         if ( $self->has_surrogate_keys_to_purge ) {
115              
116             # Something changed, means we need to purge some keys
117 0           my @keys = $self->surrogate_keys_to_purge();
118              
119             log
120              
121 0           $self->cdn_purge_now( { keys => \@keys, } );
122              
123             # Rest
124 0           $self->reset_surrogate_keys();
125             }
126              
127             # Needed for MC tests!
128 0           return 1;
129              
130             }
131              
132             =head2 datacenters()
133              
134             =cut
135              
136             sub datacenters {
137 0     0 1   my ($self) = @_;
138 0           my $net_fastly = $self->cdn_api();
139 0 0         return unless $net_fastly;
140              
141             # Uses the private interface as fastly client doesn't
142             # have this end point yet
143 0           my $datacenters = $net_fastly->client->_get('/datacenters');
144 0           return $datacenters;
145             }
146              
147             sub _format_dist_key {
148 0     0     my ( $self, $dist ) = @_;
149              
150 0           $dist = uc($dist);
151 0           $dist =~ s/:/-/g; #
152              
153 0           return 'dist=' . $dist;
154             }
155              
156             sub _format_auth_key {
157 0     0     my ( $self, $author ) = @_;
158              
159 0           $author = uc($author);
160 0           return 'author=' . $author;
161             }
162              
163             1;