view release on metacpan or  search on metacpan

Ace/Object.pm  view on Meta::CPAN

will return the column of data to the immediate right.  There is no
special behavior associated with using "tag[0]" in an array context;
it will always return the subtree rooted at the indicated tag.

Internal indices such as "Homol[2].BLASTN", do not have special
behavior in an array context.  They are always treated as if they were
called in a scalar context.

Also see B<col()> and B<get()>.

=head2 get() method

    $subtree    = $object->get($tag);
    @values     = $object->get($tag);
    @values     = $object->get($tag, $position);
    @values     = $object->get($tag => $subtag, $position);

The get() method will perform a breadth-first search through the
object (columns first, followed by rows) for the tag indicated by the
argument, returning the column of the portion of the subtree it points
to.  For example, this code fragment will return the value of the
"Fax" tag.

    ($fax_no) = $object->get('Fax');
         --> "33-67-521559"

The list versus scalar context semantics are the same as in at(), so
if you want to retrieve the scalar value pointed to by the indicated
tag, either use a list context as shown in the example, above, or a
dereference, as in:

     $fax_no = $object->get('Fax');
         --> "Fax"
     $fax_no = $object->get('Fax')->at;
         --> "33-67-521559"

An optional second argument to B<get()>, $position, allows you to
navigate the tree relative to the retrieved subtree.  Like the B<at()>
navigational indexes, $position must be a number greater than or equal
to zero.  In a scalar context, $position moves rightward through the
tree.  In an array context, $position implements "tag[2]" semantics.

For example:

     $fax_no = $object->get('Fax',0);
          --> "Fax"

     $fax_no = $object->get('Fax',1);
          --> "33-67-521559"

     $fax_no = $object->get('Fax',2);
          --> undef  # nothing beyond the fax number

     @address = $object->get('Address',2);
          --> ('CRBM duCNRS','BP 5051','34033 Montpellier','FRANCE',
               'mieg@kaa.cnrs-mop.fr,'33-67-613324','33-67-521559')

It is important to note that B<get()> only traverses tags.  It will
not traverse nodes that aren't tags, such as strings, integers or
objects.  This is in keeping with the behavior of the Ace query
language "show" command.

This restriction can lead to confusing results.  For example, consider
the following object:

 Clone: B0280  Position    Map            Sequence-III  Ends   Left   3569
                                                               Right  3585
                           Pmap           ctg377        -1040  -1024
               Positive    Positive_locus nhr-10
               Sequence    B0280
               Location    RW
               FingerPrint Gel_Number     0
                           Canonical_for  T20H1
                                          K10E5
                           Bands          1354          18


The following attempt to fetch the left and right positions of the
clone will fail, because the search for the "Left" and "Right" tags
cannot traverse "Sequence-III", which is an object, not a tag:

  my $left = $clone->get('Left');    # will NOT work
  my $right = $clone->get('Right');  # neither will this one

You must explicitly step over the non-tag node in order to make this
query work.  This syntax will work:

  my $left = $clone->get('Map',1)->get('Left');   # works
  my $left = $clone->get('Map',1)->get('Right');  # works

Or you might prefer to use the tag[2] syntax here:

  my($left,$right) = $clone->get('Map',1)->at('Ends[2]');

Although not frequently used, there is a form of get() which allows
you to stack subtags:

    $locus = $object->get('Positive'=>'Positive_locus');

Only on subtag is allowed.  You can follow this by a position if wish
to offset from the subtag.

    $locus = $object->get('Positive'=>'Positive_locus',1);

=head2 search() method

This is a deprecated synonym for get().

=head2 Autogenerated Access Methods

     $scalar = $object->Name_of_tag;
     $scalar = $object->Name_of_tag($position);
     @array  = $object->Name_of_tag;
     @array  = $object->Name_of_tag($position);
     @array  = $object->Name_of_tag($subtag=>$position);
     @array  = $object->Name_of_tag(-fill=>$tag);

The module attempts to autogenerate data access methods as needed.
For example, if you refer to a method named "Fax" (which doesn't
correspond to any of the built-in methods), then the code will call
the B<get()> method to find a tag named "Fax" and return its

Ace/Object.pm  view on Meta::CPAN

}

sub asPeptide {
  return shift()->_special_dump('peptide');
}

sub _special_dump {
  my $self = shift;
  my $dump_format = shift;
  return unless $self->db->count($self->class,$self->name);
  my $result = $self->db->raw_query($dump_format);
  $result =~ s!^//.*!!ms;
  $result;
}

#### As tab-delimited table ####
sub asTable {
    my $self = shift;
    my $string = "$self\t";
    my $right = $self->right;
    $right->_asTable(\$string,1,2) if defined($right);
    return $string . "\n";
}

