AcePerl
view release on metacpan or search on metacpan
# *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');
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:
=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
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()>.
=head2 fetch_many() method
$obj = $db->fetch_many($class,$pattern);
%classes = $db->class_count()
This returns a hash in which the keys are the class names and the
values are the total number of objects in that class. All classes
are returned, including invisible ones. Use this method if you need
to count all classes simultaneously. If you only want to count one
or two classes, it may be more efficient to call I<count($class_name)>
instead.
This method transiently uses a lot of memory. It should not be used
with Ace 4.5 servers, as they contain a memory leak in the counting
routine.
=head2 status() method
%status = $db->status;
$status = $db->status;
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
"java" style, puts the day first, as in "01 Oct 1997 00:00:00" (this
is also the style recommended for Internet dates). The default is to
use the latter notation.
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]);
These convenience functions convert the UNIX timestamp given by $time
(seconds since the epoch) into a datetime string in the format that
ACEDB requires. date() will truncate the time portion.
If not provided, $time defaults to localtime().
=head1 OTHER METHODS
=head2 debug()
2. There is no automatic recovery from connection errors.
3. Debugging has only one level of verbosity, despite the best
of intentions.
4. Performance is poor when fetching big objects, because of
many object references that must be created. This could be
improved.
5. When called in an array context at("tag[0]") should return the
current tag's entire column. It returns the current subtree instead.
6. There is no way to add comments to objects.
7. When timestamps are active, many optimizations are disabled.
8. Item number eight is still missing.
=head1 SEE ALSO
L<Ace::Object>, L<Ace::Local>, L<Ace::Model>,
L<Ace::Sequence>,L<Ace::Sequence::Multi>.
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Copyright (c) 1997-1998 Cold Spring Harbor Laboratory
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
# -------------------- AUTOLOADED SUBS ------------------
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
sub parse_longtext {
my $self = shift;
my ($title,$body) = @_;
my $mm = "parse =
Longtext $title
$body
***LongTextEnd***
" ;
$mm =~ s/\//\\\//g ;
$mm =~ s/\n/\\n/g ;
$mm .= "\n" ;
my $result = $self->raw_query($mm) ;
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
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));
return $result[0];
}
# these two only get loaded if the Ace::Freesubs .XS isn't compiled
sub freeprotect {
my $class = shift;
my $text = shift;
$text =~ s/\n/\\n/g;
$text =~ s/\t/\\t/g;
$text =~ s/"/\\"/g;
return qq("$text");
}
sub split {
my $class = shift;
my $text = shift;
$text =~ s/\\n/\n/g;
$text =~ s/\\t/\t/g;
my ($id,$ts);
($class,$id,$ts) = $text=~m/^\?(.+)(?<!\\)\?(.+)(?<!\\)\?([^?]*)$/s;
$class ||= ''; # fix uninitialized variable warnings
$id ||= '';
$class =~ s/\\\?/?/g;
$id =~ s/\\\?/?/g;
return ($class,$id) unless $ts;
return ($class,$id,$ts); # return timestamp
}
# Return a list of all the classes known to the server.
sub classes {
my ($self,$invisible) = @_;
my $query = defined($invisible) && $invisible ?
"query find class !buried"
:
"query find class visible AND !buried";
$self->raw_query($query);
return $self->_list;
}
################## iterators ##################
# Fetch many objects in iterative style
sub fetch_many {
my $self = shift;
my ($class,$pattern,$filled,$query,$chunksize) = rearrange( ['CLASS',
['PATTERN','NAME'],
['FILL','FILLED'],
'QUERY',
'CHUNKSIZE'],@_);
$pattern ||= '*';
$pattern = Ace->freeprotect($pattern);
if (defined $query) {
$query = "query $query" unless $query=~/^query\s/;
} elsif (defined $class) {
$query = qq{query find $class $pattern};
} else {
croak "must call fetch_many() with the -class or -query arguments";
}
my $iterator = Ace::Iterator->new($self,$query,$filled,$chunksize);
return $iterator;
}
sub _register_iterator {
my ($self,$iterator) = @_;
$self->{iterators}{$iterator} = $iterator;
}
sub _unregister_iterator {
my ($self,$iterator) = @_;
$self->_restore_iterator($iterator);
delete $self->{iterators}{$iterator};
}
sub _save_iterator {
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;
# fetch the list of iterators stored on the stack
my $list = $self->{iterator_stack};
# spick not supported. Abandon ship
return if @$list > 1 and $self->{no_spick};
# Find the iterator in our list. This mirrors the
( run in 0.536 second using v1.01-cache-2.11-cpan-140bd7fdf52 )