parent results from the CPAN

AcePerl


# 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++) {
    my ($x1,$y1,$x2,$y2) = $parts[$i]->calculate_boundaries($left,$top);
    my ($x3,$y3,$x4,$y4) = $parts[$i+1]->calculate_boundaries($left,$top);
    next unless ($x3 - $x1) >= 3;
    $gd->line($x2+1,($y1+$y2)/2,$x3-1,($y3+$y4)/2,gdStyled);
  }

}

1;

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

  $gd->setStyle(0,0,0,1);
  $gd->line($x1+2,$top,$x2-2,$top,gdStyledBrushed);
}

sub make_brush {
  my $self = shift;
  my $orientation = shift;

  my $brush   = GD::Image->new(3,3);
  my $bgcolor = $brush->colorAllocate(255,255,255); #white
  $brush->transparent($bgcolor);
  my $fgcolor   = $brush->colorAllocate($self->factory->panel->rgb($self->fgcolor));
  if ($orientation > 0) {
    $brush->setPixel(0,0,$fgcolor);
    $brush->setPixel(1,1,$fgcolor);
    $brush->setPixel(0,2,$fgcolor);
  } else {
    $brush->setPixel(1,0,$fgcolor);
    $brush->setPixel(0,1,$fgcolor);
    $brush->setPixel(1,2,$fgcolor);
  }

Ace/Model.pm view on Meta::CPAN

      }
      
      if ($position > $current_position) {  # here's a subtag
	push @path_stack,[$current_position,[@path]];  # remember a copy of partial path
	push @paths,[@path];                           # remember current path
	push @path,$tag;                               # append to the current path
      } elsif ($position == $current_position) {  # here's a sibling tree
	push @paths,[@path];                      # remember current path
	$path[-1] = $tag;                         # replace last item
	
	# otherwise, we're done with a subtree and need to restore context of parent
      } else {
	push @paths,[@path];                  # remember current path
	@path = ();                           # nuke path
	while (@path_stack) {
	  my $s = pop @path_stack;            # pop off an earlier partial path
	  if ($s->[0] == $position) {         # found correct context to restore
	    @path = @{$s->[1]};               # restore
	    last;
	  }
	}

Ace/Object.pm view on Meta::CPAN

    my $db = shift;
    $self->{db} = "$db";  # store string representation, not object
  }
  Ace->name2db($self->{db});
}

### Return a portion of the tree at the indicated tag path     ###
#### In a list context returns the column.  In an array context ###
#### returns a pointer to the subtree ####
#### Usually returns what is pointed to by the tag.  Will return
#### the parent object if you pass a true value as the second argument
sub at {
    my $self = shift;
    my($tag,$pos,$return_parent) = rearrange(['TAG','POS','PARENT'],@_);
    return $self->right unless $tag;
    $tag = lc $tag;

    # Removed a $` here to increase speed -- tim.cutts@incyte.com 2 Sep 1999

    if (!defined($pos) and $tag=~/(.*?)\[(\d+)\]$/) {
      $pos = $2;
      $tag = $1;
    }

    my $o = $self;
    my ($parent,$above,$left);
    my (@tags) = $self->_split_tags($tag);
    foreach $tag (@tags) {
      $tag=~s/$;/./g; # unprotect backslashed dots
      my $p = $o;
      ($o,$above,$left) = $o->_at($tag);
      return unless defined($o);
    }
    return $above || $left if $return_parent;
    return defined $pos ? $o->right($pos) : $o unless wantarray;
    return $o->col($pos);
}

