File Coverage

blib/lib/Ace.pm
Criterion Covered Total %
statement 343 498 68.9
branch 125 266 47.0
condition 42 100 42.0
subroutine 50 63 79.4
pod 26 39 66.7
total 586 966 60.7


line stmt bran cond sub pod time code
1             package Ace;
2              
3 4     4   58 use strict;
  4         115  
  4         55  
4 4     4   81 use Carp qw(croak carp cluck);
  4         35  
  4         69  
5 4     4   60 use Scalar::Util 'weaken';
  4         1158  
  4         106  
6              
7 4     4   143 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $Error $DEBUG_LEVEL);
  4         67  
  4         61  
8              
9 4     4   260 use Data::Dumper;
  4         40  
  4         152  
10 4     4   126 use AutoLoader 'AUTOLOAD';
  4         37  
  4         69  
11             require Exporter;
12             use overload
13 4         66   '""' => 'asString',
14 4     4   89   'cmp' => 'cmp';
  4         35  
15              
16             @ISA = qw(Exporter);
17              
18             # Items to export into callers namespace by default.
19             @EXPORT = qw(STATUS_WAITING STATUS_PENDING STATUS_ERROR);
20              
21             # Optional exports
22             @EXPORT_OK = qw(rearrange ACE_PARSE);
23             $VERSION = '1.91';
24              
25 4     4   61 use constant STATUS_WAITING => 0;
  4         35  
  4         108  
26 4     4   105 use constant STATUS_PENDING => 1;
  4         37  
  4         48  
27 4     4   62 use constant STATUS_ERROR => -1;
  4         86  
  4         49  
28 4     4   58 use constant ACE_PARSE => 3;
  4         37  
  4         50  
29              
30 4     4   85 use constant DEFAULT_PORT => 200005; # rpc server
  4         2174  
  4         81  
31 4     4   95 use constant DEFAULT_SOCKET => 2005; # socket server
  4         36  
  4         49  
32              
33             require Ace::Iterator;
34             require Ace::Object;
35 4     4   97 eval qq{use Ace::Freesubs}; # XS file, may not be available
  0         0  
  0         0  
