Skip to content

Instantly share code, notes, and snippets.

@mgcam
Created January 6, 2016 15:16
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mgcam/db91984da68daf74c175 to your computer and use it in GitHub Desktop.
Save mgcam/db91984da68daf74c175 to your computer and use it in GitHub Desktop.
RESTful Perl Catalyst Controller handling chain URL with multiple endpoints
package npg_qc_viewer::Controller::Mqc::Outcome;
use Moose;
use MooseX::Types::Moose qw/Int/;
BEGIN { extends 'Catalyst::Controller::REST'; }
our $VERSION = '0';
__PACKAGE__->config(default => 'application/json');
##no critic (Documentation::RequirePodAtEnd)
=head1 NAME
npg_qc_viewer::Controller::Mqc::Outcome
=head1 SYNOPSIS
Controller for a RESTful JSON service for QC outcomes.
=head1 DESCRIPTION
A Catalyst Controller for a RESTful JSON service for QC outcomes.
Handles the following chained RESTful URLs:
/mqcoutcomes/runs/*/lanes/*/tags/*
/mqcoutcomes/runs/*/lanes/*
/mqcoutcomes/runs/*
All arguments should be integers.
Currently only GET requests are supported.
GET requests - by default, a JSON representation of QC outcomes is served.
Example:
curl -X GET -H "Content-type: application/json" -H "Accept: application/json" \
"http://server:5050/mqcoutcomes/runs/255"
=head1 SUBROUTINES/METHODS
=head2 outcomes
Handles the '/mqcoutcomes/' part of chained URL (the root).
=cut
sub outcomes : PathPart('mqcoutcomes') : Chained('/') CaptureArgs(0) {
return;
}
=head2 runs_inchain
Handles the 'runs/*' part of chained URL.
=cut
sub runs_inchain : PathPart('runs') : Chained('outcomes') CaptureArgs(Int) {
my ( $self, $c, $integer ) = @_;
$c->stash->{ 'id_run' } = $integer;
return;
}
=head2 runs
Handles the 'runs/*' part of chained URL as an endpoint.
=cut
sub runs : PathPart('runs') : Chained('outcomes') : ActionClass('REST') Args(Int) {
my ( $self, $c, $integer ) = @_;
$c->stash->{ 'id_run' } = $integer;
return;
}
=head2 runs_GET
Handles GET requests for the 'runs/*' part of chained URL as an endpoint.
=cut
## no critic (NamingConventions::Capitalization)
sub runs_GET {
my ( $self, $c ) = @_;
my $query = $self->_query($c, qw/id_run/);
$self->status_ok($c, 'entity' => {
'seq' => $self->_outcome($c, $query, 'seq'),
'lib' => $self->_outcome($c, $query, 'lib'),
});
return;
}
=head2 lanes_inchain
Handles the 'lanes/*' part of chained URL.
=cut
sub lanes_inchain : PathPart('lanes') Chained('runs_inchain') CaptureArgs(Int) {
my ( $self, $c, $integer ) = @_;
$c->stash->{ 'position' } = $integer;
return;
}
=head2 lanes
Handles the 'lanes/*' part of chained URL as an endpoint.
=cut
sub lanes : PathPart('lanes') Chained('runs_inchain') : ActionClass('REST') Args(Int) {
my ( $self, $c, $integer ) = @_;
$c->stash->{ 'position' } = $integer;
return;
}
=head2 lanes_GET
Handles GET requests for the 'lanes/*' part of chained URL as an endpoint.
=cut
sub lanes_GET {
my ( $self, $c ) = @_;
my $query = $self->_query($c, qw/id_run position/);
$self->status_ok($c, 'entity' => {
'seq' => $self->_outcome($c, $query, 'seq'),
'lib' => $self->_outcome($c, $query, 'lib'),
});
return;
}
=head2 tags
Handles the 'tags/*' part of chained URL as an endpoint.
=cut
sub tags : PathPart('tags') Chained('lanes_inchain') : ActionClass('REST') Args(Int) {
my ( $self, $c, $integer ) = @_;
$c->stash->{ 'tag_index' } = $integer;
return;
}
=head2 tags_GET
Handles GET requests for the 'lanes/*' part of chained URL as an endpoint.
=cut
sub tags_GET {
my ( $self, $c ) = @_;
my $lib_query = $self->_query($c, qw/id_run position tag_index/);
my %seq_query = %{$lib_query};
delete $seq_query{'tag_index'};
$self->status_ok($c, 'entity' => {
'seq' => $self->_outcome($c, \%seq_query, 'seq'),
'lib' => $self->_outcome($c, $lib_query, 'lib'),
});
return;
}
##########################################################
#
# Copies the key-value pairs for keys in @args to a hash
# reference. The copied key is removed from the stash.
# The hash reference is returned.
#
sub _query {
my ( $self, $c, @args ) = @_;
my $query = {};
for my $arg (@args) {
$query->{$arg} = delete $c->stash->{$arg};
}
return $query;
}
sub _outcome {
my ( $self, $c, $query, $outcome_type ) = @_;
$outcome_type ||= 'seq';
my $rs_name = $outcome_type eq 'seq' ? 'MqcOutcomeEnt' : 'MqcLibraryOutcomeEnt';
return $c->model('NpgQcDB')->resultset($rs_name)->search($query)->pack();
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 DIAGNOSTICS
=head1 CONFIGURATION AND ENVIRONMENT
=head1 DEPENDENCIES
=over
=item Moose
=item MooseX::Types::Moose
=item Catalyst::Controller::REST
=back
=head1 INCOMPATIBILITIES
Incompatible with namespace::autoclean, which cleans up Int definition.
=head1 BUGS AND LIMITATIONS
=head1 AUTHOR
=head1 LICENSE AND COPYRIGHT
Copyright (C) 2016 Genome Research Ltd.
This file is part of NPG software.
NPG 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment