File Coverage

blib/lib/Monit/HTTP.pm

Criterion	Covered	Total	%
statement	98	122	80.3
branch	19	34	55.8
condition	12	32	37.5
subroutine	17	20	85.0
pod	8	8	100.0
total	154	216	71.3

#!/bin/false
# ABSTRACT: An OOP interface to Monit.
# PODNAME: Monit::HTTP

use warnings;
use strict;

package Monit::HTTP;
$Monit::HTTP::VERSION = '0.04';
use HTTP::Tiny;
use XML::Fast;

our (
    %MONIT_ACTIONS,
    %MONIT_ACTIONS_REV,
    %MONIT_STATUS,
    %MONIT_STATUS_REV,
    %MONIT_TYPES,
    %MONIT_TYPES_REV,
    %MONIT_MONITOR,
    %MONIT_MONITOR_REV,
);

BEGIN {

%MONIT_ACTIONS_REV = (
    'stop'      => 'ACTION_STOP',
    'start'     => 'ACTION_START',
    'restart'   => 'ACTION_RESTART',
    'monitor'   => 'ACTION_MONITOR',
    'unmonitor' => 'ACTION_UNMONITOR',
);
%MONIT_ACTIONS = reverse %MONIT_ACTIONS_REV;

%MONIT_MONITOR_REV = (
    0 => 'off',
    1 => 'monitored',
    2 => 'initializing',
);
%MONIT_MONITOR = reverse %MONIT_MONITOR_REV;

%MONIT_STATUS_REV = (
    0   => 'Running',
    32  => 'Connection Failed',
    512 => 'Does not exist',
);
%MONIT_STATUS = reverse %MONIT_STATUS_REV;

%MONIT_TYPES_REV = (
    0 => 'TYPE_FILESYSTEM',
    1 => 'TYPE_DIRECTORY',
    2 => 'TYPE_FILE',
    3 => 'TYPE_PROCESS',
    4 => 'TYPE_HOST',
    5 => 'TYPE_SYSTEM',
    6 => 'TYPE_FIFO',
    7 => 'TYPE_STATUS',
);
%MONIT_TYPES = reverse %MONIT_TYPES_REV;
}

# perl 5.10 has strange issues just going:
#   use constant reverse %{ MONIT_TYPES() }
# So work around it with do {}
use constant do { my %foo = reverse( %MONIT_TYPES_REV ); \%foo };
use constant do { my %foo = reverse( %MONIT_ACTIONS_REV ); \%foo };

use Exporter;

our %EXPORT_TAGS = (
    constants => [qw/
        ACTION_MONITOR
        ACTION_RESTART
        ACTION_START
        ACTION_STOP
        ACTION_UNMONITOR

        TYPE_DIRECTORY
        TYPE_FIFO
        TYPE_FILE
        TYPE_FILESYSTEM
        TYPE_HOST
        TYPE_PROCESS
        TYPE_SYSTEM
    /],

    hashes => [qw/
        %MONIT_ACTIONS
        %MONIT_ACTIONS_REV
        %MONIT_STATUS
        %MONIT_STATUS_REV
        %MONIT_TYPES
        %MONIT_TYPES_REV
        %MONIT_MONITOR
        %MONIT_MONITOR_REV
    /],
);

our @EXPORT_OK = (
    @{$EXPORT_TAGS{constants}},
    @{$EXPORT_TAGS{hashes}},
);

our @ISA = qw(Exporter);



sub new {
    my ($class, %self) = @_;

    # OOP stuff
    $class = ref($class) || $class;
    my $self = \%self;
    bless $self, $class;

    # set some defaults, if not already set
    $self->{hostname} ||= 'localhost';
    $self->{port} ||= 2812;
    $self->{use_auth} ||= 0;
    if($self->{use_auth}) {
        $self->{username} ||= 'admin';
        $self->{password} ||= 'monit';
    }

    $self->{ua} = HTTP::Tiny->new( agent => sprintf('Perl %s/%s',__PACKAGE__,$Monit::HTTP::VERSION) );
    $self->_generate_url;

    return $self
}

sub _generate_url {

    my $self = shift;

    my $auth = '';
    if (defined $self->{username} and defined $self->{password} and $self->{use_auth}) {
        $auth = sprintf('%s:%s@',$self->{username},$self->{password})
    }

    $self->{status_url} = sprintf('http://%s%s:%d/_status?format=xml',
                               $auth, $self->{hostname}, $self->{port});
}


