WWW-Crab-Client/lib/WWW/Crab/Client.pm
=head1 NAME
WWW::Crab::Client - Crab client library
=head1 SYNOPSIS
use WWW::Crab::Client;
my $crab = new WWW::Crab::Client();
my $start_response = eval {
$crab->start();
};
# Check for "inhibit" flag (optional).
if ($start_response and $start_response->{'inhibit'}) {
eval {
$crab->finish(status => WWW::Crab::Client::INHIBITED);
};
exit;
}
# 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.07;
use constant {
SUCCESS => 0,
FAIL => 1,
UNKNOWN => 2,
COULDNOTSTART => 3,
ALREADYRUNNING=> 4,
WARNING => 5,
INHIBITED => 6,
};
=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<start> or L<finish>
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 the decoded server response on success, which make include
an "inhibit" hash key.
=cut
sub start {
my $self = shift;
return $self->_write_json($self->_get_url('start'), {
command => $self->{'command'}}, 1);
}
=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'} || ''}, 0);
}
# _write_json()
#
# Sends the given object to the Crab server as a JSON message.
#
# $self->_write_json($self->_get_url($ACTION), $HASHREF, $READ);
#
# Dies on failure, and returns 1 on success, unless $READ is given a
# true value, when it attempts to decode the server response as JSON
# and return the decoded object. If there is no response, it returns
# a reference to an empty hash.
sub _write_json {
my $self = shift;
my $url = shift;
my $obj = shift;
my $read = 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 unless $read;
my $content = $res->decoded_content();
return {} unless $content;
return decode_json($content);
}
# _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__
=back
=head1 AUTHOR
Graham Bell <g.bell@eaobservatory.org>
=head1 COPYRIGHT
Copyright (C) 2012-2013 Science and Technology Facilities Council.
Copyright (C) 2016 East Asian Observatory.
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.