### Flatten out part of the tree into an array ####
### along the row.  Will not follow object references.  ###
sub row {
  my $self = shift;
  my $pos = shift;
  my @r;

Ace/Object.pm view on Meta::CPAN

  }

 TRY: {

    # look in our tag cache first
    if (exists $self->{'.PATHS'}) {

      # we've already cached the desired tree
      last TRY if exists $self->{'.PATHS'}{$lctag};
      
      # not cached, so try parents of tag
      my $m = $self->model;
      my @parents = $m->path($lctag) if $m;
      my $tree;
      foreach (@parents) {
	($tree = $self->{'.PATHS'}{lc $_}) && last;
      }
      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

Ace/Object.pm view on Meta::CPAN

  @values = map { ref($_) && ref($_) eq 'ARRAY' ? @$_ : $_ } ($oldvalue,@rest) 
    if defined($oldvalue);

  unless ($tag =~ /\./) {
    my $model = $self->model;
    my @intermediate_tags = $model->path($tag);
    $tag = join '.',@intermediate_tags,$tag;
  }

  my $row = join(".",($tag,map { (my $x = $_) =~s/\./\\./g; $x } @values));
  my $subtree = $self->at($row,undef,1);  # returns the parent

  if (@values
      && defined($subtree->{'.right'})
      && "$subtree->{'.right'}" eq $oldvalue) {
    $subtree->{'.right'} = $subtree->{'.right'}->down;
  } else {
    $subtree->{'.down'} = $subtree->{'.down'}->{'.down'}
  }

  push(@{$self->{'.update'}},join(' ','-D',

Ace/Sequence.pm view on Meta::CPAN

*abs = \&absolute;
*source_seq = \&source;
*source_tag = \&subtype;
*primary_tag = \&type;

my %plusminus = (	 '+' => '-',
		 '-' => '+',
		 '.' => '.');

# internal keys
#    parent    => reference Sequence in "+" strand
#    p_offset  => our start in the parent
#    length    => our length
#    strand    => our strand (+ or -)
#    refseq    => reference Sequence for coordinate system

# object constructor
# usually called like this:
# $seq = Ace::Sequence->new($object);
# but can be called like this:
# $seq = Ace::Sequence->new(-db=>$db,-name=>$name);
# or

Ace/Sequence.pm view on Meta::CPAN

    rearrange([
	       ['SEQ','SEQUENCE','SOURCE'],
	      'START',
	       ['END','STOP'],
	       ['OFFSET','OFF'],
	       ['LENGTH','LEN'],
	       'REFSEQ',
	       ['DATABASE','DB'],
	      ],@_);

  # Object must have a parent sequence and/or a reference
  # sequence.  In some cases, the parent sequence will be the
  # object itself.  The reference sequence is used to set up
  # the frame of reference for the coordinate system.

  # fetch the sequence object if we don't have it already
  croak "Please provide either a Sequence object or a database and name"
    unless ref($seq) || ($seq && $db);

  # convert start into offset
  $offset = $start - 1 if defined($start) and !defined($offset);

Ace/Sequence.pm view on Meta::CPAN

  $length = ($end > $start) ? $end - $offset : $end - $offset - 2
    if defined($end) && !defined($length);

  # if just a string is passed, try to fetch a Sequence object
  my $obj = ref($seq) ? $seq : $db->fetch('Sequence'=>$seq);
  unless ($obj) {
    Ace->error("No Sequence named $obj found in database");
    return;
  }

  # get parent coordinates and length of this sequence
  # 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,
		    parent     => $parent,
		    p_offset   => $p_offset,
		    refseq     => [$source,$r_offset,$r_strand],
		    strand     => $strand,
		    absolute   => 0,
		    automerge  => 1,
		   },$pack;

  # set the reference sequence
  eval { $self->refseq($refseq) } or return if defined $refseq;

  # wheww!
  return $self;
}

# return the "source" object that the user offset from
sub source {
  $_[0]->{obj};
}

# return the parent object
sub parent { $_[0]->{parent} }

# return the length
#sub length { $_[0]->{length} }
sub length { 
  my $self = shift;
  my ($start,$end) = ($self->start,$self->end);
  return $end - $start + ($end > $start ? 1 : -1);  # for stupid 1-based adjustments
}

sub reversed {  return shift->strand < 0; }

Ace/Sequence.pm view on Meta::CPAN

  BLOCK: {
      last BLOCK unless defined ($refseq);

      if (ref($refseq) && ref($refseq) eq 'ARRAY') {
	$arrayref = $refseq;
	last BLOCK;
      }

      if (ref($refseq) && ($refseq->can('smapped'))) {
	croak "Reference sequence has no common ancestor with sequence"
	  unless $self->parent eq $refseq->parent;
	my ($a,$b,$c) = @{$refseq->{refseq}};
	#	$b += $refseq->offset;
	$b += $refseq->offset;
	$arrayref = [$refseq,$b,$refseq->strand];
	last BLOCK;
      }


      # look up reference sequence in database if we aren't given
      # database object already
      $refseq = $self->db->fetch('Sequence' => $refseq)
	unless $refseq->isa('Ace::Object');
      croak "Invalid reference sequence" unless $refseq;

      # find position of ref sequence in parent strand
      my ($r_parent,$r_offset,$r_length,$r_strand) = find_parent($refseq);
      croak "Reference sequence has no common ancestor with sequence" 
	unless $r_parent eq $self->{parent};

      # set to array reference containing this information
      $arrayref = [$refseq,$r_offset,$r_strand];
    }
    $self->{refseq} = $arrayref;
  }
  return unless $prev;
  return $self->parent if $self->absolute;
  return wantarray ? @{$prev} : $prev->[0];
}

