File Coverage

lib/Sailthru/Client.pm

Criterion	Covered	Total	%
statement	177	189	93.6
branch	14	24	58.3
condition	2	9	22.2
subroutine	33	34	97.0
pod	13	21	61.9
total	239	277	86.2

package Sailthru::Client;

use strict;
use warnings;

use Carp;
use JSON::XS;
use LWP::UserAgent;
use Digest::MD5 qw( md5_hex );
use Params::Validate qw( :all );
use Readonly;
use URI;

our $VERSION = '2.3.0';
Readonly my $API_URI => 'https://api.sailthru.com/';

#
# public api
#

# args:
#
# * api_key - scalar
# * secret - scalar
# * timeout - scalar (optional)
sub new {
    my ( $class, $api_key, $secret, $timeout ) = @_;
    my $self = {
        api_key => $api_key,
        secret  => $secret,
        ua      => LWP::UserAgent->new,
        last_rate_limit_info_ref => {}
    };
    $self->{ua}->timeout($timeout) if $timeout;
    $self->{ua}->default_header( 'User-Agent' => "Sailthru API Perl Client $VERSION" );
    return bless $self, $class;
}

# args:
#
# * template_name - scalar
# * email - scalar
# * vars - hashref (optional)
# * options - hashref (optional)
# * schedule_time - scalar (optional)
sub send {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => HASHREF, default => {} },
        { type => HASHREF, default => {} },
        { type => SCALAR, default => undef }
    );
    my ( $template_name, $email, $vars, $options, $schedule_time ) = @params;
    my $data = {};
    $data->{template}      = $template_name;
    $data->{email}         = $email;
    $data->{vars}          = $vars if keys %{$vars};
    $data->{options}       = $options if keys %{$options};
    $data->{schedule_time} = $schedule_time if $schedule_time;
    return $self->api_post( 'send', $data );
}

# args:
# * send_id - scalar
sub get_send {
    my $self      = shift;
    my @params    = validate_pos( @_, { type => SCALAR } );
    my ($send_id) = @params;
    return $self->api_get( 'send', { send_id => $send_id } );
}

# args:
# * email - scalar
sub get_email {
    my $self    = shift;
    my @params  = validate_pos( @_, { type => SCALAR } );
    my ($email) = @params;
    return $self->api_get( 'email', { email => $email } );
}

# args:
# * email - scalar
# * vars - hashref (optional)
# * lists - hashref (optional)
# * templates - hashref (optional)
sub set_email {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => HASHREF, default => {} },
        { type => HASHREF, default => {} },
        { type => HASHREF, default => {} }
    );
    my ( $email, $vars, $lists, $templates ) = @params;
    my $data = {};
    $data->{email}     = $email;
    $data->{vars}      = $vars if keys %{$vars};
    $data->{lists}     = $lists if keys %{$lists};
    $data->{templates} = $templates if keys %{$templates};
    return $self->api_post( 'email', $data );
}

# args:
# * name - scalar
# * list - scalar
# * schedule_time - scalar
# * from_name - scalar
# * from_email - scalar
# * subject - scalar
# * content_html - scalar
# * content_text - scalar
# * options - hashref (optional)
sub schedule_blast {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => HASHREF, default => {} }
    );
    my ( $name, $list, $schedule_time, $from_name, $from_email, $subject, $content_html, $content_text, $options ) =
      @params;
    # initialize our data hash by copying the contents of the options hash
    my $data = { %{$options} };
    $data->{name}          = $name;
    $data->{list}          = $list;
    $data->{schedule_time} = $schedule_time;
    $data->{from_name}     = $from_name;
    $data->{from_email}    = $from_email;
    $data->{subject}       = $subject;
    $data->{content_html}  = $content_html;
    $data->{content_text}  = $content_text;
    return $self->api_post( 'blast', $data );
}

# args:
# * template_name - scalar
# * list - scalar
# * schedule_time - scalar
# * options - hashref (optional)
sub schedule_blast_from_template {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => HASHREF, default => {} },
    );
    my ( $template_name, $list, $schedule_time, $options ) = @params;
    # initialize our data hash by copying the contents of the options hash
    my $data = { %{$options} };
    $data->{copy_template} = $template_name;
    $data->{list}          = $list;
    $data->{schedule_time} = $schedule_time;
    return $self->api_post( 'blast', $data );

}