36              
37             # Map database names to objects (to fix file-caching issue)
38             my %NAME2DB;
39              
40             # internal cache of objects
41             my %MEMORY_CACHE;
42              
43             my %DEFAULT_CACHE_PARAMETERS = (
44             default_expires_in  => '1 day',
45             auto_purge_interval => '12 hours',
46             );
47              
48             # Preloaded methods go here.
49             $Error = '';
50              
51             # Pseudonyms and deprecated methods.
52             *list      = \&fetch;
53             *Ace::ERR  = *Error;
54              
55             # now completely deprecated and gone
56             # *find_many = \&fetch_many;
57             # *models = \&classes;
58              
59             sub connect {
60 3     3 1 145   my $class = shift;
61 3         33   my ($host,$port,$user,$pass,$path,$program,
62                   $objclass,$timeout,$query_timeout,$database,
63                   $server_type,$url,$u,$p,$cache,$other);
64              
65             # one-argument single "URL" form
66 3 50       190   if (@_ == 1) {
67 0         0     return $class->connect(-url=>shift);
68               }
69              
70             # multi-argument (traditional) form
71 3         71   ($host,$port,$user,$pass,
72                $path,$objclass,$timeout,$query_timeout,$url,$cache,$other) =
73                  rearrange(['HOST','PORT','USER','PASS',
74             'PATH',['CLASS','CLASSMAPPER'],'TIMEOUT',
75             'QUERY_TIMEOUT','URL','CACHE'],@_);
76              
77 3 50 0     115   ($host,$port,$u,$pass,$p,$server_type) = $class->process_url($url)
78                 or croak "Usage: Ace->connect(-host=>\$host,-port=>\$port [,-path=>\$path]\n"
79                   if defined $url;
80              
81 3 50       39   if ($path) { # local database
82 0         0     $server_type = 'Ace::Local';
83               } else { # either RPC or socket server
84 3   50     37     $host ||= 'localhost';
85 3   50     60     $user ||= $u || '';
      33        
86 3   50     53     $path ||= $p || '';
      33        
87 3 0 33     37     $port ||= $server_type eq 'Ace::SocketServer' ? DEFAULT_SOCKET : DEFAULT_PORT;
88 3 50       40     $query_timeout = 120 unless defined $query_timeout;
89 3 50 50     84     $server_type ||= 'Ace::SocketServer' if $port < 100000;
90 3 50 0     39     $server_type ||= 'Ace::RPC' if $port >= 100000;
91               }
92              
93             # we've normalized parameters, so do the actual connect
94 3 50       294   eval "require $server_type" || croak "Module $server_type not loaded: $@";
95 3 50       53   if ($path) {
96 0         0     $database = $server_type->connect(-path=>$path,%$other);
97               } else {
98 3         74     $database = $server_type->connect($host,$port,$query_timeout,$user,$pass,%$other);
99               }
100              
101 3 50       37   unless ($database) {
102 0   0     0     $Ace::Error ||= "Couldn't open database";
103 0         0     return;
104               }
105              
106 3   50     150   my $contents = {
107             'database'=> $database,
108             'host'   => $host,
109             'port'   => $port,
110             'path'   => $path,
111             'class'  => $objclass || 'Ace::Object',
112             'timeout' => $query_timeout,
113             'user'    => $user,
114             'pass'    => $pass,
115             'other'  => $other,
116             'date_style' => 'java',
117             'auto_save' => 0,
118             };
119              
120 3   33     1056   my $self = bless $contents,ref($class)||$class;
121              
122 3 50       36   $self->_create_cache($cache) if $cache;
123 3         40   $self->name2db("$self",$self);
124 3         52   return $self;
125             }
126              
127             sub reopen {
128 0     0 1 0   my $self = shift;
129 0 0       0   return 1 if $self->ping;
130 0         0   my $class = ref($self->{database});
131 0         0   my $database;
132 0 0       0   if ($self->{path}) {
133 0         0     $database = $class->connect(-path=>$self->{path},%{$self->other});
  0         0  
134               } else {
135 0         0     $database = $class->connect($self->{host},$self->{port}, $self->{timeout},
136 0         0 $self->{user},$self->{pass},%{$self->{other}});
137               }
138 0 0       0   unless ($database) {
139 0         0     $Ace::Error = "Couldn't open database";
140 0         0     return;
141               }
142 0         0   $self->{database} = $database;
143 0         0   1;
144             }
145              
146             sub class {
147 346     346 0 5299   my $self = shift;
148 346         5878   my $d = $self->{class};
149 346 50       3310   $self->{class} = shift if @_;
150 346         5038   $d;
151             }
152              
153             sub class_for {
154 214     214 0 2039   my $self = shift;
155 214         5235   my ($class,$id) = @_;
156 214         2057   my $selected_class;
157              
158 214 50       2490   if (my $selector = $self->class) {
159 214 50       4538     if (ref $selector eq 'HASH') {
    50          
    50          
160 0   0     0       $selected_class = $selector->{$class} || $selector->{'_DEFAULT_'};
161                 }
162                 elsif ($selector->can('class_for')) {
163 0         0       $selected_class = $selector->class_for($class,$id,$self);
164                 }
165                 elsif (!ref $selector) {
166 214         2040       $selected_class = $selector;
167                 }
168                 else {
169 0         0       croak "$selector is neither a scalar, nor a HASH, nor an object that supports the class_for() method";
170                 }
171               }
172              
173 214   50     2730   $selected_class ||= 'Ace::Object';
174              
175 214 50 0     2930   eval "require $selected_class; 1;" || croak $@
176                 unless $selected_class->can('new');
177              
178 214         3329   $selected_class;
179             }
180              
181             sub process_url {
182 0     0 0 0   my $class = shift;
183 0         0   my $url = shift;
184 0         0   my ($host,$port,$user,$pass,$path,$server_type) = ('','','','','','');
185              
186 0 0       0   if ($url) { # look for host:port
187 0         0     local $_ = $url;
188 0 0       0     if (m!^rpcace://([^:]+):(\d+)$!) { # rpcace://localhost:200005
    0          
    0          
    0          
    0          
189 0         0       ($host,$port) = ($1,$2);
190 0         0       $server_type = 'Ace::RPC';
191                 } elsif (m!^sace://([\w:]+)\@([^:]+):(\d+)$!) { # sace://user@localhost:2005
192 0         0       ($user,$host,$port) = ($1,$2,$3);
193 0         0       $server_type = 'Ace::SocketServer';
194                 } elsif (m!^sace://([^:]+):(\d+)$!) { # sace://localhost:2005
195 0         0       ($host,$port) = ($1,$2);
196 0         0       $server_type = 'Ace::SocketServer';
197                 } elsif (m!^tace:(/.+)$!) { # tace:/path/to/database
198 0         0       $path = $1;
199 0         0       $server_type = 'Ace::Local';
200                 } elsif (m!^(/.+)$!) { # /path/to/database
201 0         0       $path = $1;
202 0         0       $server_type = 'Ace::Local';
203                 } else {
204 0         0       return;
205                 }
206               }
207              
208 0 0       0   if ($user =~ /:/) {
209 0         0     ($user,$pass) = split /:/,$user;
210               }
211              
212 0         0   return ($host,$port,$user,$pass,$path,$server_type);
213              
214             }
215              
216             # Return the low-level Ace::AceDB object
217             sub db {
218 4624     4624 0 80826   return $_[0]->{'database'};
219             }
220              
221             # Fetch a model from the database.
222             # Since there are limited numbers of models, we cache
223             # the results internally.
224             sub model {
225 23     23 1 206   my $self = shift;
226 23         378   require Ace::Model;
227 23         218   my $model = shift;
228 23         186   my $break_cycle = shift; # for breaking cycles when following #includes
229 23         237   my $key = join(':',$self,'MODEL',$model);
230 23   66     580   $self->{'models'}{$model} ||= eval{$self->cache->get($key)};
  4         48  
231 23 100       267   unless ($self->{models}{$model}) {
232 4         58     $self->{models}{$model} =
233                   Ace::Model->new($self->raw_query("model \"$model\""),$self,$break_cycle);
234 4         42     eval {$self->cache->set($key=>$self->{models}{$model})};
  4         47  
235               }
236 23         334   return $self->{'models'}{$model};
237             }
238              
239             # cached get
240             # pass "1" for fill to get a full fill
241             # pass any other true value to get a tag fill
242             sub get {
243 9     9 1 81   my $self = shift;
244 9         87   my ($class,$name,$fill) = @_;
245              
246             # look in caches first
247 9   66     3784   my $obj = $self->memory_cache_fetch($class=>$name)
248                 || $self->file_cache_fetch($class=>$name);
249 9 100       127   return $obj if $obj;
250              
251             # _acedb_get() does the caching
252 6 50       65   $obj = $self->_acedb_get($class,$name,$fill) or return;
253 6         111   $obj;
254             }
255              
256             sub _acedb_get {
257 6     6   53   my $self = shift;
258 6         61   my ($class,$name,$filltag) = @_;
259 6 50       65   return unless $self->count($class,$name) >= 1;
260              
261             #return $self->{class}->new($class,$name,$self,1) unless $filltag;
262 6 50       89   return ($self->_list)[0] unless $filltag;
263              
264 0 0 0     0   if (defined $filltag && $filltag eq '1') { # full fill
265 0         0     return $self->_fetch();
266               } else {
267 0         0     return $self->_fetch(undef,undef,$filltag);
268               }
269             }
270              
271              
272             #### CACHE AND CARRY CODE ####
273             # Be very careful here. The key used for the memory cache is in the format
274             # db:class:name, but the key used for the file cache is in the format class:name.
275             # The difference is that the filecache has a built-in namespace but the memory
276             # cache doesn't.
277             sub memory_cache_fetch {
278 323     323 1 3105   my $self = shift;
279 323         3555   my ($class,$name) = @_;
280 323         4002   my $key = join ":",$self,$class,$name;
281 323 100       4933   return unless defined $MEMORY_CACHE{$key};
282 123 50       1532   carp "memory_cache hit on $class:$name"
283                 if Ace->debug;
284 123         1372   return $MEMORY_CACHE{$key};
285             }
286              
287             sub memory_cache_store {
288 234     234 1 2146   my $self = shift;
289 234 50       2337   croak "Usage: memory_cache_store(\$obj)" unless @_ == 1;
290 234         2330   my $obj = shift;
291 234         2746   my $key = join ':',$obj->db,$obj->class,$obj->name;
292 234 100       4771   return if exists $MEMORY_CACHE{$key};
293 192 50       2335   carp "memory_cache store on ",$obj->class,":",$obj->name if Ace->debug;
294 192         3728   weaken($MEMORY_CACHE{$key} = $obj);
295             }
296              
297             sub memory_cache_clear {
298 0     0 1 0     my $self = shift;
299 0         0     %MEMORY_CACHE = ();
300             }
301              
302             sub memory_cache_delete {
303 0     0 1 0   my $package = shift;
304 0 0       0   my $obj = shift or croak "Usage: memory_cache_delete(\$obj)";
305 0         0   my $key = join ':',$obj->db,$obj->class,$obj->name;
306 0         0   delete $MEMORY_CACHE{$key};
307             }
308              
309             # Call as:
310             # $ace->file_cache_fetch($class=>$id)
311             sub file_cache_fetch {
312 200     200 1 3221   my $self = shift;
313 200         1828   my ($class,$name) = @_;
314 200         2779   my $key = join ':',$class,$name;
315 200 50       2020   my $cache = $self->cache or return;
316 0         0   my $obj = $cache->get($key);
317 0 0 0     0   if ($obj && !exists $obj->{'.root'}) { # consistency checks
318 0         0     require Data::Dumper;
319 0         0     warn "CACHE BUG! Discarding inconsistent object $obj\n";
320 0         0     warn Data::Dumper->Dump([$obj],['obj']);
321 0         0     $cache->remove($key);
322 0         0     return;
323               }
324 0 0       0   warn "cache ",$obj?'hit':'miss'," on '$key'\n" if Ace->debug;
    0          
325 0 0       0   $self->memory_cache_store($obj) if $obj;
326 0         0   $obj;
327             }
328              
329             # call as
330             # $ace->file_cache_store($obj);
331             sub file_cache_store {
332 195     195 1 1755   my $self = shift;
333 195         1639   my $obj = shift;
334              
335 195         2262   my $key = join ':',$obj->class,$obj->name;
336 195 50       2017   my $cache = $self->cache or return;
337              
338 0 0       0   warn "caching $key obj=",overload::StrVal($obj),"\n" if Ace->debug;
339 0 0       0   if ($key eq ':') { # something badly wrong
340 0         0     cluck "NULL OBJECT";
341               }
342 0         0   $cache->set($key,$obj);
343             }
344              
345             sub file_cache_delete {
346 2     2 1 19   my $self = shift;
347 2         20   my $obj = shift;
348 2         26   my $key = join ':',$obj->class,$obj->name;
349 2 50       24   my $cache = $self->cache or return;
350              
351 0 0       0   carp "deleting $key obj=",overload::StrVal($obj),"\n" if Ace->debug;
352 0         0   $cache->remove($key,$obj);
353             }
354              
355             #### END: CACHE AND CARRY CODE ####
356              
357              
358             # Fetch one or a group of objects from the database
359             sub fetch {
360 12     12 1 247   my $self = shift;
361 12         235   my ($class,$pattern,$count,$offset,$query,$filled,$total,$filltag) =
362                 rearrange(['CLASS',['NAME','PATTERN'],'COUNT','OFFSET','QUERY',
363             ['FILL','FILLED'],'TOTAL','FILLTAG'],@_);
364              
365 12 100 66     247   if (defined $class
      100        
366                   && defined $pattern
367                   && $pattern !~ /[\?\*]/
368             # && !wantarray
369                  ) {
370 8         90     return $self->get($class,$pattern,$filled);
371               }
372              
373 4         37   $offset += 0;
374 4   100     42   $pattern ||= '*';
375 4         126   $pattern = Ace->freeprotect($pattern);
376 4 100       46   if (defined $query) {
    50          
377 1 50       19     $query = "query $query" unless $query=~/^query\s/;
378               } elsif (defined $class) {
379 3         32     $query = qq{find $class $pattern};
380               } else {
381 0         0     croak "must call fetch() with the -class or -query arguments";
382               }
383              
384              
385 4         46   my $r = $self->raw_query($query);
386              
387 4         70   my ($cnt) = $r =~ /Found (\d+) objects/m;
388 4 50       43   $$total = $cnt if defined $total;
389              
390             # Scalar context and a pattern match operation. Return the
391             # object count without bothering to fetch the objects
392 4 100 66     61   return $cnt if !wantarray and $pattern =~ /(?:[^\\]|^)[*?]/;
393              
394 3         26   my(@h);
395 3 50       29   if ($filltag) {
396 0         0     @h = $self->_fetch($count,$offset,$filltag);
397               } else {
398 3 50       38     @h = $filled ? $self->_fetch($count,$offset) : $self->_list($count,$offset);
399               }
400              
401 3 50       119   return wantarray ? @h : $h[0];
402             }
403              
404             sub cache {
405 405     405 1 4202   my $self = shift;
406 405         3930   my $d = $self->{filecache};
407 405 50       3850   $self->{filecache} = shift if @_;
408 405         10004   $d;
409             }
410              
411             sub _create_cache {
412 0     0   0   my $self = shift;
413 0         0   my $params = shift;
414 0 0 0     0   $params = {} if $params and !ref $params;
415              
416 0 0       0   return unless eval {require Cache::SizeAwareFileCache}; # not installed
  0         0  
417              
418 0         0   (my $namespace = "$self") =~ s!/!_!g;
419 0         0   my %cache_params = (
420             namespace    => $namespace,
421             %DEFAULT_CACHE_PARAMETERS,
422             %$params,
423             );
424 0         0   my $cache_obj = Cache::SizeAwareFileCache->new(\%cache_params);
425 0         0   $self->cache($cache_obj);
426             }
427              
428             # class method
429             sub name2db {
430 1248     1248 1 13066   shift;
431 1248         12666   my $name = shift;
432 1248 100       15363   return unless defined $name;
433 1221         20103   my $d = $NAME2DB{$name};
434             # weaken($NAME2DB{$name} = shift) if @_;
435 1221 100       13414   $NAME2DB{$name} = shift if @_;
436 1221         19028   $d;
437             }
438              
439             # make a new object using indicated class and name pattern
440             sub new {
441 0     0 1 0   my $self = shift;
442 0         0   my ($class,$pattern) = rearrange([['CLASS'],['NAME','PATTERN']],@_);
443 0 0 0     0   croak "You must provide -class and -pattern arguments"
444                 unless $class && $pattern;
445             # escape % signs in the string
446 0         0   $pattern = Ace->freeprotect($pattern);
447 0         0   $pattern =~ s/(?<!\\)%/\\%/g;
448 0         0   my $r = $self->raw_query("new $class $pattern");
449 0 0 0     0   if (defined($r) and $r=~/write access/im) { # this keeps changing
450 0         0     $Ace::Error = "Write access denied";
451 0         0     return;
452               }
453              
454 0 0       0   unless ($r =~ /($class)\s+\"([^\"]+)\"$/im) {
455 0         0     $Ace::Error = $r;
456 0         0     return;
457               }
458 0         0   $self->fetch($1 => $2);
459             }
460              
461             # perform an AQL query
462             sub aql {
463 0     0 1 0   my $self = shift;
464 0         0   my $query = shift;
465 0         0   my $db = $self->db;
466 0         0   my $r = $self->raw_query("aql -j $query");
467 0 0       0   if ($r =~ /(AQL error.*)/) {
468 0         0     $self->error($1);
469 0         0     return;
470               }
471 0         0   my @r;
472 0         0   foreach (split "\n",$r) {
473 0 0       0     next if m!^//!;
474 0 0       0     next if m!^\0!;
475 0         0     my ($class,$id) = Ace->split($_);
476 0         0     my @objects = map { $self->class_for($class,$id)->new(Ace->split($_),$self,1)} split "\t";
  0         0  
477 0         0     push @r,\@objects;
478               }
479 0         0   return @r;
480             }
481              
482             # Return the contents of a keyset. Pattern matches are allowed, in which case
483             # the keysets will be merged.
484             sub keyset {
485 0     0 1 0   my $self = shift;
486 0         0   my $pattern = shift;
487 0         0   $self->raw_query (qq{find keyset "$pattern"});
488 0         0   $self->raw_query (qq{follow});
489 0         0   return $self->_list;
490             }
491              
492              
493             #########################################################
494             # These functions are for low-level (non OO) access only.
495             # This is for low-level access only.
496             sub show {
497 1     1 0 11     my ($self,$class,$pattern,$tag) = @_;
498 1         12     $Ace::Error = '';
499 1 50       10     return unless $self->count($class,$pattern);
500              
501             # if we get here, then we've got some data to return.
502 1         10     my @result;
503 1 50       15     my $ts = $self->{'timestamps'} ? '-T' : '';
504 1         18     $self->{database}->query("show -j $ts $tag");
505 1         12     my $result = $self->read_object;
506 1 50       53     unless ($result =~ /(\d+) object dumped/m) {
507 0         0 $Ace::Error = 'Unexpected close during show';
508 0         0 return;
509                 }
510 1         30     return grep (!m!^//!,split("\n\n",$result));
511             }
512              
513             sub read_object {
514 76     76 0 2102     my $self = shift;
515 76 50       1126     return unless $self->{database};
516 76         1232     my $result;
517 76         1016     while ($self->{database}->status == STATUS_PENDING()) {
518 76         3141       my $data = $self->{database}->read();
519             # $data =~ s/\0//g; # get rid of nulls in the buffer
520 76 50       2918       $result .= $data if defined $data;
521                 }
522 76         1727     return $result;
523             }
524              
525             # do a query, and return the result immediately
526             sub raw_query {
527 75     75 1 1003   my ($self,$query,$no_alert,$parse) = @_;
528 75 100       1174   $self->_alert_iterators unless $no_alert;
529 75 100       1619   $self->{database}->query($query, $parse ? ACE_PARSE : () );
530 75         860   return $self->read_object;
531             }
532              
533             # return the last error
534             sub error {
535 0     0 1 0   my $class = shift;
536 0 0       0   $Ace::Error = shift() if defined($_[0]);
537 0         0   $Ace::Error=~s/\0//g; # get rid of nulls
538 0         0   return $Ace::Error;
539             }
540              
541             # close the database
542             sub close {
543 0     0 1 0   my $self = shift;
544 0 0       0   $self->raw_query('save') if $self->auto_save;
545 0         0   foreach (keys %{$self->{iterators}}) {
  0         0  
546 0         0     $self->_unregister_iterator($_);
547               }
548 0         0   delete $self->{database};
549             }
550              
551             sub DESTROY {
552 0     0   0   my $self = shift;
553 0 0       0   return if caller() =~ /^Cache\:\:/;
554 0 0       0   warn "$self->DESTROY at ", join ' ',caller() if Ace->debug;
555 0         0   $self->close;
556             }
557              
558              
559             #####################################################################
560             ###################### private routines #############################
561             sub rearrange {
562 523     523 0 6737     my($order,@param) = @_;
563 523 100       6983     return unless @param;
564 519         4709     my %param;
565              
566 519 50       8923     if (ref $param[0] eq 'HASH') {
567 0         0       %param = %{$param[0]};
  0         0  
568                 } else {
569 519 100 66     12474       return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-');
570              
571 45         431       my $i;
572                   for ($i=0;$i<@param;$i+=2) {
573 100         4733         $param[$i]=~s/^\-//; # get rid of initial - if present
574 100         1628         $param[$i]=~tr/a-z/A-Z/; # parameters are upper case
575 45         576       }
576              
577 45         697       %param = @param; # convert into associative array
578                 }
579              
580 45         542     my(@return_array);
581              
582 45         637     local($^W) = 0;
583 45         441     my($key)='';
584 45         616     foreach $key (@$order) {
585 259         3810         my($value);
586 259 100       2725         if (ref($key) eq 'ARRAY') {
587 135         3165             foreach (@$key) {
588 270 100       2763                 last if defined($value);
589 241         3119                 $value = $param{$_};
590 241         2911                 delete $param{$_};
591                         }
592                     } else {
593 124         2795             $value = $param{$key};
594 124         21320             delete $param{$key};
595                     }
596 259         3131         push(@return_array,$value);
597                 }
598 45 50       501     push (@return_array,\%param) if %param;
599 45         943     return @return_array;
600             }
601              
602             # do a query, but don't return the result
603             sub _query {
604 0     0   0   my ($self,@query) = @_;
605 0         0   $self->_alert_iterators;
606 0         0   $self->{'database'}->query("@query");
607             }
608              
609             # return a portion of the active list
610             sub _list {
611 13     13   123   my $self = shift;
612 13         190   my ($count,$offset) = @_;
613 13         109   my (@result);
614 13         208   my $query = 'list -j';
615 13 100       139   $query .= " -b $offset" if defined $offset;
616 13 100       144   $query .= " -c $count" if defined $count;
617 13         872   my $result = $self->raw_query($query);
618 13         198   $result =~ s/\0//g; # get rid of &$#&@( nulls
619 13         309   foreach (split("\n",$result)) {
620 392         5445     my ($class,$name) = Ace->split($_);
621 392 100 66     5626     next unless $class and $name;
622 314         3453     my $obj = $self->memory_cache_fetch($class,$name);
623 314   66     3684     $obj ||= $self->file_cache_fetch($class,$name);
624 314 100       3314     unless ($obj) {
625 194         1968       $obj = $self->class_for($class,$name)->new($class,$name,$self,1);
626 194         2620       $self->memory_cache_store($obj);
627 194         4440       $self->file_cache_store($obj);
628                 }
629 314         3826     push @result,$obj;
630               }
631 13         465   return @result;
632             }
633              
634             # return a portion of the active list
635             sub _fetch {
636 1     1   11   my $self = shift;
637 1         11   my ($count,$start,$tag) = @_;
638 1         10   my (@result);
639 1 50       14   $tag = '' unless defined $tag;
640 1         11   my $query = "show -j $tag";
641 1 50       14   $query .= ' -T' if $self->{timestamps};
642 1 50       15   $query .= " -b $start" if defined $start;
643 1 50       15   $query .= " -c $count" if defined $count;
644 1         15   $self->{database}->query($query);
645 1         17   while (my @objects = $self->_fetch_chunk) {
646 1         18     push (@result,@objects);
647               }
648             # copy tag into a portion of the tree
649 1 50       13   if ($tag) {
650 0         0     for my $tree (@result) {
651 0         0       my $obj = $self->class_for($tree->class,$tree->name)->new($tree->class,$tree->name,$self,1);
652 0         0       $obj->_attach_subtree($tag=>$tree);
653 0         0       $tree = $obj;
654                 }
655               }
656             # now recache 'em
657 1         10   for (@result) {
658 20 50       191     if (my $obj = $self->memory_cache_store($_)) {
659 0 0       0       %$obj = %$_ unless $obj->filled; # contents copy -- replace partial object with full object
660 0         0       $_ = $obj;
661                 } else {
662 20         196       $self->memory_cache_store($_);
663                 }
664               }
665 1 50       26   return wantarray ? @result : $result[0];
666             }
667              
668             sub _fetch_chunk {
669 2     2   19   my $self = shift;
670 2 100       27   return unless $self->{database}->status == STATUS_PENDING();
671 1         26   my $result = $self->{database}->read();
672 1         24   $result =~ s/\0//g; # get rid of &$#&@!! nulls
673 1         150   my @chunks = split("\n\n",$result);
674 1         12   my @result;
675 1         12   foreach (@chunks) {
676 21 100       222     next if m!^//!;
677 20 50       211     next unless /\S/; # occasional empty lines
678 20         227     my ($class,$id) = Ace->split($_); # /^\?([^?]+)\?([^?]+)\?/m;
679 20         218     push(@result,$self->class_for($class,$id)->newFromText($_,$self));
680               }
681 1         27   return @result;
682             }
683              
684             sub _alert_iterators {
685 72     72   652   my $self = shift;
686 72         600   foreach (keys %{$self->{iterators}}) {
  72         1423  
687 41 50       866     $self->{iterators}{$_}->invalidate if $self->{iterators}{$_};
688               }
689 72         959   undef $self->{active_list};
690             }
691              
692             sub asString {
693 2311     2311 0 24875   my $self = shift;
694 2311 50       29920   return "tace://$self->{path}" if $self->{'path'};
695 2311 50 33     26229   my $server = $self->db && $self->db->isa('Ace::SocketServer') ? 'sace' : 'rpcace';
696 2311 50       37003   return "$server://$self->{host}:$self->{port}" if $self->{'host'};
697 0         0   return ref $self;
698             }
699              
700             sub cmp {
701 0     0 0 0   my ($self,$arg,$reversed) = @_;
702 0         0   my $cmp;
703 0 0 0     0   if (ref($arg) and $arg->isa('Ace')) {
704 0         0     $cmp = $self->asString cmp $arg->asString;
705               } else {
706 0         0     $cmp = $self->asString cmp $arg;
707               }
708 0 0       0   return $reversed ? -$cmp : $cmp;
709             }
710              
711              
712             # Count the objects matching pattern without fetching them.
713             sub count {
714 14     14 1 131   my $self = shift;
715 14         201   my ($class,$pattern,$query) = rearrange(['CLASS',
716             ['NAME','PATTERN'],
717             'QUERY'],@_);
718 14         156   $Ace::Error = '';
719              
720             # A special case occurs when we have already fetched this
721             # object and it is already on the active list. In this
722             # case, we do not need to recount.
723 14 100       186   $query = '' unless defined $query;
724 14 100       138   $pattern = '' unless defined $pattern;
725 14 100       139   $class = '' unless defined $class;
726              
727 14         144   my $active_tag = "$class$pattern$query";
728 14 100 100     198   if (defined $self->{'active_list'} &&
729                   defined ($self->{'active_list'}->{$active_tag})) {
730 1         18     return $self->{'active_list'}->{$active_tag};
731               }
732              
733 13 100       122   if ($query) {
734 1 50       17     $query = "query $query" unless $query=~/^query\s/;
735               } else {
736 12         186     $pattern =~ tr/\n//d;
737 12   50     120     $pattern ||= '*';
738 12         214     $pattern = Ace->freeprotect($pattern);
739 12         138     $query = "find $class $pattern";
740               }
741 13         152   my $result = $self->raw_query($query);
742             # unless ($result =~ /Found (\d+) objects/m) {
743 13 50       266   unless ($result =~ /(\d+) Active Objects/m) {
744 0         0     $Ace::Error = 'Unexpected close during find';
745 0         0     return;
746               }
747 13         339   return $self->{'active_list'}->{$active_tag} = $1;
748             }
749              
750             1;
751              
752             __END__
753            
754             =head1 NAME
755            
756             Ace - Object-Oriented Access to ACEDB Databases
757            
758             =head1 SYNOPSIS
759            
760             use Ace;
761             # open a remote database connection
762             $db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
763             -port => 20000100);
764            
765             # open a local database connection
766             $local = Ace->connect(-path=>'~acedb/my_ace');
767            
768             # simple queries
769             $sequence = $db->fetch(Sequence => 'D12345');
770             $count = $db->count(Sequence => 'D*');
771             @sequences = $db->fetch(Sequence => 'D*');
772             $i = $db->fetch_many(Sequence=>'*'); # fetch a cursor
773             while ($obj = $i->next) {
774             print $obj->asTable;
775             }
776            
777             # complex queries
778             $query = <<END;
779             find Annotation Ready_for_submission ; follow gene ;
780             follow derived_sequence ; >DNA
781             END
782             @ready_dnas= $db->fetch(-query=>$query);
783            
784             $ready = $db->fetch_many(-query=>$query);
785             while ($obj = $ready->next) {
786             # do something with obj
787             }
788            
789             # database cut and paste
790             $sequence = $db->fetch(Sequence => 'D12345');
791             $local_db->put($sequence);
792             @sequences = $db->fetch(Sequence => 'D*');
793             $local_db->put(@sequences);
794            
795             # Get errors
796             print Ace->error;
797             print $db->error;
798            
799             =head1 DESCRIPTION
800            
801             AcePerl provides an interface to the ACEDB object-oriented database.
802             Both read and write access is provided, and ACE objects are returned
803             as similarly-structured Perl objects. Multiple databases can be
804             opened simultaneously.
805            
806             You will interact with several Perl classes: I<Ace>, I<Ace::Object>,
807             I<Ace::Iterator>, I<Ace::Model>. I<Ace> is the database accessor, and
808             can be used to open both remote Ace databases (running aceserver or
809             gifaceserver), and local ones.
810            
811             I<Ace::Object> is the superclass for all objects returned from the
812             database. I<Ace> and I<Ace::Object> are linked: if you retrieve an
813             Ace::Object from a particular database, it will store a reference to
814             the database and use it to fetch any subobjects contained within it.
815             You may make changes to the I<Ace::Object> and have those changes
816             written into the database. You may also create I<Ace::Object>s from
817             scratch and store them in the database.
818            
819             I<Ace::Iterator> is a utility class that acts as a database cursor for
820             long-running ACEDB queries. I<Ace::Model> provides object-oriented
821             access to ACEDB's schema.
822            
823             Internally, I<Ace> uses the I<Ace::Local> class for access to local
824             databases and I<Ace::AceDB> for access to remote databases.
825             Ordinarily you will not need to interact directly with either of these
826             classes.
827            
828             =head1 CREATING NEW DATABASE CONNECTIONS
829            
830             =head2 connect() -- multiple argument form
831            
832             # remote database
833             $db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
834             -port => 20000100);
835            
836             # local (non-server) database
837             $db = Ace->connect(-path => '/usr/local/acedb);
838            
839             Use Ace::connect() to establish a connection to a networked or local
840             AceDB database. To establish a connection to an AceDB server, use the
841             B<-host> and/or B<-port> arguments. For a local server, use the
842             B<-port> argument. The database must be up and running on the
843             indicated host and port prior to connecting to an AceDB server. The
844             full syntax is as follows:
845            
846             $db = Ace->connect(-host => $host,
847             -port => $port,
848             -path => $database_path,
849             -program => $local_connection_program
850             -classmapper => $object_class,
851             -timeout => $timeout,
852             -query_timeout => $query_timeout
853             -cache => {cache parameters},
854             );
855            
856             The connect() method uses a named argument calling style, and
857             recognizes the following arguments:
858            
859             =over 4
860            
861             =item B<-host>, B<-port>
862            
863             These arguments point to the host and port of an AceDB server.
864             AcePerl will use its internal compiled code to establish a connection
865             to the server unless explicitly overridden with the B<-program>
866             argument.
867            
868             =item B<-path>
869            
870             This argument indicates the path of an AceDB directory on the local
871             system. It should point to the directory that contains the I<wspec>
872             subdirectory. User name interpolations (~acedb) are OK.
873            
874             =item B<-user>
875            
876             Name of user to log in as (when using socket server B<only>). If not
877             provided, will attempt an anonymous login.
878            
879             =item B<-pass>
880            
881             Password to log in with (when using socket server).
882            
883             =item B<-url>
884            
885             An Acedb URL that combines the server type, host, port, user and
886             password in a single string. See the connect() method's "single
887             argument form" description.
888            
889             =item B<-cache>
890            
891             AcePerl can use the Cache::SizeAwareFileCache module to cache objects
892             to disk. This can result in dramatically increased performance in
893             environments such as web servers in which the same Acedb objects are
894             frequently reused. To activate this mechanism, the
895             Cache::SizeAwareFileCache module must be installed, and you must pass
896             the -cache argument during the connect() call.
897            
898             The value of -cache is a hash reference containing the arguments to be
899             passed to Cache::SizeAwareFileCache. For example:
900            
901             -cache => {
902             cache_root => '/usr/tmp/acedb',
903             cache_depth => 4,
904             default_expires_in => '1 hour'
905             }
906            
907             If not otherwise specified, the following cache parameters are assumed:
908            
909             Parameter Default Value
910             --------- -------------
911             namespace Server URL (e.g. sace://localhost:2005)
912             cache_root /tmp/FileCache (dependent on system temp directory)
913             default_expires_in 1 day
914             auto_purge_interval 12 hours
915            
916             By default, the cache is not size limited (the "max_size" property is
917             set to $NO_MAX_SIZE). To adjust the size you may consider calling the
918             Ace object's cache() method to retrieve the physical cache and then
919             calling the cache object's limit_size($max_size) method from time to
920             time. See L<Cache::SizeAwareFileCache> for more details.
921            
922             =item B<-program>
923            
924             By default AcePerl will use its internal compiled code calls to
925             establish a connection to Ace servers, and will launch a I<tace>
926             subprocess to communicate with local Ace databases. The B<-program>
927             argument allows you to customize this behavior by forcing AcePerl to
928             use a local program to communicate with the database. This argument
929             should point to an executable on your system. You may use either a
930             complete path or a bare command name, in which case the PATH
931             environment variable will be consulted. For example, you could force
932             AcePerl to use the I<aceclient> program to connect to the remote host
933             by connecting this way:
934            
935             $db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
936             -port => 20000100,
937             -program=>'aceclient');
938            
939             =item B<-classmapper>
940            
941             The optional B<-classmapper> argument (alias B<-class>) points to the
942             class you would like to return from database queries. It is provided
943             for your use if you subclass Ace::Object. For example, if you have
944             created a subclass of Ace::Object called Ace::Object::Graphics, you
945             can have the database return this subclass by default by connecting
946             this way:
947            
948             $db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
949             -port => 20000100,
950             -class=>'Ace::Object::Graphics');
951            
952             The value of B<-class> can be a hash reference consisting of AceDB
953             class names as keys and Perl class names as values. If a class name
954             does not exist in the hash, a key named _DEFAULT_ will be looked for.
955             If that does not exist, then Ace will default to Ace::Object.
956            
957             The value of B<-class> can also be an object or a classname that
958             implements a class_for() method. This method will receive three
959             arguments containing the AceDB class name, object ID and database
960             handle. It should return a string indicating the perl class to
961             create.
962            
963             =item B<-timeout>
964            
965             If no response from the server is received within $timeout seconds,
966             the call will return an undefined value. Internally timeout sets an
967             alarm and temporarily intercepts the ALRM signal. You should be aware
968             of this if you use ALRM for your own purposes.
969            
970             NOTE: this feature is temporarily disabled (as of version 1.40)
971             because it is generating unpredictable results when used with
972             Apache/mod_perl.
973            
974             =item B<-query_timeout>
975            
976             If any query takes longer than $query_timeout seconds, will return an
977             undefined value. This value can only be set at connect time, and cannot
978             be changed once set.
979            
980             =back
981            
982             If arguments are omitted, they will default to the following values:
983            
984             -host localhost
985             -port 200005;
986             -path no default
987             -program tace
988             -class Ace::Object
989             -timeout 25
990             -query_timeout 120
991            
992             If you prefer to use a more Smalltalk-like message-passing syntax, you
993             can open a connection this way too:
994            
995             $db = connect Ace -host=>'beta.crbm.cnrs-mop.fr',-port=>20000100;
996            
997             The return value is an Ace handle to use to access the database, or
998             undef if the connection fails. If the connection fails, an error
999             message can be retrieved by calling Ace->error.
1000            
1001             You may check the status of a connection at any time with ping(). It
1002             will return a true value if the database is still connected. Note
1003             that Ace will timeout clients that have been inactive for any length
1004             of time. Long-running clients should attempt to reestablish their
1005             connection if ping() returns false.
1006            
1007             $db->ping() || die "not connected";
1008            
1009             You may perform low-level calls using the Ace client C API by calling
1010             db(). This fetches an Ace::AceDB object. See THE LOW LEVEL C API for
1011             details on using this object.
1012            
1013             $low_level = $db->db();
1014            
1015             =head2 connect() -- single argument form
1016            
1017             $db = Ace->connect('sace://stein.cshl.org:1880')
1018            
1019             Ace->connect() also accepts a single argument form using a URL-type
1020             syntax. The general syntax is:
1021            
1022             protocol://hostname:port/path
1023            
1024             The I<:port> and I</path> parts are protocol-dependent as described
1025             above.
1026            
1027             Protocols:
1028            
1029             =over 4
1030            
1031             =item sace://hostname:port
1032            
1033             Connect to a socket server at the indicated hostname and port. Example:
1034            
1035             sace://stein.cshl.org:1880
1036            
1037             If not provided, the port defaults to 2005.
1038            
1039             =item rpcace://hostname:port
1040            
1041             Connect to an RPC server at the indicated hostname and RPC service number. Example:
1042            
1043             rpcace://stein.cshl.org:400000
1044            
1045             If not provided, the port defaults to 200005
1046            
1047             =item tace:/path/to/database
1048            
1049             Open up the local database at F</path/to/database> using tace. Example:
1050            
1051             tace:/~acedb/elegans
1052            
1053             =item /path/to/database
1054            
1055             Same as the previous.
1056            
1057             =back
1058            
1059             =head2 close() Method
1060            
1061             You can explicitly close a database by calling its close() method:
1062            
1063             $db->close();
1064            
1065             This is not ordinarily necessary because the database will be
1066             automatically close when it -- and all objects retrieved from it -- go
1067             out of scope.
1068            
1069             =head2 reopen() Method
1070            
1071             The ACeDB socket server can time out. The reopen() method will ping
1072             the server and if it is not answering will reopen the connection. If
1073             the database is live (or could be resurrected), this method returns
1074             true.
1075            
1076             =head1 RETRIEVING ACEDB OBJECTS
1077            
1078             Once you have established a connection and have an Ace databaes
1079             handle, several methods can be used to query the ACE database to
1080             retrieve objects. You can then explore the objects, retrieve specific
1081             fields from them, or update them using the I<Ace::Object> methods.
1082             Please see L<Ace::Object>.
1083            
1084             =head2 fetch() method
1085            
1086             $count = $db->fetch($class,$name_pattern);
1087             $object = $db->fetch($class,$name);
1088             @objects = $db->fetch($class,$name_pattern,[$count,$offset]);
1089             @objects = $db->fetch(-name=>$name_pattern,
1090             -class=>$class
1091             -count=>$count,
1092             -offset=>$offset,
1093             -fill=>$fill,
1094             -filltag=>$tag,
1095             -total=>\$total);
1096             @objects = $db->fetch(-query=>$query);
1097            
1098             Ace::fetch() retrieves objects from the database based on their class
1099             and name. You may retrieve a single object by requesting its name, or
1100             a group of objects by fetching a name I<pattern>. A pattern contains
1101             one or more wildcard characters, where "*" stands for zero or more
1102             characters, and "?" stands for any single character.
1103            
1104             This method behaves differently depending on whether it is called in a
1105             scalar or a list context, and whether it is asked to search for a name
1106             pattern or a simple name.
1107            
1108             When called with a class and a simple name, it returns the object
1109             referenced by that time, or undef, if no such object exists. In an
1110             array context, it will return an empty list.
1111            
1112             When called with a class and a name pattern in a list context, fetch()
1113             returns the list of objects that match the name. When called with a
1114             pattern in a scalar context, fetch() returns the I<number> of objects
1115             that match without actually retrieving them from the database. Thus,
1116             it is similar to count().
1117            
1118             In the examples below, the first line of code will fetch the Sequence
1119             object whose database ID is I<D12345>. The second line will retrieve
1120             all objects matching the pattern I<D1234*>. The third line will
1121             return the count of objects that match the same pattern.
1122            
1123             $object = $db->fetch(Sequence => 'D12345');
1124             @objects = $db->fetch(Sequence => 'D1234*');
1125             $cnt = $db->fetch(Sequence =>'D1234*');
1126            
1127             A variety of communications and database errors may occur while
1128             processing the request. When this happens, undef or an empty list
1129             will be returned, and a string describing the error can be retrieved
1130             by calling Ace->error.
1131            
1132             When retrieving database objects, it is possible to retrieve a
1133             "filled" or an "unfilled" object. A filled object contains the entire
1134             contents of the object, including all tags and subtags. In the case
1135             of certain Sequence objects, this may be a significant amount of data.
1136             Unfilled objects consist just of the object name. They are filled in
1137             from the database a little bit at a time as tags are requested. By
1138             default, fetch() returns the unfilled object. This is usually a
1139             performance win, but if you know in advance that you will be needing
1140             the full contents of the retrieved object (for example, to display
1141             them in a tree browser) it can be more efficient to fetch them in
1142             filled mode. You do this by calling fetch() with the argument of
1143             B<-fill> set to a true value.
1144            
1145             The B<-filltag> argument, if provided, asks the database to fill in
1146             the subtree anchored at the indicated tag. This will improve
1147             performance for frequently-accessed subtrees. For example:
1148            
1149             @objects = $db->fetch(-name => 'D123*',
1150             -class => 'Sequence',
1151             -filltag => 'Visible');
1152            
1153             This will fetch all Sequences named D123* and fill in their Visible
1154             trees in a single operation.
1155            
1156             Other arguments in the named parameter calling form are B<-count>, to
1157             retrieve a certain maximum number of objects, and B<-offset>, to
1158             retrieve objects beginning at the indicated offset into the list. If
1159             you want to limit the number of objects returned, but wish to learn
1160             how many objects might have been retrieved, pass a reference to a
1161             scalar variable in the B<-total> argument. This will return the
1162             object count. This example shows how to fetch 100 Sequence
1163             objects, starting at Sequence number 500:
1164            
1165             @some_sequences = $db->fetch('Sequence','*',100,500);
1166            
1167             The next example uses the named argument form to fetch 100 Sequence
1168             objects starting at Sequence number 500, and leave the total number of
1169             Sequences in $total:
1170            
1171             @some_sequences = $db->fetch(-class => 'Sequence',
1172             -count => 100,
1173             -offset => 500,
1174             -total => \$total);
1175            
1176             Notice that if you leave out the B<-name> argument the "*" wildcard is
1177             assumed.
1178            
1179             You may also pass an arbitrary Ace query string with the B<-query>
1180             argument. This will supersede any name and class you provide.
1181             Example:
1182            
1183             @ready_dnas= $db->fetch(-query=>
1184             'find Annotation Ready_for_submission ; follow gene ;
1185             follow derived_sequence ; >DNA');
1186            
1187             If your request is likely to retrieve very many objects, fetch() many
1188             consume a lot of memory, even if B<-fill> is false. Consider using
1189             B<fetch_many()> instead (see below). Also see the get() method, which
1190             is equivalent to the simple two-argument form of fetch().
1191            
1192             =item get() method
1193            
1194             $object = $db->get($class,$name [,$fill]);
1195            
1196             The get() method will return one and only one AceDB object
1197             identified by its class and name. The optional $fill argument can be
1198             used to control how much data is retrieved from the database. If $fill
1199             is absent or undefined, then the method will return a lightweight
1200             "stub" object that is filled with information as requested in a lazy
1201             fashion. If $fill is the number "1" then the retrieved object contains
1202             all the relevant information contained within the database. Any other
1203             true value of $fill will be treated as a tag name: the returned object
1204             will be prefilled with the subtree to the right of that tag.
1205            
1206             Examples:
1207            
1208             # return lightweight stub for Author object "Sulston JE."
1209             $author = $db->get(Author=>'Sulston JE');
1210            
1211             # return heavyweight object
1212             $author = $db->get(Author=>'Sulston JE',1);
1213            
1214             # return object containing the Address subtree
1215             $author = $db->get(Author=>'Sulston JE','Address');
1216            
1217             The get() method is equivalent to this form of the fetch()
1218             method:
1219            
1220             $object = $db->fetch($class=>$name);
1221            
1222             =head2 aql() method
1223            
1224             $count = $db->aql($aql_query);
1225             @objects = $db->aql($aql_query);
1226            
1227             Ace::aql() will perform an AQL query on the database. In a scalar
1228             context it returns the number of rows returned. In an array context
1229             it returns a list of rows. Each row is an anonymous array containing
1230             the columns returned by the query as an Ace::Object.
1231            
1232             If an AQL error is encountered, will return undef or an empty list and
1233             set Ace->error to the error message.
1234            
1235             Note that this routine is not optimized -- there is no iterator
1236             defined. All results are returned synchronously, leading to large
1237             memory consumption for certain queries.
1238            
1239             =head2 put() method
1240            
1241             $cnt = $db->put($obj1,$obj2,$obj3);
1242            
1243             This method will put the list of objects into the database,
1244             overwriting like-named objects if they are already there. This can
1245             be used to copy an object from one database to another, provided that
1246             the models are compatible.
1247            
1248             The method returns the count of objects successfully written into the
1249             database. In case of an error, processing will stop at the last
1250             object successfully written and an error message will be placed in
1251             Ace->error();
1252            
1253             =head2 parse() method
1254            
1255             $object = $db->parse('data to parse');
1256            
1257             This will parse the Ace tags contained within the "data to parse"
1258             string, convert it into an object in the databse, and return the
1259             resulting Ace::Object. In case of a parse error, the undefined value
1260             will be returned and a (hopefully informative) description of the
1261             error will be returned by Ace->error().
1262            
1263             For example:
1264            
1265             $author = $db->parse(<<END);
1266             Author : "Glimitz JR"
1267             Full_name "Jonathan R. Glimitz"
1268             Mail "128 Boylston Street"
1269             Mail "Boston, MA"
1270             Mail "USA"
1271             Laboratory GM
1272             END
1273            
1274             This method can also be used to parse several objects, but only the
1275             last object successfully parsed will be returned.
1276            
1277             =head2 parse_longtext() method
1278            
1279             $object = $db->parse($title,$text);
1280            
1281             This will parse the long text (which may contain carriage returns and
1282             other funny characters) and place it into the database with the given
1283             title. In case of a parse error, the undefined value will be returned
1284             and a (hopefully informative) description of the error will be
1285             returned by Ace->error(); otherwise, a LongText object will be returned.
1286            
1287             For example:
1288            
1289             $author = $db->parse_longtext('A Novel Inhibitory Domain',<<END);
1290             We have discovered a novel inhibitory domain that inhibits
1291             many classes of proteases, including metallothioproteins.
1292             This inhibitory domain appears in three different gene families studied
1293             to date...
1294             END
1295            
1296             =head2 parse_file() method
1297            
1298             @objects = $db->parse_file('/path/to/file');
1299             @objects = $db->parse_file('/path/to/file',1);
1300            
1301             This will call parse() to parse each of the objects found in the
1302             indicated .ace file, returning the list of objects successfully loaded
1303             into the database.
1304            
1305             By default, parsing will stop at the first object that causes a parse
1306             error. If you wish to forge on after an error, pass a true value as
1307             the second argument to this method.
1308            
1309             Any parse error messages are accumulated in Ace->error().
1310            
1311             =head2 new() method
1312            
1313             $object = $db->new($class => $name);
1314            
1315             This method creates a new object in the database of type $class and
1316             name $name. If successful, it returns the newly-created object.
1317             Otherwise it returns undef and sets $db->error().
1318            
1319             $name may contain sprintf()-style patterns. If one of the patterns is
1320             %d (or a variant), Acedb uses a class-specific unique numbering to return
1321             a unique name. For example:
1322            
1323             $paper = $db->new(Paper => 'wgb%06d');
1324            
1325             The object is created in the database atomically. There is no chance to rollback as there is
1326             in Ace::Object's object editing methods.
1327            
1328             See also the Ace::Object->add() and replace() methods.
1329            
1330             =head2 list() method
1331            
1332             @objects = $db->list(class,pattern,[count,offset]);
1333             @objects = $db->list(-class=>$class,
1334             -name=>$name_pattern,
1335             -count=>$count,
1336             -offset=>$offset);
1337            
1338             This is a deprecated method. Use fetch() instead.
1339            
1340             =head2 count() method
1341            
1342             $count = $db->count($class,$pattern);
1343             $count = $db->count(-query=>$query);
1344            
1345             This function queries the database for a list of objects matching the
1346             specified class and pattern, and returns the object count. For large
1347             sets of objects this is much more time and memory effective than
1348             fetching the entire list.
1349            
1350             The class and name pattern are the same as the list() method above.
1351            
1352             You may also provide a B<-query> argument to instead specify an
1353             arbitrary ACE query such as "find Author COUNT Paper > 80". See
1354             find() below.
1355            
1356             =head2 find() method
1357            
1358             @objects = $db->find($query_string);
1359             @objects = $db->find(-query => $query_string,
1360             -offset=> $offset,
1361             -count => $count
1362             -fill => $fill);
1363            
1364             This allows you to pass arbitrary Ace query strings to the server and
1365             retrieve all objects that are returned as a result. For example, this
1366             code fragment retrieves all papers written by Jean and Danielle
1367             Thierry-Mieg.
1368            
1369             @papers = $db->find('author IS "Thierry-Mieg *" ; >Paper');
1370            
1371             You can find the full query syntax reference guide plus multiple
1372             examples at http://probe.nalusda.gov:8000/acedocs/index.html#query.
1373            
1374             In the named parameter calling form, B<-count>, B<-offset>, and
1375             B<-fill> have the same meanings as in B<fetch()>.
1376            
1377             =head2 fetch_many() method
1378            
1379             $obj = $db->fetch_many($class,$pattern);
1380            
1381             $obj = $db->fetch_many(-class=>$class,
1382             -name =>$pattern,
1383             -fill =>$filled,
1384             -chunksize=>$chunksize);
1385            
1386             $obj = $db->fetch_many(-query=>$query);
1387            
1388             If you expect to retrieve many objects, you can fetch an iterator
1389             across the data set. This is friendly both in terms of network
1390             bandwidth and memory consumption. It is simple to use:
1391            
1392             $i = $db->fetch_many(Sequence,'*'); # all sequences!!!!
1393             while ($obj = $i->next) {
1394             print $obj->asTable;
1395             }
1396            
1397             The iterator will return undef when it has finished iterating, and
1398             cannot be used again. You can have multiple iterators open at once
1399             and they will operate independently of each other.
1400            
1401             Like B<fetch()>, B<fetch_many()> takes an optional B<-fill> (or
1402             B<-filled>) argument which retrieves the entire object rather than
1403             just its name. This is efficient on a network with high latency if
1404             you expect to be touching many parts of the object (rather than
1405             just retrieving the value of a few tags).
1406            
1407             B<fetch_many()> retrieves objects from the database in groups of a
1408             certain maximum size, 40 by default. This can be tuned using the
1409             optional B<-chunksize> argument. Chunksize is only a hint to the
1410             database. It may return fewer objects per transaction, particularly
1411             if the objects are large.
1412            
1413             You may provide raw Ace query string with the B<-query> argument. If
1414             present the B<-name> and B<-class> arguments will be ignored.
1415            
1416             =head2 find_many() method
1417            
1418             This is an alias for fetch_many(). It is now deprecated.
1419            
1420             =head2 keyset() method
1421            
1422             @objects = $db->keyset($keyset_name);
1423            
1424             This method returns all objects in a named keyset. Wildcard
1425             characters are accepted, in which case all keysets that match the
1426             pattern will be retrieved and merged into a single list of unique
1427             objects.
1428            
1429             =head2 grep() method
1430            
1431             @objects = $db->grep($grep_string);
1432             $count = $db->grep($grep_string);
1433             @objects = $db->grep(-pattern => $grep_string,
1434             -offset=> $offset,
1435             -count => $count,
1436             -fill => $fill,
1437             -filltag => $filltag,
1438             -total => \$total,
1439             -long => 1,
1440             );
1441            
1442             This performs a "grep" on the database, returning all object names or
1443             text that contain the indicated grep pattern. In a scalar context
1444             this call will return the number of matching objects. In an array
1445             context, the list of matching objects are retrieved. There is also a
1446             named-parameter form of the call, which allows you to specify the
1447             number of objects to retrieve, the offset from the beginning of the
1448             list to retrieve from, whether the retrieved objects should be filled
1449             initially. You can use B<-total> to discover the total number of
1450             objects that match, while only retrieving a portion of the list.
1451            
1452             By default, grep uses a fast search that only examines class names and
1453             lexiques. By providing a true value to the B<-long> parameter, you
1454             can search inside LongText and other places that are not usually
1455             touched on, at the expense of much more CPU time.
1456            
1457             Due to "not listable" objects that may match during grep, the list of
1458             objects one can retrieve may not always match the count.
1459            
1460             =head2 model() method
1461            
1462             $model = $db->model('Author');
1463            
1464             This will return an I<Ace::Model> object corresponding to the
1465             indicated class.
1466            
1467             =head2 new() method
1468            
1469             $obj = $db->new($class,$name);
1470             $obj = $db->new(-class=>$class,
1471             -name=>$name);
1472            
1473             Create a new object in the database with the indicated class and name
1474             and return a pointer to it. Will return undef if the object already
1475             exists in the database. The object isn't actually written into the database
1476             until you call Ace::Object::commit().
1477            
1478             =head2 raw_query() method
1479            
1480             $r = $db->raw_query('Model');
1481            
1482             Send a command to the database and return its unprocessed output.
1483             This method is necessary to gain access to features that are not yet
1484             implemented in this module, such as model browsing and complex
1485             queries.
1486            
1487             =head2 classes() method
1488            
1489             @classes = $db->classes();
1490             @all_classes = $db->classes(1);
1491            
1492             This method returns a list of all the object classes known to the
1493             server. In a list context it returns an array of class names. In a
1494