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

package Net::Fastly;

use strict;
use warnings;

use Net::Fastly::Client;
use Net::Fastly::Invoice;
use Net::Fastly::Settings;

our $VERSION = "1.08";

BEGIN {
  no strict 'refs';
  our @CLASSES = qw(Net::Fastly::User     Net::Fastly::Customer
                    Net::Fastly::Backend  Net::Fastly::Director
                    Net::Fastly::Domain   Net::Fastly::Healthcheck
                    Net::Fastly::Match    Net::Fastly::Origin
                    Net::Fastly::Service  Net::Fastly::Syslog
                    Net::Fastly::VCL      Net::Fastly::Version
                    Net::Fastly::Condition);

  foreach my $class (@CLASSES) {
    my $file = $class . '.pm';
    $file =~ s{::}{/}g;
    CORE::require($file);
    $class->import;

    my $name = $class->_path;

    foreach my $method (qw(get create update delete list)) {
        my $code = "sub { shift->_$method('$class', \@_) }";
        my $glob = "${method}_${name}";
        $glob .= "s" if $method eq 'list';
        # don't create this if it's a list and something isn't listable ...
        next if $method eq 'list' && $class->_skip_list;
        # or if it already exists (i.e it's been overidden)
        next if defined *$glob;
        *$glob = eval "$code";
    }
  }
};

=head1 NAME

Net::Fastly - client library for interacting with the Fastly web acceleration service

=head1 SYNOPSIS

    use Net::Fastly;

    my $fastly = Net::Fastly->new(%login_opts);

    my $current_user     = $fastly->current_user;
    my $current_customer = $fastly->current_customer;

    my $user     = $fastly->get_user($current_user->id);
    my $customer = $fastly->get_customer($current_customer->id);

    print "Name: ".$user->name."\n";
    print "Works for ".$user->customer->name."\n";
    print "Which is the same as ".$customer->name."\n";
    print "Which has the owner ".$customer->owner->name."\n";

    # Let's see which services we have defined
    foreach my $service ($fastly->list_services) {
        print $service->name." (".$service->id.")\n";
        foreach my $version ($service->versions) {
            print "\t".$version->number."\n";
        }
    }

    my $service        = $fastly->create_service(name => "MyFirstService");
    my $latest_version = $service->version;

    # Create a domain and a backend for the service ...
    my $domain         = $fastly->create_domain(service_id => $service->id, version => $latest_version->number, name => "www.example.com");
    my $backend        = $fastly->create_backend(service_id => $service->id, version => $latest_version->number, ipv4 => "127.0.0.1", port => 80);

    # ... and activate it. You're now hosted on Fastly.
    $latest_version->activate;

    # Let's take a peek at the VCL that Fastly generated for us
    my $vcl = $latest_version->generated_vcl;
    print "Generated VCL file is:\n".$vcl->content."\n";

    # Now let's create a new version ...
    my $new_version    = $latest_version->clone;
    # ... add a new backend ...
    my $new_backend    = $fastly->create_backend(service_id => $service->id, version => $new_version->number, ipv4 => "192.0.0.1", port => 8080);
    # ... and upload some custome vcl (presuming we have permissions)
    $new_version->upload_vcl($vcl_name, slurp($vcl_file));

    $new_version->activate;

    # Purging
    $fastly->purge('http://www.example.com');    # regular purge
    $fastly->purge('http://www.example.com', 1); # 'soft' purge (see note below)
    $service->purge_by_key('article-1');         # purge by surrogate key, note this works on $service
    $service->purge_by_key('article-1', 1);      # 'soft' purge by surrogate key
    $service->purge_all;                         # use with caution!

=head1 DESCRIPTION

=head1 METHODS

=cut


=head2 new

Create a new Fastly client. Options are

=over 4

=item user - your Fastly login

=item password - your Fastly password

=item api_key - your Fastly api key

=back

You only need to pass in C OR C and C.

Some methods require full username and password rather than just auth token.

=cut
sub new {
    my $class = shift;
    my %opts  = @_;
    my ($client, $user, $customer) = Net::Fastly::Client->new(%opts);
    my $self  = bless { _client =>  $client, _current_customer => undef, _current_user => undef}, $class;
    if ($user && $customer) {
        $self->{_current_user}     =  Net::Fastly::User->new($self, %$user);
        $self->{_current_customer} =  Net::Fastly::Customer->new($self, %$customer);
    }
    return $self;
}

=head2 client

Get the current Net::Fastly::Client

=cut
sub client { shift->{_client} }

=head2 set_customer

Set the current customer to act as.

B: this will only work if you're an admin