# args:
# * blast_id - scalar
sub get_blast {
    my $self       = shift;
    my @params     = validate_pos( @_, { type => SCALAR } );
    my ($blast_id) = @params;
    return $self->api_get( 'blast', { blast_id => $blast_id } );
}

# args:
# * template_name - scalar
sub get_template {
    my $self            = shift;
    my @params          = validate_pos( @_, { type => SCALAR } );
    my ($template_name) = @params;
    return $self->api_get( 'template', { template => $template_name } );
}

# args:
# * action - scalar
# * data - hashref
sub api_get {
    my $self = shift;
    my @params = validate_pos( @_, { type => SCALAR }, { type => HASHREF } );
    my ( $action, $data ) = @params;
    return $self->_api_request( $action, $data, 'GET' );
}

# args:
# * action - scalar
# * data - hashref
# * TODO: optional binary_key arg
sub api_post {
    my $self = shift;
    my @params = validate_pos( @_, { type => SCALAR }, { type => HASHREF } );
    my ( $action, $data ) = @params;
    return $self->_api_request( $action, $data, 'POST' );
}

# args:
# * action - scalar
# * data - hashref
sub api_delete {
    my $self = shift;
    my @params = validate_pos( @_, { type => SCALAR }, { type => HASHREF } );
    my ( $action, $data ) = @params;
    return $self->_api_request( $action, $data, 'DELETE' );
}

# args:
#
# * action - scalar
# * method - scalar
sub get_last_rate_limit_info {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => SCALAR }
    );
    my ( $action, $method ) = @params;
    $method = uc($method);

    if (exists $self->{last_rate_limit_info_ref}->{$action} and $self->{last_rate_limit_info_ref}->{$action}->{$method}) {
        return $self->{last_rate_limit_info_ref}->{$action}->{$method};
    }

    return;
}

#
# private helper methods
#

# args:
# * action - scalar
# * data - hashref
# * request_type - scalar
sub _api_request {
    my $self = shift;
    my @params = validate_pos( @_, { type => SCALAR }, { type => HASHREF }, { type => SCALAR } );
    my ( $action, $data, $request_type ) = @params;
    my $payload    = $self->_prepare_json_payload($data);
    my $action_uri = $API_URI . $action;
    my $response   = $self->_http_request( $action_uri, $payload, $request_type );

    # update rate limit information
    if ( defined $response->header('x-rate-limit-limit') and
         defined $response->header('x-rate-limit-remaining') and
         defined $response->header('x-rate-limit-reset') ) {
         $self->{last_rate_limit_info_ref}->{$action}->{$request_type} = {
             limit => $response->header('x-rate-limit-limit'),
             remaining => $response->header('x-rate-limit-remaining'),
             reset => $response->header('x-rate-limit-reset')
         };
    }

    return decode_json( $response->content );
}

# args:
# * uri - scalar
# * data - hashref
# * method - scalar
sub _http_request {
    my $self = shift;
    my @params = validate_pos( @_, { type => SCALAR }, { type => HASHREF }, { type => SCALAR } );
    my ( $uri, $data, $method ) = @params;
    $uri = URI->new($uri);
    my $response;
    if ( $method eq 'GET' ) {
        $uri->query_form($data);
        $response = $self->{ua}->get($uri);
    }
    elsif ( $method eq 'POST' ) {
        $response = $self->{ua}->post( $uri, $data );
    }
    elsif ( $method eq 'DELETE' ) {
        $uri->query_form($data);
        $response = $self->{ua}->delete($uri);
    }
    else {
        croak "Invalid method: $method";
    }
    return $response;
}

# args:
# * data - hashref
sub _prepare_json_payload {
    my $self    = shift;
    my @params  = validate_pos( @_, { type => HASHREF } );
    my ($data)  = @params;
    my $payload = {};
    $payload->{api_key} = $self->{api_key};
    $payload->{format}  = 'json';
    # this gives us nice clean utf8 encoded json text
    $payload->{json} = encode_json($data);
    $payload->{sig} = $self->_get_signature_hash( $payload, $self->{secret} );
    return $payload;
}

