File Coverage

blib/lib/Monitis.pm

Criterion	Covered	Total	%
statement	101	189	53.4
branch	20	64	31.2
condition	9	45	20.0
subroutine	23	30	76.6
pod	16	16	100.0
total	169	344	49.1

package Monitis;

use warnings;
use strict;

use LWP::UserAgent;
use HTTP::Request;
use HTTP::Headers;
use HTTP::Request::Common;

use Digest::SHA 'hmac_sha1_base64';
use JSON;

our $VERSION = '0.9';

use constant DEBUG => $ENV{MONITIS_DEBUG} || 0;

require Carp;

our $TOKEN_TTL = $ENV{MONITIS_TOKEN_TTL} || 60 * 60 * 24;    # 24 hours
my $API_VERSION = 2;

our $MAPPING = {
    sub_accounts            => 'SubAccounts',
    layout                  => 'Layout',
    contacts                => 'Contacts',
    predefined_monitors     => 'PredefinedMonitors',
    external_monitors       => 'ExternalMonitors',
    internal_monitors       => 'InternalMonitors',
    agents                  => 'Agents',
    cpu                     => 'CPU',
    memory                  => 'Memory',
    drive                   => 'Drive',
    process                 => 'Process',
    load_average            => 'LoadAverage',
    http                    => 'HTTP',
    ping                    => 'Ping',
    transaction_monitors    => 'TransactionMonitors',
    custom_monitors         => 'CustomMonitors',
    full_page_load_monitors => 'FullPageLoadMonitors',
    visitor_trackers        => 'VisitorTrackers',
    cloud_instances         => 'CloudInstances'
};

our $MAPPING_LOADED = {};

sub new {
    my $class = shift;
    my $self  = {@_};

    $self->{ua} ||= LWP::UserAgent->new(agent => "perl-monitis-api/$VERSION");

    $self->{json} ||= JSON->new;

    bless $self, $class;
}

sub auth_token {
    my ($self, $token, $expires) = @_;

    # Set
    if ($token && ref $token ne 'CODE') {
        $self->{auth_token} = $token;
        $self->{auth_token_expires} = $expires || $self->token_ttl + time;
        return $self;
    }

    my $callback = ref $token eq 'CODE' ? $token : undef;

    # Cached token
    if ($self->{auth_token} && $self->{auth_token_expires} > time) {
        return $callback->($self, $self->{auth_token}) if $callback;
        return $self->{auth_token};
    }

    # Token expired
    delete $self->{auth_token};
    delete $self->{auth_token_expires};

    unless ($self->api_key && $self->secret_key) {
        Carp::croak("API key and Secret key required for this action");
    }

    my $uri = URI->new($self->api_url);

    $uri->query_form(
        action    => 'authToken',
        output    => 'json',
        version   => $API_VERSION,
        secretkey => $self->secret_key,
        apikey    => $self->api_key
    );

    my $response = $self->ua->get($uri);

    unless ($response->is_success) {
        die "Failed to get auth token: " . $response->status_line;
    }

    my $result = $self->json->decode($response->decoded_content);

    unless ($result || exists $result->{authToken}) {
        die "Failed to get auth token, wrong response:\n"
          . $response->decoded_content . "\n";
    }

    #Success
    $self->auth_token($result->{authToken});

    $result->{authToken};
}

sub api_get {
    my $self    = shift;
    my $request = $self->build_get_request(@_);

    warn "GET>\n" if DEBUG;
    warn $request->as_string if DEBUG;

    my $response = $self->ua->request($request);

    warn "GET<\n" if DEBUG;
    warn $response->decoded_content if DEBUG;

    $self->parse_response($response);

}

sub api_post {
    my $self    = shift;
    my $request = $self->build_post_request(@_);

    warn "POST>\n" if DEBUG;
    warn $request->as_string if DEBUG;

    my $response = $self->ua->request($request);

    warn "POST<\n" if DEBUG;
    warn $response->decoded_content if DEBUG;

    $self->parse_response($response);
}

sub parse_response {
    my ($self, $res) = @_;

    my $obj = $self->json->decode($res->decoded_content);

    Carp::croak("Wrong responce: " . $res->decoded_content) unless $obj;

    $obj;
}

sub build_get_request {
    my ($self, $action, $params) = @_;
    $params ||= [];

    unless ($self->api_key) {
        Carp::croak("API key and Secret key required for this action");
    }

    my @auth = (
        apikey  => $self->api_key,
        output  => 'JSON',
        version => $API_VERSION,
    );
    my $url = URI->new($self->api_url);
    $url->query_form(@$params, @auth, action => $action);

    HTTP::Request::Common::GET($url);
}