# return strand
sub strand { return $_[0]->{strand} }

# return reference strand
sub r_strand {
  my $self = shift;
  return "+1" if $self->absolute;

Ace/Sequence.pm view on Meta::CPAN

  else {
    return $self->{offset} +1;
  }

}

sub end { 
  my ($self,$abs) = @_;
  my $start = $self->start($abs);
  my $f = $self->{length} > 0 ? 1 : -1;  # for stupid 1-based adjustments
  if ($abs && $self->refseq ne $self->parent) {
    my $r_strand = $self->r_strand;
    return $start - $self->{length} + $f 
      if $r_strand < 0 or $self->{strand} < 0 or $self->{length} < 0;
    return  $start + $self->{length} - $f
  }
  return  $start + $self->{length} - $f if $self->r_strand eq $self->{strand};
  return  $start - $self->{length} + $f;
}

# turn on absolute coordinates (relative to reference sequence)

Ace/Sequence.pm view on Meta::CPAN

  my $self = shift;
  my $prev = $self->{absolute};
  $self->{absolute} = $_[0] if defined $_[0];
  return $prev;
}

# human readable string (for debugging)
sub asString {
  my $self = shift;
  if ($self->absolute) {
    return join '',$self->parent,'/',$self->start,',',$self->end;
  } elsif (my $ref = $self->refseq){
    my $label = $ref->isa('Ace::Sequence::Feature') ? $ref->info : "$ref";
    return join '',$label,'/',$self->start,',',$self->end;

  } else {
    join '',$self->source,'/',$self->start,',',$self->end;
  }
}

sub cmp {
  my ($self,$arg,$reversed) = @_;
  if (ref($arg) and $arg->isa('Ace::Sequence')) {
    my $cmp = $self->parent cmp $arg->parent 
      || $self->start <=> $arg->start;
    return $reversed ? -$cmp : $cmp;
  }
  my $name = $self->asString;
  return $reversed ? $arg cmp $name : $name cmp $arg;
}

# Return the DNA
sub dna {
  my $self = shift;

Ace/Sequence.pm view on Meta::CPAN

      }
    }
  }

  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;

