lib/SGN/Controller/Analytics.pm

   1
   2 package SGN::Controller::Analytics;
   3
   4 use Moose;
   5 use URI::FromHash 'uri';
   6 use Data::Dumper;
   7 use JSON::XS;
   8 use Statistics::Descriptive::Full;
   9 use Time::Piece;
  10
  11 BEGIN { extends 'Catalyst::Controller' };
  12
  13 sub view_analytics_protocols :Path('/analytics_protocols') Args(0) {
  14     my $self = shift;
  15     my $c = shift;
  16
  17     my $schema = $c->dbic_schema("Bio::Chado::Schema");
  18     my $user_id;
  19     if ($c->user()) {
  20         $user_id = $c->user->get_object()->get_sp_person_id();
  21     }
  22     if (!$user_id) {
  23         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
  24     }
  25
  26     $c->stash->{template} = '/analytics_protocols/index.mas';
  27 }
  28
  29 sub analytics_protocol_detail :Path('/analytics_protocols') Args(1) {
  30     my $self = shift;
  31     my $c = shift;
  32     my $analytics_protocol_id = shift;
  33     my $schema = $c->dbic_schema("Bio::Chado::Schema");
  34     my $user = $c->user();
  35
  36     my $user_id;
  37     if ($c->user()) {
  38         $user_id = $c->user->get_object()->get_sp_person_id();
  39     }
  40     if (!$user_id) {
  41         $c->res->redirect( uri( path => '/user/login', query => { goto_url => $c->req->uri->path_query } ) );
  42         $c->detach();
  43     }
  44
  45     print STDERR "Viewing analytics protocol with id $analytics_protocol_id\n";
  46
  47     my $protocolprop_type_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'analytics_protocol_properties', 'protocol_property')->cvterm_id();
  48     my $protocolprop_results_type_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'analytics_protocol_result_summary', 'protocol_property')->cvterm_id();
  49
  50     my $q = "SELECT nd_protocol.nd_protocol_id, nd_protocol.name, nd_protocol.type_id, nd_protocol.description, nd_protocol.create_date, nd_protocolprop.value
  51         FROM nd_protocol
  52         JOIN nd_protocolprop USING(nd_protocol_id)
  53         WHERE nd_protocolprop.type_id=$protocolprop_type_cvterm_id AND nd_protocol.nd_protocol_id = ?;";
  54     my $h = $schema->storage->dbh()->prepare($q);
  55     $h->execute($analytics_protocol_id);
  56     my ($nd_protocol_id, $name, $type_id, $description, $create_date, $props_json) = $h->fetchrow_array();
  57
  58     if (! $name) {
  59         $c->stash->{template} = '/generic_message.mas';
  60         $c->stash->{message} = 'The requested analytics protocol ID does not exist in the database.';
  61         return;
  62     }
  63
  64     my $q2 = "SELECT value
  65         FROM nd_protocolprop
  66         WHERE type_id=$protocolprop_results_type_cvterm_id AND nd_protocol_id = ?;";
  67     my $h2 = $schema->storage->dbh()->prepare($q2);
  68     $h2->execute($analytics_protocol_id);
  69     my ($result_props_json) = $h2->fetchrow_array();
  70
  71     my %available_types = (
  72         SGN::Model::Cvterm->get_cvterm_row($schema, 'drone_imagery_analytics_env_simulation_protocol', 'protocol_type')->cvterm_id() => 'Drone Imagery Environment Simulation'
  73     );
  74
  75     my $result_props_json_array = $result_props_json ? decode_json $result_props_json : [];
  76     # print STDERR Dumper $result_props_json_array;
  77
  78     $c->stash->{analytics_protocol_id} = $nd_protocol_id;
  79     $c->stash->{analytics_protocol_name} = $name;
  80     $c->stash->{analytics_protocol_description} = $description;
  81     $c->stash->{analytics_protocol_type_id} = $type_id;
  82     $c->stash->{analytics_protocol_type_name} = $available_types{$type_id};
  83     $c->stash->{analytics_protocol_create_date} = $create_date;
  84     $c->stash->{analytics_protocol_properties} = decode_json $props_json;
  85     $c->stash->{analytics_protocol_result_summary} = $result_props_json_array;
  86     $c->stash->{template} = '/analytics_protocols/detail.mas';
  87 }
  88
  89 1;