File Coverage

blib/lib/Net/Fastly.pm
Criterion Covered Total %
statement 41 210 19.5
branch 6 54 11.1
condition 3 21 14.2
subroutine 9 28 32.1
pod 14 14 100.0
total 73 327 22.3


line stmt bran cond sub pod time code
1             package Net::Fastly;
2              
3 4     4   73310 use strict;
  4         6  
  4         99  
4 4     4   16 use warnings;
  4         7  
  4         110  
5              
6 4     4   1562 use Net::Fastly::Client;
  4         9  
  4         147  
7 4     4   1386 use Net::Fastly::Invoice;
  4         7  
  4         19  
8 4     4   1343 use Net::Fastly::Settings;
  4         8  
  4         17  
9              
10             our $VERSION = "1.08";
11              
12             BEGIN {
13 4     4   155 no strict 'refs';
  4         5  
  4         543  
14 4     4   16 our @CLASSES = qw(Net::Fastly::User Net::Fastly::Customer
15             Net::Fastly::Backend Net::Fastly::Director
16             Net::Fastly::Domain Net::Fastly::Healthcheck
17             Net::Fastly::Match Net::Fastly::Origin
18             Net::Fastly::Service Net::Fastly::Syslog
19             Net::Fastly::VCL Net::Fastly::Version
20             Net::Fastly::Condition);
21              
22 4         9 foreach my $class (@CLASSES) {
23 52         89 my $file = $class . '.pm';
24 52         128 $file =~ s{::}{/}g;
25 52         16029 CORE::require($file);
26 52         236 $class->import;
27            
28 52         365 my $name = $class->_path;
29            
30 52         68 foreach my $method (qw(get create update delete list)) {
31 260         417 my $code = "sub { shift->_$method('$class', \@_) }";
32 260         236 my $glob = "${method}_${name}";
33 260 100       379 $glob .= "s" if $method eq 'list';
34             # don't create this if it's a list and something isn't listable ...
35 260 50 66     563 next if $method eq 'list' && $class->_skip_list;
36             # or if it already exists (i.e it's been overidden)
37 260 100       791 next if defined *$glob;
38 256     0   11417 *$glob = eval "$code";
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
39             }
40             }
41             };
42              
43             =head1 NAME
44              
45             Net::Fastly - client library for interacting with the Fastly web acceleration service
46              
47             =head1 SYNOPSIS
48              
49             use Net::Fastly;
50              
51             my $fastly = Net::Fastly->new(%login_opts);
52            
53             my $current_user = $fastly->current_user;
54             my $current_customer = $fastly->current_customer;
55            
56             my $user = $fastly->get_user($current_user->id);
57             my $customer = $fastly->get_customer($current_customer->id);
58            
59             print "Name: ".$user->name."\n";
60             print "Works for ".$user->customer->name."\n";
61             print "Which is the same as ".$customer->name."\n";
62             print "Which has the owner ".$customer->owner->name."\n";
63            
64             # Let's see which services we have defined
65             foreach my $service ($fastly->list_services) {
66             print $service->name." (".$service->id.")\n";
67             foreach my $version ($service->versions) {
68             print "\t".$version->number."\n";
69             }
70             }
71            
72             my $service = $fastly->create_service(name => "MyFirstService");
73             my $latest_version = $service->version;
74            
75             # Create a domain and a backend for the service ...
76             my $domain = $fastly->create_domain(service_id => $service->id, version => $latest_version->number, name => "www.example.com");
77             my $backend = $fastly->create_backend(service_id => $service->id, version => $latest_version->number, ipv4 => "127.0.0.1", port => 80);
78            
79             # ... and activate it. You're now hosted on Fastly.
80             $latest_version->activate;
81            
82             # Let's take a peek at the VCL that Fastly generated for us
83             my $vcl = $latest_version->generated_vcl;
84             print "Generated VCL file is:\n".$vcl->content."\n";
85            
86             # Now let's create a new version ...
87             my $new_version = $latest_version->clone;
88             # ... add a new backend ...
89             my $new_backend = $fastly->create_backend(service_id => $service->id, version => $new_version->number, ipv4 => "192.0.0.1", port => 8080);
90             # ... and upload some custome vcl (presuming we have permissions)
91             $new_version->upload_vcl($vcl_name, slurp($vcl_file));
92            
93             $new_version->activate;
94              
95             # Purging
96             $fastly->purge('http://www.example.com'); # regular purge
97             $fastly->purge('http://www.example.com', 1); # 'soft' purge (see note below)
98             $service->purge_by_key('article-1'); # purge by surrogate key, note this works on $service
99             $service->purge_by_key('article-1', 1); # 'soft' purge by surrogate key
100             $service->purge_all; # use with caution!
101              
102             =head1 DESCRIPTION
103              
104             =head1 METHODS
105              
106             =cut
107              
108              
109             =head2 new
110              
111             Create a new Fastly client. Options are
112              
113             =over 4
114              
115             =item user - your Fastly login
116              
117             =item password - your Fastly password
118              
119             =item api_key - your Fastly api key
120              
121             =back
122              
123             You only need to pass in C OR C and C.
124              
125             Some methods require full username and password rather than just auth token.
126              
127             =cut
128             sub new {
129 1     1 1 55 my $class = shift;
130 1         2 my %opts = @_;
131 1         9 my ($client, $user, $customer) = Net::Fastly::Client->new(%opts);
132 1         10 my $self = bless { _client => $client, _current_customer => undef, _current_user => undef}, $class;
133 1 50 33     6 if ($user && $customer) {
134 0         0 $self->{_current_user} = Net::Fastly::User->new($self, %$user);
135 0         0 $self->{_current_customer} = Net::Fastly::Customer->new($self, %$customer);
136             }
137 1         9 return $self;
138             }
139              
140             =head2 client
141              
142             Get the current Net::Fastly::Client
143              
144             =cut
145 0     0 1   sub client { shift->{_client} }
146              
147             =head2 set_customer
148              
149             Set the current customer to act as.
150              
151             B: this will only work if you're an admin
152              
153             =cut
154             sub set_customer {
155 0     0 1   my $self = shift;
156 0           my $id = shift;
157 0 0         die "You must be fully authed to set the customer" unless $self->fully_authed;
158 0 0         die "You must be an admin to set the customer" unless $self->current_user->can_do('admin');
159 0           delete $self->{_current_customer};
160 0           $self->client->set_customer($id);
161             }
162              
163             =head2 authed
164              
165             Whether or not we're authed at all by either username & password or API key
166              
167             =cut
168 0     0 1   sub authed { shift->client->authed }
169              
170             =head2 fully_authed
171              
172             Whether or not we're fully (username and password) authed
173              
174             =cut
175 0     0 1   sub fully_authed { shift->client->fully_authed }
176              
177             =head2 current_user
178              
179             Return a User object representing the current logged in user.
180              
181             This will not work if you're logged in with an API key.
182              
183             =cut
184             sub current_user {
185 0     0 1   my $self = shift;
186 0 0         die "You must be fully authed to get the current user" unless $self->fully_authed;
187 0   0       $self->{_current_user} ||= $self->_get("Net::Fastly::User");
188             }
189              
190             =head2 current_customer
191              
192             Return a Customer object representing the customer of the current logged in user.
193              
194             =cut
195             sub current_customer {
196 0     0 1   my $self = shift;
197 0 0         die "You must be authed to get the current customer" unless $self->authed;
198 0   0       $self->{_current_customer} ||= $self->_get("Net::Fastly::Customer");
199             }
200              
201             =head2 commands
202              
203             Return a hash representing all commands available.
204              
205             Useful for information.
206              
207             =cut
208             sub commands {
209 0     0 1   my $self = shift;
210 0 0         return $self->{__cache_commands} if ($self->{__cache_commands});
211 0           return eval { $self->{__cache_commands} = $self->client->_get('/commands') };
  0            
212             }
213              
214             =head2 purge [soft]
215              
216             Purge the specified path from your cache.
217              
218             You can optionally pass in a true value to enable "soft" purging e.g
219              
220             $fastly->purge($url, 1);
221              
222             See L
223              
224             Previously purging made an API call to the C endpoint of the Fastly API.
225              
226             The new method of purging is done by making an HTTP request against the URL using the C HTTP method.
227              
228             This module now uses the new method. The old method can be used by passing the C into the constructor.
229              
230             my $fastly = Net::Fastly->new(%login_opts, use_old_purge_method => 1);
231              
232             =cut
233             sub purge {
234 0     0 1   my $self = shift;
235 0           my $url = shift;
236 0           my $soft = shift;
237 0           $self->client->_purge($url, headers => { 'Fastly-Soft-Purge' => $soft });
238             }
239              
240             =head2 stats [opt[s]]
241              
242             Fetches historical stats for each of your fastly services and groups the results by service id.
243              
244             If you pass in a C opt then fetches only the specified field.
245              
246             If you pass in a C opt then fetches only the specified service.
247              
248             The C and C opts can be combined.
249              
250             If you pass in an C flag then fetches historical stats information aggregated across all of your Fastly services. This cannot be combined with C and C.
251              
252             Other options available are:
253              
254             =over 4
255              
256             =item from & to
257              
258             =item by
259              
260             =item region
261              
262             =back
263              
264             See http://docs.fastly.com/docs/stats for details.
265              
266             =cut
267             sub stats {
268 0     0 1   my $self = shift;
269 0           my %opts = @_;
270            
271 0 0 0       die "You can't specify a field or a service for an aggregate request" if $opts{aggregate} && ($opts{field} || $opts{service});
      0        
272            
273 0           my $url = "/stats";
274              
275 0 0         if (delete $opts{aggregate}) {
276 0           $url .= "/aggregate";
277             }
278            
279 0 0         if (my $service = delete $opts{service}) {
280 0           $url .= "/service/$service";
281             }
282            
283 0 0         if (my $field = delete $opts{field}) {
284 0           $url .= "/field/$field";
285             }
286            
287 0           $self->client->_get_stats($url, %opts);
288             }
289              
290              
291             =head2 usage [opt[s]]
292              
293             Returns usage information aggregated across all Fastly services and grouped by region.
294              
295             If the C flag is passed then teturns usage information aggregated by service and grouped by service & region.
296              
297             Other options available are:
298              
299             =over 4
300              
301             =item from & to
302              
303             =item by
304              
305             =item region
306              
307             =back
308              
309             See http://docs.fastly.com/docs/stats for details.
310              
311             =cut
312             sub usage {
313 0     0 1   my $self = shift;
314 0           my %opts = @_;
315            
316 0           my $url = "/stats/usage";
317 0 0         $url .= "_by_service" if delete $opts{by_service};
318            
319 0           $self->client->_get_stats($url, %opts);
320             }
321              
322              
323             =head2 regions
324              
325             Fetches the list of codes for regions that are covered by the Fastly CDN service.
326              
327             =cut
328             sub regions {
329 0     0 1   my $self = shift;
330 0           $self->client->_get_stats("/stats/regions");
331             }
332              
333              
334             =head2 create_user
335              
336             =head2 create_customer
337              
338             =head2 create_service
339              
340             =head2 create_version service_id => , [opts]
341              
342             =head2 create_backend service_id => , version => , name =>
343              
344             =head2 create_director service_id => , version => , name =>
345              
346             =head2 create_domain service_id => , version => , name =>
347              
348             =head2 create_healthcheck service_id => , version => , name =>
349              
350             =head2 create_match service_id => , version => , name =>
351              
352             =head2 create_origin service_id => , version => , name =>
353              
354             =head2 create_syslog service_id => , version => , name =>
355              
356             =head2 create_vcl service_id => , version => , name =>
357              
358             =head2 create_condition service_id => , version => , name =>
359              
360             Create new objects.
361              
362             =cut
363              
364             =head2 get_user
365              
366             =head2 get_customer
367              
368             =head2 get_service
369              
370             =head2 get_version
371              
372             =head2 get_backend
373              
374             =head2 get_director
375              
376             =head2 get_domain
377              
378             =head2 get_healthcheck
379              
380             =head2 get_invoice [ ]
381              
382             Return a Net::Fastly::Invoice objects representing an invoice for all services.
383              
384             If a year and month are passed in returns the invoice for that whole month.
385              
386             Otherwise it returns the invoices for the current month to date.
387              
388             =head2 get_match
389              
390             =head2 get_origin
391              
392             =head2 get_syslog
393              
394             =head2 get_vcl
395              
396             =head2 get_version
397              
398             =head2 get_settings
399              
400             =head2 get_condition
401              
402             Get existing objects.
403              
404             =cut
405              
406              
407             =head2 update_user
408              
409             =head2 update_customer
410              
411             =head2 update_service
412              
413             =head2 update_version
414              
415             =head2 update_backend
416              
417             =head2 update_director
418              
419             =head2 update_domain
420              
421             =head2 update_healthcheck
422              
423             =head2 update_match
424              
425             =head2 update_origin
426              
427             =head2 update_syslog
428              
429             =head2 update_vcl
430              
431             =head2 update_version
432              
433             =head2 update_settings
434              
435             =head2 update_condition
436              
437             Update existing objects.
438              
439             Note - you can also do
440              
441             $obj->save;
442              
443             =cut
444              
445              
446             =head2 delete_user
447              
448             =head2 delete_customer
449              
450             =head2 delete_service
451              
452             =head2 delete_version
453              
454             =head2 delete_backend
455              
456             =head2 delete_director
457              
458             =head2 delete_domain
459              
460             =head2 delete_healthcheck
461              
462             =head2 delete_match
463              
464             =head2 delete_origin
465              
466             =head2 delete_syslog
467              
468             =head2 delete_vcl
469              
470             =head2 delete_version
471              
472             =head2 delete_condition
473              
474             Delete existing objects.
475              
476             Note - you can also do
477              
478             $obj->delete
479              
480             =cut
481              
482              
483              
484             =head2 list_users
485              
486             =head2 list_customers
487              
488             =head2 list_versions
489              
490             =head2 list_services
491              
492             =head2 list_backends
493              
494             =head2 list_directors
495              
496             =head2 list_domains
497              
498             =head2 list_healthchecks
499              
500             =head2 list_matchs
501              
502             =head2 list_origins
503              
504             =head2 list_syslogs
505              
506             =head2 list_vcls
507              
508             =head2 list_versions
509              
510             =head2 list_conditions
511              
512             Get a list of all objects
513              
514             =head2 search_services
515              
516             Search all the services that the current customer has.
517              
518             In general you'll want to do
519              
520             my @services = $fastly->search_services(name => $name);
521              
522             or
523              
524             my ($service) = $fastly->search_services(name => $name, version => $number);
525              
526             =cut
527              
528 4     4   17 use Carp;
  4         5  
  4         2659  
