GBrowse
view release on metacpan or search on metacpan
lib/Bio/Graphics/Browser2/Render/HTML/TrackListing/Categories.pm view on Meta::CPAN
$filter_active = @labels<$tracks; # mark filter active if the filter has changed the track count
}
$filter_active++ if $settings->{active_only} || $settings->{show_favorites};
# for unknown reasons, replacing the below loop with "map"
# causes lots of undefined variable warnings.
my (%labels,%label_sort);
for my $l (@labels) {
$labels{$l} = $self->render_one_track($l,\@hilite);
$label_sort{$l} = $render->label2key($l);
}
my @defaults = grep {$settings->{features}{$_}{visible} } @labels;
# Sort the tracks into categories:
# Overview tracks
# Region tracks
# Regular tracks (which may be further categorized by user)
# Plugin tracks
# External tracks
my %track_groups;
foreach (@labels) {
my $category = $self->categorize_track($_);
push @{$track_groups{$category}},$_;
}
autoEscape(0);
# Get the list of all the categories needed.
my %exclude = map {$_=>1} map {$render->translate($_)} qw(OVERVIEW REGION ANALYSIS EXTERNAL);
(my $usertrack_cat = $render->translate('UPLOADED_TRACKS_CATEGORY')||'') =~ s/:.+$//;
$usertrack_cat ||= '';
my @user_tracks = grep {/^$usertrack_cat/i} keys %track_groups;
$exclude{$_}++ foreach @user_tracks;
my @user_keys = grep {!$exclude{$_}} sort keys %track_groups;
my $all_on = $render->translate('ALL_ON');
my $all_off = $render->translate('ALL_OFF');
my (%seenit,%section_contents);
my @categories = (@user_keys,
$render->translate('OVERVIEW'),
$render->translate('REGION'),
$render->translate('ANALYSIS'),
);
unshift @categories,@user_tracks if @user_tracks;
my $c_default = $source->category_default;
my @titles; # for sorting
# For each category, create the appropriately-nested node. "My Tracks" node positions comes from the track's config file.
my $usertracks = $render->user_tracks;
foreach my $category (@categories) {
next if $seenit{$category}++;
my $id = "${category}_section";
my $category_title = (split m/(?<!\\):/,$category)[-1];
$category_title =~ s!($_)!<span style="background-color:yellow">$1</span>!gi foreach @hilite;
my $file_id;
if ($category eq $render->translate('REGION') && !$render->setting('region segment')) {
next;
}
elsif (exists $track_groups{$category}) {
my @track_labels = @{$track_groups{$category}};
$settings->{sk} ||= 'sorted'; # get rid of annoying warning
# if these tracks are in a grid, then don't sort them
BLOCK: {
no warnings; # kill annoying uninit warnings under modperl
@track_labels = sort {lc ($label_sort{$a}) cmp lc ($label_sort{$b})} @track_labels
if $settings->{sk} eq 'sorted' && !defined $category_table_labels->{$category};
}
my $visible = $filter_active ? 1
: exists $settings->{section_visible}{$id} ? $settings->{section_visible}{$id}
: $c_default;
my @entries = map {$labels{$_}} @track_labels;
my $table = $self->tableize(\@entries,$category,\@track_labels);
# Get the content for this track.
my ($control,$section)=$render->toggle_section({on=>$visible,nodiv => 1},
$id,
b(ucfirst $category_title),
div({-style=>'padding-left:1em'},
span({-id=>$id},$table)));
$control .= ' '.i({-class=>'nojs'},
checkbox(-id=>"${id}_a",-name=>"${id}_a",
-label=>$all_on,-onClick=>"gbCheck(this,1);"),
checkbox(-id=>"${id}_n",-name=>"${id}_n",
-label=>$all_off,-onClick=>"gbCheck(this,0);")
)." ".span({-class => "list",
-id => "${id}_list",
-style => "display: " . ($visible? "none" : "inline") . ";"},"")
.br();
$section_contents{$category} = div({-class=>'track_section'},$control.$section);
}
else {
next;
}
}
autoEscape(1);
my $slice_and_dice = $self->indent_categories(\%section_contents,\@categories,$filter_active);
my $expand_all = ' ' .img({-class => 'clickable expand_all range_expand',
-src => $source->globals->button_url .'/open_open.png',
-onClick => "gbExpandAll(this,'range',event)"});
return join( "\n",
start_form(-name=>'trackform',
-id=>'trackform'),
div({-class=>'searchbody',-id=> 'range', -style=>'padding-left:1em'},$expand_all,br(),$slice_and_dice),
lib/Bio/Graphics/Browser2/Render/HTML/TrackListing/Categories.pm view on Meta::CPAN
my $label = shift;
my $render = $self->render;
my $user_labels = $render->get_usertrack_labels;
return $render->translate('OVERVIEW') if $label =~ /:overview$/;
return $render->translate('REGION') if $label =~ /:region$/;
return $render->translate('EXTERNAL') if $label =~ /^(http|ftp|file):/;
return $render->translate('ANALYSIS') if $label =~ /^plugin:/;
if ($user_labels->{$label}) {
my $cat = $render->user_tracks->is_mine($user_labels->{$label})
? $render->translate('UPLOADED_TRACKS_CATEGORY')
: $render->translate('SHARED_WITH_ME_CATEGORY');
return "$cat:".$render->user_tracks->title($user_labels->{$label});
}
my $category;
for my $l ($render->language->language) {
$category ||= $render->setting($label=>"category:$l");
}
$category ||= $render->setting($label => 'category');
$category ||= ''; # prevent uninit variable warnings
$category =~ s/^["']//; # get rid of leading quotes
$category =~ s/["']$//; # get rid of trailing quotes
return $category ||= $render->translate('GENERAL');
}
# Category Table - This returns the hash of the category table.
sub category_table {
my $self = shift;
my $source = $self->source;
my $tabledata = $source->setting('category tables');
my @tabledata = shellwords($tabledata||'');
my %categorytable=();
while (@tabledata) {
my $category = shift(@tabledata);
my $rows = shift(@tabledata);
my @rows = split(/\s+/,$rows);
my $cols = shift(@tabledata);
my @cols = split(/\s+/,$cols);
$categorytable{$category}{row_labels}=\@rows;
$categorytable{$category}{col_labels}=\@cols;
}
return \%categorytable;
}
sub indent_categories {
my $self = shift;
my ($contents,$categories,$force_open) = @_;
my $category_hash = {};
my %sort_order;
my $sort_index = 0;
for my $category (@$categories) {
my $cont = $contents->{$category} || '';
my @parts = map {s/\\//g; $_} split m/(?<!\\):/,$category;
$sort_order{$_} = $sort_index++ foreach @parts;
my $i = $category_hash;
# we need to add phony __next__ and __contents__ keys to avoid
# the case in which the track sections are placed at different
# levels of the tree, for instance
# "category=level1:level2" and "category=level1"
for my $index (0..$#parts) {
$i = $i->{__next__}{$parts[$index]} ||= {};
$i->{__contents__} = $cont if $index == $#parts;
}
}
my $i = 1;
my $nested_sections = $self->nest_toggles($category_hash,\%sort_order,$force_open);
}
# Nest Toggles - This turns the nested category/subcategory hashes into a prettily-indented tracks table.
sub nest_toggles {
my $self = shift;
my ($hash,$sort,$force_open) = @_;
my $settings = $self->settings;
my $source = $self->source;
my $render = $self->render;
my $result = '';
my $default = $source->category_default;
for my $key (sort {
($sort->{$a}||0)<=>($sort->{$b}||0) || $a cmp $b
} keys %$hash) {
if ($key eq '__contents__') {
$result .= $hash->{$key}."\n";
} elsif ($key eq '__next__') {
$result .= $self->nest_toggles($hash->{$key},$sort,$force_open);
} elsif ($hash->{$key}{__next__}) {
my $id = "${key}_section";
my $ea = ' ' . img({-class => "clickable expand_all ${id}_expand",
-src => $source->globals->button_url .'/open_open.png',
-onClick => "gbExpandAll(this,'$id',event)"});
$settings->{section_visible}{$id} = $default unless exists $settings->{section_visible}{$id};
$result .= $render->toggle_section({on=>$force_open||$settings->{section_visible}{$id}},
$id,
b($key).
$ea.
span({-class => "list",
-id => "${id}_list"},''),
div({-style=>'margin-left:1.5em;margin-right:1em'},
$self->nest_toggles($hash->{$key},$sort,$force_open)));
} else {
$result .= $self->nest_toggles($hash->{$key},$sort,$force_open);
}
}
return $result;
}
1;
( run in 0.615 second using v1.01-cache-2.11-cpan-71847e10f99 )