AcePerl

 view release on metacpan or  search on metacpan

Ace.pm  view on Meta::CPAN

handle.  It should return a string indicating the perl class to
create.

=item B<-timeout>

If no response from the server is received within $timeout seconds,
the call will return an undefined value.  Internally timeout sets an
alarm and temporarily intercepts the ALRM signal.  You should be aware
of this if you use ALRM for your own purposes.

NOTE: this feature is temporarily disabled (as of version 1.40)
because it is generating unpredictable results when used with
Apache/mod_perl.

=item B<-query_timeout>

If any query takes longer than $query_timeout seconds, will return an
undefined value.  This value can only be set at connect time, and cannot
be changed once set.

=back

Ace.pm  view on Meta::CPAN

Create a new object in the database with the indicated class and name
and return a pointer to it.  Will return undef if the object already
exists in the database.  The object isn't actually written into the database
until you call Ace::Object::commit().

=head2 raw_query() method

    $r = $db->raw_query('Model');

Send a command to the database and return its unprocessed output.
This method is necessary to gain access to features that are not yet
implemented in this module, such as model browsing and complex
queries.

=head2 classes() method

   @classes = $db->classes();
   @all_classes = $db->classes(1);

This method returns a list of all the object classes known to the
server.  In a list context it returns an array of class names.  In a

Ace/Browser/AceSubs.pm  view on Meta::CPAN


=item $footer = Footer()

This function returns the contents of the footer as a string, but does 
not print it out.  It is not exported by default.

=cut

# Contents of the HTML footer.  It gets printed immediately before the </BODY> tag.
# The one given here generates a link to the "feedback" page, as well as to the
# privacy statement.  You may or may not want these features.
sub Footer {
  if (my $footer = Configuration()->Footer) {
    return $footer;
  }
  my $webmaster = $ENV{SERVER_ADMIN} || 'webmaster@sanger.ac.uk';

  my $obj_name =  escape(param('name'));
  my $obj_class = escape(param('class')) || ucfirst url(-relative=>1);
  my $referer   = escape(self_url());
  my $name      = get_symbolic();

Ace/Graphics/Fk.pm  view on Meta::CPAN


use strict;
*stop        = \&end;
*primary_tag = \&name;
*exons       = \&segments;

# usage:
# Ace::Graphics::Fk->new(
#                         -start => 1,
#                         -end   => 100,
#                         -name  => 'fred feature',
#                         -info  => $additional_stuff_to_store,
#                         -strand => +1);
#
# Alternatively, use -segments => [ [start,stop],[start,stop]...]
# to create a multisegmented feature.
sub new {
  my $class= shift;
  my %arg = @_;

  my $self = bless {},$class;

  $arg{-strand} ||= 0;
  $self->{strand} = $arg{-strand} >= 0 ? +1 : -1;
  $self->{name}   = $arg{-name};
  $self->{info}   = $arg{-info};

Ace/Graphics/Fk.pm  view on Meta::CPAN

  my $self = shift;
  return $self->{info} || $self->name;
}

1;

__END__

=head1 NAME

Ace::Graphics::Fk - A dummy feature object used for generating panel key tracks

=head1 SYNOPSIS

None.  Used internally by Ace::Graphics::Panel.

=head1 DESCRIPTION

None.  Used internally by Ace::Graphics::Panel.

=head1 SEE ALSO

Ace/Graphics/Glyph.pm  view on Meta::CPAN

package Ace::Graphics::Glyph;

use strict;
use GD;

# simple glyph class
# args:  -feature => $feature_object
# args:  -factory => $factory_object
sub new {
  my $class = shift;
  my %arg = @_;
  my $feature = $arg{-feature};
  my ($start,$end) = ($feature->start,$feature->end);
  ($start,$end) = ($end,$start) if $start > $end;
  return bless {
		@_,
		top   => 0,
		left  => 0,
		right => 0,
		start => $start,
		end   => $end
	       },$class;
}

# delegates
# any of these can be overridden safely
sub factory   {  shift->{-factory}            }
sub feature   {  shift->{-feature}            }
sub fgcolor   {  shift->factory->fgcolor      }
sub bgcolor   {  shift->factory->bgcolor   }
sub fontcolor {  shift->factory->fontcolor      }
sub fillcolor {  shift->factory->fillcolor }
sub scale     {  shift->factory->scale     }
sub width     {  shift->factory->width     }
sub font      {  shift->factory->font      }
sub option    {  shift->factory->option(shift) }
sub color     {
  my $self    = shift;

Ace/Graphics/Glyph.pm  view on Meta::CPAN

  $val = $self->width if $right && $val > $right;
  return int $val;
}

sub labelheight {
  my $self = shift;
  return $self->{labelheight} ||= $self->font->height;
}

sub label {
  my $f = (my $self = shift)->feature;
  if (ref (my $code = $self->option('label')) eq 'CODE') {
    return $code->($f);
  }
  my $info = eval {$f->info};
  return $info if $info;
  return $f->seqname if $f->can('seqname');
  return $f->primary_tag;
}

# return array containing the left,top,right,bottom

Ace/Graphics/Glyph.pm  view on Meta::CPAN

sub draw {
  my $self = shift;
  my $gd   = shift;
  my ($left,$top) = @_;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries($left,$top);

  # for nice thin lines
  $x2 = $x1 if $x2-$x1 < 1;

  if ($self->option('strand_arrow')) {
    my $orientation = $self->feature->strand;
    $self->filled_arrow($gd,$orientation,$x1,$y1,$x2,$y2);
  } else {
    $self->filled_box($gd,$x1,$y1,$x2,$y2);
  }

  # add a label if requested
  $self->draw_label($gd,@_) if $self->option('label');
}

sub draw_label {

Ace/Graphics/Glyph.pm  view on Meta::CPAN

Ace::Graphics::Glyph.

=head2 CONSTRUCTORS

Ace::Graphics::Glyph objects are constructed automatically by an
Ace::Graphics::GlyphFactory, and are not usually created by
end-developer code.

=over 4

=item $glyph = Ace::Graphics::Glyph->new(-feature=>$feature,-factory=>$factory)

Given a sequence feature, creates an Ace::Graphics::Glyph object to
display it.  The -feature argument points to the
Ace::Sequence::Feature object to display.  -factory indicates an
Ace::Graphics::GlyphFactory object from which the glyph will fetch all
its run-time configuration information.

A standard set of options are recognized.  See L<OPTIONS>.

=back

=head2 OBJECT METHODS

Ace/Graphics/Glyph.pm  view on Meta::CPAN


Retrieving glyph context:

=over 4

=item $factory = $glyph->factory

Get the Ace::Graphics::GlyphFactory associated with this object.  This
cannot be changed once it is set.

=item $feature = $glyph->feature

Get the sequence feature associated with this object.  This cannot be
changed once it is set.

=back

Retrieving glyph options:

=over 4

=item $fgcolor = $glyph->fgcolor

Ace/Graphics/Glyph.pm  view on Meta::CPAN

  -linewidth  Width of lines drawn by	1
		    glyph

  -height     Height of glyph		10

  -font       Glyph font		gdSmallFont

  -label      Whether to draw a label	false

You may pass an anonymous subroutine to -label, in which case the
subroutine will be invoked with the feature as its single argument.
The subroutine must return a string to render as the label.

=head1 SUBCLASSING Ace::Graphics::Glyph

By convention, subclasses are all lower-case.  Begin each subclass
with a preamble like this one:

 package Ace::Graphics::Glyph::crossbox;

 use strict;

Ace/Graphics/Glyph/anchored_arrow.pm  view on Meta::CPAN

  my $self = shift;
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);

  my $fg = $self->fgcolor;
  my $a2 = ($y2-$y1)/2;
  my $center = $y1+$a2;

  $gd->line($x1,$center,$x2,$center,$fg);

  if ($self->feature->start < $self->offset) {  # off left end
    if ($x2 > $a2) {
      $gd->line($x1,$center,$x1+$a2,$center-$a2,$fg);  # arrowhead
      $gd->line($x1,$center,$x1+$a2,$center+$a2,$fg);
    }
  } else {
    $gd->line($x1,$center-$a2,$x1,$center+$a2,$fg);  # tick/base
  }

  if ($self->feature->end > $self->offset + $self->length) {# off right end
    if ($x1 < $x2-$a2-1) {
      $gd->line($x2,$center,$x2-$a2,$center+$a2,$fg);  # arrowhead
      $gd->line($x2,$center,$x2-$a2,$center-$a2,$fg);
    }
  } else {
    # problems occur right at the very end because of GD confusion
    $x2-- if $self->feature->end == $self->offset + $self->length;
    $gd->line($x2,$center-$a2,$x2,$center+$a2,$fg);  # tick/base
  }

  $self->draw_ticks($gd,@_) if $self->option('tick');

  # add a label if requested
  $self->draw_label($gd,@_) if $self->option('label');
}

sub draw_label {

Ace/Graphics/Glyph/anchored_arrow.pm  view on Meta::CPAN

  my $fg = $self->fgcolor;

  # figure out tick mark scale
  # we want no more than 1 tick mark every 30 pixels
  # and enough room for the labels
  my $font = $self->font;
  my $width = $font->width;
  my $font_color = $self->fontcolor;

  my $relative = $self->option('relative_coords');
  my $start    = $relative ? 1 : $self->feature->start;
  my $stop     = $start + $self->feature->length  - 1;

  my $reversed = 0;
  if ($self->feature->strand == -1) {
    $stop = -$stop;
    $reversed = 1;
  }

  my $interval = 1;
  my $mindist =  30;
  my $widest = 5 + (length($stop) * $width);
  $mindist = $widest if $widest > $mindist;

  while (1) {
    my $pixels = $interval * $scale;
    last if $pixels >= $mindist;
    $interval *= 10;
  }

  my $first_tick = $interval * int(0.5 + $start/$interval);

  for (my $i = $first_tick; $i < $stop; $i += $interval) {
    my $tickpos = !$reversed ? $left + $self->map_pt($i-1 + $self->feature->start)
                             : $left + $self->map_pt($self->feature->start - $i - 1);
    $gd->line($tickpos,$center-$a2,$tickpos,$center+$a2,$fg);
    my $middle = $tickpos - (length($i) * $width)/2;
    $gd->string($font,$middle,$center+$a2-1,$i,$font_color) 
      if $middle > 0 && $middle < $self->factory->panel->width-($font->width * length $i);
  }

  if ($self->option('tick') >= 2) {
    my $a4 = ($y2-$y1)/4;
    for (my $i = $first_tick; $i < $stop; $i += $interval/10) {
      my $tickpos = !$reversed ? $left + $self->map_pt($i-1 + $self->feature->start)
	                       : $left + $self->map_pt($self->feature->start - $i - 1);
      $gd->line($tickpos,$center-$a4,$tickpos,$center+$a4,$fg);
    }
  }
}



