lib/SGN/Controller/Marker.pm

   1 =head1 NAME
   2
   3 SGN::Controller::Marker - controller for marker-related stuff
   4
   5 =cut
   6
   7 package SGN::Controller::Marker;
   8 use Moose;
   9 use namespace::autoclean;
  10
  11 BEGIN { extends 'Catalyst::Controller' }
  12
  13 use File::Spec::Functions;
  14
  15
  16 =head1 PUBLIC ACTIONS
  17
  18 =head2 view_rflp_image
  19
  20 Public path: /marker/<marker_id>/rflp_image/view
  21
  22 =cut
  23
  24 sub view_rflp_image: Chained('get_marker') PathPart('rflp_image/view') :Args(0) {
  25   my ( $self, $c, ) = @_;
  26
  27   my $image_size = $c->req->query_parameters->{size};
  28
  29   my $image_location = $self->rflp_image_link( $c, $c->stash->{marker} )
  30       or $c->throw_404( "RFLP image not found for SGN-M".$c->stash->{marker}->marker_id );
  31
  32   $c->stash(
  33       template => '/markers/view_rflp.mas',
  34
  35       image_location => $image_location,
  36       image_size     => $image_size
  37      );
  38 }
  39
  40
  41 =head2 marker_details
  42
  43 Public path: /marker/SGN-M23545/details
  44
  45 Show the HTML detail page for this marker.
  46
  47 =cut
  48
  49
  50 sub marker_details: Chained('get_marker') PathPart('details') :Args(0) {
  51   my ( $self, $c ) = @_;
  52
  53   $c->stash(
  54       template  => '/markers/index.mas',
  55       dbh       => $c->dbc->dbh,
  56      );
  57 }
  58
  59
  60 =head2 get_marker
  61
  62 Public path: /marker/SGN-M23545
  63
  64 Chaining base for fetching the marker indicated by the given marker
  65 id.  The marker ID is an SGN-M identifier.
  66
  67 =cut
  68
  69
  70 sub get_marker: Chained('/') PathPart('marker') :CaptureArgs(1) {
  71     my ( $self, $c, $marker_id ) = @_;
  72
  73     ($marker_id) = $marker_id =~ /^SGN-M(\d+)$/i
  74         and $c->stash->{marker} = CXGN::Marker->new( $c->dbc->dbh, $marker_id)
  75         or $c->throw_404('No marker found with that ID');
  76
  77     $c->stash->{marker_id} = $marker_id;
  78 }
  79
  80
  81 ############ helper methods ########
  82
  83 # Returns the stuff that goes in the 'href' attribute of the 'a' tag for
  84 # an RFLP image, or undef if there is no image.
  85
  86 # =cut
  87
  88 sub rflp_image_link {
  89     my ( $class, $c, $marker ) = @_;
  90     my $marker_name = uc $marker->name_that_marker();
  91     my ( $dir ) = $marker_name =~ /^(CD|CT|PC|PG|TG|PCD2)/
  92         or return;
  93
  94     my $source = catfile( $c->get_conf('image_path'), 'rflp', $dir, "$marker_name.jpg" );
  95
  96     return unless -f $source;
  97
  98     return catfile( $c->get_conf('static_datasets_url'), 'images','rflp', $dir, "$marker_name.jpg" );
  99 }
 100
 101
 102 1;