view release on metacpan or  search on metacpan

cgi-bin/gbrowse_details  view on Meta::CPAN

    my $self = shift;
    
    my $conf    = $self->globals;
    my $session = $conf->session;
    $conf->update_data_source($session);
    $self->source($conf->create_data_source($session->source));
    $self->state($session->page_settings);
    $self->add_user_tracks($session);

    my $name  = param('name');
    my $class = param('class');
    my $ref   = param('ref');
    my $start = param('start');
    my $end   = param('end');
    my $f_id  = param('feature_id');
    my $db_id = param('db_id');
    my $rmt   = param('remote');

    $self->state->{dbid} = $db_id if $db_id; # to search correct database

    # This populates the $self->{urls} variable with link rules from the config file.
    $self->get_link_urls();

    my $search = Bio::Graphics::Browser2::RegionSearch->new(
	{
	    source => $self->source,
	    state  => $self->state,
	});
    $search->init_databases();

    # this is the weird part; we create a search name based on the arguments
    # provided to us
    my ($search_term,$search_class);
    if ($f_id) {
	$search_term = "id:$f_id";
    } elsif ($class && $name) {
	$search_term  = $name;
	$search_class = $class;
    } elsif (defined $ref && defined $start && defined $end) {
	$search_term = "$ref:$start..$end";
    } else {
	$search_term = $name;
    }
    unless (defined $search_term) {
	print header,
	start_html('gbrowse_details error'),
	p({-class=>'error'},
	  'This script must be called with one or more of the parameters name, feature_id or db_id.');
	end_html;
	exit 0;
    }

    warn "search term = $search_term" if DEBUG;

    my $features = eval {$search->search_features({-name=>$search_term,-class=>$search_class})} || [];
    warn "search_features(-search_term=>$search_term): $@" if $@;

    warn "features = @$features" if DEBUG;
    warn "segments = ",join ' ',$features->[0]->segments if (DEBUG && @$features);

    # provide customized content for popup balloons
    if (defined $rmt) {
	print header,start_html;
	print $self->remote_content($rmt,$features->[0]);
	print end_html;
    }

    else {
	print header();
	my $css = $self->source->global_setting('stylesheet');
	my $stylesheet = $self->globals->resolve_path($css,'url');
	{
	    	local $^W = 0; # shut up a warning from CGI.pm
		print start_html(-title => "GBrowse Details: $search_term",
				 -style => $stylesheet);
		print h1("$name Details");
	}

	if (@$features) {
	    print $self->print_features($features);
	} else {
	    print p({-class=>'error'},'Requested feature not found in database.');
	}
	print end_html();
    }

}

sub add_user_tracks {
    my $self    = shift;
    my $session = shift;
    my $source  = $self->source;

    my $userdata = Bio::Graphics::Browser2::UserTracks->new($source,$session);
    my @user_tracks = $userdata->tracks;
    for my $track (@user_tracks) {
	my $config_path = $userdata->track_conf($track);
	eval {$source->parse_user_file($config_path)};
    }
}

######################

sub print_features {
    my $self     = shift;
    my $features = shift;
    my $subf     = shift || 0;

    my $string;

    my @colors = qw(none lightgrey yellow pink orange brown
	        tan teal cyan lime green blue gray);

    for my $f (@$features) {

	my $method = $f->primary_tag . $subf;
	warn "index = $self->{index}, method = $method" if DEBUG;
	$self->{colors}{$method} ||= $colors[$self->{index}++ % @colors];
	my $options = {-bgcolor => $self->{colors}{$method}}
	               unless $self->{colors}{$method} eq 'none';

cgi-bin/gbrowse_details  view on Meta::CPAN

    $formatter =~ s/\$description/$description/g;

    return map {my $tmp_formatter = $formatter;
		$tmp_formatter =~ s/\$value/$_/g;      
		$tmp_formatter} @values;
}

sub get_formatter {
    my $self           = shift;
    my ($feature,$tag) = @_;

    my $method  = $feature->primary_tag;
    my $source  = $feature->source_tag;
    my $key     = join ':',$method,$source,$tag;

    return $self->{formatterCache}{$key} 
      if exists $self->{formatterCache}{$key};

    my $config = $self->source;
    my $s;

    # implement simple search path for formatters
  SEARCH:
    for my $base ("$method:$source",$method,'default') {
	for my $option ($tag,'default') {
	    $s ||= $config->setting("$base:details" => lc $option);
	    $s ||= $config->setting("$base:DETAILS" => lc $option);
	    last SEARCH if defined $s;
	}
    }

    unless (defined $s) {
	$s = sub {$self->format_position(@_)}   if $tag eq 'Position';
	# $s = sub {$self->format_position(@_)} if $tag eq 'Matches';
	$s = sub {$self->format_name(@_)    }   if $tag eq 'Name';
    }
    return $self->{formatterCache}{$key} = $s;
}

sub format_position {
    my $self = shift;
    my (undef,undef,$feature) = @_;
    $self->position($feature);
}

sub format_matches {
    my $self = shift;
    my (undef,undef,$feature) = @_;
    # try to correct for common GFF2 error of indicating a -/- alignment
    # using a (-) src strand and a hit_start > hit_end
    my $bug = $feature->strand < 0 && $feature->hit->strand < 0;
    $self->position($feature->hit,undef,$bug)
}

sub format_name {
    my $self = shift;
    my $name = shift;
    b($name)
}

# do something for popup balloons
sub remote_content {
    my $self = shift;

    # the key for the text or code-ref in the gbrowse config file
    my ($key,$feat) = @_;

    my $contents = $self->source->setting('TOOLTIPS',$key) 
	or die "$key is empty";
    my $coderef = (ref $contents||'') eq 'CODE';
    return $contents unless $coderef;

    # paranoia?
    die "Error: $key is not a CODE-REF" if ref $contents && !$coderef;

    # pass feature, other args are user-defined
    my %args = (feature => $feat) if $feat;
    for my $arg (param()) {
	my @vals = param($arg);
	my $val  = @vals > 1 ? \@vals : $vals[0];
	$args{$arg} = $val;
    }
    return $contents->(\%args);
}

sub reversec {
    my $dna = shift;
    $dna =~ tr/gatcGATC/ctagCTAG/;
    $dna = reverse $dna;
    return $dna;
}

__END__