lib/SGN/Controller/GenotypeProtocol.pm

   1 package SGN::Controller::GenotypeProtocol;
   2
   3 use Moose;
   4 use Data::Dumper;
   5 use Try::Tiny;
   6 use SGN::Model::Cvterm;
   7 use Data::Dumper;
   8 use CXGN::Trial::Folder;
   9 use CXGN::Genotype::Protocol;
  10 use File::Basename qw | basename dirname|;
  11 use File::Spec::Functions;
  12 use File::Slurp qw | read_file |;
  13
  14
  15 BEGIN { extends 'Catalyst::Controller'; }
  16
  17 has 'schema' => (
  18     is       => 'rw',
  19     isa      => 'DBIx::Class::Schema',
  20     lazy_build => 1,
  21 );
  22
  23 sub _build_schema {
  24     shift->_app->dbic_schema( 'Bio::Chado::Schema', 'sgn_chado' )
  25 }
  26
  27 sub protocol_page :Path("/breeders_toolbox/protocol") Args(1) {
  28     my $self = shift;
  29     my $c = shift;
  30     my $protocol_id = shift;
  31     my $schema = $self->schema;
  32
  33     if (!$c->user()) {
  34
  35         my $url = '/' . $c->req->path;
  36         $c->res->redirect("/user/login?goto_url=$url");
  37
  38     } else {
  39
  40         my $protocol = CXGN::Genotype::Protocol->new({
  41             bcs_schema => $schema,
  42             nd_protocol_id => $protocol_id
  43         });
  44
  45     my $display_observation_unit_type;
  46     my $observation_unit_type = $protocol->sample_observation_unit_type_name;
  47     if ($observation_unit_type eq 'tissue_sample_or_accession') {
  48         $display_observation_unit_type = 'tissue sample or accession';
  49     } else {
  50         $display_observation_unit_type = $observation_unit_type;
  51     }
  52
  53     my $marker_info_keys = $protocol->marker_info_keys;
  54     my $assay_type = $protocol->assay_type;
  55     my @marker_info_headers = ();
  56     if (defined $marker_info_keys) {
  57         foreach my $info_key (@$marker_info_keys) {
  58             if ($info_key eq 'name') {
  59                 push @marker_info_headers, 'Marker Name';
  60             } elsif (($info_key eq 'intertek_name') || ($info_key eq 'facility_name')) {
  61                 push @marker_info_headers, 'Facility Marker Name';
  62             } elsif ($info_key eq 'chrom') {
  63                 push @marker_info_headers, 'Chromosome';
  64             } elsif ($info_key eq 'pos') {
  65                 push @marker_info_headers, 'Position';
  66             } elsif ($info_key eq 'alt') {
  67                 if ($assay_type eq 'KASP') {
  68                     push @marker_info_headers, 'Y-allele';
  69                 } else {
  70                     push @marker_info_headers, 'Alternate';
  71                 }
  72             } elsif ($info_key eq 'ref') {
  73                 if ($assay_type eq 'KASP') {
  74                     push @marker_info_headers, 'X-allele';
  75                 } else {
  76                     push @marker_info_headers, 'Reference';
  77                 }
  78             } elsif ($info_key eq 'qual') {
  79                 push @marker_info_headers, 'Quality';
  80             } elsif ($info_key eq 'filter') {
  81                 push @marker_info_headers, 'Filter';
  82             } elsif ($info_key eq 'info') {
  83                 push @marker_info_headers, 'Info';
  84             } elsif ($info_key eq 'format') {
  85                 push @marker_info_headers, 'Format';
  86             } elsif ($info_key eq 'sequence') {
  87                 push @marker_info_headers, 'Sequence';
  88             }
  89         }
  90     } else {
  91         @marker_info_headers = ('Marker Name','Chromosome','Position','Alternate','Reference','Quality','Filter','Info','Format');
  92     }
  93
  94     my $protocol_vcf_details_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'vcf_map_details', 'protocol_property')->cvterm_id();
  95     my $protocolprop_rs = $schema->resultset('NaturalDiversity::NdProtocolprop')->find({'nd_protocol_id' => $protocol_id, 'type_id' => $protocol_vcf_details_cvterm_id});
  96     my $map_details_protocolprop_id;
  97     if ($protocolprop_rs) {
  98         $map_details_protocolprop_id = $protocolprop_rs->nd_protocolprop_id();
  99     }
 100
 101         $c->stash->{protocol_id} = $protocol_id;
 102         $c->stash->{protocol_name} = $protocol->protocol_name;
 103         $c->stash->{protocol_description} = $protocol->protocol_description;
 104         $c->stash->{markers} = $protocol->markers || {};
 105         $c->stash->{marker_names} = $protocol->marker_names || [];
 106         $c->stash->{header_information_lines} = $protocol->header_information_lines || [];
 107         $c->stash->{reference_genome_name} = $protocol->reference_genome_name;
 108         $c->stash->{species_name} = $protocol->species_name;
 109         $c->stash->{create_date} = $protocol->create_date;
 110         $c->stash->{sample_observation_unit_type_name} = $display_observation_unit_type;
 111     $c->stash->{marker_type} = $protocol->marker_type;
 112     $c->stash->{marker_info_headers} = \@marker_info_headers;
 113     $c->stash->{assay_type} = $protocol->assay_type;
 114     $c->stash->{map_details_protocolprop_id} = $map_details_protocolprop_id;
 115     $c->stash->{template} = '/breeders_toolbox/genotyping_protocol/index.mas';
 116     }
 117 }
 118
 119
 120 sub pcr_protocol_genotype_data_download : Path('/protocol_genotype_data/pcr_download/') Args(1) {
 121     my $self  =shift;
 122     my $c = shift;
 123     my $file_id = shift;
 124     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
 125     my $metadata_schema = $c->dbic_schema('CXGN::Metadata::Schema', undef, $sp_person_id);
 126     my $file_row = $metadata_schema->resultset("MdFiles")->find({file_id => $file_id});
 127     my $file_destination =  catfile($file_row->dirname, $file_row->basename);
 128     my $contents = read_file($file_destination);
 129     my $file_name = $file_row->basename;
 130
 131     $c->res->content_type('Application/trt');
 132     $c->res->header('Content-Disposition', qq[attachment; filename="$file_name"]);
 133     $c->res->body($contents);
 134 }
 135
 136
 137 1;