File Coverage

blib/lib/WWW/Crab/Client.pm

Criterion	Covered	Total	%
statement	40	64	62.5
branch	3	14	21.4
condition	9	29	31.0
subroutine	11	15	73.3
pod	3	3	100.0
total	66	125	52.8

=head1 NAME

WWW::Crab::Client - Crab client library

=head1 SYNOPSIS

  use WWW::Crab::Client;

  my $crab = new WWW::Crab::Client();

  eval {
      $crab->start();
  };

  # Perform the cron job actions ...

  my $finished_ok = eval {
      $crab->finish(status => WWW::Crab::Client::SUCCESS, stdout => $message);
  };
  unless ($finished_ok) {
      print "Failed to report job completion.\n" . $@ . "\n" . $message;
  }

=head1 DESCRIPTION

This module implements a subset of the Crab protocol sufficient
for reporting the status of a cron job to the Crab server.
It is intended to work similarly to the Python Crab client module,
but be more convient for cron jobs written in Perl.

=cut

package WWW::Crab::Client;

use strict;

use Config::IniFiles;
use File::HomeDir;
use File::Spec;
use HTTP::Request;
use JSON;
use LWP::UserAgent;
use Sys::Hostname;

our $VERSION = 0.06;

use constant {
    SUCCESS       => 0,
    FAIL          => 1,
    UNKNOWN       => 2,
    COULDNOTSTART => 3,
    ALREADYRUNNING=> 4,
    WARNING       => 5,
};

=head1 CONSTRUCTOR

=over 4

=item new()

Constructs a new client object.  All parameters are optional.
If no job identifier is given, then a null value is sent to
the server.  If the command is unspecified, C<$0> will be used.
No communication is performed until the L or L
methods are called.

  my $crab = new WWW::Crab::Client(id       => 'job identifier',
                                   command  => 'command name',
                                   server   => 'localhost',
                                   port     => 8000,
                                   hostname => 'localhost',
                                   username => 'username',
                                   timeout  => 30);

If the other settings are not specified, the crab settings files
will be read, the CRABHOST and CRABPORT environment variables will
be checked, or defaults will be used.

=cut

sub new {
    my $class = shift;
    my %opt = @_;

    my $conf = new Config::IniFiles(-file => \'', -allowempty => 1);
    my $conf_system = File::Spec->catfile($ENV{'CRABSYSCONFIG'} || '/etc/crab',
                                          'crab.ini');
    my $conf_user = File::Spec->catfile($ENV{'CRABUSERCONFIG'} ||
                                        (File::HomeDir->my_home() . '/.crab'),
                                        'crab.ini');
    $conf = new Config::IniFiles(-file => $conf_system, '-import' => $conf,
                                 -allowempty => 1)
        if (-e $conf_system);

    $conf = new Config::IniFiles(-file => $conf_user, '-import' => $conf,
                                 -allowempty => 1)
        if (-e $conf_user);

    my $self = {
        id       => $opt{'id'}       || undef,
        command  => $opt{'command'}  || $0,
        server   => $opt{'server'}   || $ENV{'CRABHOST'} ||
                                     $conf->val('server', 'host', 'localhost'),
        port     => $opt{'port'}     || $ENV{'CRABPORT'} ||
                                     $conf->val('server', 'port', 8000),
        hostname => $opt{'hostname'} || $conf->val('client', 'hostname',
                                            hostname()),
        username => $opt{'username'} || $conf->val('client', 'username',
                                            _get_username()),
        timeout  => $opt{'timeout'}  || $conf->val('server', 'timeout', 30),
    };

    return bless $self, $class;
}

=back

=head1 METHODS

=over 4

=item start()

Reports that the job has started.

  $crab->start();

This method uses "die" to raise an exception if it is unsuccessful
in reporting to the Crab server.

Returns a true value on success.

=cut

sub start {
    my $self = shift;

    return $self->_write_json($self->_get_url('start'), {
        command => $self->{'command'}});
}

=item finish()

Reports that the job has finished.  If the status is not specified,
UNKNOWN will be sent.

  $crab->finish(status => WWW::Crab::Client::SUCCESS,
                stdout => $command_output,
                stderr => $error_message);

The following constants are defined in this module, and should be used
to obtain the appropriate Crab status codes:

  SUCCESS
  FAIL
  UNKNOWN
  COULDNOTSTART
  ALREADYRUNNING
  WARNING

This method uses "die" to raise an exception if it is unsuccessful
in reporting to the Crab server.

Returns a true value on success.

=cut

sub finish {
    my $self = shift;
    my %opt = @_;

    return $self->_write_json($self->_get_url('finish'), {
        command => $self->{'command'},
        status  => defined $opt{'status'} ? $opt{'status'} : UNKNOWN,
        stdout  => $opt{'stdout'} || '',
        stderr  => $opt{'stderr'} || ''});
}

# _write_json()
#
# Sends the given object to the Crab server as a JSON message.
#
#   $self->_write_json($self->_get_url($ACTION), $HASHREF);
#
# Dies on failure, and returns 1 on success.  Could be improved
# to return a useful value on success, so long as it is 'true'.

sub _write_json {
    my $self = shift;
    my $url = shift;
    my $obj = shift;

    my $ua = new LWP::UserAgent(timeout => $self->{'timeout'});
    my $req = new HTTP::Request(PUT => $url);
    $req->content(encode_json($obj));
    my $res = $ua->request($req);
    die $res->status_line() unless $res->is_success();
    return 1;
}

# _get_url()
#
# Returns the URL to be used for a given Crab aaction.
#
#     my $url = $self->_get_url($ACTION);
#
# Where the action is typically 'start' or 'finish'.

sub _get_url {
    my $self = shift;
    my $action = shift;

    my @path = ($self->{'hostname'}, $self->{'username'});
    push @path, $self->{'id'} if defined $self->{'id'};

    return 'http://' . $self->{'server'} . ':' . $self->{'port'} . '/' .
           join('/', 'api', '0', $action, @path);
}

# _get_username()
#
# Detects the username of the current user.
#
# This provides the default value for the username parameter
# of the WWW::Crab::Client constructor.

sub _get_username {
    my $username = undef;

    eval {
        $username = scalar getpwuid($<);
    };

    return $username if defined $username;

    eval {
        require Win32;
        $username = Win32::LoginName();
    };

    return $username if defined $username;

    return 'user';
}

1;

__END__