sub set_hostname {
    my ($self, $hostname) = @_;
    $self->{hostname} = $hostname;
    $self->_generate_url;
    return $hostname
}


sub set_port {
    my ($self, $port) = @_;
    $self->{port} = $port;
    $self->_generate_url;
    return $port
}


sub set_username {
    my ($self, $username) = @_;
    $self->{username} = $username;
    $self->_generate_url;
    return $username
}


sub set_password {
    my ($self, $password ) = @_;
    $self->{password} = $password;
    $self->_generate_url;
    return $password
}


sub _fetch_info {
    my ($self) = @_;

    my $res = $self->{ua}->get( $self->{status_url} );
    if ($res->{success}) {
        $self->_set_xml($res->{content});
        $self->{xml_hash} = xml2hash( $self->_get_xml );
    }
    else {
        die sprintf "Error while connecting to %s !\n" .
            "Status: %s\nReason: %s\nContent: %s\n",
        $self->{status_url}, $res->{status}, $res->{reason}, $res->{content} || 'NIL';
    }

    return 1
}


sub get_services {
    my ($self, $type) = @_;
    my @services;
    $type ||= '-1';

    die "Don't understand this service type!\n"
        unless $type == -1 or grep {$_ == $type} keys %{MONIT_TYPES()};

    $self->_fetch_info;

    for my $s (@{$self->{xml_hash}->{monit}->{service}}) {
        if ($type == -1 or $s->{'-type'} == $type) {
            push @services,  $s->{name};
        }
    }
    return @services;
}


sub _set_xml {
    my ($self, $xml) = @_;
    $self->{status_raw_content} = $xml;
}


sub _get_xml {
    my ($self) = @_;
    return $self->{status_raw_content};
}


sub service_status {
    my ($self, $service) = @_;
    my $status_href = {};

    $self->_fetch_info;

    for my $s (@{$self->{xml_hash}->{monit}->{service}}) {
        if ($s->{name} eq $service) {

            $status_href->{host} = $self->{hostname};

            $status_href->{'type'} = $s->{'-type'}
                if exists $s->{'-type'};

            for my $thing (qw/
                    children
                    collected_sec
                    collected_usec
                    euid
                    gid
                    group
                    monitor
                    monitormode
                    pid
                    ppid
                    name
                    pendingaction
                    status
                    status_hint
                    uid
                    uptime
                    /) {

                $status_href->{$thing} = $s->{$thing}
                    if exists $s->{$thing};

            } # main stuff loop

            # the 'system' (type 5) service sticks these things in to ->{system}, others are top level
            if (my $sys = $s->{system} || $s) {
                for my $thing (qw/ kilobyte kilobytetotal percent percenttotal /) {
                    $status_href->{memory}->{$thing} = $sys->{memory}->{$thing}
                        if exists $sys->{memory}->{$thing};
                } # memory loop

                for my $thing (qw/ kilobyte percent /) {
                    $status_href->{swap}->{$thing} = $sys->{swap}->{$thing}
                        if exists $sys->{swap}->{$thing};
                } # swap loop

                for my $thing (qw/ percent percenttotal /) {
                    $status_href->{cpu}->{$thing} = $sys->{cpu}->{$thing}
                        if exists $sys->{cpu}->{$thing};
                } # cpu loop

                for my $thing (qw/ avg01 avg05 avg15 /) {
                    $status_href->{load}->{$thing} = $sys->{load}->{$thing}
                        if exists $sys->{load}->{$thing};
                } # load loop

            }
        }
    }

    die "Service $service does not exist\n"
        unless scalar keys %$status_href;

    return $status_href

}


sub command_run {
    my ($self, $service, $command) = @_;

    die "Don't understand this action\n"
        unless grep { $command eq $_ } keys %{MONIT_ACTIONS()};

    if(not defined $service) {
        $self->{is_success} = 0;
        die "Service not specified\n";
    }

    # if services does not exist throw error

    my $url = 'http://'.$self->{hostname}.':'.$self->{port}.'/'.$service;

    my $res = $self->{ua}->post_form($url, { action => $command });
    die $res->{status}
        unless $res->{success};

    return 1
}


1; # End of Monit::HTTP

__END__