view release on metacpan or  search on metacpan

lib/Bio/WebService/LANL/SequenceLocator/Server.pm  view on Meta::CPAN

=cut

package Bio::WebService::LANL::SequenceLocator::Server;
use Web::Simple;

use Bio::WebService::LANL::SequenceLocator;
use File::Share qw< dist_file >;
use JSON qw< encode_json >;
use Text::CSV;
use Plack::App::File;
use Path::Tiny;
use IO::String;

has contact => (
    is      => 'ro',
    default => sub { $ENV{SERVER_ADMIN} || '[no address provided]' },
);

has locator => (
    is      => 'ro',
    isa     => sub {
        die "Attribute 'locator' is not a Bio::WebService::LANL::SequenceLocator"
            unless $_[0]->isa("Bio::WebService::LANL::SequenceLocator");
    },
    lazy    => 1,
    builder => sub {
        Bio::WebService::LANL::SequenceLocator->new(
            agent_string => join " ", "via", __PACKAGE__, $_[0]->contact
        )
    },
);

has about_page => (
    is      => 'ro',
    lazy    => 1,
    builder => sub { dist_file('Bio-WebService-LANL-SequenceLocator', 'about.html') },
);

has formats => (
    is      => 'ro',
    default => sub { [qw( json csv )] },
);

sub dispatch_request {
    sub (POST + /within/hiv) {
        sub (%base~&format~) {
            my ($self, $base, $format) = @_;
            $format ||= 'json';
            $format = lc $format;
            return error(406 => "format '$format' is not supported; try one of " . join(", ", @{$self->formats}))
                unless grep { $format eq $_ } @{$self->formats};

            sub (%fasta=) {
                my ($self, $fasta) = @_;
                return $self->locate_sequences_from_fasta($fasta, $base, $format);
            },
            sub (*fasta=) {
                my ($self, $fasta) = @_;
                return error(422 => $fasta->reason)
                    unless $fasta->is_upload;
                return $self->locate_sequences_from_fasta(path($fasta->path)->slurp, $base, $format);
            },
            sub (%@sequence~) {
                my ($self, $sequences) = @_;
                return $self->locate_sequences($sequences, $base, $format);
            },
        },
    },
    sub (GET + /within/hiv) {
        error( 405 => "You must make location requests using POST." )
    },
    sub (GET + /) {
        state $about = Plack::App::File->new(file => $_[0]->about_page);
        $about;
    },
}

sub locate_sequences_from_fasta {
    my $self  = shift;
    my $fasta = shift;
    my $sequences = $self->read_fasta(\$fasta)
        or return error( 415 => "Couldn't parse FASTA; invalid formating?" );
    return $self->locate_sequences($sequences, @_);
}

sub locate_sequences {
    my ($self, $sequences, $base, $format) = @_;

    return error(422 => 'At least one value for "sequence" is needed.')
        unless $sequences and @$sequences;

    my $results = $self->locator->find($sequences, base => $base)
        or return error(503 => "Backend request to LANL failed, sorry!  Contact @{[ $self->contact ]} if the problem persists.");

    return $self->format_results($results, $format);
}

sub format_results {
    my ($self, $results, $format) = @_;

    my $formatter = $self->can("as_$format")
        or return error(500 => "Unknown format '$format'");

    return $formatter->($self, $results);
}

sub as_json {
    my ($self, $results) = @_;
    my $json = eval { encode_json($results) };
    if ($@ or not $json) {
        warn $@ ? "Error encoding JSON response: $@\n"
                : "Failed to encode JSON response, but no error?!\n";
        return error(500 => "Error encoding results to JSON.  Contact @{[ $self->contact ]}");
    }

    return [
        200,
        [ 'Content-type' => 'application/json' ],
        [ $json, "\n" ],
    ];