=cut
sub set_customer {
    my $self = shift;
    my $id   = shift;
    die "You must be fully authed to set the customer" unless $self->fully_authed;
    die "You must be an admin to set the customer" unless $self->current_user->can_do('admin');
    delete $self->{_current_customer};
    $self->client->set_customer($id);
}

=head2 authed

Whether or not we're authed at all by either username & password or API key

=cut
sub authed { shift->client->authed }

=head2 fully_authed

Whether or not we're fully (username and password) authed

=cut
sub fully_authed { shift->client->fully_authed }

=head2 current_user

Return a User object representing the current logged in user.

This will not work if you're logged in with an API key.

=cut
sub current_user {
    my $self = shift;
    die "You must be fully authed to get the current user" unless $self->fully_authed;
    $self->{_current_user} ||= $self->_get("Net::Fastly::User");
}

=head2 current_customer

Return a Customer object representing the customer of the current logged in user.

=cut
sub current_customer {
    my $self = shift;
    die "You must be authed to get the current customer" unless $self->authed;
    $self->{_current_customer} ||= $self->_get("Net::Fastly::Customer");
}

=head2 commands

Return a hash representing all commands available.

Useful for information.

=cut
sub commands {
    my $self     = shift;
    return $self->{__cache_commands} if ($self->{__cache_commands});
    return eval { $self->{__cache_commands} = $self->client->_get('/commands') };
}

=head2 purge  [soft]

Purge the specified path from your cache.

You can optionally pass in a true value to enable "soft" purging e.g

    $fastly->purge($url, 1);

See L

Previously purging made an API call to the C endpoint of the Fastly API.

The new method of purging is done by making an HTTP request against the URL using the C HTTP method.

This module now uses the new method. The old method can be used by passing the C into the constructor.

    my $fastly = Net::Fastly->new(%login_opts, use_old_purge_method => 1);

=cut
sub purge {
    my $self = shift;
    my $url  = shift;
    my $soft = shift;
    $self->client->_purge($url, headers => { 'Fastly-Soft-Purge' => $soft });
}

=head2 stats [opt[s]]

Fetches historical stats for each of your fastly services and groups the results by service id.

If you pass in a C opt then fetches only the specified field.

If you pass in a C opt then fetches only the specified service.

The C and C opts can be combined.

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.

Other options available are:

=over 4

=item from & to

=item by

=item region

=back

See http://docs.fastly.com/docs/stats for details.

=cut
sub stats {
    my $self = shift;
    my %opts = @_;

    die "You can't specify a field or a service for an aggregate request" if $opts{aggregate} && ($opts{field} || $opts{service});

    my $url  = "/stats";

    if (delete $opts{aggregate}) {
        $url .= "/aggregate";
    }

    if (my $service = delete $opts{service}) {
        $url .= "/service/$service";
    }

    if (my $field = delete $opts{field}) {
        $url .= "/field/$field";
    }

    $self->client->_get_stats($url, %opts);
}


=head2 usage [opt[s]]

Returns usage information aggregated across all Fastly services and grouped by region.

If the C flag is passed then teturns usage information aggregated by service and grouped by service & region.

Other options available are:

=over 4

=item from & to

=item by

=item region

=back

See http://docs.fastly.com/docs/stats for details.

=cut
sub usage {
    my $self = shift;
    my %opts = @_;

    my $url  = "/stats/usage";
    $url .= "_by_service" if delete $opts{by_service};

    $self->client->_get_stats($url, %opts);
}


=head2 regions

Fetches the list of codes for regions that are covered by the Fastly CDN service.

=cut
sub regions {
    my $self = shift;
    $self->client->_get_stats("/stats/regions");
}


=head2 create_user

=head2 create_customer

=head2 create_service

=head2 create_version service_id => , [opts]

=head2 create_backend service_id => , version => , name =>

=head2 create_director service_id => , version => , name =>

=head2 create_domain service_id => , version => , name =>

=head2 create_healthcheck service_id => , version => , name =>

=head2 create_match service_id => , version => , name =>

=head2 create_origin service_id => , version => , name =>

=head2 create_syslog service_id => , version => , name =>

=head2 create_vcl service_id => , version => , name =>

=head2 create_condition service_id => , version => , name =>

Create new objects.

=cut

=head2 get_user

=head2 get_customer

=head2 get_service

=head2 get_version

=head2 get_backend

=head2 get_director

=head2 get_domain

=head2 get_healthcheck

=head2 get_invoice [ ]

Return a Net::Fastly::Invoice objects representing an invoice for all services.

If a year and month are passed in returns the invoice for that whole month.

Otherwise it returns the invoices for the current month to date.

=head2 get_match

=head2 get_origin

=head2 get_syslog