1;

__END__

Ace/Graphics/Glyph/anchored_arrow.pm  view on Meta::CPAN

Ace::Graphics::Glyph::anchored_arrow - The "anchored_arrow" glyph

=head1 SYNOPSIS

  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph draws an arrowhead which is anchored at one or both ends
(has a vertical base) or has one or more arrowheads.  The arrowheads
indicate that the feature does not end at the edge of the picture, but
continues.  For example:

    |-----------------------------|          both ends in picture
 <----------------------|                    left end off picture
         |---------------------------->      right end off picture
 <------------------------------------>      both ends off picture


=head2 OPTIONS

Ace/Graphics/Glyph/arrow.pm  view on Meta::CPAN

	      or perpendicular to it.

  -northeast  Whether to draw the         true
	      north or east arrowhead
	      (depending on orientation)

  -southwest  Whether to draw the         true
	      south or west arrowhead
	      (depending on orientation)

Set -parallel to false to display a point-like feature such as a
polymorphism, or to indicate an important location.  If the feature
start == end, then the glyph will draw a single arrow at the
designated location:

       ^
       |

Otherwise, there will be two arrows at the start and end:

       ^              ^
       |              |

Ace/Graphics/Glyph/dot.pm  view on Meta::CPAN

=head1 NAME

Ace::Graphics::Glyph::dot - The "ellipse" glyph

=head1 SYNOPSIS

  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph draws an ellipse the width of the scaled feature passed,
and height a possibly configured height (See Ace::Graphics::Glyph).

=head2 OPTIONS

In addition to the common options, the following glyph-specific
options are recognized:
  Option      Description                  Default
  ------      -----------                  -------

  -point      Whether to draw an ellipse   feature width
              the scaled width of the
              feature or with radius
              point.

=head1 BUGS

Please report them.

=head1 SEE ALSO

L<Ace::Sequence>, L<Ace::Sequence::Feature>, L<Ace::Graphics::Panel>,
L<Ace::Graphics::Track>, L<Ace::Graphics::Glyph::anchored_arrow>,

Ace/Graphics/Glyph/ex.pm  view on Meta::CPAN


This glyph draws an "X".

=head2 OPTIONS

In addition to the common options, the following glyph-specific
options are recognized:
  Option      Description                  Default
  ------      -----------                  -------

  -point      Whether to draw an "X" the   feature width
              scaled width of the feature
              or with arm length point.

=head1 BUGS

Please report them.

=head1 SEE ALSO

L<Ace::Sequence>, L<Ace::Sequence::Feature>, L<Ace::Graphics::Panel>,
L<Ace::Graphics::Track>, L<Ace::Graphics::Glyph::anchored_arrow>,

Ace/Graphics/Glyph/graded_segments.pm  view on Meta::CPAN

use strict;
use vars '@ISA';
use GD;
use Ace::Graphics::Glyph::segments;
@ISA = 'Ace::Graphics::Glyph::segments';

# override draw method
sub draw {
  my $self = shift;

  # bail out if this isn't the right kind of feature
  # handle both das-style and Bio::SeqFeatureI style,
  # which use different names for subparts.
  my @segments;
  my $f = $self->feature;
  if ($f->can('segments')) {
    @segments = $f->segments;

  } elsif ($f->can('sub_SeqFeature')) {
    @segments = $f->sub_SeqFeature;

  } else {
    return $self->SUPER::draw(@_);
  }

Ace/Graphics/Glyph/group.pm  view on Meta::CPAN

# a group of glyphs that move in a coordinated fashion
# currently they are always on the same vertical level (no bumping)

use strict;
use vars '@ISA';
use GD;
use Carp 'croak';

@ISA = 'Ace::Graphics::Glyph';

# override new() to accept an array ref for -feature
# the ref is not a set of features, but a set of other glyphs!
sub new {
  my $class = shift;
  my %arg = @_;
  my $parts = $arg{-feature};
  croak('Usage: Ace::Graphics::Glyph::group->new(-features=>$glypharrayref,-factory=>$factory)')
    unless ref $parts eq 'ARRAY';

  # sort parts horizontally
  my @sorted = sort { $a->left   <=> $b->left } @$parts;
  my $leftmost  = $sorted[0];
  my $rightmost = (sort { $a->right  <=> $b->right  } @$parts)[-1];

  my $self =  bless {
		     @_,
		     top      => 0,

Ace/Graphics/Glyph/group.pm  view on Meta::CPAN

  }
  return sort { $a->top <=> $b->top } @glyphs;
}

# override draw method - draw individual subparts
sub draw {
  my $self = shift;
  my $gd = shift;
  my ($left,$top) = @_;

  # bail out if this isn't the right kind of feature
  my @parts = $self->members;

  # three pixels of black, three pixels of transparent
  my $black = 1;

  my ($x1,$y1,$x2,$y2) = $parts[0]->calculate_boundaries($left,$top);
  my $center1 = ($y2 + $y1)/2;

  $gd->setStyle($black,$black,gdTransparent,gdTransparent,);
  for (my $i=0;$i<@parts-1;$i++) {

Ace/Graphics/Glyph/group.pm  view on Meta::CPAN

Ace::Graphics::Glyph::group - The group glyph

=head1 SYNOPSIS

none

=head1 DESCRIPTION

This is an internal glyph type, used by Ace::Graphics::Track for
moving sets of glyphs around as a group.  This glyph is created
automatically when processing a set of features passed to
Ace::Graphics::Panel->new as an array ref.

=head2 OPTIONS

In addition to the common options, the following glyph-specific
options are recognized:

  Option      Description               Default
  ------      -----------               -------

Ace/Graphics/Glyph/primers.pm  view on Meta::CPAN


=head1 SYNOPSIS

  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph draws two arrows oriented towards each other and connected
by a line of a contrasting color.  The length of the arrows is
immaterial, but the length of the glyph itself corresponds to the
length of the scaled feature.

=head2 OPTIONS

In addition to the common options, the following glyph-specific
options are recognized:

  Option      Description               Default
  ------      -----------               -------

  -connect    Whether to connect the      false

Ace/Graphics/Glyph/segments.pm  view on Meta::CPAN

    my $description_width = $self->font->width * length $self->description;
    $val = $left + $description_width if $left + $description_width > $val;
  }
  $val;
}

# override draw method
sub draw {
  my $self = shift;

  # bail out if this isn't the right kind of feature
  # handle both das-style and Bio::SeqFeatureI style,
  # which use different names for subparts.
  my @segments;
  my $f = $self->feature;
  if ($f->can('merged_segments')) {
    @segments = $f->merged_segments;

  } elsif ($f->can('segments')) {
    @segments = $f->segments;

  } elsif ($f->can('sub_SeqFeature')) {
    @segments = $f->sub_SeqFeature;

  } else {

Ace/Graphics/Glyph/segments.pm  view on Meta::CPAN

    $brush->setPixel(1,0,$fgcolor);
    $brush->setPixel(0,1,$fgcolor);
    $brush->setPixel(1,2,$fgcolor);
  }
  $brush;
}


sub description {
  my $self = shift;
  $self->feature->info;
}

1;

__END__

=head1 NAME

Ace::Graphics::Glyph::segments - The "discontinuous segments" glyph

=head1 SYNOPSIS

  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph draws a sequence feature that consists of multiple
discontinuous segments, such as the exons on a transcript or a gapped
alignment.  The representation is a series of filled rectangles
connected by line segments.

The features passed to it must either respond to the
Bio::SequenceFeatureI-style subSeqFeatures() method, or the
AcePerl/Das-style segments() or merged_segments() methods.

=head2 OPTIONS

In addition to the common options, this glyph recognizes the
b<-stranded> argument.  If b<-stranded> is true and the feature is an
alignment (has the target() method) then the glyph will draw little
arrows in the segment boxes to indicate the direction of the
alignment.

=head1 BUGS

Please report them.

=head1 SEE ALSO

Ace/Graphics/Glyph/toomany.pm  view on Meta::CPAN

=head1 NAME

Ace::Graphics::Glyph::toomany - The "too many to show" glyph

=head1 SYNOPSIS

  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph is intended for features that are too dense to show
properly.  Mostly a placeholder, it currently shows a filled oval.  If
you choose a bump of 0, the ovals will overlap, to give a cloud
effect.

=head2 OPTIONS

There are no glyph-specific options.

=head1 BUGS

Ace/Graphics/Glyph/transcript.pm  view on Meta::CPAN

@ISA = 'Ace::Graphics::Glyph';

use constant IMPLIED_INTRON_COLOR  => 'gray';
use constant ARROW => 4;

# override the left and right methods in order to
# provide extra room for arrows at the end
sub calculate_left {
  my $self = shift;
  my $val = $self->SUPER::calculate_left(@_);
  $val -= ARROW if $self->feature->strand < 0 && $val >= 4;
  $val;
}

sub calculate_right {
  my $self = shift;
  my $left = $self->left;
  my $val = $self->SUPER::calculate_right(@_);
  $val = $left + ARROW if $left + ARROW > $val;

  if ($self->option('label') && (my $description = $self->description)) {

Ace/Graphics/Glyph/transcript.pm  view on Meta::CPAN

    if $x1 < 0;

  $gd->line($x2,$y1,$x2,$y2,$color)
    if $x2 > $width;
}

# override draw method
sub draw {
  my $self = shift;

  # bail out if this isn't the right kind of feature
  return $self->SUPER::draw(@_) unless $self->feature->can('segments');

  # get parameters
  my $gd = shift;
  my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
  my ($left,$top) = @_;

  my $implied_intron_color = $self->option('implied_intron_color') || IMPLIED_INTRON_COLOR;
  my $gray = $self->factory->translate($implied_intron_color);
  my $fg     = $self->fgcolor;
  my $fill   = $self->fillcolor;
  my $fontcolor = $self->fontcolor;
  my $curated_exon   = $self->option('curatedexon')   ? $self->color('curatedexon') : $fill;
  my $curated_intron = $self->option('curatedintron') ? $self->color('curatedintron') : $fg;

  my @exons   = sort {$a->start<=>$b->start} $self->feature->segments;
  my @introns = $self->feature->introns if $self->feature->can('introns');

  # fill in missing introns
  my (%istart,@intron_boxes,@implied_introns,@exon_boxes);
  foreach (@introns) {
    my ($start,$stop) = ($_->start,$_->end);
    ($start,$stop) = ($stop,$start) if $start > $stop;
    $istart{$start}++;
    my $color = $_->source_tag eq 'curated' ? $curated_intron : $fg;
    push @intron_boxes,[$left+$self->map_pt($start),$left+$self->map_pt($stop),$color];
  }

Ace/Graphics/Glyph/transcript.pm  view on Meta::CPAN

    $self->filled_box($gd,@rect,$e->[2]);
  }

  my $draw_arrow = $self->option('draw_arrow');
  $draw_arrow = 1 unless defined $draw_arrow;

  if ($draw_arrow && @exon_boxes) {
    # draw little arrows to indicate direction of transcription
    # plus strand is to the right
    my $a2 = ARROW/2;
    if ($self->feature->strand > 0) {
      my $s = $exon_boxes[-1][1];
      $gd->line($s,$center,$s + ARROW,$center,$fg);
      $gd->line($s+ARROW,$center,$s+$a2,$center-$a2,$fg);
      $gd->line($s+ARROW,$center,$s+$a2,$center+$a2,$fg);
    } else {
      my $s = $exon_boxes[0][0];
      $gd->line($s,$center,$s - ARROW,$center,$fg);
      $gd->line($s - ARROW,$center,$s-$a2,$center-$a2,$fg);
      $gd->line($s - ARROW,$center,$s-$a2,$center+$a2,$fg);
    }

Ace/Graphics/Glyph/transcript.pm  view on Meta::CPAN

    # draw description
    if (my $d = $self->description) {
      $gd->string($self->font,$x1,$y2,$d,$fontcolor);
    }
  }

}

sub description {
  my $self = shift;
  my $t = $self->feature->info;
  return unless ref $t;

  my $id = $t->Brief_identification;
  my $comment = $t->Locus;
  $comment .= $comment ? " ($id)" : $id if $id;
  $comment;
}

1;

Ace/Graphics/Glyph/transcript.pm  view on Meta::CPAN


  See L<Ace::Graphics::Panel> and L<Ace::Graphics::Glyph>.

=head1 DESCRIPTION

This glyph draws a series of filled rectangles connected by up-angled
connectors or "hats".  The rectangles indicate exons; the hats are
introns.  The direction of transcription is indicated by a small arrow
at the end of the glyph, rightward for the + strand.

The feature must respond to the exons() and optionally introns()
methods, or it will default to the generic display.  Implied introns
(not returned by the introns() method) are drawn in a contrasting
color to explicit introns.

=head2 OPTIONS

In addition to the common options, the following glyph-specific
option is recognized:

  Option                Description                    Default

Ace/Graphics/Glyph/triangle.pm  view on Meta::CPAN

This glyph draws an isoceles triangle.  It is possible to draw
the triangle with the base on the N, S, E, or W side.

=head2 OPTIONS

In addition to the common options, the following glyph-specific
options are recognized:
  Option      Description                  Default
  ------      -----------                  -------

  -point      Whether to draw a triangle   feature width
              with base the scaled width
              of the feature or length
              point.

  -orient     On which side shall the      S
              base be? (NSEW)

=head1 BUGS

Please report them.

=head1 SEE ALSO

Ace/Graphics/GlyphFactory.pm  view on Meta::CPAN

}

