AcePerl
view release on metacpan or search on metacpan
use strict;
use Carp qw(croak carp cluck);
use Scalar::Util 'weaken';
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Error $DEBUG_LEVEL);
use Data::Dumper;
use AutoLoader 'AUTOLOAD';
require Exporter;
use overload
'""' => 'asString',
'cmp' => 'cmp';
@ISA = qw(Exporter);
# Items to export into callers namespace by default.
@EXPORT = qw(STATUS_WAITING STATUS_PENDING STATUS_ERROR);
# Optional exports
@EXPORT_OK = qw(rearrange ACE_PARSE);
$VERSION = '1.92';
use constant STATUS_WAITING => 0;
use constant STATUS_PENDING => 1;
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',
);
# Preloaded methods go here.
$Error = '';
# Pseudonyms and deprecated methods.
*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;
}
sub class_for {
my $self = shift;
my ($class,$id) = @_;
my $selected_class;
if (my $selector = $self->class) {
if (ref $selector eq 'HASH') {
$selected_class = $selector->{$class} || $selector->{'_DEFAULT_'};
}
elsif ($selector->can('class_for')) {
$selected_class = $selector->class_for($class,$id,$self);
}
elsif (!ref $selector) {
$selected_class = $selector;
}
else {
croak "$selector is neither a scalar, nor a HASH, nor an object that supports the class_for() method";
}
}
$selected_class ||= 'Ace::Object';
eval "require $selected_class; 1;" || croak $@
unless $selected_class->can('new');
$selected_class;
}
sub process_url {
my $class = shift;
my $url = shift;
my ($host,$port,$user,$pass,$path,$server_type) = ('','','','','','');
if ($url) { # look for host:port
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}) {
$self->{models}{$model} =
Ace::Model->new($self->raw_query("model \"$model\""),$self,$break_cycle);
eval {$self->cache->set($key=>$self->{models}{$model})};
}
return $self->{'models'}{$model};
}
# cached get
# pass "1" for fill to get a full fill
# pass any other true value to get a tag fill
sub get {
my $self = shift;
my ($class,$name,$fill) = @_;
# look in caches first
my $obj = $self->memory_cache_fetch($class=>$name)
|| $self->file_cache_fetch($class=>$name);
return $obj if $obj;
# _acedb_get() does the caching
$obj = $self->_acedb_get($class,$name,$fill) or return;
$obj;
}
sub _acedb_get {
my $self = shift;
my ($class,$name,$filltag) = @_;
return unless $self->count($class,$name) >= 1;
#return $self->{class}->new($class,$name,$self,1) unless $filltag;
return ($self->_list)[0] unless $filltag;
if (defined $filltag && $filltag eq '1') { # full fill
return $self->_fetch();
} else {
return $self->_fetch(undef,undef,$filltag);
}
}
#### CACHE AND CARRY CODE ####
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:
=over 4
=item B<-host>, B<-port>
These arguments point to the host and port of an AceDB server.
AcePerl will use its internal compiled code to establish a connection
to the server unless explicitly overridden with the B<-program>
argument.
=item B<-path>
This argument indicates the path of an AceDB directory on the local
system. It should point to the directory that contains the I<wspec>
subdirectory. User name interpolations (~acedb) are OK.
=item B<-user>
Name of user to log in as (when using socket server B<only>). If not
provided, will attempt an anonymous login.
=item B<-pass>
Password to log in with (when using socket server).
=item B<-url>
An Acedb URL that combines the server type, host, port, user and
password in a single string. See the connect() method's "single
argument form" description.
=item B<-cache>
AcePerl can use the Cache::SizeAwareFileCache module to cache objects
to disk. This can result in dramatically increased performance in
environments such as web servers in which the same Acedb objects are
frequently reused. To activate this mechanism, the
Cache::SizeAwareFileCache module must be installed, and you must pass
the -cache argument during the connect() call.
The value of -cache is a hash reference containing the arguments to be
passed to Cache::SizeAwareFileCache. For example:
-cache => {
cache_root => '/usr/tmp/acedb',
cache_depth => 4,
default_expires_in => '1 hour'
}
If not otherwise specified, the following cache parameters are assumed:
Parameter Default Value
--------- -------------
namespace Server URL (e.g. sace://localhost:2005)
cache_root /tmp/FileCache (dependent on system temp directory)
default_expires_in 1 day
auto_purge_interval 12 hours
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
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.
NOTE: this feature is temporarily disabled (as of version 1.40)
because it is generating unpredictable results when used with
Apache/mod_perl.
=item B<-query_timeout>
If any query takes longer than $query_timeout seconds, will return an
undefined value. This value can only be set at connect time, and cannot
be changed once set.
=back
If arguments are omitted, they will default to the following values:
-host localhost
-port 200005;
-path no default
-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.
$low_level = $db->db();
=head2 connect() -- single argument form
$db = Ace->connect('sace://stein.cshl.org:1880')
Ace->connect() also accepts a single argument form using a URL-type
syntax. The general syntax is:
protocol://hostname:port/path
The I<:port> and I</path> parts are protocol-dependent as described
above.
Protocols:
=over 4
=item sace://hostname:port
Connect to a socket server at the indicated hostname and port. Example:
sace://stein.cshl.org:1880
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
$object = $db->parse('data to parse');
This will parse the Ace tags contained within the "data to parse"
string, convert it into an object in the databse, and return the
resulting Ace::Object. In case of a parse error, the undefined value
will be returned and a (hopefully informative) description of the
error will be returned by Ace->error().
For example:
$author = $db->parse(<<END);
Author : "Glimitz JR"
Full_name "Jonathan R. Glimitz"
Mail "128 Boylston Street"
Mail "Boston, MA"
Mail "USA"
Laboratory GM
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.
=head2 find() method
@objects = $db->find($query_string);
@objects = $db->find(-query => $query_string,
-offset=> $offset,
-count => $count
-fill => $fill);
This allows you to pass arbitrary Ace query strings to the server and
retrieve all objects that are returned as a result. For example, this
code fragment retrieves all papers written by Jean and Danielle
Thierry-Mieg.
@papers = $db->find('author IS "Thierry-Mieg *" ; >Paper');
You can find the full query syntax reference guide plus multiple
examples at http://probe.nalusda.gov:8000/acedocs/index.html#query.
In the named parameter calling form, B<-count>, B<-offset>, and
B<-fill> have the same meanings as in B<fetch()>.
( run in 1.057 second using v1.01-cache-2.11-cpan-df04353d9ac )