# Every request must also generate a signature hash called sig according to the
# following rules:
#
# * take the string values of every parameter, including api_key
# * sort the values alphabetically, case-sensitively (i.e. ordered by Unicode code point)
# * concatenate the sorted values, and prepend this string with your shared secret
# * generate an MD5 hash of this string and use this as sig
# * now generate your URL-encoded query string from your parameters plus sig

# args:
# * params - hashref
# * secret - scalar
# NOTE This internal method assumes a single level hash with values for only 'api_key', 'format', and 'json'
# NOTE Since we pack everything into the 'json' value this is safe and we do not need to recurse down a nested hash.
sub _get_signature_hash {
    my $self = shift;
    my @params = validate_pos( @_, { type => HASHREF }, { type => SCALAR } );
    my ( $api_param_hash, $secret ) = @params;
    my @api_param_values = values %{$api_param_hash};
    my $sig_string = join '', $secret, sort @api_param_values;
    # assumes utf8 encoded text, works fine because we use encode_json internally
    return md5_hex($sig_string);
}

### XXX
### DEPRECATED METHODS
### XXX

# args:
# * email - scalar
sub getEmail {
    my $self = shift;
    warnings::warnif( 'deprecated', 'getEmail is deprecated, use get_email instead' );
    return $self->get_email(@_);
}

# args:
# * email - scalar
# * vars - hashref (optional)
# * lists - hashref (optional)
# * templates - hashref (optional)
sub setEmail {
    my $self = shift;
    warnings::warnif( 'deprecated', 'setEmail is deprecated, use set_email instead' );
    return $self->set_email(@_);
}

# args:
# * send_id - scalar
sub getSend {
    my $self = shift;
    warnings::warnif( 'deprecated', 'getSend is deprecated, use get_send instead' );
    return $self->get_send(@_);
}

# args:
# * name - scalar
# * list - scalar
# * schedule_time - scalar
# * from_name - scalar
# * from_email - scalar
# * subject - scalar
# * content_html - scalar
# * content_text - scalar
# * options - hashref (optional)
sub scheduleBlast {
    my $self = shift;
    warnings::warnif( 'deprecated', 'scheduleBlast is deprecated, use schedule_blast instead' );
    return $self->schedule_blast(@_);
}

# args:
# * blast_id - scalar
sub getBlast {
    my $self = shift;
    warnings::warnif( 'deprecated', 'getBlast is deprecated, use get_blast instead' );
    return $self->get_blast(@_);
}

sub copyTemplate {
    my $self   = shift;
    my @params = validate_pos(
        @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR },
        { type => HASHREF, default => {} }
    );
    my ( $template, $data_feed, $setup, $subject_line, $schedule_time, $list, $options ) = @params;
    warnings::warnif( 'deprecated', 'copyTemplate is deprecated, use schedule_blast_from_template instead' );
    # initialize our data hash by copying the contents of the options hash
    my $data = { %{$options} };
    $data->{copy_template} = $template;
    $data->{data_feed_url} = $data_feed;
    $data->{setup}         = $setup;
    $data->{name}          = $subject_line;
    $data->{schedule_time} = $schedule_time;
    $data->{list}          = $list;
    return $self->api_post( 'blast', $data );
}

# args:
# * template_name - scalar
sub getTemplate {
    my $self = shift;
    warnings::warnif( 'deprecated', 'getTemplate is deprecated, use get_template instead' );
    return $self->get_template(@_);
}

# args:
# * email - scalar
# * password - scalar
# * include_names - scalar (optional)
sub importContacts {
    my $self = shift;
    my @p = validate_pos( @_, { type => SCALAR }, { type => SCALAR }, { type => SCALAR, default => 0 } );
    my ( $email, $password, $include_names ) = @p;
    warnings::warnif( 'deprecated',
        'importContacts is deprecated. The contacts API has been discontinued as of August 1st, 2011.' );
    my $data = {
        email         => $email,
        password      => $password,
        include_names => $include_names,
    };
    return $self->api_post( 'contacts', $data );
}

1;

__END__