sub length {  shift->option('length',@_) }
sub offset {  shift->option('offset',@_) }
sub translate { my $self = shift; $self->panel->translate(@_) || $self->fgcolor; }
sub rgb       { shift->panel->rgb(@_) }

# create a new glyph from configuration
sub glyph {
  my $self    = shift;
  my $feature = shift;
  return $self->{glyphclass}->new(-feature => $feature,
				  -factory => $self);
}

1;
__END__

=head1 NAME

Ace::Graphics::GlyphFactory - Create Ace::Graphics::Glyphs

Ace/Graphics/GlyphFactory.pm  view on Meta::CPAN

and specific options are described in each of the
Ace::Graphics::Glyph::* manual pages.
=back

=head2 OBJECT METHODS

Once a track is created, the following methods can be invoked:

=over 4

=item $glyph = $factory->glyph($feature)

Given a sequence feature, creates an Ace::Graphics::Glyph object to
display it.  The various attributes of the glyph are set from the
options provided at factory creation time.

=item $option = $factory->option($option_name [,$new_option])

Given an option name, returns its value.  If a second argument is
provided, sets the option to the new value and returns its previous
one.

=item $index = $factory->fgcolor

Ace/Graphics/Panel.pm  view on Meta::CPAN

use constant KEYLABELFONT => gdSmallFont;
use constant KEYSPACING   => 10; # extra space between key columns
use constant KEYPADTOP    => 5;  # extra padding before the key starts
use constant KEYCOLOR     => 'cornsilk';

*push_track = \&add_track;

# package global
my %COLORS;

# Create a new panel of a given width and height, and add lists of features
# one by one
sub new {
  my $class = shift;
  my %options = @_;

  $class->read_colors() unless %COLORS;

  my $length = $options{-length} || 0;
  my $offset = $options{-offset} || 0;
  my $spacing = $options{-spacing} || 5;

Ace/Graphics/Panel.pm  view on Meta::CPAN

sub pad_right {
  my $self = shift;
  my $d = $self->{pad_right};
  $self->{pad_right} = shift if @_;
  $d || 0;
}

sub add_track {
  my $self = shift;

  # due to indecision, we accept features
  # and/or glyph types in the first two arguments
  my ($features,$glyph_name) = ([],'generic');
  while ( $_[0] !~ /^-/) {
    my $arg = shift;
    $features   = $arg and next if ref($arg);
    $glyph_name = $arg and next unless ref($arg);
  }

  $self->_add_track($glyph_name,$features,+1,@_);
}

sub unshift_track {
  my $self = shift;
  # due to indecision, we accept features
  # and/or glyph types in the first two arguments
  my ($features,$glyph_name) = ([],'generic');
  while ( (my $arg = shift) !~ /^-/) {
    $features   = $arg and next if ref($arg);
    $glyph_name = $arg and next unless ref($arg);
  }

  $self->_add_track($glyph_name,$features,-1,@_);
}

sub _add_track {
  my $self = shift;
  my ($glyph_type,$features,$direction,@options) = @_;

  unshift @options,'-offset' => $self->{offset} if defined $self->{offset};
  unshift @options,'-length' => $self->{length} if defined $self->{length};

  $features = [$features] unless ref $features eq 'ARRAY';
  my $track  = Ace::Graphics::Track->new($glyph_type,$features,@options);
  $track->set_scale(abs($self->length),$self->{width});
  $track->panel($self);
  if ($direction >= 0) {
    push @{$self->{tracks}},$track;
  } else {
    unshift @{$self->{tracks}},$track;
  }

  return $track;
}

Ace/Graphics/Panel.pm  view on Meta::CPAN


The Ace::Graphics::Panel class provides drawing and formatting
services for Ace::Sequence::Feature objects or Das::Segment::Feature
objects.

Typically you will begin by creating a new Ace::Graphics::Panel
object, passing it the width of the visual display and the length of
the segment.  

You will then call add_track() one or more times to add sets of
related features to the picture.  When you have added all the features
you desire, you may call png() to convert the image into a PNG-format
image, or boxes() to return coordinate information that can be used to
create an imagemap.

Note that this modules depends on GD.

=head1 METHODS

This section describes the class and object methods for
Ace::Graphics::Panel.

Ace/Graphics/Panel.pm  view on Meta::CPAN


new() will return undef in case of an error. If the specified glyph
name is not a valid one, new() will throw an exception.

=back

=head2 OBJECT METHODS

=over 4

=item $track = $panel->add_track($glyph,$features,@options)

The add_track() method adds a new track to the image. 

Tracks are horizontal bands which span the entire width of the panel.
Each track contains a number of graphical elements called "glyphs",
each corresponding to a sequence feature. There are different glyph
types, but each track can only contain a single type of glyph.
Options passed to the track control the color and size of the glyphs,
whether they are allowed to overlap, and other formatting attributes.
The height of a track is determined from its contents and cannot be
directly influenced.

The first two arguments are the glyph name and an array reference
containing the list of features to display.  The order of the
arguments is irrelevant, allowing either of these idioms:

  $panel->add_track(arrow => \@features);
  $panel->add_track(\@features => 'arrow');

The glyph name indicates how each feature is to be rendered.  A
variety of glyphs are available, and the number is growing.
Currently, the following glyphs are available:

  Name        Description
  ----        -----------

  box	      A filled rectangle, nondirectional.

  ellipse     A filled ellipse, nondirectional.

  arrow	      An arrow; can be unidirectional or bidirectional.
	      It is also capable of displaying a scale with
	      major and minor tickmarks, and can be oriented
	      horizontally or vertically.

  segments    A set of filled rectangles connected by solid lines.
	      Used for interrupted features, such as gapped
	      alignments.

  transcript  Similar to segments, but the connecting line is
	      a "hat" shape, and the direction of transcription
	      is indicated by a small arrow.

  transcript2 Similar to transcript, but the arrow that indicates
              the direction of transcription is the last exon
              itself.

  primers     Two inward pointing arrows connected by a line.
	      Used for STSs.

  toomany     A "cloud", to indicate too many features to show
	      individually.  This is a placeholder that will be
	      replaced by something more clever, such as a histogram
	      or density plot.

  group	      A group of related features connected by a dashed line.
	      This is used internally by the Track class and should
	      not be called explicitly.

If the glyph name is omitted from add_track(), the "box" glyph will be
used by default.

The @options array is a list of name/value pairs that control the
attributes of the track.  The options are in turn passed to the
glyphs.  Each glyph has its own specialized subset of options, but
some are shared by all glyphs:

Ace/Graphics/Panel.pm  view on Meta::CPAN

Colors can be expressed in either of two ways: as symbolic names such
as "cyan" and as HTML-style #RRGGBB triples.  The symbolic names are
the 140 colors defined in the Netscape/Internet Explorer color cube,
and can be retrieved using the Ace::Graphics::Panel->color_names()
method.

The background color is used for the background color of the track
itself.  The foreground color controls the color of lines and strings.
The interior color is used for filled objects such as boxes.

The -label argument controls whether or not the ID of the feature
should be printed next to the feature.  It is accepted by most, but
not all of the glyphs.

The -bump argument controls what happens when glyphs collide.  By
default, they will simply overlap (value 0).  A -bump value of +1 will
cause overlapping glyphs to bump downwards until there is room for
them.  A -bump value of -1 will cause overlapping glyphs to bump
upwards.

The -key argument declares that the track is to be shown in a key
appended to the bottom of the image.  The key contains a picture of a
glyph and a label describing what the glyph means.  The label is
specified in the argument to -key.

If present, the -glyph argument overrides the glyph given in the first
or second argument.

add_track() returns an Ace::Graphics::Track object.  You can use this
object to add additional features or to control the appearance of the
track with greater detail, or just ignore it.  Tracks are added in
order from the top of the image to the bottom.  To add tracks to the
top of the image, use unshift_track().

Typical usage is:

 $panel->add_track( thistle    => \@genes,
 		    -fillcolor =>  'green',
 		    -fgcolor   =>  'black',
 		    -bump      =>  +1,
 		    -height    => 10,
 		    -label     => 1);

=item $track = unshift_track($glyph,$features,@options)

unshift_track() works like add_track(), except that the new track is
added to the top of the image rather than the bottom.

B<Adding groups of features:> It is not uncommon to add a group of
features which are logically connected, such as the 5' and 3' ends of
EST reads.  To group features into sets that remain on the same
horizontal position and bump together, pass the sets as an anonymous
array.  To connect the groups by a dashed line, pass the
-connect_groups argument with a true value.  For example:

  $panel->add_track(segments => [[$abc_5,$abc_3],
				 [$xxx_5,$xxx_3],
				 [$yyy_5,$yyy_3]],
		    -connect_groups => 1);

=item $gd = $panel->gd

Ace/Graphics/Panel.pm  view on Meta::CPAN

=item $boxes = $panel->boxes

=item @boxes = $panel->boxes

The boxes() method returns the coordinates of each glyph, useful for
constructing an image map.  In a scalar context, boxes() returns an
array ref.  In an list context, the method returns the array directly.

Each member of the list is an anonymous array of the following format:

  [ $feature, $x1, $y1, $x2, $y2 ]

The first element is the feature object; either an
Ace::Sequence::Feature, a Das::Segment::Feature, or another Bioperl
Bio::SeqFeatureI object.  The coordinates are the topleft and
bottomright corners of the glyph, including any space allocated for
labels.

=back

=head2 ACCESSORS

The following accessor methods provide access to various attributes of

Ace/Graphics/Track.pm  view on Meta::CPAN

package Ace::Graphics::Track;
# This embodies the logic for drawing a single track of features.
# Features are of uniform style and are controlled by descendents of
# the Ace::Graphics::Glyph class (eek!).

use Ace::Graphics::GlyphFactory;
use Ace::Graphics::Fk;
use GD;  # maybe
use Carp 'croak';
use vars '$AUTOLOAD';
use strict;

Ace/Graphics/Track.pm  view on Meta::CPAN

  my $self = shift;
  my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
  $self->factory->$func_name(@_);
}