Ace/Sequence.pm view on Meta::CPAN

  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;
  $ref_source ||= $source;
  $ref_strand ||= $strand;

  if ($ref_strand > 0) {
    my $o = defined($ref_offset) ? $ref_offset : ($self->p_offset + $self->offset);
    # find anything that looks like a numeric field and subtract offset from it
    $$gff =~ s/(?<!\")\s+(-?\d+)\s+(-?\d+)/"\t" . ($1 - $o) . "\t" . ($2 - $o)/eg;
    $$gff =~ s/^$parent/$source/mg;
    $$gff =~ s/\#\#sequence-region\s+\S+/##sequence-region $ref_source/m;
    $$gff =~ s/FMAP_FEATURES\s+"\S+"/FMAP_FEATURES "$ref_source"/m;
    return;
  } else {  # strand eq '-'
    my $o = defined($ref_offset) ? (2 + $ref_offset) : (2 + $self->p_offset - $self->offset);
    $$gff =~ s/(?<!\")\s+(-?\d+)\s+(-?\d+)\s+([.\d]+)\s+(\S)/join "\t",'',$o-$2,$o-$1,$3,$plusminus{$4}/eg;
    $$gff =~ s/(Target \"[^\"]+\" )(-?\d+) (-?\d+)/$1 $3 $2/g;
    $$gff =~ s/^$parent/$source/mg;
    $$gff =~ s/\#\#sequence-region\s+\S+\s+(-?\d+)\s+(-?\d+)/"##sequence-region $ref_source " . ($o - $2) . ' ' . ($o - $1) . ' (reversed)'/em;
    $$gff =~ s/FMAP_FEATURES\s+"\S+"\s+(-?\d+)\s+(-?\d+)/"FMAP_FEATURES \"$ref_source\" " . ($o - $2) . ' ' . ($o - $1) . ' (reversed)'/em;
  }

}

# return a name for the object
sub name {
  return shift->source_seq->name;
}

# for compatibility with Ace::Sequence::Feature
sub info {
  return shift->source_seq;
}

###################### internal functions #################
# not necessarily object-oriented!!

# return parent, parent offset and strand
sub find_parent {
  my $obj = shift;

  # first, if we are passed an Ace::Sequence, then we can inherit
  # these settings directly
  return (@{$obj}{qw(parent p_offset length)},$obj->r_strand)
    if $obj->isa('Ace::Sequence');

  # otherwise, if we are passed an Ace::Object, then we must
  # traverse upwards until we find a suitable parent
  return _traverse($obj) if $obj->isa('Ace::Object');

  # otherwise, we don't know what to do...
  croak "Source sequence not an Ace::Object or an Ace::Sequence";
}

sub _get_parent {
  my $obj = shift;
  # ** DANGER DANGER WILL ROBINSON! **
  # This is an experiment in caching parents to speed lookups.  Probably eats memory voraciously.
  return $CACHE{$obj} if CACHE && exists $CACHE{$obj};
  my $p = $obj->get(S_Parent=>2)|| $obj->get(Source=>1);
  return unless $p;
  return CACHE ? $CACHE{$obj} = $p->fetch 
               : $p->fetch;
}

sub _get_children {
  my $obj = shift;
  my @pieces = $obj->get(S_Child=>2);

Ace/Sequence.pm view on Meta::CPAN


  return ($tl,$offset,$strand < 0 ? ($length,'-1') : ($length,'+1') ) if $length;
}

sub _get_toplevel {
  my $obj = shift;
  my $class = $obj->class;
  my $name  = $obj->name;

  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 (@_) {

Ace/Sequence.pm view on Meta::CPAN

  }
  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 {

Ace/Sequence.pm view on Meta::CPAN

system is based on the sequence segment selected at object creation
time.  That is, the "+1" strand is the natural direction of the
I<Ace::Sequence> object, and base pair 1 is its first base pair.  This
behavior can be overridden by providing a reference sequence to the
new() method, in which case the orientation and position of the
reference sequence establishes the coordinate system for the object.

In addition to the reference sequence, there are two other sequences
used by I<Ace::Sequence> for internal bookeeping.  The "source"
sequence corresponds to the smallest ACeDB sequence object that
completely encloses the selected sequence segment.  The "parent"
sequence is the smallest ACeDB sequence object that contains the
"source".  The parent is used to derive the length and orientation of
source sequences that are not directly associated with DNA objects.

In many cases, the source sequence will be identical to the sequence
initially passed to the new() method.  However, there are exceptions
to this rule.  One common exception occurs when the offset and/or
length cross the boundaries of the passed-in sequence.  In this case,
the ACeDB database is searched for the smallest sequence that contains 
both endpoints of the I<Ace::Sequence> object.

The other common exception occurs in Ace 4.8, where there is support

Ace/Sequence.pm view on Meta::CPAN

relative to the source (using 1-based indexing).  This method is
called automatically when the I<Ace::Sequence> is used in a string
context.

=head2 source_seq()

  $source = $seq->source_seq;

Return the source of the I<Ace::Sequence>.

=head2 parent_seq()

  $parent = $seq->parent_seq;

Return the immediate ancestor of the sequence.  The parent of the
top-most sequence (such as the CHROMOSOME link) is itself.  This
method is used internally to ascertain the length of source sequences
which are not associated with a DNA object.

NOTE: this procedure is a trifle funky and cannot reliably be used to
traverse upwards to the top-most sequence.  The reason for this is
that it will return an I<Ace::Sequence> in some cases, and an
I<Ace::Object> in others.  Use get_parent() to traverse upwards
through a uniform series of I<Ace::Sequence> objects upwards.

=head2 refseq([$seq])

  $refseq = $seq->refseq;

Returns the reference sequence, if one is defined.

  $seq->refseq($new_ref);

Ace/Sequence.pm view on Meta::CPAN

(which typically happens during intermediate stages of a sequencing
project.  In such a case, the returned sequence will contain the
correct number of "-" characters.

=head2 name()

  $name = $seq->name;

Return the name of the source sequence as a string.

=head2 get_parent()

  $parent = $seq->parent;

Return the immediate ancestor of this I<Ace::Sequence> (i.e., the
sequence that contains this one).  The return value is a new
I<Ace::Sequence> or undef, if no parent sequence exists.

=head2 get_children()

  @children = $seq->get_children();

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

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

%REV = ('+1' => '-1',
	'-1' => '+1');  # war is peace, &c.

use overload 
  '""' => 'asString',
  ;

# parse a line from a sequence list
sub new {
  my $pack = shift;
  my ($parent,$ref,$r_offset,$r_strand,$abs,$gff_line,$db) = @_;
  my ($sourceseq,$method,$type,$start,$end,$score,$strand,$frame,$group) = split "\t",$gff_line;
  if (defined($strand)) {
    $strand = $strand eq '-' ? '-1' : '+1';
  } else {
    $strand = 0;
  }

  # for efficiency/performance, we don't use superclass new() method, but modify directly
  # handling coordinates.  See SCRAPS below for what should be in here
  $strand = '+1' if $strand < 0 && $r_strand < 0;  # two wrongs do make a right

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

  my $length = ($end > $start) ? $end - $offset : $end - $offset - 2;

  # handle negative strands
  $offset ||= 0;
  $offset *= -1 if $r_strand < 0 && $strand != $r_strand;

  my $self= bless {
		   obj      => $ref,
		   offset   => $offset,
		   length   => $length,
		   parent   => $parent,
		   p_offset => $r_offset,
		   refseq   => [$ref,$r_offset,$r_strand],
		   strand   => $r_strand,
		   fstrand  => $strand,
		   absolute => $abs,
		   info     => {
				seqname=> $sourceseq,
				method => $method,
				type   => $type,
				score  => $score,

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

  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.pm view on Meta::CPAN

    $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
B<-secondary> argument, which points to one or more secondary databases 
from which to fetch annotation information.

=over 4

=item -source

The sequence source.  This must be an I<Ace::Object> of the "Sequence" 
class, or be a sequence-like object containing the SMap tag (see
below).

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

HTML,BODY {
   background-color: #EEEEE0
}
H1,H2,H3,H4,I,EM,B,LI,UL,OL,DD,DT,ADDRESS,DL,A,STRONG,BLOCKQUOTE,P  {
    font-family: sans-serif;
    background-color: transparent;
}
TABLE {
    font-family: sans-serif;
}
TR,TD.search {
   font-size: 10pt;
}

.acetree {
   font-size: 10pt;

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

HTML,BODY {
   background-color: #EEEEE0
}
H1,H2,H3,H4,I,EM,B,LI,UL,OL,DD,DT,ADDRESS,DL,A,STRONG,BLOCKQUOTE,P  {
    font-family: sans-serif;
    background-color: transparent;
}
TABLE {
    font-family: sans-serif;
}
TABLE.search {
    border-top: 0px;
    padding-top: 0px;
    margin-top: 0px;
}
.acetree {

acelib/wh/mystdlib.h view on Meta::CPAN

#define MAXPATHLEN        _MAX_PATH

#define popen _popen
#define pclose _pclose

/* rename to actual WIN32 built-in functions
* (rbrusk): this little code generated a "trigraph" error message
* when built in unix with the gcc compiler; however, I don't understand
* why gcc even sees this code, which is #if defined(WIN32)..#endif protected.
* Changing these to macros is problematic in lex4subs.c et al, which expects
* the names as function names (without parentheses.  So, I change them back..
* If the trigraph error message returns, look for another explanation,
* like MSDOS carriage returns, or something? */
#define strcasecmp  _stricmp 
#define strncasecmp  _strnicmp 
#endif /* WIN32 */

#else  /* not POSIX etc. e.g. SUNOS */

/* local versions of general types */

examples/upstream.pl view on Meta::CPAN

my $upstream = shift || die "Usage: upstream.pl <size (bp)>\n";

my $db1 = Ace->connect(-host=>HOST,-port=>MAPS)  || die "Connection failure: ",Ace->error;
my $db2 = Ace->connect(-host=>HOST,-port=>GENES) || die "Connection failure: ",Ace->error;

warn "Fetching all predicted genes, please wait....\n";
my @genes = $db2->fetch('Predicted_Gene' => '*');
for my $gene(@genes) {
  my $seq = Ace::Sequence->new(-seq=>$gene,-offset=>(- $upstream),-length=>$upstream);
  next unless my $s = Ace::Sequence->new(-db=>$db1,
					 -name   => $seq->parent,
					 -offset => $seq->offset,
					 -length => $seq->length);
  print $gene,"\t",$s->dna,"\n";
}

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