529             sub _list {
530 0     0     my $self = shift;
531 0           my $class = shift;
532 0           my %opts = @_;
533 0           my $list = $self->client->_get($class->_list_path(%opts), %opts);
534 0 0         return () unless $list;
535 0           return map { $class->new($self, %$_) } @$list;
  0            
536             }
537              
538             sub _get {
539 0     0     my $self = shift;
540 0           my $class = shift;
541 0           my $hash;
542 0 0         if (@_) {
543 0           $hash = $self->client->_get($class->_get_path(@_));
544             } else {
545 0           $hash = $self->client->_get("/current_".$class->_path);
546             }
547 0 0         return undef unless $hash;
548 0           return $class->new($self, %$hash);
549             }
550              
551             sub _create {
552 0     0     my $self = shift;
553 0           my $class = shift;
554 0           my %args = @_;
555 0           my $hash = $self->client->_post($class->_post_path(%args), %args);
556 0           return $class->new($self, %$hash);
557             }
558              
559             sub _update {
560 0     0     my $self = shift;
561 0           my $class = shift;
562 0           my $obj = shift;
563 0           my %fds = $obj->_as_hash;
564 0           my $hash = $self->client->_put($class->_put_path($obj), map { $_ => $fds{$_} } grep { $_ !~ m/^(service_id|version)$/ } keys %fds);
  0            
  0            
565 0           return $class->new($self, %$hash);
566             }
567              
568             sub _delete {
569 0     0     my $self = shift;
570 0           my $class = shift;
571 0           my $obj = shift;
572 0 0         $obj = bless $obj, $class if 'HASH' eq ref($obj);
573 0           return defined $self->client->_delete($class->_delete_path($obj));
574             }
575              
576              
577             =head1 CLASS METHODS
578              
579             =head2 load_options
580              
581             Attempts to load various config options in the form
582              
583             =
584            
585             From a file.
586              
587             Skips whitespace and lines starting with C<#>.
588              
589             =cut
590              
591             sub load_options {
592 0     0 1   my $file = shift;
593 0           my %options = ();
594 0 0         return %options unless -f $file;
595              
596 0 0         open(my $fh, $file) || die "Couldn't open $file: $!\n";
597 0           while (<$fh>) {
598 0           chomp;
599 0 0         next if /^#/;
600 0 0         next if /^\s*$/;
601 0 0         next unless /=/;
602 0           s/(^\s*|\s*$)//g;
603 0           my ($key, $val) = split /\s*=\s*/, $_, 2;
604 0           $options{$key} = $val;
605             }
606 0           close($fh);
607 0           return %options;
608             }
609              
610             =head2 get_options
611              
612             Tries to load options from the file[s] passed in using,
613             C, stopping when it finds the first one.
614              
615             Then it overrides those options with command line options
616             of the form
617              
618             --=
619              
620             =cut
621             sub get_options {
622 0     0 1   my @configs = @_;
623 0           my %options;
624 0           foreach my $config (@configs) {
625 0 0         next unless -f $config;
626 0           %options = load_options($config);
627 0           last;
628             }
629 0   0       while (@ARGV && $ARGV[0] =~ m!^-+(\w+)\=(.+)$!) {
630 0 0         if ($1 eq "config") {
631 0 0         die "No such file '$2'" unless -f $2;
632 0           my %tmp = load_options($2);
633 0           $options{$_} = $tmp{$_} for keys %tmp;
634             } else {
635 0           $options{$1} = $2;
636             }
637 0           shift @ARGV;
638             }
639 0 0         die "Couldn't find options from command line arguments or ".join(", ", @configs)."\n" unless keys %options;
640 0           return %options;
641             }
642              
643             =head1 COPYRIGHT
644              
645             Copyright 2011 - Fastly Inc
646              
647             Distributed under the same terms as Perl itself.
648              
649             =head1 SUPPORT
650              
651             Mail support at fastly dot com if you have problems.
652              
653             =head1 DEVELOPERS
654              
655             http://github.com/fastly/fastly-perl
656              
657             http://www.fastly.com/documentation
658              
659             =cut
660             1;