sub DESTROY { }

# Pass a list of Ace::Sequence::Feature objects, and a glyph name
sub new {
  my $class = shift;
  my ($glyph_name,$features,@options) = @_;

  $glyph_name ||= 'generic';
  $features   ||= [];

  my $glyph_factory = $class->make_factory($glyph_name,@options);
  my $self = bless {
		    features => [],                     # list of Ace::Sequence::Feature objects
		    factory  => $glyph_factory,         # the glyph class associated with this track
		    glyphs   => undef,                  # list of glyphs
		   },$class;
  $self->add_feature($_) foreach @$features;
  $self;
}

# control bump direction:
#    +1   => bump downward
#    -1   => bump upward
#     0   => no bump
sub bump {
  my $self = shift;
  $self->factory->option('bump',@_);
}

# add a feature (or array ref of features) to the list
sub add_feature {
  my $self       = shift;
  my $feature    = shift;
  if (ref($feature) eq 'ARRAY') {
    my $name     = ++$self->{group_name};
    $self->{group_ids}{$name} = $feature;
  } else {
    push @{$self->{features}},$feature;
  }
}

# link a set of features together so that they bump as a group
sub add_group {
  my $self     = shift;
  my $features = shift;
  ref($features) eq 'ARRAY' or croak("Usage: Ace::Graphics::Track->add_group(\$arrayref)");
  $self->add_feature($features);
}

# delegate lineheight to the glyph
sub lineheight {
  shift->{factory}->height(@_);
}

# the scale is horizontal, measured in pixels/bp
sub scale {
  my $self = shift;

Ace/Graphics/Track.pm  view on Meta::CPAN


# return the glyph class
sub factory {
  my $self = shift;
  my $g = $self->{factory};
  $self->{factory} = shift if @_;
  $g;
}

# return boxes for each of the glyphs
# will be an array of four-element [$feature,l,t,r,b] arrays
sub boxes {
  my $self = shift;
  my ($left,$top) = @_;
  $top  += 0; $left += 0;
  my @result;

  my $glyphs = $self->layout;

  for my $g (@$glyphs) {
    my ($l,$t,$r,$b) = $g->box;
    push @result,[$g->feature,$left+$l,$top+$t,$left+$r,$top+$b];

  }

  return wantarray ? @result : \@result;
}

# synthesize a key glyph
sub keyglyph {
  my $self = shift;
  my $scale = 1/$self->scale;  # base pairs/pixel
  # two segments, at pixels 0->50, 60->80
  my $offset = $self->offset;
  my $feature = Ace::Graphics::Fk->new(-segments=>[ [ 0*$scale +$offset,50*$scale+$offset],
						    [60*$scale+$offset, 80*$scale+$offset]
						    ],
				       -name => $self->option('key'),
				       -strand => '+1');
  my $factory = $self->factory->clone;
  $factory->scale($self->scale);
  $factory->width($self->width);
  $factory->option(label=>1);  # turn on labels
  return $factory->glyph($feature);
}

# draw glyphs onto a GD object at the indicated position
sub draw {
  my $self = shift;
  my ($gd,$left,$top) = @_;
  $top  += 0;  $left += 0;
  my $glyphs = $self->layout;

  # draw background

Ace/Graphics/Track.pm  view on Meta::CPAN

    $_->draw($gd,$left,$top) foreach @{$self->{groups}};
  }
}

