AcePerl
view release on metacpan or search on metacpan
}
$self->fetch($1 => $2);
}
# perform an AQL query
sub aql {
my $self = shift;
my $query = shift;
my $db = $self->db;
my $r = $self->raw_query("aql -j $query");
if ($r =~ /(AQL error.*)/) {
$self->error($1);
return;
}
my @r;
foreach (split "\n",$r) {
next if m!^//!;
next if m!^\0!;
my ($class,$id) = Ace->split($_);
my @objects = map { $self->class_for($class,$id)->new(Ace->split($_),$self,1)} split "\t";
push @r,\@objects;
}
}
# do a query, and return the result immediately
sub raw_query {
my ($self,$query,$no_alert,$parse) = @_;
$self->_alert_iterators unless $no_alert;
$self->{database}->query($query, $parse ? ACE_PARSE : () );
return $self->read_object;
}
# return the last error
sub error {
my $class = shift;
$Ace::Error = shift() if defined($_[0]);
$Ace::Error=~s/\0//g; # get rid of nulls
return $Ace::Error;
}
# close the database
sub close {
my $self = shift;
$self->raw_query('save') if $self->auto_save;
while ($obj = $ready->next) {
# do something with obj
}
# database cut and paste
$sequence = $db->fetch(Sequence => 'D12345');
$local_db->put($sequence);
@sequences = $db->fetch(Sequence => 'D*');
$local_db->put(@sequences);
# Get errors
print Ace->error;
print $db->error;
=head1 DESCRIPTION
AcePerl provides an interface to the ACEDB object-oriented database.
Both read and write access is provided, and ACE objects are returned
as similarly-structured Perl objects. Multiple databases can be
opened simultaneously.
You will interact with several Perl classes: I<Ace>, I<Ace::Object>,
I<Ace::Iterator>, I<Ace::Model>. I<Ace> is the database accessor, and
The connect() method uses a named argument calling style, and
recognizes the following arguments:
=over 4
=item B<-host>, B<-port>
These arguments point to the host and port of an AceDB server.
AcePerl will use its internal compiled code to establish a connection
to the server unless explicitly overridden with the B<-program>
argument.
=item B<-path>
This argument indicates the path of an AceDB directory on the local
system. It should point to the directory that contains the I<wspec>
subdirectory. User name interpolations (~acedb) are OK.
=item B<-user>
-class Ace::Object
-timeout 25
-query_timeout 120
If you prefer to use a more Smalltalk-like message-passing syntax, you
can open a connection this way too:
$db = connect Ace -host=>'beta.crbm.cnrs-mop.fr',-port=>20000100;
The return value is an Ace handle to use to access the database, or
undef if the connection fails. If the connection fails, an error
message can be retrieved by calling Ace->error.
You may check the status of a connection at any time with ping(). It
will return a true value if the database is still connected. Note
that Ace will timeout clients that have been inactive for any length
of time. Long-running clients should attempt to reestablish their
connection if ping() returns false.
$db->ping() || die "not connected";
You may perform low-level calls using the Ace client C API by calling
In the examples below, the first line of code will fetch the Sequence
object whose database ID is I<D12345>. The second line will retrieve
all objects matching the pattern I<D1234*>. The third line will
return the count of objects that match the same pattern.
$object = $db->fetch(Sequence => 'D12345');
@objects = $db->fetch(Sequence => 'D1234*');
$cnt = $db->fetch(Sequence =>'D1234*');
A variety of communications and database errors may occur while
processing the request. When this happens, undef or an empty list
will be returned, and a string describing the error can be retrieved
by calling Ace->error.
When retrieving database objects, it is possible to retrieve a
"filled" or an "unfilled" object. A filled object contains the entire
contents of the object, including all tags and subtags. In the case
of certain Sequence objects, this may be a significant amount of data.
Unfilled objects consist just of the object name. They are filled in
from the database a little bit at a time as tags are requested. By
default, fetch() returns the unfilled object. This is usually a
performance win, but if you know in advance that you will be needing
the full contents of the retrieved object (for example, to display
=head2 aql() method
$count = $db->aql($aql_query);
@objects = $db->aql($aql_query);
Ace::aql() will perform an AQL query on the database. In a scalar
context it returns the number of rows returned. In an array context
it returns a list of rows. Each row is an anonymous array containing
the columns returned by the query as an Ace::Object.
If an AQL error is encountered, will return undef or an empty list and
set Ace->error to the error message.
Note that this routine is not optimized -- there is no iterator
defined. All results are returned synchronously, leading to large
memory consumption for certain queries.
=head2 put() method
$cnt = $db->put($obj1,$obj2,$obj3);
This method will put the list of objects into the database,
overwriting like-named objects if they are already there. This can
be used to copy an object from one database to another, provided that
the models are compatible.
The method returns the count of objects successfully written into the
database. In case of an error, processing will stop at the last
object successfully written and an error message will be placed in
Ace->error();
=head2 parse() method
$object = $db->parse('data to parse');
This will parse the Ace tags contained within the "data to parse"
string, convert it into an object in the databse, and return the
resulting Ace::Object. In case of a parse error, the undefined value
will be returned and a (hopefully informative) description of the
error will be returned by Ace->error().
For example:
$author = $db->parse(<<END);
Author : "Glimitz JR"
Full_name "Jonathan R. Glimitz"
Mail "128 Boylston Street"
Mail "Boston, MA"
Mail "USA"
Laboratory GM
This method can also be used to parse several objects, but only the
last object successfully parsed will be returned.
=head2 parse_longtext() method
$object = $db->parse($title,$text);
This will parse the long text (which may contain carriage returns and
other funny characters) and place it into the database with the given
title. In case of a parse error, the undefined value will be returned
and a (hopefully informative) description of the error will be
returned by Ace->error(); otherwise, a LongText object will be returned.
For example:
$author = $db->parse_longtext('A Novel Inhibitory Domain',<<END);
We have discovered a novel inhibitory domain that inhibits
many classes of proteases, including metallothioproteins.
This inhibitory domain appears in three different gene families studied
to date...
END
=head2 parse_file() method
@objects = $db->parse_file('/path/to/file');
@objects = $db->parse_file('/path/to/file',1);
This will call parse() to parse each of the objects found in the
indicated .ace file, returning the list of objects successfully loaded
into the database.
By default, parsing will stop at the first object that causes a parse
error. If you wish to forge on after an error, pass a true value as
the second argument to this method.
Any parse error messages are accumulated in Ace->error().
=head2 new() method
$object = $db->new($class => $name);
This method creates a new object in the database of type $class and
name $name. If successful, it returns the newly-created object.
Otherwise it returns undef and sets $db->error().
$name may contain sprintf()-style patterns. If one of the patterns is
%d (or a variant), Acedb uses a class-specific unique numbering to return
a unique name. For example:
$paper = $db->new(Paper => 'wgb%06d');
The object is created in the database atomically. There is no chance to rollback as there is
in Ace::Object's object editing methods.
@objects = $db->find($query_string);
@objects = $db->find(-query => $query_string,
-offset=> $offset,
-count => $count
-fill => $fill);
This allows you to pass arbitrary Ace query strings to the server and
retrieve all objects that are returned as a result. For example, this
code fragment retrieves all papers written by Jean and Danielle
Thierry-Mieg.
@papers = $db->find('author IS "Thierry-Mieg *" ; >Paper');
You can find the full query syntax reference guide plus multiple
examples at http://probe.nalusda.gov:8000/acedocs/index.html#query.
In the named parameter calling form, B<-count>, B<-offset>, and
B<-fill> have the same meanings as in B<fetch()>.
=head2 fetch_many() method
$obj = $db->fetch_many($class,$pattern);
Sets or queries the I<auto_save> variable. If true, the "save"
command will be issued automatically before the connection to the
database is severed. The default is true.
Examples:
$db->auto_save(1);
$flag = $db->auto_save;
=head2 error() method
Ace->error;
This returns the last error message. Like UNIX errno, this variable
is not reset between calls, so its contents are only valid after a
method call has returned a result value indicating a failure.
For your convenience, you can call error() in any of several ways:
print Ace->error();
print $db->error(); # $db is an Ace database handle
print $obj->error(); # $object is an Ace::Object
There's also a global named $Ace::Error that you are free to use.
=head2 datetime() and date()
$datetime = Ace->datetime($time);
$today = Ace->datetime();
$date = Ace->date($time);
$today = Ace->date([$time]);
the query result.
=item read()
Read the result from the last query sent to the server and return it
as a string. ACE may return the result in pieces, breaking between
whole objects. You may need to read repeatedly in order to fetch the
entire result. Canonical example:
$acedb->query("find Sequence D*");
die "Got an error ",$acedb->error() if $acedb->status == STATUS_ERROR;
while ($acedb->status == STATUS_PENDING) {
$result .= $acedb->read;
}
=item status()
Return the status code from the last operation. Status codes are
exported by default when you B<use> Ace.pm. The status codes you may
see are:
STATUS_WAITING The server is waiting for a query.
STATUS_PENDING A query has been sent and Ace is waiting for
you to read() the result.
STATUS_ERROR A communications or syntax error has occurred
=item error()
Returns a more detailed error code supplied by the Ace server. Check
this value when STATUS_ERROR has been returned. These constants are
also exported by default. Possible values:
ACE_INVALID
ACE_OUTOFCONTEXT
ACE_SYNTAXERROR
ACE_UNRECOGNIZED
Please see the ace client library documentation for a full description
of these error codes and their significance.
=item encore()
This method may return true after you have performed one or more
read() operations, and indicates that there is more data to read. You
will not ordinarily have to call this method.
=back
=head1 BUGS
1. The ACE model should be consulted prior to updating the database.
2. There is no automatic recovery from connection errors.
3. Debugging has only one level of verbosity, despite the best
of intentions.
4. Performance is poor when fetching big objects, because of
many object references that must be created. This could be
improved.
5. When called in an array context at("tag[0]") should return the
current tag's entire column. It returns the current subtree instead.
8. Item number eight is still missing.
=head1 SEE ALSO
L<Ace::Object>, L<Ace::Local>, L<Ace::Model>,
L<Ace::Sequence>,L<Ace::Sequence::Multi>.
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
# -------------------- AUTOLOADED SUBS ------------------
$Ace::Error = '';
foreach my $object (@objects) {
croak "Can't put a non-Ace object into an Ace database"
unless $object->isa('Ace::Object');
croak "Can't put a non-object into a database"
unless $object->isObject;
$object = $object->fetch unless $object->isRoot; # make sure we're putting root object
my $data = $object->asAce;
$data =~ s/\n/; /mg;
my $result = $self->raw_query("parse = $data");
$Ace::Error = $result if $result =~ /sorry|parse error/mi;
return $count if $Ace::Error;
$count++; # bump if succesful
}
return $count;
}
# Parse a single object and return the result as an object
sub parse {
my $self = shift;
my $ace_data = shift;
my @lines = split("\n",$ace_data);
foreach (@lines) { s/;/\\;/; } # protect semicolons
my $query = join("; ",@lines);
my $result = $self->raw_query("parse = $query");
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
return $results[0];
}
# Parse a single object as longtext and return the result
# as an object
sub parse_longtext {
my $self = shift;
my ($title,$body) = @_;
my $mm = "parse =
Longtext $title
$body
***LongTextEnd***
" ;
$mm =~ s/\//\\\//g ;
$mm =~ s/\n/\\n/g ;
$mm .= "\n" ;
my $result = $self->raw_query($mm) ;
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
return $results[0];
}
# Parse a file and return all the results
sub parse_file {
my $self = shift;
my ($file,$keepgoing) = @_;
local(*ACE);
local($/) = ''; # paragraph mode
my(@objects,$errors);
open(ACE,$file) || croak "$file: $!";
while (<ACE>) {
chomp;
my $obj = $self->parse($_);
unless ($obj) {
$errors .= $Ace::Error; # keep track of errors
last unless $keepgoing;
}
push(@objects,$obj);
}
close ACE;
$Ace::Error = $errors;
return @objects;
}
# Create a new Ace::Object in the indicated database
# (doesn't actually write into database until you do a commit)
sub new {
my $self = shift;
my ($class,$name) = rearrange([qw/CLASS NAME/],@_);
return if $self->fetch($class,$name);
my $obj = $self->class_for($class,$name)->new($class,$name,$self);
Ace/Browser/AceSubs.pm view on Meta::CPAN
Header Footer DB_Name AceMultipleChoices);
%EXPORT_TAGS = ( );
use constant DEFAULT_DATABASE => 'default';
use constant PRIVACY => 'misc/privacy'; # privacy/cookie statement
use constant SEARCH_BROWSE => 'search'; # a fallback search script
my %VALID; # cache for get_symbolic() lookups
=item AceError($message)
This subroutine will print out an error message and exit the script.
The text of the message is taken from $message.
=cut
sub AceError {
my $msg = shift;
PrintTop(undef,undef,'Error');
print CGI::font({-color=>'red'},$msg);
PrintBottom();
Apache->exit(0) if defined &Apache::exit;
Ace/Browser/AceSubs.pm view on Meta::CPAN
print @COOKIES ? header(-cookie=>\@COOKIES,@_) : header(@_);
@COOKIES = ();
$HEADER++;
}
=item AceInit()
This subroutine initializes the AcePerl connection to the configured
database. If the database cannot be opened, it generates an error
message and exits. This subroutine is not exported by default, but is
called by PrintTop() and Header() internally.
=cut
# Subroutines used by all scripts.
# Will generate an HTTP 'document not found' error if you try to get an
# undefined database name. Check the return code from this function and
# return immediately if not true (actually, not needed because we exit).
sub AceInit {
$HEADER = 0;
$TOP = 0;
@COOKIES = ();
# keeps track of what sections should be open
%OPEN = param('open') ? map {$_ => 1} split(' ',param('open')) : () ;
return 1 if Configuration();
# if we get here, it is a big NOT FOUND error
print header(-status=>'404 Not Found',-type=>'text/html');
$HEADER++;
print start_html(-title => 'Database Not Found',
-style => Ace::Browser::SiteDefs->getConfig(DEFAULT_DATABASE)->Style,
),
h1('Database not found'),
p('The requested database',i(get_symbolic()),'is not recognized',
'by this server.');
print p('Please return to the',a({-href=>referer()},'referring page.')) if referer();
print end_html;
Apache::exit(0) if defined &Apache::exit; # bug out of here!
exit(0);
}
=item AceMissing([$class,$name])
This subroutine will print out an error message indicating that an
object is present in AceDB, but that the information the user
requested is absent. It will then exit the script. This is
infrequently encountered when following XREFed objects. If the class
and name of the object are not provided as arguments, they are taken
from CGI's param() function.
=cut
sub AceMissing {
my ($class,$name) = @_;
Ace/Browser/AceSubs.pm view on Meta::CPAN
ol(
li([
map {ObjectLink($_,font({-color=>'red'},$_->class).': '.$_)} @$objects
])
);
PrintBottom();
}
=item AceNotFound([$class,$name])
This subroutine will print out an error message indicating that the
requested object is not present in AceDB, even as a name. It will then
exit the script. If the class and name of the object are not provided
as arguments, they are taken from CGI's param() function.
=cut
sub AceNotFound {
my $class = shift || param('class');
my $name = shift || param('name');
PrintTop(undef,undef,"$class: $name not found");
Ace/Browser/SearchSubs.pm view on Meta::CPAN
Given a title and the HTML contents, this formats the search into a
table and gives it the background and foreground colors used elsewhere
for searches. The formatted search is then printed.
The HTML contents are usually a fill-out form. For convenience, you
can provide the contents in multiple parts (lines or elements) and
they will be concatenated together.
If the first argument is a hashref, then its contents will be passed
to start_form() to override the form arguments.
=cut
sub AceSearchTable {
my %attributes = %{shift()} if ref($_[0]) eq 'HASH';
my ($title,@body) = @_;
print
start_form(-action=>url(-absolute=>1,-path_info=>1).'#results',%attributes),
a({-name=>'search'},''),
table({-border=>0,-width=>'100%'},
Ace/Browser/SearchSubs.pm view on Meta::CPAN
push(@hidden,hidden(-name=>$_,-value=>[param($_)]));
}
push(@buttons,
td({-valign=>'MIDDLE',-align=>'CENTER'},
start_form({-name=>'form1'}),
submit(-name=>'Go',-label=>'Go to'),
'page',
popup_menu(-name=>'scroll',-Values=>\@v,-labels=>\%v,
-default=>($page-1)*MAXOBJECTS-$offset,
-override=>1,
-onChange=>'document.form1.submit()'),
"of $pages",
@hidden,
end_form()
)
);
push(@buttons,td({-align=>'LEFT',-valign=>'MIDDLE'},
$offset + MAXOBJECTS <= $count
? a({-href=>$url
Ace/Browser/SiteDefs.pm view on Meta::CPAN
my $file = shift;
no strict 'vars';
no strict 'refs';
$file =~ m!([/a-zA-Z0-9._-]+)!;
my $safe = $1;
(my $ns = $safe) =~ s/\W/_/g;
my $namespace = __PACKAGE__ . '::Config::' . $ns;
unless (eval "package $namespace; require '$safe';") {
die "compile error while parsing config file '$safe': $@\n";
}
# build the object up from the values compiled into the $namespace area
my %data;
# get the scalars
local *symbol;
foreach (keys %{"${namespace}::"}) {
*symbol = ${"${namespace}::"}{$_};
$data{ucfirst(lc $_)} = $symbol if defined($symbol);
$data{ucfirst(lc $_)} = \%symbol if defined(%symbol);
Ace/Browser/SiteDefs.pm view on Meta::CPAN
return "$root/$file";
}
sub resolveConf {
my $pack = shift;
my $file = shift;
unless ($SITE_DEFS) {
(my $rpath = __PACKAGE__) =~ s{::}{/}g;
my $path = $INC{"${rpath}.pm"}
|| warn "Unexpected error: can't locate acebrowser SiteDefs.pm file";
$path =~ s![^/]*$!!; # trim to directory
$SITE_DEFS = $path;
}
return "$SITE_DEFS/$file";
}
sub get_config {
my $pack = shift;
return unless exists $ENV{MOD_PERL};
Ace/Graphics/Glyph.pm view on Meta::CPAN
@_,
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) }
Ace/Graphics/Glyph.pm view on Meta::CPAN
sub fill {
my $self = shift;
my $gd = shift;
my ($x1,$y1,$x2,$y2) = @_;
if ( ($x2-$x1) >= 2 && ($y2-$y1) >= 2 ) {
$gd->fill($x1+1,$y1+1,$self->fillcolor);
}
}
# draw the thing onto a canvas
# this definitely gets overridden
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')) {
Ace/Graphics/Glyph.pm view on Meta::CPAN
Move the glyph in pixel coordinates by the indicated delta-x and
delta-y values.
=item ($x1,$y1,$x2,$y2) = $glyph->box
Return the current position of the glyph.
=back
These methods are intended to be overridden in subclasses:
=over 4
=item $glyph->calculate_height
Calculate the height of the glyph.
=item $glyph->calculate_left
Calculate the left side of the glyph.
Ace/Graphics/Glyph.pm view on Meta::CPAN
By convention, subclasses are all lower-case. Begin each subclass
with a preamble like this one:
package Ace::Graphics::Glyph::crossbox;
use strict;
use vars '@ISA';
@ISA = 'Ace::Graphics::Glyph';
Then override the methods you need to. Typically, just the draw()
method will need to be overridden. However, if you need additional
room in the glyph, you may override calculate_height(),
calculate_left() and calculate_right(). Do not directly override
height(), left() and right(), as their purpose is to cache the values
returned by their calculating cousins in order to avoid time-consuming
recalculation.
A simple draw() method looks like this:
sub draw {
my $self = shift;
$self->SUPER::draw(@_);
my $gd = shift;
Ace/Graphics/Glyph/anchored_arrow.pm view on Meta::CPAN
use vars '@ISA';
@ISA = 'Ace::Graphics::Glyph';
sub calculate_height {
my $self = shift;
my $val = $self->SUPER::calculate_height;
$val += $self->font->height if $self->option('tick');
$val;
}
# override draw method
sub draw {
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);
Ace/Graphics/Glyph/arrow.pm view on Meta::CPAN
@ISA = 'Ace::Graphics::Glyph';
sub bottom {
my $self = shift;
my $val = $self->SUPER::bottom(@_);
$val += $self->font->height if $self->option('tick');
$val += $self->labelheight if $self->option('label');
$val;
}
# override draw method
sub draw {
my $self = shift;
my $parallel = $self->option('parallel');
$parallel = 1 unless defined $parallel;
$self->draw_parallel(@_) if $parallel;
$self->draw_perpendicular(@_) unless $parallel;
}
sub draw_perpendicular {
my $self = shift;
Ace/Graphics/Glyph/graded_segments.pm view on Meta::CPAN
package Ace::Graphics::Glyph::graded_segments;
# package to use for drawing anything that is interrupted
# (has the segment() method) and that has a score associated
# with each segment
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;
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;
Ace/Graphics/Glyph/group.pm view on Meta::CPAN
my $previous = $occupied{$y};
last if $previous->right + 2 < $g->left; # no collision at this position
$pos += $previous->height + 2; # collision, so bump
}
$occupied{$pos} = $g; # remember where we are
$g->move(0,$pos);
}
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;
Ace/Graphics/Glyph/primers.pm view on Meta::CPAN
@ISA = 'Ace::Graphics::Glyph';
use constant HEIGHT => 4;
# we do not need the default amount of room
sub calculate_height {
my $self = shift;
return $self->option('label') ? HEIGHT + $self->labelheight + 2 : HEIGHT;
}
# override draw method
sub draw {
my $self = shift;
my $gd = shift;
my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
my $fg = $self->fgcolor;
my $a2 = HEIGHT/2;
my $center = $y1 + $a2;
# just draw us as a solid line -- very simple
Ace/Graphics/Glyph/segments.pm view on Meta::CPAN
package Ace::Graphics::Glyph::segments;
# package to use for drawing anything that is interrupted
# (has the segment() method)
use strict;
use vars '@ISA';
use GD;
@ISA = 'Ace::Graphics::Glyph';
use constant GRAY => 'lightgrey';
my %BRUSHES;
# override right to allow for label
sub calculate_right {
my $self = shift;
my $left = $self->left;
my $val = $self->SUPER::calculate_right(@_);
if ($self->option('label') && (my $description = $self->description)) {
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;
Ace/Graphics/Glyph/toomany.pm view on Meta::CPAN
package Ace::Graphics::Glyph::toomany;
# DAS-compatible package to use for drawing a box
use strict;
use vars '@ISA';
@ISA = 'Ace::Graphics::Glyph';
# draw the thing onto a canvas
# this definitely gets overridden
sub draw {
my $self = shift;
my $gd = shift;
my ($left,$top) = @_;
my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries($left,$top);
$self->filled_oval($gd,$x1,$y1,$x2,$y2);
# add a label if requested
$self->draw_label($gd,@_) if $self->option('label');
Ace/Graphics/Glyph/transcript.pm view on Meta::CPAN
package Ace::Graphics::Glyph::transcript;
# package to use for drawing transcripts
use strict;
use vars '@ISA';
@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;
Ace/Graphics/Glyph/transcript.pm view on Meta::CPAN
my $val = $self->SUPER::calculate_right(@_);
$val = $left + ARROW if $left + ARROW > $val;
if ($self->option('label') && (my $description = $self->description)) {
my $description_width = $self->font->width * length $description;
$val = $left + $description_width if $left + $description_width > $val;
}
$val;
}
# override the bottom method in order to provide extra room for
# the label
sub calculate_height {
my $self = shift;
my $val = $self->SUPER::calculate_height(@_);
$val += $self->labelheight if $self->option('label') && $self->description;
$val;
}
# override filled_box method
sub filled_box {
my $self = shift;
my $gd = shift;
my ($x1,$y1,$x2,$y2,$color) = @_;
my $linewidth = $self->option('linewidth') || 1;
$color ||= $self->fillcolor;
$gd->filledRectangle($x1,$y1,$x2,$y2,$color);
$gd->rectangle($x1,$y1,$x2,$y2,$self->fgcolor);
# if the left end is off the end, then cover over
# the leftmost line
my ($width) = $gd->getBounds;
$gd->line($x1,$y1,$x1,$y2,$color)
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) = @_;
Ace/Graphics/Panel.pm view on Meta::CPAN
key printed at bottom of panel
(if any)
Typically you will pass new() an object that implements the
Bio::RangeI interface, providing a length() method, from which the
panel will derive its scale.
$panel = Ace::Graphics::Panel->new(-segment => $sequence,
-width => 800);
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)
Ace/Graphics/Panel.pm view on Meta::CPAN
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.
Ace/Graphics/Panel.pm view on Meta::CPAN
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:
Ace/Iterator.pm view on Meta::CPAN
my $object2 = $iterator2->next;
} while $object1 && $object2;
=head1 SEE ALSO
L<Ace>, L<Ace::Model>, L<Ace::Object>
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
__END__
Ace/Local.pm view on Meta::CPAN
sub auto_save {
my $self = shift;
$self->{'auto_save'} = $_[0] if defined $_[0];
return $self->{'auto_save'};
}
sub status {
return $_[0]->{'status'};
}
sub error {
my $self = shift;
return $self->{'error'};
}
sub query {
my $self = shift;
my $query = shift;
warn "query($query)\n" if $self->debug;
if ($self->debug) {
my $msg = $query || '';
warn "\tquery($msg)";
}
Ace/Local.pm view on Meta::CPAN
=item B<-path>
Path to the database (location of the "wspec/" directory).
=item B<-program>
Used to indicate the location of the desired I<giface> or
I<gifaceclient> executable. You may also use I<tace> or I<aceclient>,
but in that case the asGIF() functionality will nog work. Can be used
to override the search path.
=item B<-host>
Used when invoking I<gifaceclient>. Indicates the host to connect to.
=item B<-port>
Used when invoking I<gifaceclient>. Indicates the port to connect to.
=item B<-nosync>
Ace/Local.pm view on Meta::CPAN
the query result.
=head2 read()
Read the result from the last query sent to the server and return it
as a string. ACE may return the result in pieces, breaking between
whole objects. You may need to read repeatedly in order to fetch the
entire result. Canonical example:
$accessor->query("find Sequence D*");
die "Got an error ",$accessor->error() if $accessor->status == STATUS_ERROR;
while ($accessor->status == STATUS_PENDING) {
$result .= $accessor->read;
}
=head2 low_read()
Read whatever data's available, or undef if none. This is only used
by the ace.pl replacement for giface/tace.
=head2 status()
Return the status code from the last operation. Status codes are
exported by default when you B<use> Ace.pm. The status codes you may
see are:
STATUS_WAITING The server is waiting for a query.
STATUS_PENDING A query has been sent and Ace is waiting for
you to read() the result.
STATUS_ERROR A communications or syntax error has occurred
=head2 error()
May return a more detailed error code supplied by Ace. Error checking
is not fully implemented.
=head2 encore()
This method will return true after you have performed one or more
read() operations, and indicates that there is more data to read.
B<encore()> is functionally equivalent to:
$encore = $accessor->status == STATUS_PENDING;
Ace/Local.pm view on Meta::CPAN
$accessor->auto_save(1);
$flag = $accessor->auto_save;
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Iterator>, L<Ace::Model>
=head1 AUTHOR
Lincoln Stein <lstein@w3.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Model.pm view on Meta::CPAN
print "Paper is unique" if $model=~/Paper ?Paper UNIQUE/;
=head1 SEE ALSO
L<Ace>
=head1 AUTHOR
Lincoln Stein <lstein@w3.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998, Lincoln D. Stein
This library is free software;
you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
Ace/Object.pm view on Meta::CPAN
$pos = $subtag;
} else { # position on subtag and search again
return $t->fetch->search($subtag,$pos)
if $t->isObject || (defined($t->right) and $t->right->isObject);
return $t->search($subtag,$pos);
}
}
return defined $pos ? $t->right($pos) : $t unless wantarray;
# We do something verrrry interesting in an array context.
# If no position is defined, we return the column to the right.
# If a position is defined, we return everything $POS tags
# to the right (so-called tag[2] system).
return $t->col($pos);
}
# utility routine used in partial tree caching
sub _attach_subtree {
my $self = shift;
my ($tag,$subobject) = @_;
Ace/Object.pm view on Meta::CPAN
1;
}
# returns true if the object is a tag.
sub isTag {
my $self = shift;
return 1 if $self->class eq 'tag';
return;
}
# return the most recent error message
sub error {
$Ace::Error=~s/\0//g; # get rid of nulls
return $Ace::Error;
}
### Returns the object's model (as an Ace::Model object)
sub model {
my $self = shift;
return unless $self->db && $self->isObject;
return $self->db->model($self->class);
}
### Return the class in which to bless all objects retrieved from
# database. Might want to override in other classes
sub factory {
return __PACKAGE__;
}
#####################################################################
#####################################################################
############### mostly private functions from here down #############
#####################################################################
#####################################################################
# simple clone
Ace/Object.pm view on Meta::CPAN
# Update object
$sequence->replace('Visible.Overlap_Right',$r,'M55555');
$sequence->add('Visible.Homology','GR91198');
$sequence->delete('Source.Clone','MBR122');
$sequence->commit();
# Rollback changes
$sequence->rollback()
# Get errors
print $sequence->error;
=head1 DESCRIPTION
I<Ace::Object> is the base class for objects returned from ACEDB
databases. Currently there is only one type of I<Ace::Object>, but
this may change in the future to support more interesting
object-specific behaviors.
Using the I<Ace::Object> interface, you can explore the internal
structure of an I<Ace::Object>, retrieve its content, and convert it
Ace/Object.pm view on Meta::CPAN
object de novo and write it into the database.
For information on connecting to ACEDB databases and querying them,
see L<Ace>.
=head1 ACEDB::OBJECT METHODS
The structure of an Ace::Object is very similar to that of an Acedb
object. It is a tree structure like this one (an Author object):
Thierry-Mieg J->Full_name ->Jean Thierry-Mieg
|
Laboratory->FF
|
Address->Mail->CRBM duCNRS
| | |
| | BP 5051
| | |
| | 34033 Montpellier
| | |
| | FRANCE
Ace/Object.pm view on Meta::CPAN
Each node in the tree has a type and a name. Types include integers,
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
Ace/Object.pm view on Meta::CPAN
add_tree(), delete() and replace() for ways to manipulate this object.
=head2 name() method
$name = $object->name();
Return the name of the Ace::Object. This happens automatically
whenever you use the object in a context that requires a string or a
number. For example:
$object = $db->fetch(Author,"Thierry-Mieg J");
print "$object did not write 'Pride and Prejudice.'\n";
=head2 class() method
$class = $object->class();
Return the class of the object. The return value may be one of
"float," "int," "date," "tag," "txt," "dna," "peptide," and "scalar."
(The last is used internally by Perl to represent objects created
programatically prior to committing them to the database.) The class
Ace/Object.pm view on Meta::CPAN
Called without any arguments, these two methods will move one step.
Called with a numeric argument >= 0 they will move the indicated
number of steps (zero indicates no movement).
$full_name = $object->right->right;
$full_name = $object->right(2);
$city = $object->right->down->down->right->right->down->down;
$city = $object->right->down(2)->right(2)->down(2);
If $object contains the "Thierry-Mieg J" Author object, then the first
series of accesses shown above retrieves the string "Jean
Thierry-Mieg" and the second retrieves "34033 Montpellier." If the
right or bottom pointers are NULL, these methods will return undef.
In addition to being somewhat awkard, you will probably never need to
use these methods. A simpler way to retrieve the same information
would be to use the at() method described in the next section.
The right() and down() methods always walk through the tree of the
current object. They do not follow object pointers into the database.
Use B<fetch()> (or the deprecated B<pick()> or B<follow()> methods)
instead.
Ace/Object.pm view on Meta::CPAN
at() returns slightly different results depending on the context in
which it is called. In a list context, it returns the column of
values to the B<right> of the tag. However, in a scalar context, it
returns the subtree rooted at the tag. To appreciate the difference,
consider these two cases:
$name1 = $object->at('Full_name');
($name2) = $object->at('Full_name');
After these two statements run, $name1 will be the tag object named
"Full_name", and $name2 will be the text object "Jean Thierry-Mieg",
The relationship between the two is that $name1->right leads to
$name2. This is a powerful and useful construct, but it can be a trap
for the unwary. If this behavior drives you crazy, use this
construct:
$name1 = $object->at('Full_name')->at();
For finer control over navigation, path components can include
optional indexes to indicate navigation to the right of the current
path component. Here is the syntax:
$object->at('tag1[index1].tag2[index2].tag3[index3]...');
Indexes are zero-based. An index of [0] indicates no movement
relative to the current component, and is the same as not using an
index at all. An index of [1] navigates one step to the right, [2]
moves two steps to the right, and so on. Using the Thierry-Mieg
object as an example again, here are the results of various indexes:
$object = $db->fetch(Author,"Thierry-Mieg J");
$a = $object->at('Address[0]') --> "Address"
$a = $object->at('Address[1]') --> "Mail"
$a = $object->at('Address[2]') --> "CRBM duCNRS"
In an array context, the last index in the path does something very
interesting. It returns the entire column of data K steps to the
right of the path, where K is the index. This is used to implement
so-called "tag[2]" syntax, and is very useful in some circumstances.
For example, here is a fragment of code to return the Thierry-Mieg
object's full address without having to refer to each of the
intervening "Mail", "E_Mail" and "Phone" tags explicitly.
@address = $object->at('Address[2]');
--> ('CRBM duCNRS','BP 5051','34033 Montpellier','FRANCE',
'mieg@kaa.cnrs-mop.fr,'33-67-613324','33-67-521559')
Similarly, "tag[3]" will return the column of data three hops to the
right of the tag. "tag[1]" is identical to "tag" (with no index), and
will return the column of data to the immediate right. There is no
Ace/Object.pm view on Meta::CPAN
foreach (@papers) {
my $paper = $_->fetch;
print $paper->asString;
}
You can provide an optional positional index to rapidly navigate
through the tree or to obtain tag[2] behavior. In the following
examples, the first two return the object's Fax number, and the third
returns all data two hops to the right of Address.
$object = $db->fetch(Author => 'Thierry-Mieg J');
($fax_no) = $object->Fax;
$fax_no = $object->Fax(1);
@address = $object->Address(2);
You may also position at a subtag, using this syntax:
$representative = $object->Laboratory('Representative');
Both named tags and positions can be combined as follows:
Ace/Object.pm view on Meta::CPAN
In a scalar context, B<col()> returns the number of items in the
column.
=head2 row() method
@row=$object->row();
@row=$object->row($position);
B<row()> will return the row of data to the right of the object. The
first member of the list will be the object itself. In the case of
the "Thierry-Mieg J" object, the example below will return the list
('Address','Mail','CRBM duCNRS').
@row = $object->Address->row();
You can provide an optional position to move rightward one or more
places before retrieving the row. This code fragment will return
('Mail','CRBM duCNRS'):
@row = $object->Address->row(1);
Ace/Object.pm view on Meta::CPAN
will vary for different object classes.
You can optionally provide asGIF with a B<-clicks> argument to
simulate the action of a user clicking on the image. The click
coordinates should be formatted as an array reference that contains a
series of two-element subarrays, each corresponding to the X and Y
coordinates of a single mouse click. There is currently no way to
pass information about middle or right mouse clicks, dragging
operations, or keystrokes. You may also specify a B<-dimensions> to
control the width and height of the returned GIF. Since there is no
way of obtaining the preferred size of the image in advance, this is
not usually useful.
The optional B<-display> argument allows you to specify an alternate
display for the object. For example, Clones can be displayed either
with the PMAP display or with the TREE display. If not specified, the
default display is used.
The optional B<-view> argument allows you to specify an alternative
view for MAP objects only. If not specified, you'll get the default
view.
Ace/Object.pm view on Meta::CPAN
$author->add_row('Full_name','Joseph M. Smith');
$author->add_row('Laboratory',$lab);
$lab->commit();
$author->commit();
The result code indicates whether the addition was syntactically
correct. add_row() will fail if you attempt to add a duplicate entry
(that is, one with exactly the same tag and value). In this case, use
replace() instead. Currently there is no checking for an attempt to
add multiple values to a single-valued (UNIQUE) tag. The error will
be detected and reported at commit() time however.
The add() method is an alias for add_row().
See also the Ace->new() method.
=head2 add_tree()
$result_code = $object->add_tree($tag=>$ace_object);
$result_code = $object->add_tree(-tag=>$tag,-tree=>$ace_object);
Ace/Object.pm view on Meta::CPAN
Here is an example of copying the "Assembly_tags" subtree
from one database object to another:
$remote = Ace->connect(-port=>200005) || die "can't connect";
$ac3 = $remote->fetch(Sequence=>'AC3') || die "can't get AC7";
my $assembly = $ac3->at('Assembly_tags');
$local = Ace->connect(-path=>'~acedb') || die "can't connect";
$AC3copy = Ace::Object->new(Sequence=>'AC3copy',$local);
$AC3copy->add_tree('Assembly_tags'=>$tags);
$AC3copy->commit || warn $AC3copy->error;
Notice that this syntax will not work the way you think it should:
$AC3copy->add_tree('Assembly_tags'=>$ac3->at('Assembly_tags'));
This is because call at() in an array context returns the column to
the right of the tag, not the tag itself.
Here's an example of building up a complex structure from scratch
using a combination of add() and add_tree():
$newObj = Ace::Object->new(Sequence=>'A555',$local);
my $assembly = Ace::Object->new(tag=>'Assembly_tags');
$assembly->add('Finished Left'=>[10,20,'ABC']);
$assembly->add('Clone right end'=>[1000,2000,'DEF']);
$assembly->add('Clone right end'=>[8000,9876,'FRED']);
$assembly->add('Finished Right'=>[1000,3000,'ETHEL']);
$newObj->add_tree('Assembly_tags'=>$assembly);
$newObj->commit || warn $newObj->error;
=head2 delete() method
$result_code = $object->delete($tag_path,$value);
$result_code = $object->delete(-path=>$tag_path,
-value=>$value);
Delete the indicated tag and value from the object. This example
deletes the address line "FRANCE" from the Author's mailing address:
Ace/Object.pm view on Meta::CPAN
delete() result code indicates whether the replace was successful.
Currently is true if the old value was identified.
=head2 commit() method
$result_code = $object->commit;
Commits all add(), replace() and delete() operations to the database.
It can also be used to write a completely new object into the
database. The result code indicates whether the object was
successfully written. If an error occurred, further details can be
found in the Ace->error() error string.
=head2 rollback() method
$object->rollback;
Discard all adds, deletions and replacements, returning the object to
the state it was in prior to the last commit().
rollback() works by deleting the object from Perl memory and fetching
the object anew from AceDB. If someone has changed the object in the
Ace/Object.pm view on Meta::CPAN
$result_code = $object->kill;
This will remove the object from the database immediately and
completely. It does not wait for a commit(), and does not respond to
a rollback(). If successful, you will be left with an empty object
that contains just the class and object names. Use with care!
In the case of failure, which commonly happens when the database is
not open for writing, this method will return undef. A description of
the problem can be found by calling the error() method.
=head2 date_style() method
$object->date_style('ace');
This is a convenience method that can be used to set the date format
for all objects returned by the database. It is exactly equivalent to
$object->db->date_style('ace');
Ace/Object.pm view on Meta::CPAN
This returns the comment attached to an object or object subtree, if
any. Comments are I<Comment> objects and have the interesting
property that a single comment can refer to multiple objects. If
there is no comment attached to the current subtree, this method will
return undef.
Currently you cannot create a new comment in AcePerl or edit an old
one.
=head2 error() method
$error = $object->error;
Returns the error from the previous operation, if any. As in
Ace::error(), this string will only have meaning if the previous
operation returned a result code indicating an error.
=head2 factory() method
WARNING - THIS IS DEFUNCT AND NO LONGER WORKS. USE THE Ace->class() METHOD INSTEAD
$package = $object->factory;
When a root Ace object instantiates its tree of tags and values, it
creates a hierarchical structure of Ace::Object objects. The
factory() method determines what class to bless these subsidiary
objects into. By default, they are Ace::Object objects, but you can
override this method in a child class in order to create more
specialized Ace::Object classes. The method should return a string
corresponding to the package to bless the object into. It receives
the current Ace::Object as its first argument.
=head2 debug() method
$object->debug(1);
Change the debugging mode. A zero turns off debugging messages.
Integer values produce debug messages on standard error. Higher
integers produce progressively more verbose messages. This actually
is just a front end to Ace->debug(), so the debugging level is global.
=head1 SEE ALSO
L<Ace>, L<Ace::Model>, L<Ace::Object>, L<Ace::Local>,
L<Ace::Sequence>,L<Ace::Sequence::Multi>
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Object.pm view on Meta::CPAN
$result = $db->raw_query($cmd,0,'parse'); # sets Ace::Error for us
} else { # old way for RPC server and local
my $cmd = join('; ',"$self->{'class'} : $name",
@{$self->{'.update'}});
warn $cmd if $self->debug;
$result = $db->raw_query("parse = $cmd");
}
if (defined($result) and $result=~/write( or admin)? access/im) { # this keeps changing
$Ace::Error = "Write access denied";
} elsif (defined($result) and $result =~ /sorry|parse error/mi) {
$Ace::Error = $result;
}
return if $Ace::Error;
undef $self->{'.update'};
# this will force a fresh retrieval of the object
# and synchronize our in-memory copy with the db
delete $self->{'.right'};
delete $self->{'.PATHS'};
return 1;
}
Ace/Object/Wormbase.pm view on Meta::CPAN
package Ace::Object::Wormbase;
use strict;
use Carp;
use Ace::Object;
# $Id: Wormbase.pm,v 1.3 2003/12/27 15:52:35 todd Exp $
use vars '@ISA';
@ISA = 'Ace::Object';
# override the Locus method for backward compatibility with model shift
sub Locus {
my $self = shift;
return $self->SUPER::Locus(@_) unless $self->class eq 'Sequence';
if (wantarray) {
return ($self->Locus_genomic_seq,$self->Locus_other_seq);
} else {
return $self->Locus_genomic_seq || $self->Locus_other_seq;
}
}
Ace/Sequence.pm view on Meta::CPAN
# convert start into offset
$offset = $start - 1 if defined($start) and !defined($offset);
# convert stop/end into length
$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;
Ace/Sequence.pm view on Meta::CPAN
=item -length
The length of the sequence to return. Either a positive or negative
integer can be specified. If a negative length is given, the returned
sequence will be complemented relative to the source sequence.
=item -refseq
The sequence to use to establish the coordinate system for the
returned sequence. Normally the source sequence is used to establish
the coordinate system, but this can be used to override that choice.
You can provide either an I<Ace::Object> or just a sequence name for
this argument. The source and reference sequences must share a common
ancestor, but do not have to be directly related. An attempt to use a
disjunct reference sequence, such as one on a different chromosome,
will fail.
=item -name
As an alternative to using an I<Ace::Object> with the B<-source>
argument, you may specify a source sequence using B<-name> and B<-db>.
Ace/Sequence.pm view on Meta::CPAN
=item -db
This argument is required if the source sequence is specified by name
rather than by object reference.
=back
If new() is successful, it will create an I<Ace::Sequence> object and
return it. Otherwise it will return undef and return a descriptive
message in Ace->error(). Certain programming errors, such as a
failure to provide required arguments, cause a fatal error.
=head2 Reference Sequences and the Coordinate System
When retrieving information from an I<Ace::Sequence>, the coordinate
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.
Ace/Sequence.pm view on Meta::CPAN
=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,
Ace/Sequence.pm view on Meta::CPAN
Returns the L<Ace> database accessor associated with this sequence.
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Sequence::Feature>,
L<Ace::Sequence::FeatureList>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Many thanks to David Block <dblock@gene.pbi.nrc.ca> for finding and
fixing the nasty off-by-one errors.
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
__END__
Ace/Sequence/Feature.pm view on Meta::CPAN
=back
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Sequence>,L<Ace::Sequence::Homol>,
L<Ace::Sequence::FeatureList>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/FeatureList.pm view on Meta::CPAN
=back
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Sequence>,
L<Ace::Sequence::Feature>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@w3.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/GappedAlignment.pm view on Meta::CPAN
(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
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/Gene.pm view on Meta::CPAN
(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
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/Homol.pm view on Meta::CPAN
=head1 SEE ALSO
L<Ace>, L<Ace::Object>,
L<Ace::Sequence>,L<Ace::Sequence::FeatureList>,
L<Ace::Sequence::Feature>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@w3.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/Multi.pm view on Meta::CPAN
=item -length
The length of the sequence to return. Either a positive or negative
integer can be specified. If a negative length is given, the returned
sequence will be complemented relative to the source sequence.
=item -refseq
The sequence to use to establish the coordinate system for the
returned sequence. Normally the source sequence is used to establish
the coordinate system, but this can be used to override that choice.
You can provide either an I<Ace::Object> or just a sequence name for
this argument. The source and reference sequences must share a common
ancestor, but do not have to be directly related. An attempt to use a
disjunct reference sequence, such as one on a different chromosome,
will fail.
=item -name
As an alternative to using an I<Ace::Object> with the B<-source>
argument, you may specify a source sequence using B<-name> and B<-db>.
Ace/Sequence/Multi.pm view on Meta::CPAN
This argument points to one or more previously-opened annotation
databases. You may use a scalar if there is only one annotation
database. Otherwise, use an array reference. You may add and delete
annotation databases after the object is created by using the
add_secondary() and delete_secondary() methods.
=back
If new() is successful, it will create an I<Ace::Sequence::Multi>
object and return it. Otherwise it will return undef and return a
descriptive message in Ace->error(). Certain programming errors, such
as a failure to provide required arguments, cause a fatal error.
=head1 OBJECT METHODS
Most methods are inherited from I<Ace::Sequence>. The following
additional methods are supported:
=over 4
=item secondary()
Ace/Sequence/Multi.pm view on Meta::CPAN
=back
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Sequence>,L<Ace::Sequence::Homol>,
L<Ace::Sequence::FeatureList>, L<Ace::Sequence::Feature>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@w3.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/Sequence/Transcript.pm view on Meta::CPAN
(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
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1999, Lincoln D. Stein
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
Ace/SocketServer.pm view on Meta::CPAN
use constant ACESERV_CLIENT_HELLO => "bonjour";
use constant ACESERV_SERVER_HELLO => "et bonjour a vous";
sub connect {
my $class = shift;
my ($host,$port,$timeout,$user,$pass) = rearrange(['HOST','PORT','TIMEOUT','USER','PASS'],@_);
$user ||= DEFAULT_USER;
$pass ||= DEFAULT_PASS;
$timeout ||= DEFAULT_TIMEOUT;
my $s = IO::Socket::INET->new("$host:$port") ||
return _error("Couldn't establish connection");
my $self = bless { socket => $s,
client_id => 0, # client ID provided by server
timeout => $timeout,
},$class;
return unless $self->_handshake($user,$pass);
$self->{status} = STATUS_WAITING;
$self->{encoring} = 0;
return $self;
}
Ace/SocketServer.pm view on Meta::CPAN
# Is _recv_msg() bringing things down in flames? Maybe!
my ($msg,$body) = $self->_recv_msg('strip');
warn "Did not get expected ACESERV_MSGKILL message, got $msg instead"
if defined($msg) and $msg ne ACESERV_MSGKILL;
}
sub encore { return shift->{encoring} }
sub status { shift->{status} }
sub error { $Ace::Error; }
sub query {
my $self = shift;
my ($request,$parse) = @_;
warn "query($request)" if Ace->debug;
unless ($self->_send_msg($request,$parse)) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
$self->{encoring} = 0;
return 1;
}
sub read {
my $self = shift;
return _error("No pending query") unless $self->status == STATUS_PENDING;
$self->_do_encore || return if $self->encore;
# call select() here to time out
if ($self->{timeout}) {
my $rdr = '';
vec($rdr,fileno($self->{socket}),1) = 1;
my $result = select($rdr,undef,undef,$self->{timeout});
return _error("Query timed out") unless $result;
}
my ($msg,$body) = $self->_recv_msg;
return unless defined $msg;
$msg =~ s/\0.+$//; # socketserver bug workaround: get rid of junk in message
if ($msg eq ACESERV_MSGOK or $msg eq ACESERV_MSGFAIL) {
$self->{status} = STATUS_WAITING;
$self->{encoring} = 0;
} elsif ($msg eq ACESERV_MSGENCORE) {
$self->{status} = STATUS_PENDING; # not strictly necessary, but helpful to document
$self->{encoring} = 1;
} else {
$self->{status} = STATUS_ERROR;
return _error($body);
}
return $body;
}
sub write {
my $self = shift;
my $data = shift;
unless ($self->_send_msg($data,1)) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
$self->{encoring} = 0;
return 1;
}
sub _error {
$Ace::Error = shift;
return;
}
# return socket (read only)
sub socket { $_[0]->{socket} }
# ----------------------------- low level -------------------------------
sub _do_encore {
my $self = shift;
unless ($self->_send_msg('encore')) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
return 1;
}
sub _handshake {
my $self = shift;
my ($user,$pass) = @_;
$self->_send_msg(ACESERV_CLIENT_HELLO);
my ($msg,$nonce) = $self->_recv_msg('strip');
return unless $msg eq ACESERV_MSGOK;
# hash username and password
my $authdigest = md5_hex(md5_hex($user . $pass).$nonce);
$self->_send_msg("$user $authdigest");
my $body;
($msg,$body) = $self->_recv_msg('strip');
return _error("server: $body") unless $body eq ACESERV_SERVER_HELLO;
return 1;
}
sub _send_msg {
my ($self,$msg,$parse) = @_;
return unless my $sock = $self->{socket};
local $SIG{'PIPE'} = 'IGNORE';
$msg .= "\0"; # add terminating null
my $request;
if ($parse) {
Ace/SocketServer.pm view on Meta::CPAN
}
sub _recv_msg {
my $self = shift;
my $strip_null = shift;
return unless my $sock = $self->{socket};
my ($header,$body);
my $bytes = CORE::read($sock,$header,HEADER_LEN);
unless ($bytes > 0) {
$self->{status} = STATUS_ERROR;
return _error("Connection closed by remote server: $!");
}
my ($magic,$length,$junk1,$clientID,$junk2,$msg) = unpack HEADER,$header;
$self->{client_id} ||= $clientID;
$msg =~ s/\0*$//;
$self->{last_msg} = $msg;
if ($length > 0) {
return _error("read of body failed: $!" )
unless CORE::read($sock,$body,$length);
$body =~ s/\0*$// if defined($strip_null) && $strip_null;
return ($msg,$body);
} else {
return $msg;
}
}
1;
1.92 Tue Nov 11 11:43:17 EST 2008
1. Cache ignores objects that do not have a proper name.
1.91 Tue Oct 31 17:42:00 EST 2006
1. Updated AUTOLOAD style so that inheritance works again.
2. Removed dependency on WeakRef
1.90 Thu Mar 17 17:09:10 EST 2005
1. Fixed error in which the -fill argument wasn't being passed down to get() caching code.
2. Added a debug() method to Ace::SocketServer && Ace::Local.
1.89 Wed Mar 9 18:25:45 EST 2005
1. Added caching code.
2. Now requires ace binaries 4_9s or later.
3. Requires CACHE::CACHE and WeakRef for caching.
1.87 10/3/03
1. Fixed unreadable GIF images produced by recent versions of GifAceServer.
2. Fixed Ace::Model to handle #tags properly.
consume 99% of CPU time while waiting for tace to answer a long query.
2. Fixed bug in get() and at() in which tags got duplicated because
of capitalization variations.
1.53 1/23/99
1. Bug fix in Ace::find function. Was causing a crash.
1.52 1/21/99
1. Fixed bad bug in the kill method which caused objects
to be removed from the database seemingly randomly.
2. Optimized tag searching to improve performance when
navigating objects.
3. Better error message reporting when objects do not contain
a desired tag.
1.51 12/14/98
1. Comparison between objects now is more sensible:
"eq" performs a string comparison on object names
"==" performs an object comparison. Two objects are
identical iff their names, classes and databases are identical
2. Fixed bugs involving names containing "*" and "?" characters.
3. Added the -long option to grep.
4. Added the -display option to asGIF()
5. The follow() method now follows a tag into the database.
1.50 10/28.98
1. THE SEMANTICS OF AUTOGENERATED FUNCTIONS HAS CHANGED. THEY NOW
ALWAYS DEREFERENCE THE TAG AND FETCH AN OBJECT FROM THE DATABASE.
2. Added the Ace::put() function to the Ace object, allowing you to move
objects from one database to another.
3. Added Ace::Object::add_row() and add_tree() functions, making it easier to build
up objects from scratch, or to mix and match objects from different databases.
4. Added Ace::parse() and parse_file() methods, for creating objects from .ace files.
5. Removed nulls from error strings.
1.47-49 Internal releases
1.46 1. Fixed nasty bug in which newlines appeared as "n" in text
fields.
1.45. 1. Fixed problems with autogeneration
2. Added the format() routine 3. Added the model() methods and
Ace::Model class
of directory configuration questions. See README.ACEBROWSER for more details
on installation.
At this point, Makefile.PL will create the make files necessary to build
AcePerl. Among other things, the Makefile.PL script will attempt
to guess the type of your machine and its operating system. This information
is needed to select the correct makefile in the ACEDB library
directory, AcePerl-X.XX/ace/.
If AcePerl fails to make correctly later in the process, it may be
because the script guessed wrong. You can override this guess by
setting the machine type using the ACEDB_MACHINE environment
variable. On a C-shell or TC-shell machine, use a command like
this one:
setenv ACEDB_MACHINE ALPHA_4_GCC; perl Makefile.PL
On a Bourne-shell or Korn-shell system, use:
ACEDB_MACHINE=ALPHA_4_GCC; export ACEDB_MACHINE
perl Makefile.PL
( run in 1.326 second using v1.01-cache-2.11-cpan-49f99fa48dc )