view release on metacpan or  search on metacpan

cgi-bin/gbrowse_syn  view on Meta::CPAN

sub species_chooser {
  # pointless if < 3 species
  return '' if keys %$MAP < 3;
  my $src = $CONF->search_src();
  my @species = grep {$_ ne $src} grep {$MAP->{$_}->{db}} keys %$MAP;
  my $default = $CONF->page_settings->{species} || \@species;
  push @$default, $CONF->page_settings('old_src');

  if (!param('species')) {
    $default = [keys %$MAP];
  }
 
  b(wiki_help('Aligned_Species',,$CONF->tr('Aligned Species'))) . ':' . br .
  checkbox_group(
		 -id        => 'speciesChooser',
		 -name      => 'species',
		 -values    => \@species,
		 -labels    => { map {$_ => $MAP->{$_}->{desc} } @species },
		 -default   => $default,
		 -multiple  => 1,
		 -size      => 8,
		 -override  => 1,
	     );
}

sub expand_notice {
  # pointless if < 4 species
  return '' if keys %$MAP < 4;
  my $state = param('display') || $CONF->page_settings->{display};
  my $ref = $CONF->search_src; 
  my $title = b(wiki_help("Display_Mode",$CONF->tr("Display Mode")), ':');

  my $url = url . "/" . $CONF->source;
  if ($state eq 'expanded') {
    return br, $title, br,  "Three species/panel ",
	a( {-href => $url.'?display=compact'}, 'Click to show all species in one panel');
  } 
  else {
    return br, $title, br, 'All species in one panel ',
    a( {-href => $url.'?display=expanded'}, 'Click to show reference plus two species/panel');
  }
}

sub landmark_search {
  my $segment = shift;
  my $default = format_segment($segment) if $segment;
  return $CONF->setting('no search')
      ? '' : b(wiki_help('Landmark',$CONF->tr('Landmark'))).':'.br.
      textfield(-name=>'name', -size=>25, -value=>$default);
}

sub species_search {
  my $default = $CONF->page_settings("search_src");
  my %labels = map {$_=>$MAP->{$_}{desc}} keys %$MAP; 
  my $values  = [sort {$MAP->{$a}{desc} cmp $MAP->{$b}{desc}} grep {$MAP->{$_}{desc}} keys %labels];
  unshift @$values, '';

  my $onchange = "document.searchform.submit()";
  return b(wiki_help('Reference_Species',$CONF->tr('Genome to Search'))) . ':' . br .
      popup_menu(
		 -onchange => $onchange,
		 -name     =>'search_src',
		 -values   => $values,
		 -labels   => \%labels,
		 -default  => $default,
		 -override => 1
		 );
}

sub search_form {
  my $segment = shift;
  print start_form(-name=>'searchform',-method => 'post');
  navigation_table($segment);
}

sub db_map {
  my %map;
  my @map = shellwords($CONF->setting('source_map'));
  while (my($symbol,$db,$desc) = splice(@map,0,3)) {
    $map{$symbol}{db}   = $db;
    $map{$symbol}{desc} = $desc;
  }
  \%map;
}

sub _type_from_box {
  my $box = shift;
  my @type = split ':', $box->[0];
  my ($feature,$fname) = @type[0,-1];
  return ($feature,$fname);
}


sub draw_image {
  my ($page_settings,$hits,@species) = @_;
  my ($toggle_section,@hits);
  for my $species (@species) {
    push @hits, grep {$_->src2 eq $species} @$hits;
  }
  
  my $src     = $CONF->page_settings("search_src");
  my $segment = $CONF->current_segment or return;
  my $max_segment = $CONF->setting('max_segment') || MAX_SEGMENT;

  if ( $segment->length > $max_segment) {
    my $units = $CONF->unit_label($max_segment);
    print h2("Sorry: the size of region $segment exceeds the maximum ($units)");
    exit;
  }

  my $max_gap = $segment->length * ($CONF->setting('max_span') || MAX_SPAN);

  # dynamically create synteny blocks
  @hits = aggregate(\@hits) if $CONF->page_settings("aggregate");
  
  # save the hits by name so we can access them from the name alone
  for (@hits) {
    $CONF->name2hit( $_->name => $_ );
  }
 

cgi-bin/gbrowse_syn  view on Meta::CPAN

    $slidertable = "$name not found in ".($CONF->search_src||'NO SPECIES SELECTED');
    my $style = "font-size:90%;color:red";
    $slidertable = p(b(span({-style=>$style},$slidertable)));
  }

  $CONF->section_setting(Instructions => 'open');
  $CONF->section_setting(Search => 'open');

 		   
  $table .= toggle( $CONF->tr('Instructions'),
			   div({-class=>'searchtitle'},
			       br.'Select a Region to Browse and a Reference species:',
			       p($CONF->show_examples())));
  
  my $html_frag = $INVALID_SRC ? '' : html_frag($segment,$CONF->page_settings);
  $table .= toggle( $CONF->tr('Search'),
                    table({-border=>0, -width => '100%', -cellspacing=>0},
                          TR({-class=>'searchtitle'},
                             td({-align=>'left', -colspan=>3},
                                $html_frag
                                )
                             ),
			  TR({-class=>'searchtitle'},
			     td({-align=>'left', -width=>'30%'},
				[
				 landmark_search($segment) . ' ' .
				 submit(-name=>$CONF->tr('Search')) .
				 reset(-name=>$CONF->tr('Reset'), -onclick=>"window.location='?reset=1'"),
				 species_search(),
				 $slidertable
				 ]
				)
			     ),
			  TR({-class=>'searchtitle'},
			     td({-colspan=>3},
				species_chooser())
			     ),
			  TR({-class=>'searchtitle'},
			     td({-valign=>'bottom'},
				source_menu()
				) .
			     td( {-colspan=>2, -valign=>'bottom'},
				expand_notice()
				)
			     ),
			  ) # end table
		    ); # end toggle section

  print $table,br;
}