# lay out -- this uses the infamous bump algorithm
sub layout {
  my $self = shift;
  my $force = shift || 0;
  return $self->{glyphs} if $self->{glyphs} && !$force;

  my $f = $self->{features};
  my $factory = $self->factory;
  $factory->scale($self->scale);  # set the horizontal scale
  $factory->width($self->width);

  # create singleton glyphs
  my @singletons = map { $factory->glyph($_) } @$f;

  # create linked groups of glyphs
  my @groups;
  if (my $groups = $self->{group_ids}) {

Ace/Graphics/Track.pm  view on Meta::CPAN

				     );


  my $track = $panel->add_track('transcript'
   		                -fillcolor =>  'wheat',
				-fgcolor   =>  'black',
				-bump      =>  +1,
				-height    =>  10,
				-label     =>  1);
  foreach (@transcripts) {
     $track->add_feature($_);
  }

  my $boxes = $panel->boxes;
  print $panel->png;


=head1 DESCRIPTION

The Ace::Graphics::Track class is used by Ace::Graphics::Panel to lay
out a set of sequence features using a uniform glyph type. You will
ordinarily work with panels rather than directly with tracks.

=head1 METHODS

This section describes the class and object methods for
Ace::Graphics::Panel.

=head2 CONSTRUCTORS

There is only one constructor, the new() method.  It is ordinarily
called by Ace::Graphics::Panel, and not in end-developer code.

=over 4

=item $track = Ace::Graphics::Track->new($glyph_name,$features,@options)

The new() method creates a new track object from the provided glyph
name and list of features.  The arguments are similar to those in
Ace::Graphics::Panel->new().

If successful new() will return a new Ace::Graphics::Track.
Otherwise, it will return undef.

If the specified glyph name is not a valid one, new() will throw an
exception.

=back

=head2 OBJECT METHODS

Once a track is created, the following methods can be invoked.

=over 4

=item $track->add_feature($feature)

This adds a new feature to the track.  The feature can either be a
single object that implements the Bio::SeqFeatureI interface (such as
an Ace::Sequence::Feature or Das::Segment::Feature), or can be an
anonymous array containing a set of related features.  In the latter
case, the track will attempt to keep the features in the same
horizontal band and will not allow any other features to overlap.

=item $track->add_group($group)

This behaves the same as add_feature(), but requires that its argument
be an array reference containing a list of grouped features.

=item $track->draw($gd,$left,$top)

Render the track on a previously-created GD::Image object.  The $left
and $top arguments indicate the position at which to start rendering.

=item $boxes = $track->boxes($left,$top)

=item @boxes = $track->boxes($left,$top)

Return an array of array references indicating glyph coordinates for
each of the render features.  $left and $top indicate the offset for
the track on the image plane.  In a scalar context, this method
returns an array reference of glyph coordinates.  In a list context,
it returns the list itself.

See Ace::Graphics::Panel->boxes() for the format of the result.

=back

=head2 ACCESSORS

Ace/Graphics/Track.pm  view on Meta::CPAN


=head2 INTERNAL METHODS

The following methods are used internally, but may be useful for those
implementing new glyph types.

=over 4

=item $glyphs = $track->layout

Layout the features, and return an anonymous array of
Ace::Graphics::Glyph objects that have been created and correctly
positioned.

Because layout is an expensive operation, calling this method several
times will return the previously-cached result, ignoring any changes
to track attributes.

=item $height = $track->height

Invokes layout() and returns the height of the track.

Ace/Object.pm  view on Meta::CPAN

      if ($tree) {
	$self->{'.PATHS'}{$lctag} = $tree->search($tag);
	$self->_dirty(1);
	last TRY;
      }
    }

    # If the object hasn't been filled already, then we can use
    # acedb's query mechanism to fetch the subobject.  This is a
    # big win for large objects.  ...However, we have to disable
    # this feature if timestamps are active.
    unless ($self->filled) {
      my $subobject = $self->newFromText(
					 $self->db->show($self->class,$self->name,$tag),
					 $self->db
					);
      if ($subobject) {
	$subobject->{'.nocache'}++;
	$self->_attach_subtree($lctag => $subobject);
      } else {
	$self->{'.PATHS'}{$lctag} = undef;

Ace/Object.pm  view on Meta::CPAN

strings, text, floating point numbers, as well as specialized
biological types, such as "dna" and "peptide."  Another fundamental
type is "tag," which is a text identifier used to label portions of
the tree.  Examples of tags include "Paper" and "Laboratory" in the
example above.

In addition to these built-in types, there are constructed types known
as classes.  These types are specified by the data model.  In the
above example, "Thierry-Mieg J" is an object of the "Author" class,
and "Genome Project Database" is an object of the "Paper" class.  An
interesting feature of objects is that you can follow them into the
database, retrieving further information.  For example, after
retrieving the "Genome Project Database" Paper from the Author object,
you could fetch more information about it, either by following B<its>
right pointer, or by using one of the specialized navigation routines
described below.

=head2 new() method

    $object = new Ace::Object($class,$name,$database);
    $object = new Ace::Object(-class=>$class,

Ace/Object.pm  view on Meta::CPAN

     return qq{<FONT COLOR="blue">$obj</FONT>} if $obj->isObject; 
   }

   $object->asHTML(\&process_cell);

=head2 asXML() method

   $result = $object->asXML;

asXML() returns a well-formed XML representation of the object.  The
particular representation is still under discussion, so this feature
is primarily for demonstration.

=head2 asGIF() method

  ($gif,$boxes) = $object->asGIF();
  ($gif,$boxes) = $object->asGIF(-clicks=>[[$x1,$y1],[$x2,$y2]...]
	                         -dimensions=> [$width,$height],
				 -coords    => [$top,$bottom],
				 -display   => $display_type,
				 -view      => $view_type,

Ace/Object.pm  view on Meta::CPAN

  return $string unless lc($self->date_style) eq 'ace';
  %MO = (Jan=>1,Feb=>2,Mar=>3,
	 Apr=>4,May=>5,Jun=>6,
	 Jul=>7,Aug=>8,Sep=>9,
	 Oct=>10,Nov=>11,Dec=>12) unless %MO;
  my ($day,$mo,$yr) = split(" ",$string);
  return "$yr-$MO{$mo}-$day";
}

### Return an XML syntax representation  ###
### Consider this feature experimental   ###
sub asXML {
    my $self = shift;
    return unless defined($self->right);

    my ($do_content,$do_class,$do_value,$do_timestamps) = rearrange([qw(CONTENT CLASS VALUE TIMESTAMPS)],@_);
    $do_content    = 0 unless defined $do_content;
    $do_class      = 1 unless defined $do_class;
    $do_value      = 1 unless defined $do_value;
    $do_timestamps = 1 unless (defined $do_timestamps && !$do_timestamps) || !$self->db->timestamps;
    my %options = (content    => $do_content,

Ace/Sequence.pm  view on Meta::CPAN

  # the parent is an Ace Sequence object in the "+" strand
  my ($parent,$p_offset,$p_length,$strand) = find_parent($obj);
  return unless $parent;

  # handle negative strands
  my $r_strand = $strand;
  my $r_offset = $p_offset;
  $offset ||= 0;
  $offset *= -1 if $strand < 0;

  # handle feature objects
  $offset += $obj->offset if $obj->can('smapped');

  # get source
  my $source = $obj->can('smapped') ? $obj->source : $obj;

  # store the object into our instance variables
  my $self = bless {
		    obj        => $source,
		    offset     => $offset,
		    length     => $length || $p_length,

Ace/Sequence.pm  view on Meta::CPAN

  $raw=~s/\n//g;
  $raw =~ s/\0+\Z//; # blasted nulls!
  my $effective_strand = $self->end >= $self->start ? '+1' : '-1';
  _complement(\$raw) if $self->r_strand ne $effective_strand;
  return $self->{dna} = $raw;
}

# return a gff file
sub gff {
  my $self = shift;
  my ($abs,$features) = rearrange([['ABS','ABSOLUTE'],'FEATURES'],@_);
  $abs = $self->absolute unless defined $abs;

  # can provide list of feature names, such as 'similarity', or 'all' to get 'em all
  #  !THIS IS BROKEN; IT SHOULD LOOK LIKE FEATURE()!
  my $opt = $self->_feature_filter($features);

  my $gff = $self->_gff($opt);
  warn $gff if $self->debug;

  $self->transformGFF(\$gff) unless $abs;
  return $gff;
}

# return a GFF object using the optional GFF.pm module
sub GFF {

Ace/Sequence.pm  view on Meta::CPAN


  my @lines = grep !/^\/\//,split "\n",$self->gff(@_);
  local *IN;
  local ($^W) = 0;  # prevent complaint by GFF module
  tie *IN,'GFF::Filehandle',\@lines;
  my $gff = GFF::GeneFeatureSet->new;
  $gff->read(\*IN,$filter,$converter) if $gff;
  return $gff;
}

# Get the features table.  Can filter by type/subtype this way:
# features('similarity:EST','annotation:assembly_tag')
sub features {
  my $self = shift;
  my ($filter,$opt) = $self->_make_filter(@_);

  # get raw gff file
  my $gff = $self->gff(-features=>$opt);

  # turn it into a list of features
  my @features = $self->_make_features($gff,$filter);

  if ($self->automerge) {  # automatic merging
    # fetch out constructed transcripts and clones
    my %types = map {lc($_)=>1} (@$opt,@_);
    if ($types{'transcript'}) {
      push @features,$self->_make_transcripts(\@features);
      @features = grep {$_->type !~ /^(intron|exon)$/ } @features;
    }
    push @features,$self->_make_clones(\@features)      if $types{'clone'};
    if ($types{'similarity'}) {
      my @f = $self->_make_alignments(\@features);
      @features = grep {$_->type ne 'similarity'} @features;
      push @features,@f;
    }
  }

  return wantarray ? @features : \@features;
}

# A little bit more complex - assemble a list of "transcripts"
# consisting of Ace::Sequence::Transcript objects.  These objects
# contain a list of exons and introns.
sub transcripts {
  my $self    = shift;
  my $curated = shift;
  my $ef       = $curated ? "exon:curated"   : "exon";
  my $if       = $curated ? "intron:curated" : "intron";
  my $sf       = $curated ? "Sequence:curated" : "Sequence";
  my @features = $self->features($ef,$if,$sf);
  return unless @features;
  return $self->_make_transcripts(\@features);
}

sub _make_transcripts {
  my $self = shift;
  my $features = shift;

  require Ace::Sequence::Transcript;
  my %transcripts;

  for my $feature (@$features) {
    my $transcript = $feature->info;
    next unless $transcript;
    if ($feature->type =~ /^(exon|intron|cds)$/) {
      my $type = $1;
      push @{$transcripts{$transcript}{$type}},$feature;
    } elsif ($feature->type eq 'Sequence') {
      $transcripts{$transcript}{base} ||= $feature;
    }
  }

  # get rid of transcripts without exons
  foreach (keys %transcripts) {
    delete $transcripts{$_} unless exists $transcripts{$_}{exon}
  }

  # map the rest onto Ace::Sequence::Transcript objects
  return map {Ace::Sequence::Transcript->new($transcripts{$_})} keys %transcripts;
}

# Reassemble clones from clone left and right ends
sub clones {
  my $self = shift;
  my @clones = $self->features('Clone_left_end','Clone_right_end','Sequence');
  my %clones;
  return unless @clones;
  return $self->_make_clones(\@clones);
}

sub _make_clones {
  my $self = shift;
  my $features = shift;

  my (%clones,@canonical_clones);
  my $start_label = $self->strand < 0 ? 'end' : 'start';
  my $end_label   = $self->strand < 0 ? 'start' : 'end';
  for my $feature (@$features) {
    $clones{$feature->info}{$start_label} = $feature->start if $feature->type eq 'Clone_left_end';
    $clones{$feature->info}{$end_label}   = $feature->start if $feature->type eq 'Clone_right_end';

    if ($feature->type eq 'Sequence') {
      my $info = $feature->info;
      next if $info =~ /LINK|CHROMOSOME|\.\w+$/;
      if ($info->Genomic_canonical(0)) {
	push (@canonical_clones,$info->Clone) if $info->Clone;
      }
    }
  }

  foreach (@canonical_clones) {
    $clones{$_} ||= {};
  }

  my @features;
  my ($r,$r_offset,$r_strand) = $self->refseq;
  my $parent = $self->parent;
  my $abs = $self->absolute;
  if ($abs) {
    $r_offset  = 0;
    $r = $parent;
    $r_strand = '+1';
  }

  # BAD HACK ALERT.  WE DON'T KNOW WHERE THE LEFT END OF THE CLONE IS SO WE USE
  # THE MAGIC NUMBER -99_999_999 to mean "off left end" and
  # +99_999_999 to mean "off right end"
  for my $clone (keys %clones) {
    my $start = $clones{$clone}{start} || -99_999_999;
    my $end   = $clones{$clone}{end}   || +99_999_999;
    my $phony_gff = join "\t",($parent,'Clone','structural',$start,$end,'.','.','.',qq(Clone "$clone"));
    push @features,Ace::Sequence::Feature->new($parent,$r,$r_offset,$r_strand,$abs,$phony_gff);
  }
  return @features;
}

# Assemble a list of "GappedAlignment" objects. These objects
# contain a list of aligned segments.
sub alignments {
  my $self    = shift;
  my @subtypes = @_;
  my @types = map { "similarity:\^$_\$" } @subtypes;
  push @types,'similarity' unless @types;
  return $self->features(@types);
}

sub segments {
  my $self = shift;
  return;
}

sub _make_alignments {
  my $self = shift;
  my $features = shift;
  require Ace::Sequence::GappedAlignment;

  my %homol;

  for my $feature (@$features) {
    next unless $feature->type eq 'similarity';
    my $target = $feature->info;
    my $subtype = $feature->subtype;
    push @{$homol{$target,$subtype}},$feature;
  }

  # map onto Ace::Sequence::GappedAlignment objects
  return map {Ace::Sequence::GappedAlignment->new($homol{$_})} keys %homol;
}

# return list of features quickly
sub feature_list {
  my $self = shift;
  return $self->{'feature_list'} if $self->{'feature_list'};
  return unless my $raw = $self->_query('seqfeatures -version 2 -list');
  return $self->{'feature_list'} = Ace::Sequence::FeatureList->new($raw);
}

# transform a GFF file into the coordinate system of the sequence
sub transformGFF {
  my $self = shift;
  my $gff = shift;
  my $parent  = $self->parent;
  my $strand  = $self->{strand};
  my $source  = $self->source;
  my ($ref_source,$ref_offset,$ref_strand)  = $self->refseq;

Ace/Sequence.pm  view on Meta::CPAN


  my $smap = $obj->db->raw_query("gif smap -from $class:$name");
  my ($parent,$pstart,$pstop,$tstart,$tstop,$map_type) = 
    $smap =~ /^SMAP\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(.+)/;

  $parent ||= '';
  $parent =~ s/^Sequence://;  # remove this in next version of Acedb
  return ($parent,$pstart,$pstop);
}

# create subroutine that filters GFF files for certain feature types
sub _make_filter {
  my $self = shift;
  my $automerge = $self->automerge;

  # parse out the filter
  my %filter;
  foreach (@_) {
    my ($type,$filter) = split(':',$_,2);
    if ($automerge && lc($type) eq 'transcript') {
      @filter{'exon','intron','Sequence','cds'} = ([undef],[undef],[undef],[undef]);

Ace/Sequence.pm  view on Meta::CPAN


    $sub = eval $s;
    croak $@ if $@;
  } else {
    $sub = sub { 1; }
  }
  return ($sub,$promiscuous ? [] : [keys %filter]);
}

# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
  my $self = shift;
  my ($gff,$filter) = @_;

  my ($r,$r_offset,$r_strand) = $self->refseq;
  my $parent = $self->parent;
  my $abs    = $self->absolute;
  if ($abs) {
    $r_offset  = 0;
    $r = $parent;
    $r_strand = '+1';
  }
  my @features = map {Ace::Sequence::Feature->new($parent,$r,$r_offset,$r_strand,$abs,$_)}
                 grep !m@^(?:\#|//)@ && $filter->($_),split("\n",$gff);
}


# low level GFF call, no changing absolute to relative coordinates
sub _gff {
  my $self = shift;
  my ($opt,$db) = @_;
  my $data = $self->_query("seqfeatures -version 2 $opt",$db);
  $data =~ s/\0+\Z//;
  return $data; #blasted nulls!
}

# shortcut for running a gif query
sub _query {
  my $self = shift;
  my $command = shift;
  my $db      = shift || $self->db;

  my $parent = $self->parent;
  my $start = $self->start(1);
  my $end   = $self->end(1);
  ($start,$end) = ($end,$start) if $start > $end;  #flippity floppity

  my $coord   = "-coords $start $end";

  # BAD BAD HACK ALERT - CHECKS THE QUERY THAT IS PASSED DOWN
  # ALSO MAKES THINGS INCOMPATIBLE WITH PRIOR 4.9 servers.
#  my $opt     = $command =~ /seqfeatures/ ? '-nodna' : '';
  my $opt = '-noclip';

  my $query = "gif seqget $parent $opt $coord ; $command";
  warn $query if $self->debug;

  return $db->raw_query("gif seqget $parent $opt $coord ; $command");
}

# utility function -- reverse complement
sub _complement {
  my $dna = shift;
  $$dna =~ tr/GATCgatc/CTAGctag/;
  $$dna = scalar reverse $$dna;
}

sub _feature_filter {
  my $self = shift;
  my $features = shift;
  return '' unless $features;
  my $opt = '';
  $opt = '+feature ' . join('|',@$features) if ref($features) eq 'ARRAY' && @$features;
  $opt = "+feature $features" unless ref $features;
  $opt;
}

1;

=head1 NAME

Ace::Sequence - Examine ACeDB Sequence Objects

=head1 SYNOPSIS

Ace/Sequence.pm  view on Meta::CPAN

    # open database connection and get an Ace::Object sequence
    use Ace::Sequence;

    $db  = Ace->connect(-host => 'stein.cshl.org',-port => 200005);
    $obj = $db->fetch(Predicted_gene => 'ZK154.3');

    # Wrap it in an Ace::Sequence object 
    $seq = Ace::Sequence->new($obj);

    # Find all the exons
    @exons = $seq->features('exon');

    # Find all the exons predicted by various versions of "genefinder"
    @exons = $seq->features('exon:genefinder.*');

    # Iterate through the exons, printing their start, end and DNA
    for my $exon (@exons) {
      print join "\t",$exon->start,$exon->end,$exon->dna,"\n";
    }

    # Find the region 1000 kb upstream of the first exon
    $sub = Ace::Sequence->new(-seq=>$exons[0],
                              -offset=>-1000,-length=>1000);

    # Find all features in that area
    @features = $sub->features;

    # Print its DNA
    print $sub->dna;

    # Create a new Sequence object from the first 500 kb of chromosome 1
    $seq = Ace::Sequence->new(-name=>'CHROMOSOME_I',-db=>$db,
			      -offset=>0,-length=>500_000);

    # Get the GFF dump as a text string
    $gff = $seq->gff;

    # Limit dump to Predicted_genes
    $gff_genes = $seq->gff(-features=>'Predicted_gene');

    # Return a GFF object (using optional GFF.pm module from Sanger)
    $gff_obj = $seq->GFF;

=head1 DESCRIPTION

I<Ace::Sequence>, and its allied classes L<Ace::Sequence::Feature> and
L<Ace::Sequence::FeatureList>, provide a convenient interface to the
ACeDB Sequence classes and the GFF sequence feature file format.

Using this class, you can define a region of the genome by using a
landmark (sequenced clone, link, superlink, predicted gene), an offset
from that landmark, and a distance.  Offsets and distances can be
positive or negative.  This will return an I<Ace::Sequence> object.
Once a region is defined, you may retrieve its DNA sequence, or query
the database for any features that may be contained within this
region.  Features can be returned as objects (using the
I<Ace::Sequence::Feature> class), as GFF text-only dumps, or in the
form of the GFF class defined by the Sanger Centre's GFF.pm module.

This class builds on top of L<Ace> and L<Ace::Object>.  Please see
their manual pages before consulting this one.

=head1 Creating New Ace::Sequence Objects, the new() Method

 $seq = Ace::Sequence->new($object);

Ace/Sequence.pm  view on Meta::CPAN


Returns all subsequences that exist as independent objects in the
ACeDB database.  What exactly is returned is dependent on the data
model.  In older ACeDB databases, the only subsequences are those
under the catchall Subsequence tag.  In newer ACeDB databases, the
objects returned correspond to objects to the right of the S_Child
subtag using a tag[2] syntax, and may include Predicted_genes,
Sequences, Links, or other objects.  The return value is a list of
I<Ace::Sequence> objects.

=head2 features()

  @features = $seq->features;
  @features = $seq->features('exon','intron','Predicted_gene');
  @features = $seq->features('exon:GeneFinder','Predicted_gene:hand.*');

features() returns an array of I<Sequence::Feature> objects.  If
called without arguments, features() returns all features that cross
the sequence region.  You may also provide a filter list to select a
set of features by type and subtype.  The format of the filter list
is:

  type:subtype

Where I<type> is the class of the feature (the "feature" field of the
GFF format), and I<subtype> is a description of how the feature was
derived (the "source" field of the GFF format).  Either of these
fields can be absent, and either can be a regular expression.  More
advanced filtering is not supported, but is provided by the Sanger
Centre's GFF module.

The order of the features in the returned list is not specified.  To
obtain features sorted by position, use this idiom:

  @features = sort { $a->start <=> $b->start } $seq->features;

=head2 feature_list()

  my $list = $seq->feature_list();

This method returns a summary list of the features that cross the
sequence in the form of a L<Ace::Feature::List> object.  From the
L<Ace::Feature::List> object you can obtain the list of feature names
and the number of each type.  The feature list is obtained from the
ACeDB server with a single short transaction, and therefore has much
less overhead than features().

See L<Ace::Feature::List> for more details.

=head2 transcripts()

This returns a list of Ace::Sequence::Transcript objects, which are
specializations of Ace::Sequence::Feature.  See L<Ace::Sequence::Transcript>
for details.

=head2 clones()

Ace/Sequence.pm  view on Meta::CPAN

This returns a list of Ace::Sequence::Feature objects containing
reconstructed clones.  This is a nasty hack, because ACEDB currently
records clone ends, but not the clones themselves, meaning that we
will not always know both ends of the clone.  In this case the missing
end has a synthetic position of -99,999,999 or +99,999,999.  Sorry.

=head2 gff()

  $gff = $seq->gff();
  $gff = $seq->gff(-abs      => 1,
                   -features => ['exon','intron:GeneFinder']);

This method returns a GFF file as a scalar.  The following arguments
are optional:

=over 4

=item -abs

Ordinarily the feature entries in the GFF file will be returned in
coordinates relative to the start of the I<Ace::Sequence> object.
Position 1 will be the start of the sequence object, and the "+"
strand will be the sequence object's natural orientation.  However if
a true value is provided to B<-abs>, the coordinate system used will
be relative to the start of the source sequence, i.e. the native ACeDB
Sequence object (usually a cosmid sequence or a link).  

If a reference sequence was provided when the I<Ace::Sequence> was
created, it will be used by default to set the coordinate system.
Relative coordinates can be reenabled by providing a false value to
B<-abs>.  

Ordinarily the coordinate system manipulations automatically "do what
you want" and you will not need to adjust them.  See also the abs()
method described below.

=item -features

The B<-features> argument filters the features according to a list of
types and subtypes.  The format is identical to the one described for
the features() method.  A single filter may be provided as a scalar
string.  Multiple filters may be passed as an array reference.

=back

See also the GFF() method described next.

=head2 GFF()

  $gff_object = $seq->gff;
  $gff_object = $seq->gff(-abs      => 1,
                   -features => ['exon','intron:GeneFinder']);

The GFF() method takes the same arguments as gff() described above,
but it returns a I<GFF::GeneFeatureSet> object from the GFF.pm
module.  If the GFF module is not installed, this method will generate 
a fatal error.

=head2 absolute()

 $abs = $seq->absolute;
 $abs = $seq->absolute(1);

This method controls whether the coordinates of features are returned
in absolute or relative coordinates.  "Absolute" coordinates are
relative to the underlying source or reference sequence.  "Relative"
coordinates are relative to the I<Ace::Sequence> object.  By default,
coordinates are relative unless new() was provided with a reference
sequence.  This default can be examined and changed using absolute().

=head2 automerge()

  $merge = $seq->automerge;
  $seq->automerge(0);

This method controls whether groups of features will automatically be
merged together by the features() call.  If true (the default), then
the left and right end of clones will be merged into "clone" features,
introns, exons and CDS entries will be merged into
Ace::Sequence::Transcript objects, and similarity entries will be
merged into Ace::Sequence::GappedAlignment objects.

=head2 db()

  $db = $seq->db;

Returns the L<Ace> database accessor associated with this sequence.

Ace/Sequence/Feature.pm  view on Meta::CPAN

  my $self = shift;
  my $seq = $self->_field('seqname');
  $self->db->fetch(Sequence=>$seq); 
}

sub method    { shift->_field('method',@_) }  # ... I prefer "method"
sub subtype   { shift->_field('method',@_) }  # ... or even "subtype"
sub type      { shift->_field('type',@_)   }  # ... I prefer "type"
sub score     { shift->_field('score',@_)  }  # float indicating some sort of score
sub frame     { shift->_field('frame',@_)  }  # one of 1, 2, 3 or undef
sub info      {                  # returns Ace::Object(s) with info about the feature
  my $self = shift;
  unless ($self->{group}) {
    my $info = $self->{info}{group} || 'Method "'.$self->method.'"';
    $info =~ s/(\"[^\"]*);([^\"]*\")/$1$;$2/g;
    my @data = split(/\s*;\s*/,$info);
    foreach (@data) { s/$;/;/g }
    $self->{group} = [map {$self->toAce($_)} @data];
  }
  return wantarray ? @{$self->{group}} : $self->{group}->[0];
}

Ace/Sequence/Feature.pm  view on Meta::CPAN

    # open database connection and get an Ace::Object sequence
    use Ace::Sequence;

    # get a megabase from the middle of chromosome I
    $seq = Ace::Sequence->new(-name   => 'CHROMOSOME_I,
                              -db     => $db,
			      -offset => 3_000_000,
			      -length => 1_000_000);

    # get all the homologies (a list of Ace::Sequence::Feature objs)
    @homol = $seq->features('Similarity');

    # Get information about the first one
    $feature = $homol[0];
    $type    = $feature->type;
    $subtype = $feature->subtype;
    $start   = $feature->start;
    $end     = $feature->end;
    $score   = $feature->score;

    # Follow the target
    $target  = $feature->info;

    # print the target's start and end positions
    print $target->start,'-',$target->end, "\n";

=head1 DESCRIPTION

I<Ace::Sequence::Feature> is a subclass of L<Ace::Sequence::Feature>
specialized for returning information about particular features in a
GFF format feature table.

=head1  OBJECT CREATION

You will not ordinarily create an I<Ace::Sequence::Feature> object
directly.  Instead, objects will be created in response to a feature()
call to an I<Ace::Sequence> object.  If you wish to create an
I<Ace::Sequence::Feature> object directly, please consult the source
code for the I<new()> method.

=head1 OBJECT METHODS

Most methods are inherited from I<Ace::Sequence>.  The following
methods are also supported:

=over 4

=item seqname()

  $object = $feature->seqname;

Return the ACeDB Sequence object that this feature is attached to.
The return value is an I<Ace::Object> of the Sequence class.  This
corresponds to the first field of the GFF format and does not
necessarily correspond to the I<Ace::Sequence> object from which the
feature was obtained (use source_seq() for that).

=item source()

=item method()

=item subtype()

  $source = $feature->source;

These three methods are all synonyms for the same thing.  They return
the second field of the GFF format, called "source" in the
documentation.  This is usually the method or algorithm used to
predict the feature, such as "GeneFinder" or "tRNA" scan.  To avoid
ambiguity and enhance readability, the method() and subtype() synonyms
are also recognized.

=item feature()

=item type()

  $type = $feature->type;

These two methods are also synonyms.  They return the type of the
feature, such as "exon", "similarity" or "Predicted_gene".  In the GFF
documentation this is called the "feature" field.  For readability,
you can also use type() to fetch the field.

=item abs_start()

  $start = $feature->abs_start;

This method returns the absolute start of the feature within the
sequence segment indicated by seqname().  As in the I<Ace::Sequence>
method, use start() to obtain the start of the feature relative to its
source.

=item abs_start()

  $start = $feature->abs_start;

This method returns the start of the feature relative to the sequence
segment indicated by seqname().  As in the I<Ace::Sequence> method,
you will more usually use the inherited start() method to obtain the
start of the feature relative to its source sequence (the
I<Ace::Sequence> from which it was originally derived).

=item abs_end()

  $start = $feature->abs_end;

This method returns the end of the feature relative to the sequence
segment indicated by seqname().  As in the I<Ace::Sequence> method,
you will more usually use the inherited end() method to obtain the end
of the feature relative to the I<Ace::Sequence> from which it was
derived.

=item score()

  $score = $feature->score;

For features that are associated with a numeric score, such as
similarities, this returns that value.  For other features, this
method returns undef.

=item strand()

  $strand = $feature->strand;

Returns the strandedness of this feature, either "+1" or "-1".  For
features that are not stranded, returns 0.

=item reversed()

  $reversed = $feature->reversed;

Returns true if the feature is reversed relative to its source
sequence.

=item frame()

  $frame = $feature->frame;

For features that have a frame, such as a predicted coding sequence,
returns the frame, either 0, 1 or 2.  For other features, returns undef.

=item group()

=item info()

=item target()

  $info = $feature->info;

These methods (synonyms for one another) return an Ace::Object
containing other information about the feature derived from the 8th
field of the GFF format, the so-called "group" field.  The type of the
Ace::Object is dependent on the nature of the feature.  The
possibilities are shown in the table below:

  Feature Type           Value of Group Field
  ------------            --------------------
  
  note                   A Text object containing the note.
  
  similarity             An Ace::Sequence::Homology object containing
                         the target and its start/stop positions.

  intron                 An Ace::Object containing the gene from 
  exon                   which the feature is derived.
  misc_feature

  other                  A Text object containing the group data.

=item asString()

  $label = $feature->asString;

Returns a human-readable identifier describing the nature of the
feature.  The format is:

 $type:$name/$start-$end

for example:

 exon:ZK154.3/1-67

This method is also called automatically when the object is treated in
a string context.

Ace/Sequence/FeatureList.pm  view on Meta::CPAN

  foreach (@lines) {
    next if m!^//!;
    my ($minor,$major,$count) = split "\t";
    next unless $count > 0;
    $parsed{$major}{$minor} += $count;
    $parsed{_TOTAL} += $count;
  }
  return bless \%parsed,$package;
}

# no arguments, scalar context -- count all features
# no arguments, array context  -- list of major types
# 1 argument, scalar context   -- count of major type
# 1 argument, array context    -- list of minor types
# 2 arguments                  -- count of subtype
sub types {
  my $self = shift;
  my ($type,$subtype) = @_;
  my $count = 0;

  unless ($type) {

Ace/Sequence/FeatureList.pm  view on Meta::CPAN


=head1 SYNOPSIS

    # get a megabase from the middle of chromosome I
    $seq = Ace::Sequence->new(-name   => 'CHROMOSOME_I,
                              -db     => $db,
			      -offset => 3_000_000,
			      -length => 1_000_000);

    # find out what's there
    $list = $seq->feature_list;

    # Scalar context: count all the features
    $feature_count = $list->types;

    # Array context: list all the feature types
    @feature_types = $list->types;

    # Scalar context, 1 argument.  Count this type
    $gene_cnt = $list->types('Predicted_gene');
    print "There are $gene_cnt genes here.\n";

    # Array context, 1 argument.  Get list of subtypes
    @subtypes = $list->types('Predicted_gene');

    # Two arguments. Count type & subtype
    $genefinder_cnt = $list->types('Predicted_gene','genefinder');

=head1 DESCRIPTION

I<Ace::Sequence::FeatureList> is a small class that provides
statistical information about sequence features.  From it you can
obtain summary counts of the features and their types within a
selected region.

=head1 OBJECT CREATION

You will not ordinarily create an I<Ace::Sequence::FeatureList> object
directly.  Instead, objects will be created by calling a
I<Ace::Sequence> object's feature_list() method.  If you wish to
create an I<Ace::Sequence::FeatureList> object directly, please consult
the source code for the I<new()> method.

=head1 OBJECT METHODS

There are only two methods in I<Ace::Sequence::FeatureList>.

=over 4

=item type()

This method has five distinct behaviors, depending on its context and
the number of parameters.  Usage should be intuitive

 Context       Arguments       Behavior
 -------       ---------       --------

 scalar         -none-         total count of features in list
 array          -none-         list feature types (e.g. "exon")
 scalar          type          count features of this type
 array           type          list subtypes of this type
 -any-       type,subtype      count features of this type & subtype

For example, this code fragment will count the number of exons present
on the list:

  $exon_count = $list->type('exon');

This code fragment will count the number of exons found by "genefinder":

  $predicted_exon_count = $list->type('exon','genefinder');

Ace/Sequence/GappedAlignment.pm  view on Meta::CPAN

use overload 
  '""' => 'asString',
  'fallback' => 'TRUE';
  ;
use vars '$VERSION';
$VERSION = '1.20';

*sub_SeqFeature = \&merged_segments;


# autoload delegates everything to the Sequence feature
sub AUTOLOAD {
  my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
  my $self = shift;
  $self->{base}->$func_name(@_);
}

sub new {
  my $class = shift;
  my $segments = shift;
  my @segments = sort {$a->start <=> $b->start} @$segments;

Ace/Sequence/GappedAlignment.pm  view on Meta::CPAN


Return a list of Ace::Sequence::Feature objects corresponding to
similar segments.

=item relative()

  $relative = $gene->relative;
  $gene->relative(1);

This turns on and off relative coordinates.  By default, the exons and
intron features will be returned in the coordinate system used by the
gene.  If relative() is set to a true value, then coordinates will be
expressed as relative to the start of the gene.  The first exon will
(usually) be 1.

=head1 SEE ALSO

L<Ace>, L<Ace::Object>, L<Ace::Sequence>,L<Ace::Sequence::Homol>,
L<Ace::Sequence::Feature>, L<Ace::Sequence::FeatureList>, L<GFF>

=head1 AUTHOR

Ace/Sequence/Gene.pm  view on Meta::CPAN


Return a list of Ace::Sequence::Feature objects corresponding to
coding sequence.  THIS IS NOT YET IMPLEMENTED.

=item relative()

  $relative = $gene->relative;
  $gene->relative(1);

This turns on and off relative coordinates.  By default, the exons and
intron features will be returned in the coordinate system used by the
gene.  If relative() is set to a true value, then coordinates will be
expressed as relative to the start of the gene.  The first exon will
(usually) be 1.

=head1 SEE ALSO

L<Ace>, L<Ace::Object>, L<Ace::Sequence>,L<Ace::Sequence::Homol>,
L<Ace::Sequence::Feature>, L<Ace::Sequence::FeatureList>, L<GFF>

=head1 AUTHOR

Ace/Sequence/Homol.pm  view on Meta::CPAN

#}

1;

=head1 NAME

Ace::Sequence::Homol - Temporary Sequence Homology Class

=head1 SYNOPSIS

    # Get all similarity features from an Ace::Sequence
    @homol = $seq->features('Similarity');

    # sort by score
    @sorted = sort { $a->score <=> $b->score } @homol;

    # the last one has the highest score
    $best = $sorted[$#sorted];

    # fetch its associated Ace::Sequence::Homol
    $homol = $best->target;

Ace/Sequence/Homol.pm  view on Meta::CPAN

I<Ace::Sequence::Homol> is a subclass of L<Ace::Object> (B<not>
L<Ace::Sequence>) which is specialized for returning information about
a DNA or protein homology.  This is a temporary placeholder for a more
sophisticated homology class which will include support for
alignments.

=head1 OBJECT CREATION

You will not ordinarily create an I<Ace::Sequence::Homol> object
directly.  Instead, objects will be created in response to an info()
or group() method call on a similarity feature in an
I<Ace::Sequence::Feature> object.  If you wish to create an
I<Ace::Sequence::Homol> object directly, please consult the source
code for the I<new()> method.

=head1 OBJECT METHODS

Most methods are inherited from I<Ace::Object>.  The following
methods are also supported:

=over 4

Ace/Sequence/Homol.pm  view on Meta::CPAN


Returns the end of the area that is similar to the
I<Ace::Sequence::Feature> from which his homology was derived.
Coordinates are relative to the target homology.

=item asString()

  $label = $homol->asString;

Returns a human-readable identifier describing the nature of the
feature.  The format is:

 $name/$start-$end

for example:

 HUMGEN13/1-67

This method is also called automatically when the object is treated in
a string context.

Ace/Sequence/Multi.pm  view on Meta::CPAN

  foreach (@_) {
    delete $self->{'secondary'}->{$_};
  }
}

sub db {
  return $_[0]->SUPER::db() unless $_[1];
  return $_[0]->{'secondary'}->{$_[1]} || $_[0]->SUPER::db();
}

# return list of features quickly
sub feature_list {
  my $self = shift;
  return $self->{'feature_list'} if $self->{'feature_list'};
  my $raw;

  for my $db ($self->db,$self->secondary) {
    $raw .= $self->_query($db,'seqfeatures -version 2 -list');
    $raw .= "\n";  # avoid nulls
  }

  return $self->{'feature_list'} = Ace::Sequence::FeatureList->new($raw);
}

# return a unified gff file
sub gff {
  my $self = shift;
  my ($abs,$features) = rearrange([['ABS','ABSOLUTE'],'FEATURES'],@_);
  my   $db = $self->db;

  my $gff = $self->SUPER::gff(-Abs=>$abs,-Features=>$features,-Db=>$db);
  return unless $gff;
  return $gff unless $self->secondary;

  my(%seen,@lines);

  foreach (grep !$seen{$_}++,split("\n",$gff)) {  #ignore duplicates
    next if m!^//!;  # ignore comments
    push @lines,/^\#/ ? $_ : join "\t",$_,$db;
  }

  my $opt = $self->_feature_filter($features);

  for my $db ($self->secondary) {
    my $supplement = $self->_gff($opt,$db);
    $self->transformGFF(\$supplement) unless $abs;

    my $string = $db->asString;

    foreach (grep !$seen{$_}++,split("\n",$supplement)) {  #ignore duplicates
      next if m!^(//|\#)!;  # ignore comments
      push(@lines, join "\t",$_,$string);   # add database as an eighth field
    }
  }

  return join("\n",@lines,'');
}

# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
  my $self = shift;
  my ($gff,$filter) = @_;

  my @dbs = ($self->db,$self->secondary);
  my %dbs = map { $_->asString => $_ } @dbs;

  my ($r,$r_offset,$r_strand) = $self->refseq;
  my $abs = $self->absolute;
  if ($abs) {
    $r_offset  = 0;
    $r = $self->parent;
    $r_strand = '+1';
  }
  my @features;
  foreach (split("\n",$gff)) {
    next if m[^(?:\#|//)];
    next unless $filter->($_);
    next unless my ($dbname) = /\t(\S+)$/;
    next unless my $db = $dbs{$dbname};
    next unless my $parent = $self->parent;
    push @features,Ace::Sequence::Feature->new($parent,$r,$r_offset,$r_strand,$abs,$_,$db);
  }

  return @features;
}

1;

__END__

=head1 NAME

Ace::Sequence::Multi - Combine Feature Tables from Multiple Databases

Ace/Sequence/Multi.pm  view on Meta::CPAN

    # Make an Ace::Sequence::Multi object
    $seq = Ace::Sequence::Multi->new(-name   => 'CHROMOSOME_I,
                                     -db     => $ref,
			             -offset => 3_000_000,
			             -length => 1_000_000);

    # add the secondary databases
    $seq->add_secondary($db1,$db2);

    # get all the homologies (a list of Ace::Sequence::Feature objs)
    @homol = $seq->features('Similarity');

    # Get information about the first one -- goes to the correct db
    $feature = $homol[0];
    $type    = $feature->type;
    $subtype = $feature->subtype;
    $start   = $feature->start;
    $end     = $feature->end;
    $score   = $feature->score;

    # Follow the target
    $target  = $feature->info;

    # print the target's start and end positions
    print $target->start,'-',$target->end, "\n";

=head1 DESCRIPTION

I<Ace::Sequence::Multi> transparently combines information stored
about a sequence in a reference database with features tables from any 
number of annotation databases.  The resulting object can be used just 
like an Ace::Sequence object, except that the features remember their
database of origin and go back to that database for information.

This class will only work properly if the reference database and all
annotation databases share the same cosmid map.

=head1  OBJECT CREATION

You will use the new() method to create new Ace::Sequence::Multi
objects.  The arguments are identical to the those in the
Ace::Sequence parent class, with the addition of an option

Ace/Sequence/Transcript.pm  view on Meta::CPAN

use Ace::Sequence::Feature;
use vars '$AUTOLOAD';
use overload 
  '""' => 'asString',
  ;

# for compatibility with the Ace::Graphics::Glyph::segments glyph, and
# with Bioperl SeqFeatureI:
*sub_SeqFeature = *merged_segments = *segments = \&exons;

# autoload delegates everything to the Sequence feature
sub AUTOLOAD {
  my($pack,$func_name) = $AUTOLOAD=~/(.+)::([^:]+)$/;
  my $self = shift;
  $self->{base}->$func_name(@_);
}

sub DESTROY { }

sub new {
  my $class = shift;

Ace/Sequence/Transcript.pm  view on Meta::CPAN


Return a list of Ace::Sequence::Feature objects corresponding to
coding sequence.  THIS IS NOT YET IMPLEMENTED.

=item relative()

  $relative = $gene->relative;
  $gene->relative(1);

This turns on and off relative coordinates.  By default, the exons and
intron features will be returned in the coordinate system used by the
gene.  If relative() is set to a true value, then coordinates will be
expressed as relative to the start of the gene.  The first exon will
(usually) be 1.

=head1 SEE ALSO

L<Ace>, L<Ace::Object>, L<Ace::Sequence>,L<Ace::Sequence::Homol>,
L<Ace::Sequence::Feature>, L<Ace::Sequence::FeatureList>, L<GFF>

=head1 AUTHOR

README  view on Meta::CPAN

connection to this server like this:

   $db = Ace->connect('sace://aceserver.cshl.org:2005');

Otherwise, if you wish to communicate with your own ACEDB database,
you must use ACEDB version 4.8a or higher, available from this
location:

	ftp://ncbi.nlm.nih.gov/repository/acedb/
	
To take full advantage of the sequence annotation features in the
Ace::Sequence and Ace::Sequence::Feature classes, you will need
version 4.9r or higher.

If you wish to use AcePerl in a client-server fashion, you must get
sgifaceserver up and running.  Some hints on installing the
sgifaceserver application are given later in this README.

Follow these steps to unpack, build and install AcePerl:

1. Unpack the AcePerl distribution with this command:

README  view on Meta::CPAN

interface to any local or remote ace database.  If you have the Perl
Term::readline module installed, it gives you command-line editing,
completion, and history.

The script "dump_cdna.pl" shows you how to dump out all spliced cDNAs
from wormbase.org.  Other dump scripts show similar tricks.  You can
use these as templates for doing other biologically interesting
tricks.

There is also family of CGI scripts that run on top of AcePerl to give
a WebAce-like interface to Ace (it is not as feature-full as WebAce,
but it is probably easier to set up and run).  This package is now part
of the AcePerl distribution, but is not installed unless you specifically
request it.  See README.ACEBROWSER for details.

INSTALLING THE ACEDB SERVER

See ACEDB.HOWTO in the docs/ directory for instructions on compiling
acedb and installing the server application to start up when needed.

Lincoln Stein

acebrowser/cgi-bin/generic/pic  view on Meta::CPAN


  print_map($name,$class,$boxes);
}

sub print_map {
    my ($name,$class,$boxes) = @_;
    my @lines;
    my $old_clicks = param('click');
    Delete('click');

    # Collect some statistics in order to inhibit those features
    # that are too dense to click on sensibly.
    my %centers;
    foreach my $box (@$boxes) {
	my $center = center($box->{'coordinates'});
	$centers{$center}++;
    }

    my $user_agent =  http('User_Agent');
    my $modern = $user_agent=~/Mozilla\/([\d.]+)/ && $1 >= 4;

acebrowser/htdocs/stylesheets/aceperl.css  view on Meta::CPAN

                    height: 4;
                    bump: +1;
                    key: 'C.\ briggsae\ similarity';
                  }
.Prosite          { background-color: bisque;
                    color: black;
                    height: 4;
                    bump: +1;
                    key: 'prosite';
                  }
.Misc_feature     { background-color: bisque;
                    color: black;
                    height: 4;
                    bump: +1;
                    key: 'Miscellaneous';
                  }
.Clone            { color: black;
                    height: 7;
                    bump: +1;
                    key: 'YACs\ &\ Cosmids';
                  }



( run in 0.481 second using v1.01-cache-2.11-cpan-4d50c553e7e )