cgi-bin/tools/sixframe_translate.pl

   1 use CatalystX::GlobalContext qw( $c );
   2 # instead of linking to this, consider just embedding the translations
   3 # directly into the relevant detail page
   4
   5 use strict;
   6 use warnings;
   7
   8 use CGI;
   9 use Bio::PrimarySeq;
  10
  11 my $cgi = CGI->new;
  12 my $seq = get_legacy_est( $cgi ) || get_legacy_unigene( $cgi ) || get_direct_seq( $cgi )
  13     or $c->throw( message => 'No sequence found.', is_error => 0 );
  14
  15 $c->forward_to_mason_view( '/tools/sixframe_translate_standalone.mas',
  16                            seq => $seq,
  17                            blast_url => '/tools/blast'
  18                          );
  19
  20
  21 # ========= helper functions =======
  22
  23 sub get_legacy_est {
  24     my ($cgi) = @_;
  25
  26     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  27
  28     my $est_id = $cgi->param('est_id')
  29         or return;
  30
  31     my $est = $c->dbic_schema('SGN::Schema', undef, $sp_person_id)
  32                 ->resultset('Est')
  33                 ->find( $est_id )
  34         or return;
  35
  36     return Bio::PrimarySeq->new( -id   => "SGN-E".($est_id+0),
  37                                  -seq  => $est->hqi_seq,
  38                                );
  39 }
  40
  41 sub get_legacy_unigene {
  42     my ($cgi) = @_;
  43
  44     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
  45
  46     my $unigene_id = $cgi->param('unigene_id')
  47         or return;
  48
  49     my $unigene = $c->dbic_schema('SGN::Schema', undef, $sp_person_id)
  50                     ->resultset('Unigene')
  51                     ->find( $unigene_id )
  52         or return;
  53
  54     return Bio::PrimarySeq->new( -id   => 'SGN-U'.( $unigene_id+0 ),
  55                                  -seq  => $unigene->seq,
  56                                );
  57 }
  58
  59 sub get_direct_seq {
  60     my ($cgi) = @_;
  61
  62     my $seq = $cgi->param('seq')
  63         or return;
  64
  65     my ( $seqid, $sequence ) = split '#', $seq;
  66     return Bio::PrimarySeq->new( -id => $seqid, -seq => $seq );
  67
  68 }
  69