view release on metacpan or  search on metacpan

lib/Bio/CIPRES.pm  view on Meta::CPAN

use warnings;

use Carp;
use Config::Tiny;
use List::Util qw/first/;
use LWP;
use URI;
use URI::Escape;
use XML::LibXML;

use Bio::CIPRES::Job;
use Bio::CIPRES::Error;

our $VERSION = '0.004002';
our $SERVER  = 'cipresrest.sdsc.edu';
our $API     = 'cipresrest/v1';
our $DOMAIN  = 'Cipres Authentication';

my %required = ( # must be defined after config parsing
    url     => "https://$SERVER/$API/",
    timeout => 60,
    app_id  => 'cipres_perl-E9B8D52FA2A54472BF13F25E4CD957D4',
    user    => undef,
    pass    => undef,
);

my %umb_only = ( # only for UMBRELLA auth
    eu             => undef, # if this is defined, then the rest are:
    eu_email       => undef, # REQUIRED
    app_name       => undef, # REQUIRED
    eu_institution => undef, # optional
    eu_country     => undef, # optional
);

my @eu_headers = qw/
    eu
    eu_email
    eu_institution
    eu_country
/;

sub new {

    my ($class, %args) = @_;
    my $self = bless {}, $class;

    # parse properties from file or constructor
    $self->_parse_args(%args);

    # setup user agent
    $self->{agent} = LWP::UserAgent->new(
        agent    => __PACKAGE__ . "/$VERSION",
        ssl_opts => {verify_hostname => 0},
        timeout  => $self->{cfg}->{timeout},
    );
   
    # create URI object for easier protocol/port parsing
    $self->{uri} = URI->new( $self->{cfg}->{url} );

    my $netloc = join ':', $self->{uri}->host, $self->{uri}->port;
    $self->{agent}->credentials(
        $netloc,
        $DOMAIN,
        $self->{cfg}->{user},
        $self->{cfg}->{pass}
    );

    my %headers = ( 'cipres-appkey' => $self->{cfg}->{app_id} );

    $self->{account} = uri_escape( $self->{cfg}->{user} );

    # UMBRELLA headers
    if (defined $self->{cfg}->{eu}) {
        croak "eu_email required for UMBRELLA authentication"
            if (! defined $self->{cfg}->{'eu_email'});
        croak "app_name required for UMBRELLA authentication"
            if (! defined $self->{cfg}->{'app_name'});
        for my $h (@eu_headers) {
            my $val = $self->{cfg}->{$h} // next;
            $h =~ s/_/\-/g;
            $headers{"cipres-$h"} = $val;
        }

        $self->{account}
            = uri_escape( "$self->{cfg}->{app_name}.$self->{cfg}->{eu}" );
    }

    $self->{uri}->path("/$API/job/$self->{account}");
    $self->{agent}->default_header(%headers);

    croak "Failed CIPRES API connection test\n"
        if (! $self->_check_connection);

    return $self;

}

sub _parse_args {

    my ($self, %args) = @_;
    my ($fn_cfg) = delete $args{conf};

    # set defaults
    $self->{cfg} = {%required}; # copy, don't reference!

    # read from config file if asked, overwriting defaults
    if (defined $fn_cfg) {
        croak "Invalid or missing configuration file specified"
            if (! -e $fn_cfg);
        my $cfg = Config::Tiny->read( $fn_cfg )
            or croak "Error reading configuration file: $@";
        $self->{cfg}->{$_} = $cfg->{_}->{$_}
            for (keys %{ $cfg->{_} });

    }

    # read parameters from constructor, overwriting if present
    $self->{cfg}->{$_} = $args{$_} for (keys %args);

    # check that all defined fields are valid
    my @extra = grep {! exists $required{$_} && ! exists $umb_only{$_}}

lib/Bio/CIPRES.pm  view on Meta::CPAN

=over 1

=item * eu - end user name

=item * eu_email - end user email address

=item * app_name - UMBRELLA application name as registered with CIPRES

=item * eu_institution - end user institution (currently optional)

=item * eu_country - end user two-letter country code (currently optional)

=back

=item B<submit_job>

    my $job = $ua->submit_job( %params );

Submit a new job to the CIPRES service. Params are set based on the tool
documentation (not covered here). Returns a L<Bio::CIPRES::Job> object.

Most params are passed as simple key => value pairs of strings based on the
CIPRES tool documentation. B<One important nuance>, however, is in the
handling of input files. If the contents of a input file are to be passed in
as a scalar, they should be provided directly as the scalar value to the
appropriate key:

    my $job = $ua->submit_job( 'input.infile_' => $in_contents );

However, if the input file is to be uploaded by filename, it should be passed
as an array reference:

    my $job = $ua->submit_job( 'input.infile_' => [$in_filename] );

Failure to understand the difference will result in errors either during job
submission or during the job run.

=item B<list_jobs>

    for my $job ( $ua->list_jobs ) {
        # do something
    }

Returns an array of L<Bio::CIPRES::Job> objects representing jobs in the
user's workspace.

=item B<get_job>

    my $job = $ua->get_job( $job_handle );

Takes a single argument (string containing the job handle/ID) and returns a
L<Bio::CIPRES::Job> object representing the appropriate job, or undef if not
found.

=back

=head1 TESTING

The distribution can be installed and tested in the usual ways. Note however,
that running the full test suite requires CIPRES REST credentials (not shipped
with package for obvious reasons). If a credentials file is found at
"$ENV{HOME}/.cipres", the full test suite will be run -- otherwise only
rudimentary tests will be run and most will be skipped.

=head1 CAVEATS AND BUGS

This is code is in alpha testing stage and the API is not guaranteed to be
stable.

Currently the use of UMBRELLA authentication is not implemented.

Please report bugs to the author.

=head1 SEE ALSO

L<https://www.phylo.org/restusers/documentation.action>

=head1 AUTHOR

Jeremy Volkening <jdv@base2bio.com>

=head1 COPYRIGHT AND LICENSE

Copyright 2016-2018 Jeremy Volkening

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/>.

=cut