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.12";

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;

    # username/password authentication is deprecated and will not be available
    # starting September 2020; use {api_key: 'your-key'} as the login option
    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

=head2 A Note About Authentication

Authenticating with a username/password is deprecated and will no longer be available starting September 2020.

Authenticating with an API Token is shown in the example synopsis below. For more information on API Tokens, please see [Fastly's API Token documentation](https://developer.fastly.com/reference/api/auth/). For more information about authenticating to our API, please see our [Authentication section](https://developer.fastly.com/reference/api/#authentication).

=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;