AcePerl
view release on metacpan or search on metacpan
use constant STATUS_ERROR => -1;
use constant ACE_PARSE => 3;
use constant DEFAULT_PORT => 200005; # rpc server
use constant DEFAULT_SOCKET => 2005; # socket server
require Ace::Iterator;
require Ace::Object;
eval qq{use Ace::Freesubs}; # XS file, may not be available
# Map database names to objects (to fix file-caching issue)
my %NAME2DB;
# internal cache of objects
my %MEMORY_CACHE;
my %DEFAULT_CACHE_PARAMETERS = (
default_expires_in => '1 day',
auto_purge_interval => '12 hours',
);
*list = \&fetch;
*Ace::ERR = *Error;
# now completely deprecated and gone
# *find_many = \&fetch_many;
# *models = \&classes;
sub connect {
my $class = shift;
my ($host,$port,$user,$pass,$path,$program,
$objclass,$timeout,$query_timeout,$database,
$server_type,$url,$u,$p,$cache,$other);
# one-argument single "URL" form
if (@_ == 1) {
return $class->connect(-url=>shift);
}
# multi-argument (traditional) form
($host,$port,$user,$pass,
$path,$objclass,$timeout,$query_timeout,$url,$cache,$other) =
rearrange(['HOST','PORT','USER','PASS',
'PATH',['CLASS','CLASSMAPPER'],'TIMEOUT',
'QUERY_TIMEOUT','URL','CACHE'],@_);
($host,$port,$u,$pass,$p,$server_type) = $class->process_url($url)
or croak "Usage: Ace->connect(-host=>\$host,-port=>\$port [,-path=>\$path]\n"
if defined $url;
if ($path) { # local database
$server_type = 'Ace::Local';
} else { # either RPC or socket server
$host ||= 'localhost';
$user ||= $u || '';
$path ||= $p || '';
$port ||= $server_type eq 'Ace::SocketServer' ? DEFAULT_SOCKET : DEFAULT_PORT;
$query_timeout = 120 unless defined $query_timeout;
$server_type ||= 'Ace::SocketServer' if $port < 100000;
$server_type ||= 'Ace::RPC' if $port >= 100000;
}
# we've normalized parameters, so do the actual connect
eval "require $server_type" || croak "Module $server_type not loaded: $@";
if ($path) {
$database = $server_type->connect(-path=>$path,%$other);
} else {
$database = $server_type->connect($host,$port,$query_timeout,$user,$pass,%$other);
}
unless ($database) {
$Ace::Error ||= "Couldn't open database";
return;
}
my $contents = {
'database'=> $database,
'host' => $host,
'port' => $port,
'path' => $path,
'class' => $objclass || 'Ace::Object',
'timeout' => $query_timeout,
'user' => $user,
'pass' => $pass,
'other' => $other,
'date_style' => 'java',
'auto_save' => 0,
my $self = bless $contents,ref($class)||$class;
$self->_create_cache($cache) if $cache;
$self->name2db("$self",$self);
return $self;
}
sub reopen {
my $self = shift;
return 1 if $self->ping;
my $class = ref($self->{database});
my $database;
if ($self->{path}) {
$database = $class->connect(-path=>$self->{path},%{$self->other});
} else {
$database = $class->connect($self->{host},$self->{port}, $self->{timeout},
$self->{user},$self->{pass},%{$self->{other}});
}
unless ($database) {
$Ace::Error = "Couldn't open database";
return;
}
$self->{database} = $database;
1;
}
sub class {
my $self = shift;
my $d = $self->{class};
$self->{class} = shift if @_;
$d;
}
local $_ = $url;
if (m!^rpcace://([^:]+):(\d+)$!) { # rpcace://localhost:200005
($host,$port) = ($1,$2);
$server_type = 'Ace::RPC';
} elsif (m!^sace://([\w:]+)\@([^:]+):(\d+)$!) { # sace://user@localhost:2005
($user,$host,$port) = ($1,$2,$3);
$server_type = 'Ace::SocketServer';
} elsif (m!^sace://([^:]+):(\d+)$!) { # sace://localhost:2005
($host,$port) = ($1,$2);
$server_type = 'Ace::SocketServer';
} elsif (m!^tace:(/.+)$!) { # tace:/path/to/database
$path = $1;
$server_type = 'Ace::Local';
} elsif (m!^(/.+)$!) { # /path/to/database
$path = $1;
$server_type = 'Ace::Local';
} else {
return;
}
}
if ($user =~ /:/) {
($user,$pass) = split /:/,$user;
}
return ($host,$port,$user,$pass,$path,$server_type);
}
# Return the low-level Ace::AceDB object
sub db {
return $_[0]->{'database'};
}
# Fetch a model from the database.
# Since there are limited numbers of models, we cache
# the results internally.
sub model {
my $self = shift;
require Ace::Model;
my $model = shift;
my $break_cycle = shift; # for breaking cycles when following #includes
my $key = join(':',$self,'MODEL',$model);
$self->{'models'}{$model} ||= eval{$self->cache->get($key)};
unless ($self->{models}{$model}) {
my $key = join ':',$obj->class,$obj->name;
my $cache = $self->cache or return;
carp "deleting $key obj=",overload::StrVal($obj),"\n" if Ace->debug;
$cache->remove($key,$obj);
}
#### END: CACHE AND CARRY CODE ####
# Fetch one or a group of objects from the database
sub fetch {
my $self = shift;
my ($class,$pattern,$count,$offset,$query,$filled,$total,$filltag) =
rearrange(['CLASS',['NAME','PATTERN'],'COUNT','OFFSET','QUERY',
['FILL','FILLED'],'TOTAL','FILLTAG'],@_);
if (defined $class
&& defined $pattern
&& $pattern !~ /[\?\*]/
# && !wantarray
#########################################################
# These functions are for low-level (non OO) access only.
# This is for low-level access only.
sub show {
my ($self,$class,$pattern,$tag) = @_;
$Ace::Error = '';
return unless $self->count($class,$pattern);
# if we get here, then we've got some data to return.
my @result;
my $ts = $self->{'timestamps'} ? '-T' : '';
$self->{database}->query("show -j $ts $tag");
my $result = $self->read_object;
unless ($result =~ /(\d+) object dumped/m) {
$Ace::Error = 'Unexpected close during show';
return;
}
return grep (!m!^//!,split("\n\n",$result));
}
sub read_object {
my $self = shift;
return unless $self->{database};
my $result;
while ($self->{database}->status == STATUS_PENDING()) {
my $data = $self->{database}->read();
# $data =~ s/\0//g; # get rid of nulls in the buffer
$result .= $data if defined $data;
}
return $result;
}
# 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;
foreach (keys %{$self->{iterators}}) {
$self->_unregister_iterator($_);
}
delete $self->{database};
}
sub DESTROY {
my $self = shift;
return if caller() =~ /^Cache\:\:/;
warn "$self->DESTROY at ", join ' ',caller() if Ace->debug;
$self->close;
}
push(@return_array,$value);
}
push (@return_array,\%param) if %param;
return @return_array;
}
# do a query, but don't return the result
sub _query {
my ($self,@query) = @_;
$self->_alert_iterators;
$self->{'database'}->query("@query");
}
# return a portion of the active list
sub _list {
my $self = shift;
my ($count,$offset) = @_;
my (@result);
my $query = 'list -j';
$query .= " -b $offset" if defined $offset;
$query .= " -c $count" if defined $count;
# return a portion of the active list
sub _fetch {
my $self = shift;
my ($count,$start,$tag) = @_;
my (@result);
$tag = '' unless defined $tag;
my $query = "show -j $tag";
$query .= ' -T' if $self->{timestamps};
$query .= " -b $start" if defined $start;
$query .= " -c $count" if defined $count;
$self->{database}->query($query);
while (my @objects = $self->_fetch_chunk) {
push (@result,@objects);
}
# copy tag into a portion of the tree
if ($tag) {
for my $tree (@result) {
my $obj = $self->class_for($tree->class,$tree->name)->new($tree->class,$tree->name,$self,1);
$obj->_attach_subtree($tag=>$tree);
$tree = $obj;
}
$_ = $obj;
} else {
$self->memory_cache_store($_);
}
}
return wantarray ? @result : $result[0];
}
sub _fetch_chunk {
my $self = shift;
return unless $self->{database}->status == STATUS_PENDING();
my $result = $self->{database}->read();
$result =~ s/\0//g; # get rid of &$#&@!! nulls
my @chunks = split("\n\n",$result);
my @result;
foreach (@chunks) {
next if m!^//!;
next unless /\S/; # occasional empty lines
my ($class,$id) = Ace->split($_); # /^\?([^?]+)\?([^?]+)\?/m;
push(@result,$self->class_for($class,$id)->newFromText($_,$self));
}
return @result;
__END__
=head1 NAME
Ace - Object-Oriented Access to ACEDB Databases
=head1 SYNOPSIS
use Ace;
# open a remote database connection
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
# open a local database connection
$local = Ace->connect(-path=>'~acedb/my_ace');
# simple queries
$sequence = $db->fetch(Sequence => 'D12345');
$count = $db->count(Sequence => 'D*');
@sequences = $db->fetch(Sequence => 'D*');
$i = $db->fetch_many(Sequence=>'*'); # fetch a cursor
while ($obj = $i->next) {
print $obj->asTable;
}
find Annotation Ready_for_submission ; follow gene ;
follow derived_sequence ; >DNA
END
@ready_dnas= $db->fetch(-query=>$query);
$ready = $db->fetch_many(-query=>$query);
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
can be used to open both remote Ace databases (running aceserver or
gifaceserver), and local ones.
I<Ace::Object> is the superclass for all objects returned from the
database. I<Ace> and I<Ace::Object> are linked: if you retrieve an
Ace::Object from a particular database, it will store a reference to
the database and use it to fetch any subobjects contained within it.
You may make changes to the I<Ace::Object> and have those changes
written into the database. You may also create I<Ace::Object>s from
scratch and store them in the database.
I<Ace::Iterator> is a utility class that acts as a database cursor for
long-running ACEDB queries. I<Ace::Model> provides object-oriented
access to ACEDB's schema.
Internally, I<Ace> uses the I<Ace::Local> class for access to local
databases and I<Ace::AceDB> for access to remote databases.
Ordinarily you will not need to interact directly with either of these
classes.
=head1 CREATING NEW DATABASE CONNECTIONS
=head2 connect() -- multiple argument form
# remote database
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
# local (non-server) database
$db = Ace->connect(-path => '/usr/local/acedb);
Use Ace::connect() to establish a connection to a networked or local
AceDB database. To establish a connection to an AceDB server, use the
B<-host> and/or B<-port> arguments. For a local server, use the
B<-port> argument. The database must be up and running on the
indicated host and port prior to connecting to an AceDB server. The
full syntax is as follows:
$db = Ace->connect(-host => $host,
-port => $port,
-path => $database_path,
-program => $local_connection_program
-classmapper => $object_class,
-timeout => $timeout,
-query_timeout => $query_timeout
-cache => {cache parameters},
);
The connect() method uses a named argument calling style, and
recognizes the following arguments:
By default, the cache is not size limited (the "max_size" property is
set to $NO_MAX_SIZE). To adjust the size you may consider calling the
Ace object's cache() method to retrieve the physical cache and then
calling the cache object's limit_size($max_size) method from time to
time. See L<Cache::SizeAwareFileCache> for more details.
=item B<-program>
By default AcePerl will use its internal compiled code calls to
establish a connection to Ace servers, and will launch a I<tace>
subprocess to communicate with local Ace databases. The B<-program>
argument allows you to customize this behavior by forcing AcePerl to
use a local program to communicate with the database. This argument
should point to an executable on your system. You may use either a
complete path or a bare command name, in which case the PATH
environment variable will be consulted. For example, you could force
AcePerl to use the I<aceclient> program to connect to the remote host
by connecting this way:
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100,
-program=>'aceclient');
=item B<-classmapper>
The optional B<-classmapper> argument (alias B<-class>) points to the
class you would like to return from database queries. It is provided
for your use if you subclass Ace::Object. For example, if you have
created a subclass of Ace::Object called Ace::Object::Graphics, you
can have the database return this subclass by default by connecting
this way:
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100,
-class=>'Ace::Object::Graphics');
The value of B<-class> can be a hash reference consisting of AceDB
class names as keys and Perl class names as values. If a class name
does not exist in the hash, a key named _DEFAULT_ will be looked for.
If that does not exist, then Ace will default to Ace::Object.
The value of B<-class> can also be an object or a classname that
implements a class_for() method. This method will receive three
arguments containing the AceDB class name, object ID and database
handle. It should return a string indicating the perl class to
create.
=item B<-timeout>
If no response from the server is received within $timeout seconds,
the call will return an undefined value. Internally timeout sets an
alarm and temporarily intercepts the ALRM signal. You should be aware
of this if you use ALRM for your own purposes.
-program tace
-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
db(). This fetches an Ace::AceDB object. See THE LOW LEVEL C API for
details on using this object.
If not provided, the port defaults to 2005.
=item rpcace://hostname:port
Connect to an RPC server at the indicated hostname and RPC service number. Example:
rpcace://stein.cshl.org:400000
If not provided, the port defaults to 200005
=item tace:/path/to/database
Open up the local database at F</path/to/database> using tace. Example:
tace:/~acedb/elegans
=item /path/to/database
Same as the previous.
=back
=head2 close() Method
You can explicitly close a database by calling its close() method:
$db->close();
This is not ordinarily necessary because the database will be
automatically close when it -- and all objects retrieved from it -- go
out of scope.
=head2 reopen() Method
The ACeDB socket server can time out. The reopen() method will ping
the server and if it is not answering will reopen the connection. If
the database is live (or could be resurrected), this method returns
true.
=head1 RETRIEVING ACEDB OBJECTS
Once you have established a connection and have an Ace databaes
handle, several methods can be used to query the ACE database to
retrieve objects. You can then explore the objects, retrieve specific
fields from them, or update them using the I<Ace::Object> methods.
Please see L<Ace::Object>.
=head2 fetch() method
$count = $db->fetch($class,$name_pattern);
$object = $db->fetch($class,$name);
@objects = $db->fetch($class,$name_pattern,[$count,$offset]);
@objects = $db->fetch(-name=>$name_pattern,
-class=>$class
-count=>$count,
-offset=>$offset,
-fill=>$fill,
-filltag=>$tag,
-total=>\$total);
@objects = $db->fetch(-query=>$query);
Ace::fetch() retrieves objects from the database based on their class
and name. You may retrieve a single object by requesting its name, or
a group of objects by fetching a name I<pattern>. A pattern contains
one or more wildcard characters, where "*" stands for zero or more
characters, and "?" stands for any single character.
This method behaves differently depending on whether it is called in a
scalar or a list context, and whether it is asked to search for a name
pattern or a simple name.
When called with a class and a simple name, it returns the object
referenced by that time, or undef, if no such object exists. In an
array context, it will return an empty list.
When called with a class and a name pattern in a list context, fetch()
returns the list of objects that match the name. When called with a
pattern in a scalar context, fetch() returns the I<number> of objects
that match without actually retrieving them from the database. Thus,
it is similar to count().
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
them in a tree browser) it can be more efficient to fetch them in
filled mode. You do this by calling fetch() with the argument of
B<-fill> set to a true value.
The B<-filltag> argument, if provided, asks the database to fill in
the subtree anchored at the indicated tag. This will improve
performance for frequently-accessed subtrees. For example:
@objects = $db->fetch(-name => 'D123*',
-class => 'Sequence',
-filltag => 'Visible');
This will fetch all Sequences named D123* and fill in their Visible
trees in a single operation.
consume a lot of memory, even if B<-fill> is false. Consider using
B<fetch_many()> instead (see below). Also see the get() method, which
is equivalent to the simple two-argument form of fetch().
=item get() method
$object = $db->get($class,$name [,$fill]);
The get() method will return one and only one AceDB object
identified by its class and name. The optional $fill argument can be
used to control how much data is retrieved from the database. If $fill
is absent or undefined, then the method will return a lightweight
"stub" object that is filled with information as requested in a lazy
fashion. If $fill is the number "1" then the retrieved object contains
all the relevant information contained within the database. Any other
true value of $fill will be treated as a tag name: the returned object
will be prefilled with the subtree to the right of that tag.
Examples:
# return lightweight stub for Author object "Sulston JE."
$author = $db->get(Author=>'Sulston JE');
# return heavyweight object
$author = $db->get(Author=>'Sulston JE',1);
The get() method is equivalent to this form of the fetch()
method:
$object = $db->fetch($class=>$name);
=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"
END
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.
See also the Ace::Object->add() and replace() methods.
=head2 list() method
@objects = $db->list(class,pattern,[count,offset]);
@objects = $db->list(-class=>$class,
-name=>$name_pattern,
-count=>$count,
-offset=>$offset);
This is a deprecated method. Use fetch() instead.
=head2 count() method
$count = $db->count($class,$pattern);
$count = $db->count(-query=>$query);
This function queries the database for a list of objects matching the
specified class and pattern, and returns the object count. For large
sets of objects this is much more time and memory effective than
fetching the entire list.
The class and name pattern are the same as the list() method above.
You may also provide a B<-query> argument to instead specify an
arbitrary ACE query such as "find Author COUNT Paper > 80". See
find() below.
$obj = $db->fetch_many($class,$pattern);
$obj = $db->fetch_many(-class=>$class,
-name =>$pattern,
-fill =>$filled,
-chunksize=>$chunksize);
$obj = $db->fetch_many(-query=>$query);
If you expect to retrieve many objects, you can fetch an iterator
across the data set. This is friendly both in terms of network
bandwidth and memory consumption. It is simple to use:
$i = $db->fetch_many(Sequence,'*'); # all sequences!!!!
while ($obj = $i->next) {
print $obj->asTable;
}
The iterator will return undef when it has finished iterating, and
cannot be used again. You can have multiple iterators open at once
and they will operate independently of each other.
Like B<fetch()>, B<fetch_many()> takes an optional B<-fill> (or
B<-filled>) argument which retrieves the entire object rather than
just its name. This is efficient on a network with high latency if
you expect to be touching many parts of the object (rather than
just retrieving the value of a few tags).
B<fetch_many()> retrieves objects from the database in groups of a
certain maximum size, 40 by default. This can be tuned using the
optional B<-chunksize> argument. Chunksize is only a hint to the
database. It may return fewer objects per transaction, particularly
if the objects are large.
You may provide raw Ace query string with the B<-query> argument. If
present the B<-name> and B<-class> arguments will be ignored.
=head2 find_many() method
This is an alias for fetch_many(). It is now deprecated.
=head2 keyset() method
$count = $db->grep($grep_string);
@objects = $db->grep(-pattern => $grep_string,
-offset=> $offset,
-count => $count,
-fill => $fill,
-filltag => $filltag,
-total => \$total,
-long => 1,
);
This performs a "grep" on the database, returning all object names or
text that contain the indicated grep pattern. In a scalar context
this call will return the number of matching objects. In an array
context, the list of matching objects are retrieved. There is also a
named-parameter form of the call, which allows you to specify the
number of objects to retrieve, the offset from the beginning of the
list to retrieve from, whether the retrieved objects should be filled
initially. You can use B<-total> to discover the total number of
objects that match, while only retrieving a portion of the list.
By default, grep uses a fast search that only examines class names and
This will return an I<Ace::Model> object corresponding to the
indicated class.
=head2 new() method
$obj = $db->new($class,$name);
$obj = $db->new(-class=>$class,
-name=>$name);
Create a new object in the database with the indicated class and name
and return a pointer to it. Will return undef if the object already
exists in the database. The object isn't actually written into the database
until you call Ace::Object::commit().
=head2 raw_query() method
$r = $db->raw_query('Model');
Send a command to the database and return its unprocessed output.
This method is necessary to gain access to features that are not yet
implemented in this module, such as model browsing and complex
queries.
=head2 classes() method
@classes = $db->classes();
@all_classes = $db->classes(1);
This method returns a list of all the object classes known to the
server. In a list context it returns an array of class names. In a
scalar context, it the number of classes defined in the database.
Ordinarily I<classes()> will return only those classes that are
exposed to the user interface for browsing, the so-called "visible"
classes. Pass a true argument to the call to retrieve non-visible
classes as well.
=head2 class_count() method
%classes = $db->class_count()
Returns various bits of status information from the server. In an
array context, returns a hash of hashes. In a scalar context, returns a
reference to a hash of hashes. Keys and subkeys are as follows
code
program name of acedb binary
version version of acedb binary
build build date of acedb binary in format Jan 25 2003 16:21:24
database
title name of the database
version version of the database
dbformat database format version number
directory directory in which the database is stored
session session number
user user under which server is running
write whether the server has write access
address global address - not known if this is useful
resources
classes number of classes defined
keys number of keys defined
memory amount of memory used by acedb objects (bytes)
For example, to get the program version:
my $version = $db->status->{code}{version};
=head2 title() method
my $title = $db->title
Returns the version of the current database, equivalent
to $db->status->{database}{title};
=head2 version() method
my $version = $db->version;
Returns the version of the current database, equivalent
to $db->status->{database}{version};
=head2 date_style() method
$style = $db->date_style();
$style = $db->date_style('ace');
$style = $db->date_style('java');
For historical reasons, AceDB can display dates using either of two
different formats. The first format, which I call "ace" style, puts
the year first, as in "1997-10-01". The second format, which I call
B<date_style()> can be used to set or retrieve the current style.
Called with no arguments, it returns the current style, which will be
one of "ace" or "java." Called with an argument, it will set the
style to one or the other.
=head2 timestamps() method
$timestamps_on = $db->timestamps();
$db->timestamps(1);
Whenever a data object is updated, AceDB records the time and date of
the update, and the user ID it was running under. Ordinarily, the
retrieval of timestamp information is suppressed to conserve memory
and bandwidth. To turn on timestamps, call the B<timestamps()> method
with a true value. You can retrieve the current value of the setting
by calling the method with no arguments.
Note that activating timestamps disables some of the speed
optimizations in AcePerl. Thus they should only be activated if you
really need the information.
=head2 auto_save()
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]);
=head2 debug()
$debug_level = Ace->debug([$new_level])
This class method gets or sets the debug level. Higher integers
increase verbosity. 0 or undef turns off debug messages.
=head2 name2db()
$db = Ace->name2db($name [,$database])
This class method associates a database URL with an Ace database
object. This is used internally by the Ace::Object class in order to
discover what database they "belong" to.
=head2 cache()
Get or set the Cache::SizeAwareFileCache object, if one has been
created.
=head2 memory_cache_fetch()
$obj = $db->memory_cache_fetch($class,$name)
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.
# -------------------- AUTOLOADED SUBS ------------------
sub debug {
my $package = shift;
my $d = $DEBUG_LEVEL;
$DEBUG_LEVEL = shift if @_;
$d;
}
# Return true if the database is still connected. This is oddly convoluted
# because there are numerous things that can go wrong, including:
# 1. server has gone away
# 2. server has timed out our connection! (grrrrr)
# 3. communications channel contains unread garbage and is in an inconsistent state
sub ping {
my $self = shift;
local($SIG{PIPE})='IGNORE'; # so we don't get a fatal exception during the check
my $result = $self->raw_query('');
return unless $result; # server has gone away
return if $result=~/broken connection|client time out/; # server has timed us out
return unless $self->{database}->status() == STATUS_WAITING(); #communications oddness
return 1;
}
# Get or set the display style for dates
sub date_style {
my $self = shift;
$self->{'date_style'} = $_[0] if defined $_[0];
return $self->{'date_style'};
}
# Get or set whether we retrieve timestamps
sub timestamps {
my $self = shift;
$self->{'timestamps'} = $_[0] if defined $_[0];
return $self->{'timestamps'};
}
# Add one or more objects to the database
sub put {
my $self = shift;
my @objects = @_;
my $count = 0;
$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
$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);
return $obj;
}
# Return the layout, which contains classes that should be displayed
sub layout {
# Return a hash of all the classes and the number of objects in each
sub class_count {
my $self = shift;
return $self->raw_query('classes') =~ /^\s+(\S+) (\d+)/gm;
}
# Return a hash of miscellaneous status information from the server
# (to be expanded later)
sub status {
my $self = shift;
my $data = $self->raw_query('status');
study $data;
my %status;
# -Code section
my ($program) = $data=~/Program:\s+(.+)/m;
my ($aceversion) = $data=~/Version:\s+(.+)/m;
my ($build) = $data=~/Build:\s+(.+)/m;
$status{code} = { program=>$program,
version=>$aceversion,
build =>$build};
# -Database section
my ($title) = $data=~/Title:\s+(.+)/m;
my ($name) = $data=~/Name:\s+(.+)/m;
my ($release) = $data=~/Release:\s+(.+)/m;
my ($directory) = $data=~/Directory:\s+(.+)/m;
my ($session) = $data=~/Session:\s+(\d+)/m;
my ($user) = $data=~/User:\s+(.+)/m;
my ($write) = $data=~/Write Access:\s+(.+)/m;
my ($address) = $data=~/Global Address:\s+(\d+)/m;
$status{database} = {
title => $title,
version => $name,
dbformat => $release,
directory => $directory,
session => $session,
user => $user,
write => $write,
address => $address,
};
# other info - not all
my ($classes) = $data=~/classes:\s+(\d+)/;
my ($keys) = $data=~/keys:\s+(\d+)/;
my ($memory) = $data=~/blocks:\s+\d+,\s+allocated \(kb\):\s+(\d+)/;
$status{resources} = {
classes => $classes,
keys => $keys,
memory => $memory * 1024,
};
return wantarray ? %status : \%status;
}
sub title {
my $self = shift;
my $status= $self->status;
$status->{database}{title};
}
sub version {
my $self = shift;
my $status= $self->status;
$status->{database}{version};
}
sub auto_save {
my $self = shift;
if ($self->db && $self->db->can('auto_save')) {
$self->db->auto_save;
} else {
$self->{'auto_save'} = $_[0] if defined $_[0];
return $self->{'auto_save'};
}
@h;
}
sub pick {
my ($self,$class,$item) = @_;
$Ace::Error = '';
# assumption of uniqueness of name is violated by some classes!
# return () unless $self->count($class,$item) == 1;
return unless $self->count($class,$item) >= 1;
# if we get here, then we've got some data to return.
# yes, we're repeating code slightly...
my @result;
my $ts = $self->{'timestamps'} ? '-T' : '';
my $result = $self->raw_query("show -j $ts");
unless ($result =~ /(\d+) object dumped/m) {
$Ace::Error = 'Unexpected close during pick';
return;
}
@result = grep (!m!^\s*//!,split("\n\n",$result));
my $self = shift;
my $iterator = shift;
return unless $self->{iterators}{$iterator};
$self->{iterator_stack} ||= [];
return 1 if grep { $_ eq $iterator } @{$self->{iterator_stack}};
$self->raw_query("spush",'no_alert');
unshift @{$self->{iterator_stack}},$iterator;
1; # result code -- CHANGE THIS LATER
}
# horrid method that keeps the database's view of
# iterators in synch with our view
sub _restore_iterator {
my $self = shift;
my $iterator = shift;
# no such iterator known, return false
return unless $self->{iterators}{$iterator};
# make other iterators save themselves
$self->_alert_iterators;
return unless $i < @$list;
# Sse spop if the list size is 1. Otherwise use spick, which is
# only supported in hacked versions of the server.
my $result = $i == 0 ? $self->raw_query("spop",'no_alert')
: $self->raw_query("spick $i",'no_alert');
if ($result =~ /Keyword spick does not match/) {
# _restore_iterator will now only work for a single iterator (non-reentrantly)
$self->{no_spick}++;
$self->raw_query('spop','no_alert') foreach @$list; # empty database stack
$self->{iterator_stack} = []; # and local copy
return;
}
unless (($result =~ /The stack now holds (\d+) keyset/ && ($1 == (@$list-1) ))
or
($result =~ /stack is (now )?empty/ && @$list == 1)
) {
$Ace::Error = 'Unexpected result from spick: $result';
return;
Ace/Browser/AceSubs.pm view on Meta::CPAN
my $bookmark = cookie(
-name=>"HOME_${db}",
-value=>$referer,
-path=>'/');
push(@COOKIES,$bookmark);
}
if ($searches{$quovadis}) {
Delete('Go');
my $search_name = "SEARCH_${db}_${quovadis}";
my $search_data = cookie(-name => $search_name,
-value => query_string(),
-path=>'/',
);
my $last_search = cookie(-name=>"ACEDB_$db",
-value=>$quovadis,
-path=>'/');
push(@COOKIES,$search_data,$last_search);
}
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
Ace/Browser/AceSubs.pm view on Meta::CPAN
and name of the object are not provided as arguments, they are taken
from CGI's param() function.
=cut
sub AceMissing {
my ($class,$name) = @_;
$class ||= param('class');
$name ||= param('name');
PrintTop(undef,undef,$name);
print strong('There is no further information about this object in the database.');
PrintBottom();
Apache->exit(0) if defined &Apache::exit;
exit(0);
}
=item AceMultipleChoices($symbol,$report,$objects)
This function is called when a search has recovered multiple objects
and the user must make a choice among them. The user is presented
with an ordered list of the objects, and asked to click on one of
Ace/Browser/AceSubs.pm view on Meta::CPAN
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");
print p(font({-color => 'red'},
strong("The $class named \"$name\" is not found in the database.")));
PrintBottom();
Apache->exit(0) if defined &Apache::exit;
exit(0);
}
=item ($uri,$physical_path) = AcePicRoot($directory)
This function returns the physical and URL paths of a temporary
directory in which the pic script can write pictures. Not exported by
default. Returns a two-element list containing the URL and physical
Ace/Browser/AceSubs.pm view on Meta::CPAN
}
=item $configuration = Configuration()
The Configuration() function returns the Ace::Browser::SiteDefs object
for the current session. From this object you can retrieve
information from the configuration file.
=cut
# get the configuration object for this database
sub Configuration {
my $s = get_symbolic()||return;
return Ace::Browser::SiteDefs->getConfig($s);
}
=item $name = DB_Name()
This function returns the symbolic name of the current database, for
example "default".
=cut
*DB_Name = \&get_symbolic;
=item DoRedirect($object)
This subroutine immediately redirects to the default display for the
Ace::Object indicated by $object and exits the script. It must be
Ace/Browser/AceSubs.pm view on Meta::CPAN
my $obj_name = escape(param('name'));
my $obj_class = escape(param('class')) || ucfirst url(-relative=>1);
my $referer = escape(self_url());
my $name = get_symbolic();
# set up the feedback link
my $feedback_link = Configuration()->Feedback_recipients &&
$obj_name &&
(url(-relative=>1) ne 'feedback') ?
a({-href=>ResolveUrl("misc/feedback/$name","name=$obj_name;class=$obj_class;referer=$referer")},
"Click here to send data or comments to the maintainers")
: '';
# set up the privacy statement link
my $privacy_link = ( Configuration()->Print_privacy_statement &&
url(-relative=>1) ne PRIVACY())
?
a({ -href=>ResolveUrl(PRIVACY."/$name") },'Privacy Statement')
: '';
my ($home,$label) = @{Configuration()->Home};
Ace/Browser/AceSubs.pm view on Meta::CPAN
</TD>
</TR>
</TABLE>
END
}
=item $object = GetAceObject()
This function is called by display scripts to return the
Ace::Object.that the user wishes to view. It automatically opens or
refreshes the database, and performs the request using the values of the
"name" and "class" CGI variables.
If a single object is found, the function returns it as the function
result. If no objects are found, it returns undef. If more than one
object is found, the function invokes AceMultipleChoices() and exits
the script.
=cut
# open database, return object requested by CGI parameters
sub GetAceObject {
my $db = OpenDatabase() || AceError("Couldn't open database."); # exits
my $name = param('name') or return;
my $class = param('class') or return;
my @objs = $db->fetch($class => $name);
if (@objs > 1) {
AceMultipleChoices($name,'',\@objs);
Apache->exit(0) if defined &Apache::exit;
exit(0);
}
return $objs[0];
}
Ace/Browser/AceSubs.pm view on Meta::CPAN
my $object = shift;
my $link_text = shift;
my $target = shift;
my $url = Object2URL($object,@_) or return ($link_text || "$object");
my @targ = $target ? (-target=>$target) : ();
return a({-href=>Object2URL($object,@_),-name=>"$object",@targ},($link_text || "$object"));
}
=item $db = OpenDatabase()
This function opens the Acedb database designated by the configuration
file. In modperl environments, this function caches database handles
and reuses them, pinging and reopening them in the case of timeouts.
This function is not exported by default.
=cut
use Carp 'cluck';
################ open a database #################
sub OpenDatabase {
my $name = shift || get_symbolic();
AceInit();
$name =~ s!/$!!;
my $db = $DB{$name};
return $db if $db && $db->ping;
my ($host,$port,$user,$password,
$cache_root,$cache_size,$cache_expires,$auto_purge_interval)
= getDatabasePorts($name);
Ace/Browser/AceSubs.pm view on Meta::CPAN
hash before calling start_html(). See the pic script for an example
of how this is done this.
This function is not exported by default.
=cut
=item $url = ResolveUrl($url,$param)
Given a URL and a set of parameters, this function does the necessary
magic to add the symbolic database name to the end of the URL (if
needed) and then tack the parameters onto the end.
A typical call is:
$url = ResolveUrl('/cgi-bin/ace/generic/tree','name=fred;class=Author');
This function is not exported by default.
=cut
Ace/Browser/AceSubs.pm view on Meta::CPAN
}
=item $url = Url($display,$params)
Given a symbolic display name, such as "tree" and a set of parameters,
this function looks up its URL and then calls ResolveUrl() to create a
single Url.
When hard-coding relative URLs into AceBrowser scripts, it is
important to pass them through Url(). The reason for this is that
AceBrowser may need to attach the database name to the URL in order to
identify it.
Example:
my $url = Url('../sequence_dump',"name=$name;long_dump=yes");
print a({-href=>$url},'Dump this sequence');
=cut
sub Url {
Ace/Browser/AceSubs.pm view on Meta::CPAN
<td>';
}
sub Close_table{
print '</tr>
</td>
</table>';
}
# return host and port for symbolic database name
sub getDatabasePorts {
my $name = shift;
my $config = Ace::Browser::SiteDefs->getConfig($name);
return ($config->Host,$config->Port,
$config->Username,$config->Password,
$config->Cacheroot,$config->Cachesize,$config->Cacheexpires,$config->Cachepurge,
) if $config;
# If we get here, then try getservbynam()
# I think this is a bit of legacy code.
Ace/Browser/SiteDefs.pm view on Meta::CPAN
The config object methods are a canonicalized form of the
configuration file variables, in which the first character of the
method is uppercase, and subsequent characters are lower case. For
example, if the configuration variable was $ROOT, the method will be
$config_object->Root.
=head2 Working with Configuration Objects
To fetch a configuration object, use the Ace::Browser::AceSubs
Configuration() function. This will return a configuration object for
the current database:
$config_object = Configuration();
Thereafter, it's just a matter of making the proper method calls.
If the Configuration file is a.... The method call returns a...
---------------------------------- ----------------------------
Scalar variable Scalar
Array variable Array reference
Ace/Browser/SiteDefs.pm view on Meta::CPAN
# get location of configuration file
use Ace::Browser::LocalSiteDefs '$SITE_DEFS';
my %CONFIG;
my %CACHETIME;
my %CACHED;
sub getConfig {
my $package = shift;
my $name = shift;
croak "Usage: getConfig(\$database_name)" unless defined $name;
$package = ref $package if ref $package;
my $file = "${name}.pm";
# make search relative to SiteDefs.pm file
my $path = $package->get_config || $package->resolveConf($file);
return unless -r $path;
return $CONFIG{$name} if exists $CONFIG{$name} and $CACHETIME{$name} >= (stat($path))[9];
return unless $CONFIG{$name} = $package->_load($path);
$CONFIG{$name}->{'name'} ||= $name; # remember name
Ace/Browser/SiteDefs.pm view on Meta::CPAN
$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);
$data{ucfirst(lc $_)} = \@symbol if defined(@symbol);
$data{ucfirst(lc $_)} = \&symbol if defined(&symbol);
undef *symbol unless defined &symbol; # conserve some memory
}
# special case: get the search scripts as both an array and as a hash
if (my @searches = @{"$namespace\:\:SEARCHES"}) {
$data{Searches} = [ @searches[map {2*$_} (0..@searches/2-1)] ];
%{$data{Search_titles}} = @searches;
}
# return this thing as a blessed object
return bless \%data,$package;
}
sub resolvePath {
my $self = shift;
my $file = shift;
my $root = $self->Root || '/cgi-bin';
return "$root/$file";
}
sub resolveConf {
Ace/Browser/TreeSubs.pm view on Meta::CPAN
# colors
use constant OPENCOLOR => '#FF0000'; # color when a tree is expanded
use constant CLOSEDCOLOR => '#909090'; # color when a tree is collapsed
# auto-expand subtrees when the number of subobjects is
# less than or equal to this number
use constant MAXEXPAND => 4;
# A hack to allow access to external images.
# We use the name of the database as a URL to an external image.
# The URL will look like this:
# /ace_images/external/database_name/foo.gif
# You must arrange for the URL to return the correct image, either with
# a CGI script, a symbolic link, or a redirection directive.
sub AceImageHackURL {
my $image_name = shift;
# correct some bad image file names in the database
$image_name .= '.jpeg' unless $image_name =~ /\.(gif|jpg|jpeg|png|tiff|ps)$/;
my $picture_path = Configuration->Pictures->[0];
return join('/',$picture_path,Configuration->Name,'external',escape("$image_name"));
}
1;
Ace/Graphics/Panel.pm view on Meta::CPAN
$panel->add_track(segments => [[$abc_5,$abc_3],
[$xxx_5,$xxx_3],
[$yyy_5,$yyy_3]],
-connect_groups => 1);
=item $gd = $panel->gd
The gd() method lays out the image and returns a GD::Image object
containing it. You may then call the GD::Image object's png() or
jpeg() methods to get the image data.
=item $png = $panel->png
The png() method returns the image as a PNG-format drawing, without
the intermediate step of returning a GD::Image object.
=item $boxes = $panel->boxes
=item @boxes = $panel->boxes
Ace/Iterator.pm view on Meta::CPAN
$i = $db->fetch_many(Sequence=>'*'); # fetch a cursor
while ($obj = $i->next) {
print $obj->asTable;
}
=head1 DESCRIPTION
The Ace::Iterator class implements a persistent query on an Ace
database. You can create multiple simultaneous queries and retrieve
objects from each one independently of the others. This is useful
when a query is expected to return more objects than can easily fit
into memory. The iterator is essentially a database "cursor."
=head2 new() Method
$iterator = Ace::Iterator->new(-db => $db,
-query => $query,
-filled => $filled,
-chunksize => $chunksize);
An Ace::Iterator is returned by the Ace accessor's object's
fetch_many() method. You usually will not have cause to call the new()
method directly. If you do so, the parameters are as follows:
=over 4
=item -db
The Ace database accessor object to use.
=item -query
A query, written in Ace query language, to pass to the database. This
query should return a list of objects.
=item -filled
If true, then retrieve complete objects from the database, rather than
empty object stubs. Retrieving filled objects uses more memory and
network bandwidth than retrieving unfilled objects, but it's
recommended if you know in advance that you will be accessing most or
all of the objects' fields, for example, for the purposes of
displaying the objects.
=item -chunksize
The iterator will fetch objects from the database in chunks controlled
by this argument. The default is 40. You may want to tune the
chunksize to optimize the retrieval for your application.
=back
=head2 next() method
$object = $iterator->next;
This method retrieves the next object from the query, performing
whatever database accesses it needs. After the last object has been
fetched, the next() will return undef. Usually you will call next()
inside a loop like this:
while (my $object = $iterator->next) {
# do something with $object
}
Because of the way that object caching works, next() will be most
efficient if you are only looping over one iterator at a time.
Although parallel access will work correctly, it will be less
Ace/Local.pm view on Meta::CPAN
my($pid) = open2($rdr,$wtr,"$program $args");
unless ($pid) {
$Ace::Error = <$rdr>;
return undef;
}
# Figure out the prompt by reading until we get zero length,
# then take whatever's at the end.
unless ($nosync) {
local($/) = "> ";
my $data = <$rdr>;
($prompt) = $data=~/^(.+> )/m;
unless ($prompt) {
$Ace::Error = "$program didn't open correctly";
return undef;
}
}
return bless {
'read' => $rdr,
'write' => $wtr,
'prompt' => $prompt,
Ace/Local.pm view on Meta::CPAN
warn "\tquery($msg)";
}
return undef if $self->{'status'} == STATUS_ERROR;
do $self->read() until $self->{'status'} != STATUS_PENDING;
my $wtr = $self->{'write'};
print $wtr "$query\n";
$self->{'status'} = STATUS_PENDING;
}
sub low_read { # hack to accomodate "uninitialized database" warning from tace
my $self = shift;
my $rdr = $self->{'read'};
return undef unless $self->{'status'} == STATUS_PENDING;
my $rin = '';
my $data = '';
vec($rin,fileno($rdr),1)=1;
unless (select($rin,undef,undef,1)) {
$self->{'status'} = STATUS_WAITING;
return undef;
}
sysread($rdr,$data,READSIZE);
return $data;
}
sub read {
my $self = shift;
return undef unless $self->{'status'} == STATUS_PENDING;
my $rdr = $self->{'read'};
my $len = defined $self->{'buffer'} ? length($self->{'buffer'}) : 0;
my $plen = length($self->{'prompt'});
my ($result, $bytes, $pos, $searchfrom);
while (1) {
# Read the data directly onto the end of the buffer
$bytes = sysread($rdr, $self->{'buffer'},
READSIZE, $len);
unless ($bytes > 0) {
$self->{'status'} = STATUS_ERROR;
return;
}
# check for prompt
# The following checks were implemented using regexps and $' and
# friends. I have changed this to use {r}index and substr (a)
# because they're much faster than regexps and (b) because using
# $' and $` causes all regexps in a program to execute
# very slowly due to excessive and unnecessary pre/post-match
# copying -- tim.cutts@incyte.com 08 Sep 1999
# Note, don't need to search the whole buffer for the prompt;
# just need to search the new data and the prompt length from
# any previous data.
$searchfrom = ($len <= $plen) ? 0 : ($len - $plen);
if (($pos = index($self->{'buffer'},
$self->{'prompt'},
$searchfrom)) > 0) {
$self->{'status'} = STATUS_WAITING;
$result = substr($self->{'buffer'}, 0, $pos);
$self->{'buffer'} = '';
return $result;
Ace/Local.pm view on Meta::CPAN
return $path unless $homedir;
$path =~ s!^~[^/]*!$homedir!;
return $path;
}
__END__
=head1 NAME
Ace::Local - use giface, tace or gifaceclient to open a local connection to an Ace database
=head1 SYNOPSIS
use Ace::Local
my $ace = Ace::Local->connect(-path=>'/usr/local/acedb/elegans');
$ace->query('find author Se*');
die "Query unsuccessful" unless $ace->status;
$ace->query('show');
while ($ace->encore) {
print $ace->read;
}
=head1 DESCRIPTION
This class is provided for low-level access to local (non-networked)
Ace databases via the I<giface> program. You will generally not need
to access it directly. Use Ace.pm instead.
For the sake of completeness, the method can also use the I<aceclient>
program for its access. However the Ace::AceDB class is more efficient
for this purpose.
=head1 METHODS
=head2 connect()
$accessor = Ace::Local->connect(-path=>$path_to_database);
Connect to the database at the indicated path using I<giface> and
return a connection object (an "accessor"). I<Giface> must be on the
current search path. Multiple accessors may be open simultaneously.
Arguments include:
=over 4
=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>
Ace/Local.pm view on Meta::CPAN
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
Ace/Local.pm view on Meta::CPAN
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;
In fact, this is how it's implemented.
=head2 auto_save()
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:
$accessor->auto_save(1);
$flag = $accessor->auto_save;
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Iterator>, L<Ace::Model>
Ace/Model.pm view on Meta::CPAN
$VERSION = '1.51';
my $TAG = '\b\w+\b';
my $KEYWORD = q[^(XREF|UNIQUE|ANY|FREE|REPEAT|Int|Text|Float|DateType)$];
my $METAWORD = q[^(XREF|UNIQUE|ANY|FREE|REPEAT|Int|Text|Float|DateType)$];
# construct a new Ace::Model
sub new {
my $class = shift;
my ($data,$db,$break_cycle) = @_;
$break_cycle ||= {};
$data=~s!\s+//.*$!!gm; # remove all comments
$data=~s!\0!!g;
my ($name) = $data =~ /\A[\?\#](\w+)/;
my $self = bless {
name => $name,
raw => $data,
submodels => [],
},$class;
if (!$break_cycle->{$name} && $db && (my @hashes = grep {$_ ne $name} $data =~ /\#(\S+)/g)) {
$break_cycle->{$name}++;
my %seen;
my @submodels = map {$db->model($_,$break_cycle)} grep {!$seen{$_}++} @hashes;
$self->{submodels} = \@submodels;
}
return $self;
}
sub name {
Ace/Model.pm view on Meta::CPAN
$name = $model->name;
@tags = $model->tags;
print "Paper is a valid tag" if $model->valid_tag('Paper');
=head1 DESCRIPTION
This class is provided for access to AceDB class models. It provides
the model in human-readable form, and does some limited but useful
parsing on your behalf.
Ace::Model objects are obtained either by calling an Ace database
handle's model() method to retrieve the model of a named class, or by
calling an Ace::Object's model() method to retrieve the object's
particular model.
=head1 METHODS
=head2 new()
$model = Ace::Model->new($model_data);
This is a constructor intended only for use by Ace and Ace::Object
classes. It constructs a new Ace::Model object from the raw string
data in models.wrm.
=head2 name()
$name = $model->name;
This returns the class name for the model.
=head2 tags()
@tags = $model->tags;
Ace/Model.pm view on Meta::CPAN
$boolean = $model->valid_tag($tag);
This returns true if the given tag is part of the model.
=head2 path()
@path = $model->path($tag)
Returns the path to the indicated tag, returning a list of intermediate tags.
For example, in the C elegans ?Locus model, the path for 'Compelementation_data"
will return the list ('Type','Gene').
=head2 asString()
print $model->asString;
asString() returns the human-readable representation of the model with
comments stripped out. Internally this method is called to
automatically convert the model into a string when appropriate. You
need only to start performing string operations on the model object in
Ace/Object.pm view on Meta::CPAN
: $self->{'class'};
}
################### name and class together #################
sub id {
my $self = shift;
return "$self->{class}:$self->{name}";
}
############## return true if two objects are equivalent ##################
# to be equivalent, they must have identical names, classes and databases #
# We handle comparisons between objects and numbers ourselves, and let #
# Perl handle comparisons between objects and strings #
sub eq {
my ($a,$b,$rev) = @_;
unless (UNIVERSAL::isa($b,'Ace::Object')) {
$a = $a->name + 0; # convert to numeric
return $a == $b; # do a numeric comparison
}
return 1 if ($a->name eq $b->name)
&& ($a->class eq $b->class)
Ace/Object.pm view on Meta::CPAN
sub ne {
return !&eq;
}
############ returns true if this is a top-level object #######
sub isRoot {
return exists shift()->{'.root'};
}
################### handle to ace database #################
sub db {
my $self = shift;
if (@_) {
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 ###
Ace/Object.pm view on Meta::CPAN
$self->{'.dirty'} = shift if @_ && $self->isRoot;
$self->{'.dirty'};
}
#### return true if tree is populated, without populating it #####
sub filled {
my $self = shift;
return exists($self->{'.right'}) || exists($self->{'.raw'});
}
#### return true if you can follow the object in the database (i.e. a class ###
sub isPickable {
return shift->isObject;
}
#### Return a string representation of the object subject to Ace escaping rules ###
sub escape {
my $self = shift;
my $name = $self->name;
my $needs_escaping = $name=~/[^\w.-]/ || $self->isClass;
return $name unless $needs_escaping;
Ace/Object.pm view on Meta::CPAN
$self->_parse;
return $self->{'.down'} unless defined $pos;
my $node = $self;
while ($pos--) {
defined($node = $node->down) || return;
}
$node;
}
#############################################
# fetch current node from the database #
sub fetch {
my ($self,$tag) = @_;
return $self->search($tag) if defined $tag;
my $thing_to_pick = ($self->isTag and defined($self->right)) ? $self->right : $self;
return $thing_to_pick unless $thing_to_pick->isObject;
my $obj = $self->db->get($thing_to_pick->class,$thing_to_pick->name) if $self->db;
return $obj;
}
#############################################
# follow a tag into the database, returning a
# list of followed objects.
sub follow {
my $self = shift;
my ($tag,$filled) = rearrange(['TAG','FILLED'],@_);
return unless $self->db;
return $self->fetch() unless $tag;
my $class = $self->class;
my $name = Ace->freeprotect($self->name);
my @options;
if ($filled) {
@options = $filled =~ /^[a-zA-Z]/ ? ('filltag' => $filled) : ('filled'=>1);
}
return $self->db->fetch(-query=>"find $class $name ; follow $tag",@options);
}
# returns true if the object has a Model, i.e, can be followed into
# the database.
sub isObject {
my $self = shift;
return _isObject($self->class);
1;
}
# returns true if the object is a tag.
sub isTag {
my $self = shift;
return 1 if $self->class eq 'tag';
Ace/Object.pm view on Meta::CPAN
}
### 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
# Turn into a toplevel object
$newobj{'.root'}++;
return bless \%newobj,$pack;
}
sub _fill {
my $self = shift;
return if $self->filled;
return unless $self->db && $self->isObject;
my $data = $self->db->pick($self->class,$self->name);
return unless $data;
# temporary object, don't cache it.
my $new = $self->newFromText($data,$self->db);
%{$self}=%{$new};
$new->{'.nocache'}++; # this line prevents the thing from being cached
$self->_dirty(1);
}
sub _parse {
my $self = shift;
return unless my $raw = $self->{'.raw'};
Ace/Object.pm view on Meta::CPAN
my $o = $self->right;
while ($o) {
return ($o->right($pos),$p,$self) if (lc($o) eq lc($tag));
$p = $o;
$o = $o->down;
}
return;
}
# Used to munge special data types. Right now dates are the
# only examples.
sub _ace_format {
my $self = shift;
my ($class,$name) = @_;
return undef unless defined $class && defined $name;
return $class eq 'date' ? $self->_to_ace_date($name) : $name;
}
# It's an object unless it is one of these things
sub _isObject {
Ace/Object.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Object - Manipulate Ace Data Objects
=head1 SYNOPSIS
# open database connection and get an object
use Ace;
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
$sequence = $db->fetch(Sequence => 'D12345');
# Inspect the object
$r = $sequence->at('Visible.Overlap_Right');
@row = $sequence->row;
@col = $sequence->col;
@tags = $sequence->tags;
# Explore object substructure
@more_tags = $sequence->at('Visible')->tags;
@col = $sequence->at("Visible.$more_tags[1]")->col;
# Follow a pointer into database
$r = $sequence->at('Visible.Overlap_Right')->fetch;
$next = $r->at('Visible.Overlap_left')->fetch;
# Classy way to do the same thing
$r = $sequence->Overlap_right;
$next = $sequence->Overlap_left;
# Pretty-print object
print $sequence->asString;
print $sequence->asTabs;
Ace/Object.pm view on Meta::CPAN
# 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
into various types of text representation. You can also fetch a
representation of any object as a GIF image.
If you have write access to the databases, add new data to an object,
replace existing data, or kill it entirely. You can also create a new
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
Ace/Object.pm view on Meta::CPAN
such as the multiple papers written by the Author.
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
$object = new Ace::Object($class,$name,$database);
$object = new Ace::Object(-class=>$class,
-name=>$name,
-db=>database);
You can create a new Ace::Object from scratch by calling the new()
routine with the object's class, its identifier and a handle to the
database to create it in. The object won't actually be created in the
database until you add() one or more tags to it and commit() it (see
below). If you do not provide a database handle, the object will be
created in memory only.
Arguments can be passed positionally, or as named parameters, as shown
above.
This routine is usually used internally. See also add_row(),
add_tree(), delete() and replace() for ways to manipulate this object.
=head2 name() method
Ace/Object.pm view on Meta::CPAN
$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
may also be a user-constructed type such as Sequence, Clone or
Author. These user-constructed types usually have an initial capital
letter.
=head2 db() method
$db = $object->db();
Return the database that the object is associated with.
=head2 isClass() method
$bool = $object->isClass();
Returns true if the object is a class (can be fetched from the
database).
=head2 isTag() method
$bool = $object->isTag();
Returns true if the object is a tag.
=head2 tags() method
@tags = $object->tags();
Ace/Object.pm view on Meta::CPAN
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.
=head2 at() method
$subtree = $object->at($tag_path);
@values = $object->at($tag_path);
at() is a simple way to fetch the portion of the tree that you are
interested in. It takes a single argument, a simple tag or a path. A
Ace/Object.pm view on Meta::CPAN
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
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
Ace/Object.pm view on Meta::CPAN
=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
contents.
Unlike get(), this method will B<always step into objects>. This
means that:
$map = $clone->Map;
Ace/Object.pm view on Meta::CPAN
@papers = $author->Paper;
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');
Ace/Object.pm view on Meta::CPAN
versions, calling an autogenerated method in a scalar context returned
the subtree rooted at the tag. In the current version, an implicit
right() and dereference is performed.
=head2 fetch() method
$new_object = $object->fetch;
$new_object = $object->fetch($tag);
Follow object into the database, returning a new object. This is
the best way to follow object references. For example:
$laboratory = $object->at('Laboratory')->fetch;
print $laboratory->asString;
Because the previous example is a frequent idiom, the optional $tag
argument allows you to combine the two operations into a single one:
$laboratory = $object->fetch('Laboratory');
=head2 follow() method
@papers = $object->follow('Paper');
@filled_papers = $object->follow(-tag=>'Paper',-filled=>1);
@filled_papers = $object->follow(-tag=>'Paper',-filled=>'Author');
The follow() method will follow a tag into the database, dereferencing
the column to its right and returning the objects resulting from this
operation. Beware! If you follow a tag that points to an object,
such as the Author "Paper" tag, you will get a list of all the Paper
objects. If you follow a tag that points to a scalar, such as
"Full_name", you will get an empty string. In a scalar context, this
method will return the number of objects that would have been
followed.
The full named-argument form of this call accepts the arguments
B<-tag> (mandatory) and B<-filled> (optional). The former points to
the tag to follow. The latter accepts a boolean argument or the name
of a subtag. A numeric true argument will return completely "filled"
objects, increasing network and memory usage, but possibly boosting
performance if you have a high database access latency.
Alternatively, you may provide the name of a tag to follow, in which
case just the named portion of the subtree in the followed objects
will be filled (v.g.)
For backward compatability, if follow() is called without any
arguments, it will act like fetch().
=head2 pick() method
Deprecated method. This has the same semantics as fetch(), which
Ace/Object.pm view on Meta::CPAN
Use whatever syntax is most comfortable for you.
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'):
Ace/Object.pm view on Meta::CPAN
The option B<-coords> argument allows you to provide the top and
bottom of the display for MAP objects only. These coordinates are in
the map's native coordinate system (cM, bp). By default, AceDB will
show most (but not necessarily all) of the map according to xace's
display rules. If you call this method with the B<-getcoords>
argument and a true value, it will return a two-element array
containing the coordinates of the top and bottom of the map.
asGIF() returns a two-element array. The first element is the GIF
data. The second element is an array reference that indicates special
areas of the image called "boxes." Boxes are rectangular areas that
surround buttons, and certain displayed objects. Using the contents
of the boxes array, you can turn the GIF image into a client-side
image map. Unfortunately, not everything that is clickable is
represented as a box. You still have to pass clicks on unknown image
areas back to the server for processing.
Each box in the array is a hash reference containing the following
keys:
'coordinates' => [$left,$top,$right,$bottom]
'class' => object class or "BUTTON"
'name' => object name, if any
'comment' => a text comment of some sort
I<coordinates> points to an array of points indicating the top-left and
bottom-right corners of the rectangle. I<class> indicates the class
of the object this rectangle surrounds. It may be a database object,
or the special word "BUTTON" for one of the display action buttons.
I<name> indicates the name of the object or the button. I<comment> is
some piece of information about the object in question. You can
display it in the status bar of the browser or in a popup window if
your browser provides that facility.
=head2 asDNA() and asPeptide() methods
$dna = $object->asDNA();
$peptide = $object->asPeptide();
Ace/Object.pm view on Meta::CPAN
will return strings corresponding to the DNA or peptide sequence in
FASTA format.
=head2 add_row() method
$result_code = $object->add_row($tag=>$value);
$result_code = $object->add_row($tag=>[list,of,values]);
$result_code = $object->add(-path=>$tag,
-value=>$value);
add_row() updates the tree by adding data to the indicated tag path. The
example given below adds the value "555-1212" to a new Address entry
named "Pager". You may call add_row() a second time to add a new value
under this tag, creating multi-valued entries.
$object->add_row('Address.Pager'=>'555-1212');
You may provide a list of values to add an entire row of data. For
example:
$sequence->add_row('Assembly_tags'=>['Finished Left',38949,38952,'AC3']);
Actually, the array reference is not entirely necessary, and if you
prefer you can use this more concise notation:
$sequence->add_row('Assembly_tags','Finished Left',38949,38952,'AC3');
No check is done against the database model for the correct data type
or tag path. The update isn't actually performed until you call
commit(), at which time a result code indicates whether the database
update was successful.
You may create objects that reference other objects this way:
$lab = new Ace::Object('Laboratory','LM',$db);
$lab->add_row('Full_name','The Laboratory of Medicine');
$lab->add_row('City','Cincinatti');
$lab->add_row('Country','USA');
$author = new Ace::Object('Author','Smith J',$db);
Ace/Object.pm view on Meta::CPAN
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);
The add_tree() method will insert an entire Ace subtree into the object
to the right of the indicated tag. This can be used to build up
complex Ace objects, or to copy portions of objects from one database
to another. The first argument is a tag path, and the second is the
tree that you wish to insert. As with add_row() the database will
only be updated when you call commit().
When inserting a subtree, you must be careful to remember that
everything to the *right* of the node that you are pointing at will be
inserted; not the node itself. For example, given this Sequence
object:
Sequence AC3
DB_info Database EMBL
Assembly_tags Finished Left 1 4 AC3
Clone left end 1 4 AC3
Clone right end 5512 5515 K07C5
38949 38952 AC3
Finished Right 38949 38952 AC3
If we use at('Assembly_tags') to fetch the subtree rooted on the
"Assembly_tags" tag, it is the tree to the right of this tag,
beginning with "Finished Left", that will be inserted.
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;
Ace/Object.pm view on Meta::CPAN
$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:
$object->delete('Address.Mail','FRANCE');
No actual database deletion occurs until you call commit(). The
delete() result code indicates whether the deletion was successful.
Currently it is always true, since the database model is not checked.
=head2 replace() method
$result_code = $object->replace($tag_path,$oldvalue,$newvalue);
$result_code = $object->replace(-path=>$tag_path,
-old=>$oldvalue,
-new=>$newvalue);
Replaces the indicated tag and value with the new value. This example
changes the address line "FRANCE" to "LANGUEDOC" in the Author's
mailing address:
$object->delete('Address.Mail','FRANCE','LANGUEDOC');
No actual database changes occur until you call commit(). The
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
database while you were working with it, you will see this version,
ot the one you originally fetched.
If you are creating an entirely new object, you I<must> add at least
one tag in order to enter the object into the database.
=head2 kill() method
$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');
Note that the text representation of the date will change for all
objects returned from this database, not just the current one.
=head2 isRoot() method
print "Top level object" if $object->isRoot;
This method will return true if the object is a "top level" object,
that is the root of an object tree rather than a subtree.
=head2 model() method
Ace/Object.pm view on Meta::CPAN
This method will return the object's model as an Ace::Model object, or
undef if the object does not have a model. See L<Ace::Model> for
details.
=head2 timestamp() method
$stamp = $object->timestamp;
The B<timestamp()> method will retrieve the modification time and date
from the object. This works both with top level objects and with
subtrees. Timestamp handling must be turned on in the database, or
B<timestamp()> will return undef.
The returned timestamp is actually a UserSession object which can be
printed and explored like any other object. However, there is
currently no useful information in UserSession other than its name.
=head2 comment() method
$comment = $object->comment;
Ace/Object.pm view on Meta::CPAN
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;
Ace/Object.pm view on Meta::CPAN
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) =
Ace/Object.pm view on Meta::CPAN
my $current = $self->right;
my @tags;
while (defined($current)) {
push(@tags,$current);
$current = $current->down;
}
return @tags;
}
################# kill an object ################
# Removes the object from the database immediately.
sub kill {
my $self = shift;
return unless my $db = $self->db;
return 1 unless $db->count($self->class,$self->name);
my $result = $db->raw_query("kill");
if (defined($result) and $result=~/write access/im) { # this keeps changing
$Ace::Error = "Write access denied";
return;
}
# uncache cached values and clear the object out
Ace/Object.pm view on Meta::CPAN
$p->{'.right'} = $values[0];
}
push(@{$self->{'.update'}},join(' ',map { Ace->freeprotect($_) } (@tags,@values)));
delete $self->{'.PATHS'}; # uncache cached values
$self->_dirty(1);
1;
}
# Use this method to add an entire subobject to the right of the tag.
# The tree may come from another database.
sub add_tree {
my $self = shift;
my($tag,$value,@rest) = rearrange([['TAG','PATH'],['VALUE','TREE']],@_);
croak "Value must be an Ace::Object" unless ref($value) && $value->isa('Ace::Object');
unless ($tag =~ /\./) {
my $model = $self->model;
my @intermediate_tags = $model->path($tag);
$tag = join '.',@intermediate_tags,$tag;
}
Ace/Object.pm view on Meta::CPAN
my $self = shift;
my($tag,$oldvalue,$newvalue,@rest) = rearrange([['TAG','PATH'],
['OLDVALUE','OLD'],
['NEWVALUE','NEW']],@_);
$self->delete($tag,$oldvalue);
$self->add($tag,$newvalue,@rest);
delete $self->{'.PATHS'}; # uncache cached values
1;
}
# commit changes from local copy to database copy
sub commit {
my $self = shift;
return unless my $db = $self->db;
my ($retval,@cmd);
my $name = $self->{'name'};
return unless defined $name;
$name =~ s/([^a-zA-Z0-9_-])/\\$1/g;
return 1 unless exists $self->{'.update'} && $self->{'.update'};
Ace/Object.pm view on Meta::CPAN
# and synchronize our in-memory copy with the db
delete $self->{'.right'};
delete $self->{'.PATHS'};
return 1;
}
# undo changes
sub rollback {
my $self = shift;
undef $self->{'.update'};
# this will force object to be reloaded from database
# next time it is needed.
delete $self->{'.right'};
delete $self->{'.PATHS'};
1;
}
sub debug {
my $self = shift;
Ace->debug(@_);
}
### Get or set the date style (actually calls through to the database object) ###
sub date_style {
my $self = shift;
return unless $self->db;
return $self->db->date_style(@_);
}
sub _asHTML {
my($self,$out,$position,$level,$morph_code) = @_;
do {
$$out .= "<TR ALIGN=LEFT VALIGN=TOP>" unless $position;
Ace/Object.pm view on Meta::CPAN
} while defined $self;
return --$level;
}
# This function is overly long because it is optimized to prevent parsing
# parts of the tree that haven't previously been parsed.
sub _asTable {
my($self,$out,$position,$level) = @_;
do {
if ($self->{'.raw'}) { # we still have raw data, so we can optimize
my ($a,$start,$end) = @{$self}{ qw(.col .start_row .end_row) };
my @to_append = map { join("\t",@{$_}[$a..$#{$_}]) } @{$self->{'.raw'}}[$start..$end];
my $new_row;
foreach (@to_append) {
# hack alert
s/(\?.*?[^\\]\?.*?[^\\]\?)\S*/$self->_ace_format(Ace->split($1))/eg;
if ($new_row++) {
$$out .= "\n";
$$out .= "\t" x ($level-1)
}
Ace/Object.pm view on Meta::CPAN
$string = "<B>$self</B>";
} elsif ($self->isComment) {
$string = "<I>$self</I>";
} else {
$string = qq{<FONT COLOR="blue">$self</FONT>} ;
}
return ($string,$prune);
}
# Insert a new tag or value.
# Local only. Will not affect the database.
# Returns the inserted tag, or the preexisting
# tag, if already there.
sub _insert {
my ($self,$tag) = @_;
my $p = $self->{'.right'};
return $self->{'.right'} = $self->new('tag',$tag)
unless $p;
while ($p) {
return $p if "$p" eq $tag;
last unless $p->{'.down'};
Ace/Sequence.pm view on Meta::CPAN
'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);
# 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
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
Ace/Sequence.pm view on Meta::CPAN
sub type { 'Sequence' }
sub subtype { }
sub debug {
my $self = shift;
my $d = $self->{_debug};
$self->{_debug} = shift if @_;
$d;
}
# return the database this sequence is associated with
sub db {
return Ace->name2db($_[0]->{db} ||= $_[0]->source->db);
}
sub start {
my ($self,$abs) = @_;
$abs = $self->absolute unless defined $abs;
return $self->{p_offset} + $self->{offset} + 1 if $abs;
if ($self->refseq) {
Ace/Sequence.pm view on Meta::CPAN
}
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);
Ace/Sequence.pm view on Meta::CPAN
}
1;
=head1 NAME
Ace::Sequence - Examine ACeDB Sequence Objects
=head1 SYNOPSIS
# open database connection and get an Ace::Object sequence
use Ace::Sequence;
$db = Ace->connect(-host => 'stein.cshl.org',-port => 200005);
$obj = $db->fetch(Predicted_gene => 'ZK154.3');
# Wrap it in an Ace::Sequence object
$seq = Ace::Sequence->new($obj);
# Find all the exons
@exons = $seq->features('exon');
Ace/Sequence.pm view on Meta::CPAN
I<Ace::Sequence>, and its allied classes L<Ace::Sequence::Feature> and
L<Ace::Sequence::FeatureList>, provide a convenient interface to the
ACeDB Sequence classes and the GFF sequence feature file format.
Using this class, you can define a region of the genome by using a
landmark (sequenced clone, link, superlink, predicted gene), an offset
from that landmark, and a distance. Offsets and distances can be
positive or negative. This will return an I<Ace::Sequence> object.
Once a region is defined, you may retrieve its DNA sequence, or query
the database for any features that may be contained within this
region. Features can be returned as objects (using the
I<Ace::Sequence::Feature> class), as GFF text-only dumps, or in the
form of the GFF class defined by the Sanger Centre's GFF.pm module.
This class builds on top of L<Ace> and L<Ace::Object>. Please see
their manual pages before consulting this one.
=head1 Creating New Ace::Sequence Objects, the new() Method
$seq = Ace::Sequence->new($object);
Ace/Sequence.pm view on Meta::CPAN
-length => $length,
-refseq => $reference_sequence);
$seq = Ace::Sequence->new(-name => $name,
-db => $db,
-offset => $offset,
-length => $length,
-refseq => $reference_sequence);
In order to create an I<Ace::Sequence> you will need an active I<Ace>
database accessor. Sequence regions are defined using a "source"
sequence, an offset, and a length. Optionally, you may also provide a
"reference sequence" to establish the coordinate system for all
inquiries. Sequences may be generated from existing I<Ace::Object>
sequence objects, from other I<Ace::Sequence> and
I<Ace::Sequence::Feature> objects, or from a sequence name and a
database handle.
The class method named new() is the interface to these facilities. In
its simplest, one-argument form, you provide new() with a
previously-created I<Ace::Object> that points to Sequence or
sequence-like object (the meaning of "sequence-like" is explained in
more detail below.) The new() method will return an I<Ace::Sequence>
object extending from the beginning of the object through to its
natural end.
In the named-parameter form of new(), the following arguments are
Ace/Sequence.pm view on Meta::CPAN
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>.
The I<Ace::Sequence> module will use the provided database accessor to
fetch a Sequence object with the specified name. new() will return
undef is no Sequence by this name is known.
=item -db
This argument is required if the source sequence is specified by name
rather than by object reference.
=back
Ace/Sequence.pm view on Meta::CPAN
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
for "sequence-like" objects that contain the C<SMap> ("Sequence Map")
tag. The C<SMap> tag provides genomic location information for
arbitrary object -- not just those descended from the Sequence class.
This allows ACeDB to perform genome map operations on objects that are
not directly related to sequences, such as genetic loci that have been
interpolated onto the physical map. When an C<SMap>-containing object
is passed to the I<Ace::Sequence> new() method, the module will again
Ace/Sequence.pm view on Meta::CPAN
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
subtag using a tag[2] syntax, and may include Predicted_genes,
Sequences, Links, or other objects. The return value is a list of
I<Ace::Sequence> objects.
=head2 features()
@features = $seq->features;
@features = $seq->features('exon','intron','Predicted_gene');
@features = $seq->features('exon:GeneFinder','Predicted_gene:hand.*');
Ace/Sequence.pm view on Meta::CPAN
merged together by the features() call. If true (the default), then
the left and right end of clones will be merged into "clone" features,
introns, exons and CDS entries will be merged into
Ace::Sequence::Transcript objects, and similarity entries will be
merged into Ace::Sequence::GappedAlignment objects.
=head2 db()
$db = $seq->db;
Returns the L<Ace> database accessor associated with this sequence.
=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>
Ace/Sequence/Feature.pm view on Meta::CPAN
sub method { shift->_field('method',@_) } # ... I prefer "method"
sub subtype { shift->_field('method',@_) } # ... or even "subtype"
sub type { shift->_field('type',@_) } # ... I prefer "type"
sub score { shift->_field('score',@_) } # float indicating some sort of score
sub frame { shift->_field('frame',@_) } # one of 1, 2, 3 or undef
sub info { # returns Ace::Object(s) with info about the feature
my $self = shift;
unless ($self->{group}) {
my $info = $self->{info}{group} || 'Method "'.$self->method.'"';
$info =~ s/(\"[^\"]*);([^\"]*\")/$1$;$2/g;
my @data = split(/\s*;\s*/,$info);
foreach (@data) { s/$;/;/g }
$self->{group} = [map {$self->toAce($_)} @data];
}
return wantarray ? @{$self->{group}} : $self->{group}->[0];
}
# bioperl compatibility
sub primary_tag { shift->type(@_) }
sub source_tag { shift->subtype(@_) }
sub db { # database identifier (from Ace::Sequence::Multi)
my $self = shift;
my $db = $self->_field('db',@_);
return $db || $self->SUPER::db;
}
sub group { $_[0]->info; }
sub target { $_[0]->info; }
sub asString {
my $self = shift;
Ace/Sequence/Feature.pm view on Meta::CPAN
my ($tag,@values) = $thing=~/(\"[^\"]+?\"|\S+)/g;
foreach (@values) { # strip the damn quotes
s/^\"(.*)\"$/$1/; # get rid of leading and trailing quotes
}
return $self->tag2ace($tag,@values);
}
# synthesize an artificial Ace object based on the tag
sub tag2ace {
my $self = shift;
my ($tag,@data) = @_;
# Special cases, hardcoded in Ace GFF code...
my $db = $self->db;;
my $class = $db->class;
# for Notes we just return a text, no database associated
return $class->new(Text=>$data[0]) if $tag eq 'Note';
# for homols, we create the indicated Protein or Sequence object
# then generate a bogus Homology object (for future compatability??)
if ($tag eq 'Target') {
my ($objname,$start,$end) = @data;
my ($classe,$name) = $objname =~ /^(\w+):(.+)/;
return Ace::Sequence::Homol->new_homol($classe,$name,$db,$start,$end);
}
# General case:
my $obj = $class->new($tag=>$data[0],$self->db);
return $obj if defined $obj;
# Last resort, return a Text
return $class->new(Text=>$data[0]);
}
sub sub_SeqFeature {
return wantarray ? () : 0;
}
1;
=head1 NAME
Ace::Sequence::Feature - Examine Sequence Feature Tables
=head1 SYNOPSIS
# open database connection and get an Ace::Object sequence
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the homologies (a list of Ace::Sequence::Feature objs)
@homol = $seq->features('Similarity');
Ace/Sequence/Feature.pm view on Meta::CPAN
note A Text object containing the note.
similarity An Ace::Sequence::Homology object containing
the target and its start/stop positions.
intron An Ace::Object containing the gene from
exon which the feature is derived.
misc_feature
other A Text object containing the group data.
=item asString()
$label = $feature->asString;
Returns a human-readable identifier describing the nature of the
feature. The format is:
$type:$name/$start-$end
Ace/Sequence/GappedAlignment.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Sequence::GappedAlignment - Gapped alignment object
=head1 SYNOPSIS
# open database connection and get an Ace::Sequence object
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the gapped alignments
@alignments = $seq->alignments('EST_GENOME');
Ace/Sequence/Gene.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Sequence::Gene - Simple "Gene" Object
=head1 SYNOPSIS
# open database connection and get an Ace::Object sequence
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the genes
@genes = $seq->genes;
Ace/Sequence/Multi.pm view on Meta::CPAN
my $opt = $self->_feature_filter($features);
for my $db ($self->secondary) {
my $supplement = $self->_gff($opt,$db);
$self->transformGFF(\$supplement) unless $abs;
my $string = $db->asString;
foreach (grep !$seen{$_}++,split("\n",$supplement)) { #ignore duplicates
next if m!^(//|\#)!; # ignore comments
push(@lines, join "\t",$_,$string); # add database as an eighth field
}
}
return join("\n",@lines,'');
}
# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
my $self = shift;
my ($gff,$filter) = @_;
Ace/Sequence/Multi.pm view on Meta::CPAN
__END__
=head1 NAME
Ace::Sequence::Multi - Combine Feature Tables from Multiple Databases
=head1 SYNOPSIS
use Ace::Sequence::Multi;
# open reference database
$ref = Ace->connect(-host=>'stein.cshl.org',-port=>200009);
# open some secondary databases
$db1 = Ace->connect(-host=>'stein.cshl.org',-port=>200010);
$db2 = Ace->connect(-path=>'/usr/local/acedb/mydata');
# Make an Ace::Sequence::Multi object
$seq = Ace::Sequence::Multi->new(-name => 'CHROMOSOME_I,
-db => $ref,
-offset => 3_000_000,
-length => 1_000_000);
# add the secondary databases
$seq->add_secondary($db1,$db2);
# get all the homologies (a list of Ace::Sequence::Feature objs)
@homol = $seq->features('Similarity');
# Get information about the first one -- goes to the correct db
$feature = $homol[0];
$type = $feature->type;
$subtype = $feature->subtype;
$start = $feature->start;
Ace/Sequence/Multi.pm view on Meta::CPAN
# 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).
Ace/Sequence/Multi.pm view on Meta::CPAN
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>.
The I<Ace::Sequence> module will use the provided database accessor to
fetch a Sequence object with the specified name. new() will return
undef is no Sequence by this name is known.
=item -db
This argument is required if the source sequence is specified by name
rather than by object reference. It must be a previously opened
handle to the reference database.
=item -secondary
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()
@databases = $seq->secondary;
Return a list of the secondary databases currently in use, or an empty
list if none.
=item add_secondary()
$seq->add_secondary($db1,$db2,...)
Add one or more secondary databases to the list of annotation
databases. Duplicate databases will be silently ignored.
=item delete_secondary()
$seq->delete_secondary($db1,$db2,...)
Delete one or more secondary databases from the list of annotation
databases. Databases not already in use will be silently ignored.
=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
Ace/Sequence/Transcript.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Sequence::Transcript - Simple "Gene" Object
=head1 SYNOPSIS
# open database connection and get an Ace::Object sequence
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the transcripts
@genes = $seq->transcripts;
Ace/SocketServer.pm view on Meta::CPAN
$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;
to return fewer than the correct number of objects (approximately 0.2% loss).
1.54 2/10/99
1. Fixed spin-loop (polling) bug in Ace::Local. Should no longer
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
3. search() now takes an optional numeric argument indicating how
far to the right in the tree to go before retrieving the column.
Specifically, search($tag,2) implements tag[2] semantics.
4. automatically-generated methods (such as Homol) now take an optional
numeric argument that is passed to search. $obj->Homol(2) implements
tag[2] semantics.
5. fetch() now takes an optional tag argument which will be followed
prior to fetching from the database. $obj->fetch('Laboratory') will
return the Laboratory object.
6. tace can be used to access local databases, by passing a -path
argument to the Ace::connect() method.
7. dates are displayed in Java style (3 March 1998 hh:mm:ss) by
default. This can be altered with a call to Ace::date_style().
8. Default port has changed to 23456
1.34 5/20/98 Fixed bug in Ace.xs caused by 1.33 change! Only some objects
were retrieved by fetch().
GFF/Filehandle.pm view on Meta::CPAN
# this is a dumb trick to work around GFF.pm's current inability to
# take data from memory. It makes the in-memory data look like a filehandle.
package GFF::Filehandle;
sub TIEHANDLE {
my ($package,$datalines) = @_;
return bless $datalines,$package;
}
sub READLINE {
my $self = shift;
return shift @$self;
}
1;
examples/upstream2.pl
install.PLS
make_docs.PLS
t/basic.t
t/object.t
t/sequence.t
t/update.t
typemap
util/install.PLS
util/ace.PLS
META.yml Module meta-data (added by MakeMaker)
Makefile.PL view on Meta::CPAN
use Config;
use ExtUtils::MakeMaker qw(prompt WriteMakefile);
use File::Path;
require 5.8.0;
my $choice;
while (!$choice) {
$reply = prompt(
"\nWhat do you want to build?\n\n" .
" 1) Interface to Ace socket server and local databases (pure Perl)\n" .
" 2) The above plus XS optimizations (requires C compiler)\n" .
" 3) The above plus RPC server interface (requires C compiler)\n\n" .
"Enter your choice: ", "1");
if ($reply =~ /(\d+)/) {
$choice = $1;
die "invalid choice: $choice!" if $choice < 1 || $choice > 3;
}
}
$choice ||= 1; # safe default
Makefile.PL view on Meta::CPAN
=head1 SYNOPSIS
use Ace::Browser::LocalSiteDefs qw($SITE_DEFS $HTML_PATH $CGI_PATH);
=head1 DESCRIPTION
This file, which is created at install time, defines three exportable
variables:
$SITE_DEFS Location of the directory that hold's AceBrowser's database-specific
configuration files, e.g. /usr/local/apache/conf/ace/
$HTML_PATH Location of AceBrowser's HTML files and images, e.g. ~www/htdocs/ace/
$CGI_PATH Location of AceBrowser's CGI scripts, e.g. ~www/cgi-bin/ace/
=head1 SEE ALSO
L<Ace>
This is version 1.86 of AcePerl, a Perl interface for the ACEDB
object-oriented database. Designed specifically for use in genome
sequencing projects, ACEDB provides powerful modeling and management
services for biological and laboratory data. For others, it is a good
open source introduction to the world of object-oriented databases
See the ChangeLog for important notices, including recent user
interfaces changes. Please see DISCLAIMER.txt for disclaimers of
warranty.
INSTALLATION:
In addition to this package, you will need Perl 5.00503 or higher
(5.6.0 or higher recommended), and the Digest::MD5 module. Both are
available on CPAN (http://www.cpan.org).
If you are using AcePerl to communicate with WormBase, a public server
is running on host aceserver.cshl.org, port 2005. You can open a
connection to this server like this:
$db = Ace->connect('sace://aceserver.cshl.org:2005');
Otherwise, if you wish to communicate with your own ACEDB database,
you must use ACEDB version 4.8a or higher, available from this
location:
ftp://ncbi.nlm.nih.gov/repository/acedb/
To take full advantage of the sequence annotation features in the
Ace::Sequence and Ace::Sequence::Feature classes, you will need
version 4.9r or higher.
If you wish to use AcePerl in a client-server fashion, you must get
2. cd AcePerl-X.XX
3. perl Makefile.PL
This script will ask you whether you wish to build: (1) the minimal package
with support only for newer (socket) versions of the Ace server, (3) the maximum
package, which supports both older (RPC) and newer (socket) versions of the
Ace server, or (2) a version that supports the socket server and has some C
language optimizations. Choice (3) is recommended. All versions will support
local Acedb databases.
The script will also ask you whether you wish to install support for the
AceBrowser Web server extensions. Only answer yes if you are installing
on a machine that already runs a web server and you wish to have AceBrowser
installed. If you answer in the affirmative, then you will be asked a number
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
that it works correctly for the next person who tries it.
4. make
This will build the ACEDB client library, libaceperl.a, in the ace
subdirectory. It will then link in the Perl client subs.
5. make test (optional)
You may "make test" to test the system. It will attempt to open a
connection to a database at beta.crbm.cnrs-mop.fr:20000100. You may
change these defaults by setting the environment variables ACEDB_HOST
and ACEDB_PORT, or by defining them on the command line, as in:
make test ACEDB_HOST=localhost ACEDB_PORT=200005
However, since some of the tests are dependent on specific values in
the database, this may cause some tests to fail. Do not be alarmed if
a handful of tests fail. Do be alarmed if all of the tests fail.
6. make install
This will install AcePerl into your perl5 library directory.
You may need to be root (superuser) in order to "make install". This
is because Perl will want to install the newly-built files into its
library tree, /usr/local/lib/perl5/site_perl (or something similar),
and this tree is usually not writable by mere mortals. Do not
want to define PERL5LIB to be the location of the machine-specific
build directory. For example:
setenv PERL5LIB $HOME/ace/bin.LINUX_4_OPT
Or you could reinstall AcePerl in the main Perl library tree just by
entering the wperl/ subdirectory, and rerunning "perl Makefile.PL"
without defining INSTALLSITELIB.
See ACEDB.HOWTO in the docs/ subdirectory for instructions on
obtaining and setting up the ACeDB database. You'll find other hints
here too.
USING ACEPERL
A. Read the copious documentation
perldoc Ace
B. Review the examples
A few useful examples can be found in the "examples" subdirectory.
Among these is a script called "ace.pl", which implements a text
interface to any local or remote ace database. If you have the Perl
Term::readline module installed, it gives you command-line editing,
completion, and history.
The script "dump_cdna.pl" shows you how to dump out all spliced cDNAs
from wormbase.org. Other dump scripts show similar tricks. You can
use these as templates for doing other biologically interesting
tricks.
There is also family of CGI scripts that run on top of AcePerl to give
a WebAce-like interface to Ace (it is not as feature-full as WebAce,
README.ACEBROWSER view on Meta::CPAN
AceBrowser Version 3.1
September 20, 2001
The AcePerl distribution now includes a collection of CGI scripts that
run on top of AcePerl to provide a simple browsable interface to ACEDB
databases. Some of the code has been tuned for the C. elegans
database, but most of it is fully generic.
Demos are running at http://stein.cshl.org/elegans/.
REQUIREMENTS:
1. AcePerl 1.76 or higher (available at http://stein.cshl.org/AcePerl/)
2. Perl 5.6.0 or higher
3. CGI.pm 2.77 or higher (available at http://stein.cshl.org/WWW/software/CGI)
4. A Web server
5. sgifaceserver 4.8c or higher. For best results, use the version of
README.ACEBROWSER view on Meta::CPAN
install AceBrowser. Answer "yes."
3. You will be asked for the installation locations for several groups
of files. The answers depend on the configuration of your web server
The install script will attempt to create any directories that do not
already exist.
a. Site-specific configuration file directory
Acebrowser needs access to one or more configuration files.
Each file describes a data source and how information from
the data source is to be rendered. All configuration files
are stored in a directory at the location indicated here.
The default is /usr/local/apache/conf/ace/.
b. Acebrowser CGI script directory
The core of Acebrowser is a set of CGI scripts. This is the
directory that will contain them. Choose a directory that will
be recognized by the web server as containing CGI script. If
you are using Apache/mod_perl, select a directory under the
README.ACEBROWSER view on Meta::CPAN
Depending on the permissions of your web server directories, you may
have to be root in order to create some of these directories.
4. Run "make", "make test" and "make install" as described in the main
README. If this is successful, run "make install-browser". This will
copy the acebrowser files into the directories chosen in step (3).
Depending on the permissions of your web server directories, you may
have to be root in order to complete this step.
5. If you installed the CGI scripts in their default location, you
should now be able to search the C. elegans database by fetching the
following URL:
http://your.host/cgi-bin/ace/searches/text
You can then follow the links to browse the database. A slightly more
sophisticated search allows you to search a subset of object classes:
http://your.host/cgi-bin/ace/searches/basic
or the entire list of object classes:
http://your.host/cgi-bin/ace/searches/browser
There is also a default Acebrowser "home page" installed at the URL:
http://your.host/ace/index.html
You may have to adjust these URLs for the locations of the directories
chosen in step (3).
CONFIGURATION
Acebrowser is configured to allow access to multiple ACEDB databases.
You can customize each database extensively by changing the appearance
of pages, adding new search capabilities, and adding new displays for
particular Ace object classes.
Each database has a symbolic name, and each symbolic name corresponds
to a configuration file located in the site-specific configuration
directory. There are three databases defined in a new Acebrowser
installation:
simple An acedb database running on port 2005 of the
local host
moviedb An example database of movies running on port 200008
of stein.cshl.org
default An oldish snapshot of the C. elegans database running
on port 2005 of stein.cshl.org
To select among the data sources, append the symbolic name to the end
of the URL of the desired CGI script. For example, to do a text
search on the "moviedb" database, fetch this URL:
http://your.site/cgi-bin/ace/searches/text/moviedb
If no symbolic name is specified, the default database is assumed.
http://your.site/cgi-bin/ace/searches/text
is equivalent to
http://your.site/cgi-bin/ace/searches/text/default
As described in EXTENDING ACEBROWSER, another way to select among
databases is to place the CGI script itself in a directory with the
same name as the database. For example, if you have written a
specialized CGI script called screenplay that is designed to work with
the "moviedb" database, you could place it in a subdirectory named
moviedb, and refer to it this way:
http://your.site/cgi-bin/ace/moviedb/screenplay
The symbolic name can actually appear anywhere in the path, so this
would work as well:
http://your.site/cgi-bin/ace/moviedb/custom/screenplay
THE CONFIGURATION FILES
The configuration files are located in the directory selected for
acebrowser configuration. Their names are formed by appending ".pm"
to the symbolic name of the database. For example, the configuration
file "simple.pm" corresponds to the database "simple".
Each of the configuration files is actually an executable Perl script.
As such it can use any Perl constructions you wish, including variable
interpolation. The purpose of the configuration file is to set a
series of configuration variables, which by convention are all
uppercase. For example, here is an excerpt from the default.pm
configuration file:
$HOST = 'stein.cshl.org';
$PORT = 2005;
$USERNAME = '';
$PASSWORD = '';
In addition to scalar variables, the configuration file is used to set
arrays, hashes and specially-named functions.
If you are only interested in accessing a single database, it is
easiest to modify the default.pm configuration file. To serve
multiple databases, just make a copy of default.pm and edit the copy.
If, for some reason, Acebrowser cannot find its configuration files,
it will generate an internal server error. The location of the
configuration files directory is stored in the module
Ace::Browser::LocalSiteDefs, typically somewhere inside the
"site_perl" subdirectory of the Perl library directory (use "perl -V"
to see where that is). You can find out where Acebrowser expects to
find its configuration files by running the following command:
perl -MAce::Browser::LocalSiteDefs \
README.ACEBROWSER view on Meta::CPAN
This is where Acebrowser expects to find its icons. This subdirectory
holds icons and other small static images. Note how the
previously-defined $DOCROOT variable is used. You will probably not
need to change this.
$IMAGES = "$DOCROOT/images";
This is where Acebrowser expects to find its "images" subdirectory.
This directory contains images generated dynamically by the ACEDB
database. It *must* be writable by the web server user, usually
"nobody". When the AcePerl install script creates this directory, it
makes it world-writable by default. You may prefer to make it owned
by the "nobody" user and/or group.
$HOST = 'stein.cshl.org';
This is the name of the host where the desired acedb server can be
found.
$PORT = 2005;
This is the network port on which the desired acedb server is
listening. Network ports in the range 1024-65535 are assumed to
correspond to the newer socket-based sgifaceserver. Ports in the
range 65536-4,294,967,296 are assumed to correspond to the older
RPC-based gifaceserver.
$USERNAME = '';
$PASSWORD = '';
For password-protected ACEDB databases, these variables contain the
username and password.
$STYLESHEET = "$DOCROOT/stylesheets/aceperl.css";
This is the cascading stylesheet used to set the background color,
font, table colors, and so forth. You probably don't need to change
this, but you might want to modify the stylesheet itself.
@PICTURES = ($IMAGES => "$HTML_PATH/images");
README.ACEBROWSER view on Meta::CPAN
$ROOT = '/movies';
EXTENDING ACEBROWSER
Acedb is fundamentally object based. In addition to having a name,
each object has a class, such as "Sequence". Acebrowser takes
advantage of this object structure by allowing you to assign one or
more displays to a class. Each display is a CGI script that fetches
the desired object from the database, formats it, and displays it as
HTML or an image.
Whenever Acebrowser is called upon to display an object, it consults
the configuration file to determine what displays are registered for
the object, and then presents a row of display names across the top of
the window. In Acebrowser jargon, this line of displays is called the
"type selector." The user can change the display to use by selecting
the corresponding link.
Three generic displays, which will work with all databases, come with
Acebrowser:
tree an HTML representation of the Acedb object which
presents the object in the form of a collapsible outline.
xml an XML representation of the Acedb object
pic a clickable GIF image, as returned from gifaceserver.
#ifndef ACEPERL_H
#define ACEPERL_H
#define STATUS_WAITING 0
#define STATUS_PENDING 1
#define STATUS_ERROR -1
#define ACE_PARSE 3
typedef struct AceDB {
ace_handle* database;
unsigned char* answer;
int length;
int encoring;
int status;
int errcode;
} AceDB;
#endif
if (RETVAL == NULL) XSRETURN_UNDEF;
RETVAL->encoring = FALSE;
RETVAL->status = STATUS_WAITING;
RETVAL->answer = NULL;
RETVAL->errcode = 0;
ace = openServer(host,rpc_port,timeOut);
if (ace == NULL) {
safefree(RETVAL);
XSRETURN_UNDEF;
} else {
RETVAL->database = ace;
}
OUTPUT:
RETVAL
void
DESTROY(self)
AceDB* self
CODE:
if (self->answer != NULL)
free((void*) self->answer);
if (self->database != NULL)
closeServer(self->database);
safefree((char*)self);
ace_handle*
handle(self)
AceDB* self
CODE:
RETVAL = self->database;
OUTPUT:
RETVAL
int
encore(self)
AceDB* self
CODE:
RETVAL = self->encoring;
OUTPUT:
RETVAL
char* request
int type
PREINIT:
unsigned char* answer = NULL;
int retval,length,isWrite=0,isEncore=0;
CODE:
if (type == ACE_PARSE)
isWrite = 1;
else if (type > 0)
isEncore = 1;
retval = askServerBinary(self->database,request,
&answer,&length,&isEncore,CHUNKSIZE);
if (self->answer) {
free((void*) self->answer);
self->answer = NULL;
}
self->errcode = retval;
self->status = STATUS_WAITING;
if ((retval > 0) || (answer == NULL) ) {
self->status = STATUS_ERROR;
RETVAL = 0;
read(self)
AceDB* self
PREINIT:
unsigned char* answer = NULL;
int retval,length,encore=0;
CODE:
if (self->status != STATUS_PENDING)
XSRETURN_UNDEF;
if (self->answer == NULL && self->encoring) {
retval = askServerBinary(self->database,"encore",&answer,
&length,&encore,CHUNKSIZE);
self->errcode = retval;
self->encoring = encore;
if ((retval > 0) || (answer == NULL) ) {
self->status = STATUS_ERROR;
XSRETURN_UNDEF;
}
self->answer = answer;
self->length = length;
}
acebrowser/cgi-bin/generic/acetable view on Meta::CPAN
use Ace 1.38;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
AceInit();
$NAME = param('name');
#$PARMS = param('parms');
# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");
AceHeader();
AceError(<<END) unless $NAME ;
Call this script with URL parameters of
<VAR>name</VAR> and <VAR>parms,</VAR> where
"name" is the name of a table definition in acedb
END
display_table($NAME," ");
exit 0;
acebrowser/cgi-bin/generic/acetable view on Meta::CPAN
my ($n,$c) = (escape($name),escape($parms));
print
start_html(-Title=>"$name: $parms",
-Style=>STYLE,
-Class=>'tree',
-Bgcolor=>BGCOLOR_TREE),
h1("$name: $parms"),
&show_table($obj),
#$obj->asHTML() || strong('No more text information about this object in the database'),
FOOTER,
end_html;
}
sub show_table {
my $obj = shift;
my $dna = "$obj";
#$dna=~s/(\w{50})/$1/g;
return (pre($dna),0);
acebrowser/cgi-bin/generic/model view on Meta::CPAN
}
print_tree($model);
PrintBottom();
exit 0;
sub print_tree {
my $obj = shift;
print $obj->asHTML(\&to_href)
|| strong('No more text information about this object in the database'),"\n";
}
# this is cut-and-paste out of etree, but with simplifications
sub to_href {
my $obj = shift;
unless ($obj->isObject or $obj->isTag) {
$obj =~s/\\n/<BR>/g;
return ($obj,0);
}
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
my $b2 = $map_stop + $half;
$b2 = $max if $b2 > $max;
my $b1 = $b2 - ($map_stop - $map_start);
my $m1 = $map_start + $half/2;
my $m2 = $map_stop - $half/2;
print start_table({-border=>1});
print TR(td({-align=>'CENTER',-class=>'datatitle',-colspan=>2},'Map Control'));
print start_TR();
print td(
table({-border=>0},
TR(td(' '),
td(
$map_start > $min ?
a({-href=>"$self?name=$name;class=$class;map_start=$a1;map_stop=$a2"},
img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
:
font({-color=>'#A0A0A0'},img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
#!/usr/bin/perl
# generic tree display
# should work with any data model
use strict;
use vars qw/$DB $URL $NAME $CLASS/;
use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs qw(:DEFAULT Url);
use Ace::Browser::TreeSubs;
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
my $obj = shift;
my $name = $obj->name;
my $class = $obj->class;
my ($n,$c) = (escape($name),escape($class));
my $myimage = ($class =~ /^Picture/ ? $obj->Pick_me_to_call->right->right : 'No_Image') ;
if ($class eq 'LongText'){
print $obj->asHTML(sub { pre(shift) });
}
else{
print $obj->asHTML(\&to_href) || strong('No more text information
about this object in the database'), "\n";
}
}
sub to_href {
my $obj = shift;
unless ($obj->isObject or $obj->isTag) {
if ($obj=~/\S{50}/){ # if you have >50 chars without a space
$obj=~s/(\S{50})/$1\n/g; # add some
$obj = "<pre>$obj</pre>";# and assume preformatted (e.g. seq)
acebrowser/cgi-bin/generic/xml view on Meta::CPAN
#!/usr/bin/perl
# generic xml display
# should work with any data model
use strict;
use vars qw($DB);
use Ace 1.65;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
#!/usr/bin/perl
# -*- Mode: perl -*-
# file: feedback
# Provide feedback to data curator(s)
use strict;
use CGI 2.42 qw(:standard);
use Ace::Browser::AceSubs qw(:DEFAULT Header DB_Name);
use vars '@FEEDBACK_RECIPIENTS';
# This page called with the parameters:
# recipients- numeric index(es) for recipients of message
# name - name of object to update
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
h1($title);
}
sub print_instructions {
my @defaults;
for (my $i=0; $i<@FEEDBACK_RECIPIENTS; $i++) {
push @defaults,$i if $FEEDBACK_RECIPIENTS[$i][2];
}
print
p({-class=>'small'},
"Use this form to send new data or corrections to",
"the maintainers of this database. An e-mail message",
"will be sent to the individuals selected from the list",
"below."),
blockquote({-class=>'small'},
checkbox_group(-name => 'recipients',
-Values => [(0..$#FEEDBACK_RECIPIENTS)],
-Labels => { map {
$_=>"$FEEDBACK_RECIPIENTS[$_]->[0] ($FEEDBACK_RECIPIENTS[$_]->[1])"
} (0..$#FEEDBACK_RECIPIENTS) },
-defaults=>\@defaults,
-linebreak=>1));
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
AceError($error);
return;
}
return 1;
}
sub print_confirmation {
print
p("Thank you for taking the time to submit this information.",
"Please use the buttons below to submit more reports or to",
"return to the database.",
),
start_form,
submit(-name=>'restart',-label=>'Submit Another Report'),
hidden('referer'),
submit(-name=>'return',-label=>'Return to Database'),
end_form;
}
( run in 0.551 second using v1.01-cache-2.11-cpan-0d8aa00de5b )