sub build_post_request {
    my ($self, $action, $params) = @_;
    $params ||= [];

    unless ($self->api_key && $self->secret_key) {
        Carp::croak("API key and Secret key required for this action");
    }

    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime(time);
    my $timestamp = sprintf "%4d-%02d-%02d %02d:%02d:%02d",
      $year + 1900, $mon + 1, $mday, $hour, $min, $sec;

    my @auth = (
        apikey     => $self->api_key,
        validation => 'HMACSHA1',
        output     => 'JSON',
        version    => $API_VERSION,
        timestamp  => $timestamp
    );

    my @final_params = (@$params, @auth, 'action' => $action);

    push @final_params, checksum => $self->checksum(\@final_params);

    HTTP::Request::Common::POST($self->api_url => \@final_params);
}

sub checksum {
    my ($self, $parameters) = @_;

    Carp::croak("Monitis secret key required for checksum generation")
      unless $self->secret_key;

    my @sorted_params;

    for (my $i = 0; $i <= $#$parameters; $i += 2) {
        push @sorted_params, [@{$parameters}[$i, $i + 1]];
    }

    @sorted_params =
      sort { $a->[0] cmp $b->[0] or $a->[1] cmp $b->[1] } @sorted_params;

    my $validation_string = join '', map { $_->[0] . $_->[1] } @sorted_params;

    my $checksum = hmac_sha1_base64 $validation_string, $self->secret_key;

    $checksum .= '=' while length($checksum) % 4;

    $checksum;
}

sub api_url {
    my $self   = shift;
    my $typeof = ref($self) ? $self->{_typeof} || '' : '';
    my $class  = ref($self) || $self;

    return 'http://monitis.com/api' unless $typeof;
    return 'http://monitis.com/api' if $class eq $typeof;

    return 'http://monitis.com/api' unless $typeof->can('api_url');

    # Mapped class has own API url
    return $typeof->api_url;
}

sub DESTROY {

# Placeholder for AUTOLOAD

}

sub AUTOLOAD {
    my $self = shift;
    my ($package, $method) = our $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;

    # Map instance to certain package
    if (exists $MAPPING->{$method}) {
        return $self->_map_to($MAPPING->{$method});
    }

    unless ($self->{_typeof} && $self->{_typeof}->can($method)) {
        Carp::croak qq/Can't locate object method "$method" via "$package"/;
    }

    # Get mapped package method
    no strict 'refs';
    my $package_method = \&{"$self->{_typeof}::$method"};
    use strict;

    # Unmap instance
    my $typeof = delete $self->{_typeof};
    local $self->{_typeof} = $typeof;

    $self->$package_method(@_);
}

sub ua {
    my $self = shift;

    return $self->{ua} unless @_;

    $self->{ua} = shift;
    $self;
}

sub json {
    my $self = shift;

    return $self->{json} unless @_;

    $self->{json} = shift;
    $self;
}

sub token_ttl {
    my $self = shift;

    return $self->{token_ttl} || $TOKEN_TTL unless @_;

    $self->{token_ttl} = shift;
    $self;
}

sub _map_to {
    my ($self, $package) = @_;

    $self->{_typeof} = "Monitis::$package";

    if (!$MAPPING_LOADED->{$package}) {

        # TODO: Make pretty warning
        eval "require $self->{_typeof};";
        if ($@) {
            delete $self->{_typeof};
            $MAPPING_LOADED->{$package} = -1;
            Carp::croak($@);
        }
        $MAPPING_LOADED->{$package} = 1;
    }
    elsif ($MAPPING_LOADED->{$package} < 0) {
        my $error = delete $self->{_typeof};
        Carp::croak("Package '$error' contains errors");
    }

    $self;
}

sub context {
    my $self = shift;

    return $self->{_typeof} unless @_;

    $self->{_typeof} = shift;
    $self;
}

sub api_key {
    my $self = shift;

    return $self->{api_key} unless @_;

    $self->{api_key} = shift;
    $self;
}

sub secret_key {
    my $self = shift;

    return $self->{secret_key} unless @_;

    $self->{secret_key} = shift;
    $self;
}

sub prepare_params {
    my ($self, $params, $mandatory, $optional) = @_;

    $mandatory ||= [];
    $optional  ||= [];

    my %existing_keys;

    # Save callback, if provided
    my $callback = ref $params->[-1] eq 'CODE' ? pop @$params : undef;

    for (my $i = 0; $i <= $#$params; $i += 2) {
        $existing_keys{$params->[$i]} = 1;
    }

    my @lack = grep !exists $existing_keys{$_}, @$mandatory;
    if (@lack) {
        Carp::croak("Missing mandatory parameters: " . join(', ', @lack));
    }

    my %param_keys = map { $_ => 1 } @$mandatory, @$optional;
    my @final_params;


    my @extra;
    for (my $i = 0; $i <= $#$params; $i += 2) {
        unless (exists $param_keys{$params->[$i]}) {
            push @extra, $params->[$i];
        }
        push @final_params, @{$params}[$i, $i + 1];
    }

    if (@extra) {
        Carp::carp("Unexpected parameters: " . join(', ', @extra));
    }

    push @final_params, $callback if $callback;

    return \@final_params;
}

1;

__END__