view release on metacpan or  search on metacpan

lib/Bio/Graphics/Browser2/RenderPanels.pm  view on Meta::CPAN

  my $self = shift;
  my %args = @_;

  my $labels          = $args{-labels}    or die "programming error";
  my $segment         = $args{-segment}   or die "programming error";
  my $tracks          = $args{-tracks}    or die "programming error";
  my $filters         = $args{-filters}   or die "programming error";
  my $fsettings       = $args{-fsettings} or die "programming error";

  warn "[$$] add_features_to_track @{$args{-labels}}" if DEBUG;

  my $max_labels      = $self->label_density;
  my $max_bump        = $self->bump_density;

  my $length  = $self->segment_length;
  my $source  = $self->source;

  # sort tracks by the database they come from
  my (%db2label,%db2db);
  for my $label (@$labels) {
    my $db = eval { $source->open_database($label,$length)};
    unless ($db) { warn "Couldn't open database for $label: $@"; next; }
    $db2label{$db}{$label}++;
    $db2db{$db}  =  $db;  # cache database object
  }

  my (%iterators,%iterator2dbid,%is_summary,%type2label);
  for my $db (keys %db2db) {
      my @labels           = keys %{$db2label{$db}};

      my (@full_types,@summary_types);
      for my $l (@labels) {
	  my @types = $source->label2type($l,$length) or next;
	  if ($source->show_summary($l,$length,$self->settings)) {
	      $is_summary{$l}++;
	      push @summary_types,@types;
	  } else {
	      push @full_types,@types;
	  }
	  $type2label{$_}{$l}++ foreach @types;
      }
      $self->{_type2label}=\%type2label;

      warn "[$$] RenderPanels->get_iterator(@full_types)"  if DEBUG;
      warn "[$$] RenderPanels->get_summary_iterator(@summary_types)" if DEBUG;
      if (@summary_types &&
	  (my $iterator = $self->get_summary_iterator($db2db{$db},$segment,\@summary_types))) {
	  $iterators{$iterator}     = $iterator;
	  $iterator2dbid{$iterator} = $source->db2id($db);
      }

      if (@full_types && (my $iterator = $self->get_iterator($db2db{$db},$segment,\@full_types))) {
	  $iterators{$iterator}     = $iterator;
	  $iterator2dbid{$iterator} = $source->db2id($db);
      }
  }

  my (%groups,%feature_count,%group_pattern,%group_field);

  # The effect of this loop is to fetch a feature from each iterator in turn
  # using a queueing scheme. This allows streaming iterators to parallelize a
  # bit. This may not be worth the effort.
  my (%feature2dbid,%classes,%limit_hit,%has_subtracks);

  while (keys %iterators) {
    for my $iterator (values %iterators) {

      my $feature;

      unless ($feature = $iterator->next_seq) {
	delete $iterators{$iterator};
	next;
      }

      $source->add_dbid_to_feature($feature,$iterator2dbid{$iterator});
      my @labels = $self->feature2label($feature);

      warn "[$$] $iterator->next_seq() returns $feature, will assign to @labels" if DEBUG;

      for my $l (@labels) {

          $l =~ s/:\d+//;  # get rid of semantic zooming tag

	  my $track = $tracks->{$l}  or next;

	  my $stt        = $self->subtrack_manager($l);
	  my $is_summary = $is_summary{$l};

	  $filters->{$l}->($feature) or next if $filters->{$l} && !$is_summary;
	  $feature_count{$l}++;

	  # -----------------------------------------------------------------------------
	  # GROUP CODE
	  # Handle name-based groupings.
	  unless (exists $group_pattern{$l}) {
	      $group_pattern{$l} =  $source->semantic_setting($l => 'group_pattern',$length);
	      $group_pattern{$l} =~ s!^/(.+)/$!$1!
		  if $group_pattern{$l}; # clean up regexp delimiters
	  }

	  # Handle generic grouping (needed for GFF3 database)
 	  $group_field{$l} = $source->semantic_setting($l => 'group_on',$length)
	      unless exists $group_field{$l};

	  if (my $pattern = $group_pattern{$l}) {
	      my $name = $feature->name or next;
	      (my $base = $name) =~ s/$pattern//i;
	      $groups{$l}{$base}  ||= Bio::Graphics::Feature->new(-type   => 'group',
								  -name   => $feature->display_name,
								  -strand => $feature->strand,
		  );
	      $groups{$l}{$base}->add_segment($feature);
	      next;
	  }

	  if (my $field = $group_field{$l}) {
	      my $base = eval{$feature->$field};
	      if (defined $base) {
		  $groups{$l}{$base} ||= Bio::Graphics::Feature->new(-name   => $feature->display_name,
								     -start  => $feature->start,
								     -end    => $feature->end,