=head2 get_vcl

=head2 get_version

=head2 get_settings

=head2 get_condition

Get existing objects.

=cut


=head2 update_user

=head2 update_customer

=head2 update_service

=head2 update_version

=head2 update_backend

=head2 update_director

=head2 update_domain

=head2 update_healthcheck

=head2 update_match

=head2 update_origin

=head2 update_syslog

=head2 update_vcl

=head2 update_version

=head2 update_settings

=head2 update_condition

Update existing objects.

Note - you can also do

    $obj->save;

=cut


=head2 delete_user

=head2 delete_customer

=head2 delete_service

=head2 delete_version

=head2 delete_backend

=head2 delete_director

=head2 delete_domain

=head2 delete_healthcheck

=head2 delete_match

=head2 delete_origin

=head2 delete_syslog

=head2 delete_vcl

=head2 delete_version

=head2 delete_condition

Delete existing objects.

Note - you can also do

    $obj->delete

=cut



=head2 list_users

=head2 list_customers

=head2 list_versions

=head2 list_services

=head2 list_backends

=head2 list_directors

=head2 list_domains

=head2 list_healthchecks

=head2 list_matchs

=head2 list_origins

=head2 list_syslogs

=head2 list_vcls

=head2 list_versions

=head2 list_conditions

Get a list of all objects

=head2 search_services

Search all the services that the current customer has.

In general you'll want to do

        my @services = $fastly->search_services(name => $name);

or

        my ($service) = $fastly->search_services(name => $name, version => $number);

=cut

use Carp;
sub _list {
    my $self     = shift;
    my $class    = shift;
    my %opts     = @_;
    my $list     = $self->client->_get($class->_list_path(%opts), %opts);
    return () unless $list;
    return map { $class->new($self, %$_) } @$list;
}

sub _get {
    my $self  = shift;
    my $class = shift;
    my $hash;
    if (@_) {
        $hash = $self->client->_get($class->_get_path(@_));
    } else {
        $hash = $self->client->_get("/current_".$class->_path);
    }
    return undef unless $hash;
    return $class->new($self, %$hash);
}

sub _create {
    my $self  = shift;
    my $class = shift;
    my %args  = @_;
    my $hash  = $self->client->_post($class->_post_path(%args), %args);
    return $class->new($self, %$hash);
}

sub _update {
    my $self  = shift;
    my $class = shift;
    my $obj   = shift;
    my %fds   = $obj->_as_hash;
    my $hash  = $self->client->_put($class->_put_path($obj), map { $_ => $fds{$_} } grep { $_ !~ m/^(service_id|version)$/ } keys %fds);
    return $class->new($self, %$hash);
}

sub _delete {
    my $self  = shift;
    my $class = shift;
    my $obj   = shift;
    $obj      = bless $obj, $class if 'HASH' eq ref($obj);
    return defined $self->client->_delete($class->_delete_path($obj));
}


=head1 CLASS METHODS

=head2 load_options

Attempts to load various config options in the form

    =

From a file.

Skips whitespace and lines starting with C<#>.

=cut

sub load_options {
    my $file    = shift;
    my %options = ();
    return %options unless -f $file;

    open(my $fh, $file) || die "Couldn't open $file: $!\n";
    while (<$fh>) {
        chomp;
        next if /^#/;
        next if /^\s*$/;
        next unless /=/;
        s/(^\s*|\s*$)//g;
        my ($key, $val) = split /\s*=\s*/, $_, 2;
        $options{$key} = $val;
    }
    close($fh);
    return %options;
}

=head2 get_options

Tries to load options from the file[s] passed in using,
C, stopping when it finds the first one.

Then it overrides those options with command line options
of the form

    --=

=cut
sub get_options {
    my @configs = @_;
    my %options;
    foreach my $config (@configs) {
        next unless -f $config;
        %options = load_options($config);
        last;
    }
    while (@ARGV && $ARGV[0] =~ m!^-+(\w+)\=(.+)$!) {
        if ($1 eq "config") {
            die "No such file '$2'" unless -f $2;
            my %tmp = load_options($2);
            $options{$_} = $tmp{$_} for keys %tmp;
        } else {
            $options{$1} = $2;
        }
        shift @ARGV;
    }
    die "Couldn't find options from command line arguments or ".join(", ", @configs)."\n" unless keys %options;
    return %options;
}

=head1 COPYRIGHT

Copyright 2011 - Fastly Inc

Distributed under the same terms as Perl itself.

=head1 SUPPORT

Mail support at fastly dot com if you have problems.

=head1 DEVELOPERS

http://github.com/fastly/fastly-perl

http://www.fastly.com/documentation

=cut
1;