#### In "ace" format ####
sub asAce {
  my $self = shift;
  my $string = $self->isRoot ? join(' ',$self->class,':',$self->escape) . "\n" : '';
  $self->right->_asAce(\$string,0,[]);
  return "$string\n\n";
}

### Pretty-printed version ###
sub asString {
  my $self = shift;
  my $MAXWIDTH = shift || $DEFAULT_WIDTH;
  my $tabs = $self->asTable;
  return "$self" unless $tabs;
  my(@lines) = split("\n",$tabs);
  my($result,@max);
  foreach (@lines) {
    my(@fields) = split("\t");
    for (my $i=0;$i<@fields;$i++) {
      $max[$i] = length($fields[$i]) if
	!defined($max[$i]) or $max[$i] < length($fields[$i]);
    }
  }
  foreach (@max) { $_ = $MAXWIDTH if $_ > $MAXWIDTH; } # crunch long lines
  my $format1 = join(' ',map { "^"."<"x $max[$_] } (0..$#max)) . "\n";
  my $format2 =   ' ' . join('  ',map { "^"."<"x ($max[$_]-1) } (0..$#max)) . "~~\n";
  $^A = '';
  foreach (@lines) {
    my @data = split("\t");
    push(@data,('')x(@max-@data));
    formline ($format1,@data);
    formline ($format2,@data);
  }
  return ($result = $^A,$^A='')[0];
}

# run a series of GIF commands and return the Gif and the semi-parsed
# "boxes" structure.  Commands is typically a series of mouseclicks
# ($gif,$boxes) = $aceObject->asGif(-clicks=>[[$x1,$y1],[$x2,$y2]...],
#                                   -dimensions=>[$x,$y]);
sub asGif {
  my $self = shift;
  my ($clicks,$dimensions,$display,$view,$coords,$getcoords) = rearrange(['CLICKS',
									  ['DIMENSIONS','DIM'],
									  'DISPLAY',
									  'VIEW',
									  'COORDS',
									  'GETCOORDS',
									  ],@_);
  $display = "-D $display" if $display;
  $view    = "-view $view" if $view;
  my $c;
  if ($coords) {
    $c    =  ref($coords) ? "-coords @$coords" : "-coords $coords";
  }
  my @commands;
  if ($view || $c || $self->class =~ /Map/i) {
      @commands = "gif map \"@{[$self->name]}\" $view $c";
  } else {
      @commands = "gif display $display $view @{[$self->class]} \"@{[$self->name]}\"";
  }
  push(@commands,"Dimensions @$dimensions") if ref($dimensions);
  push(@commands,map { "mouseclick @{$_}" } @$clicks) if ref($clicks);

  if ($getcoords) { # just want the coordinates
    my ($start,$stop);
    my $data = $self->db->raw_query(join(' ; ',@commands));    
    return unless $data =~ /\"[^\"]+\" ([\d.-]+) ([\d.-]+)/;
    ($start,$stop) = ($1,$2);
    return ($start,$stop);
  }

  push(@commands,"gifdump -");

  # do the query
  my $data = $self->db->raw_query(join(' ; ',@commands));

  # A $' has been removed here to improve speed -- tim.cutts@incyte.com 2 Sep 1999

  # did this query succeed?
  my ($bytes, $trim);
  return unless ($bytes, $trim) = $data=~m!^// (\d+) bytes\n\0*(.+)!sm;

  my $gif = substr($trim,0,$bytes);

  # now process the boxes
  my @b;
  my @boxes = split("\n",substr($trim,$bytes));
  foreach (@boxes) {
    last if m!^//!;
    chomp;
    my ($left,$top,$right,$bottom,$class,$name,$comments) = 
      m/^\s*\d*\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\w+):"(.+)"\s*(.*)/;
    next unless defined $left;
    $comments=~s/\s+$//; # sometimes there's extra white space at the end
    my $box = {'coordinates'=>[$left,$top,$right,$bottom],
	       'class'=>$class,
	       'name' =>$name,
	       'comment'=>$comments};
    push (@b,$box);
  }
  return ($gif,\@b);
}

############## timestamp and comment information ############
sub timestamp {
    my $self = shift;
    return $self->{'.timestamp'} = $_[0] if defined $_[0];
    if ($self->db && !$self->{'.timestamp'}) {
      $self->_fill;
      $self->_parse;
    }
    return $self->{'.timestamp'} if $self->{'.timestamp'};
    return unless defined $self->right;
    return $self->{'.timestamp'} = $self->right->timestamp;
}

sub comment {
    my $self = shift;
    return $self->{'.comment'} = $_[0] if defined $_[0];
    if ($self->db && !$self->{'.comment'}) {
      $self->_fill;
      $self->_parse;
    }
    return $self->{'.comment'};
}

### Return list of all the tags in the object ###
sub tags {
    my $self = shift;
    my $current = $self->right;
    my @tags;
    while (defined($current)) {
	push(@tags,$current);
	$current = $current->down;
    }