sub expand_display {
  return '' if keys %$MAP < 4;
  my $options = [qw/expanded compact/];
  my $labels  = { expanded => 'ref. species plus 2',
		  compact  => 'all species in one panel' };
  my $default = ['expanded'];
  my $name    = 'display';

  b(' ', wiki_help("Display Mode",$CONF->tr('Display Mode')), ': ') .
  popup_menu({-name => $name, -labels => $labels, -values => $options, -default => $default});
}

sub options_table {
  my @onclick = ();
  my $radio_style = {-style=>"background:lightyellow;border:5px solid lightyellow", @onclick};
  my $space = '&nbsp;&nbsp';
  my @grid = (span($radio_style, option_check('Grid lines', 'pgrid'))) unless $SYNTENY_IO->nomap;

  print toggle( $CONF->tr('Display_settings'),
                table({-cellpadding => 5, -width => '100%', -border => 0, -class => 'searchtitle'},
                      TR(
                         td(
                            b(wiki_help('Image Widths',$CONF->tr('Image widths')), ': '),
                            span( $radio_style, radio_group( -name   => 'imagewidth',
                                                             -values => [640,768,800,1024,1280],
                                                             -default=>$CONF->page_settings('imagewidth'),
                                                             @onclick ))
                            ),
                         td(
                             expand_display()
                             ),
                         td(
                            submit(-name => 'Update Image')
                            )
                         ),
                      TR(
                         td( {-colspan => 3},
                             b(wiki_help('Image Options',$CONF->tr('Image options')), ': '),
                             div(
                                 span($radio_style, option_check('Chain alignments', 'aggregate')),$space,
                                 span($radio_style, option_check('Flip minus strand panels', 'pflip')),$space,
                                 @grid,
                                 span($radio_style, option_check('Edges', 'edge')), $space,
                                 span($radio_style, option_check('Shading', 'shading')),
                                 )
                             )
                         )
                      )
                );
}


sub option_check {
  my $label = shift;
  my $name  = shift;
  $label = wiki_help($label,$CONF->tr($label));
  my $checked = $CONF->page_settings("$name") ? 'on' : 'off';
  return $label.' '.radio_group(-name => $name, -values => [qw/on off/], -default =>$checked);
}

sub source_menu {
  my $settings = shift;
  my @sources      = $CONF->sources;
  my $show_sources = $CONF->setting('show sources');
  $show_sources    = 1 unless defined $show_sources;   # default to true
  my $sources = $show_sources && @sources > 1;
  my $source = $CONF->get_source;
  return $sources ? b(wiki_help('Data Source',$CONF->tr('Data Source')), ': ') . br.
      popup_menu(-onchange => 'document.searchform.submit()',
		 -name   => 'source',
		 -values => \@sources,
		 -labels => { map {$_ => $CONF->description($_)} $CONF->sources},
		 -default => $source,		 
		 ) : $CONF->description($sources[0]);
}


sub aggregate {
  my $hits = shift;
  $CONF->{parts} = {};

  my @sorted_hits = sort { $a->target cmp $b->target || $a->tstart <=> $b->tstart} @$hits;

  my (%group,$last_hit);

  for my $hit (@sorted_hits) {
    if ($last_hit && belong_together($last_hit,$hit)) {
      push @{$group{$last_hit}}, $hit;
      $group{$hit} = $group{$last_hit};
    }
    else {
      push @{$group{$hit}}, $hit;
    }

    $last_hit = $hit;
  }

  $hits = [];
  my %seen;
  for my $grp (grep {++$seen{$_} == 1} values %group) {
    if (@$grp > 1) {
      my @coords  = sort {$a<=>$b} map {$_->start,$_->end}   @$grp;
      my @tcoords = sort {$a<=>$b} map {$_->tstart,$_->tend} @$grp;
      my $hit = Legacy::DB::SyntenyBlock->new($grp->[0]->name."_aggregate");
      $hit->add_part($grp->[0]->src,$grp->[0]->tgt);
      $hit->start(shift @coords);
      $hit->end(pop @coords);
      $hit->tstart(shift @tcoords);
      $hit->tend(pop @tcoords);
      $CONF->{parts}->{$hit->name} = $grp;
      push @$hits, $hit;
    }
    else {
      push @$hits, $grp->[0];
    }
  }

  return @$hits;
}

sub belong_together { 
  my ($feat1,$feat2) = @_;
  my $max_gap = $CONF->setting('max_gap') || MAX_GAP;
  return unless $feat1->target  eq $feat2->target;  # same chromosome
  return unless $feat1->seqid   eq $feat2->seqid;   # same reference sequence
  return unless $feat1->tstrand eq $feat2->tstrand; # same strand                                                                                            
  if ($feat1->tstrand eq '+') {
    return unless $feat1->end < $feat2->end;   # '+' strand monotonically increasing                                                                            
  } else {