08463dfabcd9eca6f73636f4c64547b99e9bf485
[p5sagit/p5-mst-13.2.git] / ext / DB_File / DB_File.pm
1 # DB_File.pm -- Perl 5 interface to Berkeley DB 
2 #
3 # written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
4 # last modified 14th November 1995
5 # version 1.01
6
7 package DB_File::HASHINFO ;
8 use Carp;
9
10 sub TIEHASH
11 {
12     bless {} ;
13 }
14
15 %elements = ( 'bsize'     => 0,
16               'ffactor'   => 0,
17               'nelem'     => 0,
18               'cachesize' => 0,
19               'hash'      => 0,
20               'lorder'    => 0
21             ) ;
22
23 sub FETCH 
24 {  
25     return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
26
27     croak "DB_File::HASHINFO::FETCH - Unknown element '$_[1]'" ;
28 }
29
30
31 sub STORE 
32 {
33     if ( defined $elements{$_[1]} )
34     {
35         $_[0]{$_[1]} = $_[2] ;
36         return ;
37     }
38     
39     croak "DB_File::HASHINFO::STORE - Unknown element '$_[1]'" ;
40 }
41
42 sub DELETE 
43 {
44     if ( defined $elements{$_[1]} )
45     {
46         delete ${$_[0]}{$_[1]} ;
47         return ;
48     }
49     
50     croak "DB_File::HASHINFO::DELETE - Unknown element '$_[1]'" ;
51 }
52
53
54 sub DESTROY {undef %{$_[0]} }
55 sub FIRSTKEY { croak "DB_File::HASHINFO::FIRSTKEY is not implemented" }
56 sub NEXTKEY { croak "DB_File::HASHINFO::NEXTKEY is not implemented" }
57 sub EXISTS { croak "DB_File::HASHINFO::EXISTS is not implemented" }
58 sub CLEAR { croak "DB_File::HASHINFO::CLEAR is not implemented" }
59
60 package DB_File::BTREEINFO ;
61 use Carp;
62
63 sub TIEHASH
64 {
65     bless {} ;
66 }
67
68 %elements = ( 'flags'   => 0,
69               'cachesize'  => 0,
70               'maxkeypage' => 0,
71               'minkeypage' => 0,
72               'psize'      => 0,
73               'compare'    => 0,
74               'prefix'     => 0,
75               'lorder'     => 0
76             ) ;
77
78 sub FETCH 
79 {  
80     return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
81
82     croak "DB_File::BTREEINFO::FETCH - Unknown element '$_[1]'" ;
83 }
84
85
86 sub STORE 
87 {
88     if ( defined $elements{$_[1]} )
89     {
90         $_[0]{$_[1]} = $_[2] ;
91         return ;
92     }
93     
94     croak "DB_File::BTREEINFO::STORE - Unknown element '$_[1]'" ;
95 }
96
97 sub DELETE 
98 {
99     if ( defined $elements{$_[1]} )
100     {
101         delete ${$_[0]}{$_[1]} ;
102         return ;
103     }
104     
105     croak "DB_File::BTREEINFO::DELETE - Unknown element '$_[1]'" ;
106 }
107
108
109 sub DESTROY {undef %{$_[0]} }
110 sub FIRSTKEY { croak "DB_File::BTREEINFO::FIRSTKEY is not implemented" }
111 sub NEXTKEY { croak "DB_File::BTREEINFO::NEXTKEY is not implemented" }
112 sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" }
113 sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" }
114
115 package DB_File::RECNOINFO ;
116 use Carp;
117
118 sub TIEHASH
119 {
120     bless {} ;
121 }
122
123 %elements = ( 'bval'      => 0,
124               'cachesize' => 0,
125               'psize'     => 0,
126               'flags'     => 0,
127               'lorder'    => 0,
128               'reclen'    => 0,
129               'bfname'    => 0
130             ) ;
131 sub FETCH 
132 {  
133     return $_[0]{$_[1]} if defined $elements{$_[1]}  ;
134
135     croak "DB_File::RECNOINFO::FETCH - Unknown element '$_[1]'" ;
136 }
137
138
139 sub STORE 
140 {
141     if ( defined $elements{$_[1]} )
142     {
143         $_[0]{$_[1]} = $_[2] ;
144         return ;
145     }
146     
147     croak "DB_File::RECNOINFO::STORE - Unknown element '$_[1]'" ;
148 }
149
150 sub DELETE 
151 {
152     if ( defined $elements{$_[1]} )
153     {
154         delete ${$_[0]}{$_[1]} ;
155         return ;
156     }
157     
158     croak "DB_File::RECNOINFO::DELETE - Unknown element '$_[1]'" ;
159 }
160
161
162 sub DESTROY {undef %{$_[0]} }
163 sub FIRSTKEY { croak "DB_File::RECNOINFO::FIRSTKEY is not implemented" }
164 sub NEXTKEY { croak "DB_File::RECNOINFO::NEXTKEY is not implemented" }
165 sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" }
166 sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" }
167
168
169
170 package DB_File ;
171 use Carp;
172
173 $VERSION = 1.01 ;
174
175 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
176 $DB_BTREE = TIEHASH DB_File::BTREEINFO ;
177 $DB_HASH  = TIEHASH DB_File::HASHINFO ;
178 $DB_RECNO = TIEHASH DB_File::RECNOINFO ;
179
180 require TieHash;
181 require Exporter;
182 use AutoLoader;
183 require DynaLoader;
184 @ISA = qw(TieHash Exporter DynaLoader);
185 @EXPORT = qw(
186         $DB_BTREE $DB_HASH $DB_RECNO 
187         BTREEMAGIC
188         BTREEVERSION
189         DB_LOCK
190         DB_SHMEM
191         DB_TXN
192         HASHMAGIC
193         HASHVERSION
194         MAX_PAGE_NUMBER
195         MAX_PAGE_OFFSET
196         MAX_REC_NUMBER
197         RET_ERROR
198         RET_SPECIAL
199         RET_SUCCESS
200         R_CURSOR
201         R_DUP
202         R_FIRST
203         R_FIXEDLEN
204         R_IAFTER
205         R_IBEFORE
206         R_LAST
207         R_NEXT
208         R_NOKEY
209         R_NOOVERWRITE
210         R_PREV
211         R_RECNOSYNC
212         R_SETCURSOR
213         R_SNAPSHOT
214         __R_UNUSED
215 );
216
217 sub AUTOLOAD {
218     local($constname);
219     ($constname = $AUTOLOAD) =~ s/.*:://;
220     $val = constant($constname, @_ ? $_[0] : 0);
221     if ($! != 0) {
222         if ($! =~ /Invalid/) {
223             $AutoLoader::AUTOLOAD = $AUTOLOAD;
224             goto &AutoLoader::AUTOLOAD;
225         }
226         else {
227             ($pack,$file,$line) = caller;
228             croak "Your vendor has not defined DB macro $constname, used at $file line $line.
229 ";
230         }
231     }
232     eval "sub $AUTOLOAD { $val }";
233     goto &$AUTOLOAD;
234 }
235
236 @liblist = ();
237 @liblist = split ' ', $Config::Config{"DB_File_loadlibs"} 
238     if defined $Config::Config{"DB_File_loadlibs"};
239
240 bootstrap DB_File @liblist;
241
242 # Preloaded methods go here.  Autoload methods go after __END__, and are
243 # processed by the autosplit program.
244
245 1;
246 __END__
247
248 =cut
249
250 =head1 NAME
251
252 DB_File - Perl5 access to Berkeley DB
253
254 =head1 SYNOPSIS
255
256  use DB_File ;
257   
258  [$X =] tie %hash,  DB_File, $filename [, $flags, $mode, $DB_HASH] ;
259  [$X =] tie %hash,  DB_File, $filename, $flags, $mode, $DB_BTREE ;
260  [$X =] tie @array, DB_File, $filename, $flags, $mode, $DB_RECNO ;
261    
262  $status = $X->del($key [, $flags]) ;
263  $status = $X->put($key, $value [, $flags]) ;
264  $status = $X->get($key, $value [, $flags]) ;
265  $status = $X->seq($key, $value [, $flags]) ;
266  $status = $X->sync([$flags]) ;
267  $status = $X->fd ;
268     
269  untie %hash ;
270  untie @array ;
271
272 =head1 DESCRIPTION
273
274 B<DB_File> is a module which allows Perl programs to make use of the
275 facilities provided by Berkeley DB.  If you intend to use this
276 module you should really have a copy of the Berkeley DB manualpage at
277 hand. The interface defined here mirrors the Berkeley DB interface
278 closely.
279
280 Berkeley DB is a C library which provides a consistent interface to a
281 number of database formats.  B<DB_File> provides an interface to all
282 three of the database types currently supported by Berkeley DB.
283
284 The file types are:
285
286 =over 5
287
288 =item DB_HASH
289
290 This database type allows arbitrary key/data pairs to be stored in data
291 files. This is equivalent to the functionality provided by other
292 hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. Remember though,
293 the files created using DB_HASH are not compatible with any of the
294 other packages mentioned.
295
296 A default hashing algorithm, which will be adequate for most
297 applications, is built into Berkeley DB. If you do need to use your own
298 hashing algorithm it is possible to write your own in Perl and have
299 B<DB_File> use it instead.
300
301 =item DB_BTREE
302
303 The btree format allows arbitrary key/data pairs to be stored in a
304 sorted, balanced binary tree.
305
306 As with the DB_HASH format, it is possible to provide a user defined
307 Perl routine to perform the comparison of keys. By default, though, the
308 keys are stored in lexical order.
309
310 =item DB_RECNO
311
312 DB_RECNO allows both fixed-length and variable-length flat text files
313 to be manipulated using the same key/value pair interface as in DB_HASH
314 and DB_BTREE.  In this case the key will consist of a record (line)
315 number.
316
317 =back
318
319 =head2 How does DB_File interface to Berkeley DB?
320
321 B<DB_File> allows access to Berkeley DB files using the tie() mechanism
322 in Perl 5 (for full details, see L<perlfunc/tie()>). This facility
323 allows B<DB_File> to access Berkeley DB files using either an
324 associative array (for DB_HASH & DB_BTREE file types) or an ordinary
325 array (for the DB_RECNO file type).
326
327 In addition to the tie() interface, it is also possible to use most of
328 the functions provided in the Berkeley DB API.
329
330 =head2 Differences with Berkeley DB
331
332 Berkeley DB uses the function dbopen() to open or create a database.
333 Below is the C prototype for dbopen().
334
335       DB*
336       dbopen (const char * file, int flags, int mode, 
337               DBTYPE type, const void * openinfo)
338
339 The parameter C<type> is an enumeration which specifies which of the 3
340 interface methods (DB_HASH, DB_BTREE or DB_RECNO) is to be used.
341 Depending on which of these is actually chosen, the final parameter,
342 I<openinfo> points to a data structure which allows tailoring of the
343 specific interface method.
344
345 This interface is handled slightly differently in B<DB_File>. Here is
346 an equivalent call using B<DB_File>.
347
348         tie %array, DB_File, $filename, $flags, $mode, $DB_HASH ;
349
350 The C<filename>, C<flags> and C<mode> parameters are the direct
351 equivalent of their dbopen() counterparts. The final parameter $DB_HASH
352 performs the function of both the C<type> and C<openinfo> parameters in
353 dbopen().
354
355 In the example above $DB_HASH is actually a reference to a hash
356 object. B<DB_File> has three of these pre-defined references. Apart
357 from $DB_HASH, there is also $DB_BTREE and $DB_RECNO.
358
359 The keys allowed in each of these pre-defined references is limited to
360 the names used in the equivalent C structure. So, for example, the
361 $DB_HASH reference will only allow keys called C<bsize>, C<cachesize>,
362 C<ffactor>, C<hash>, C<lorder> and C<nelem>.
363
364 To change one of these elements, just assign to it like this
365
366         $DB_HASH{cachesize} = 10000 ;
367
368
369 =head2 RECNO
370
371
372 In order to make RECNO more compatible with Perl the array offset for all
373 RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
374
375
376 =head2 In Memory Databases
377
378 Berkeley DB allows the creation of in-memory databases by using NULL
379 (that is, a C<(char *)0 in C) in place of the filename.  B<DB_File>
380 uses C<undef> instead of NULL to provide this functionality.
381
382
383 =head2 Using the Berkeley DB Interface Directly
384
385 As well as accessing Berkeley DB using a tied hash or array, it is also
386 possible to make direct use of most of the functions defined in the
387 Berkeley DB documentation.
388
389
390 To do this you need to remember the return value from the tie.
391
392         $db = tie %hash, DB_File, "filename"
393
394 Once you have done that, you can access the Berkeley DB API functions
395 directly.
396
397         $db->put($key, $value, R_NOOVERWRITE) ;
398
399 All the functions defined in L<dbx(3X)> are available except for
400 close() and dbopen() itself. The B<DB_File> interface to these
401 functions have been implemented to mirror the the way Berkeley DB
402 works. In particular note that all the functions return only a status
403 value. Whenever a Berkeley DB function returns data via one of its
404 parameters, the B<DB_File> equivalent does exactly the same.
405
406 All the constants defined in L<dbopen> are also available.
407
408 Below is a list of the functions available.
409
410 =over 5
411
412 =item get
413
414 Same as in C<recno> except that the flags parameter is optional.
415 Remember the value associated with the key you request is returned in
416 the $value parameter.
417
418 =item put
419
420 As usual the flags parameter is optional. 
421
422 If you use either the R_IAFTER or R_IBEFORE flags, the key parameter
423 will have the record number of the inserted key/value pair set.
424
425 =item del
426
427 The flags parameter is optional.
428
429 =item fd
430
431 As in I<recno>.
432
433 =item seq
434
435 The flags parameter is optional.
436
437 Both the key and value parameters will be set.
438
439 =item sync
440
441 The flags parameter is optional.
442
443 =back
444
445 =head1 EXAMPLES
446
447 It is always a lot easier to understand something when you see a real
448 example. So here are a few.
449
450 =head2 Using HASH
451
452         use DB_File ;
453         use Fcntl ;
454         
455         tie %h,  "DB_File", "hashed", O_RDWR|O_CREAT, 0640, $DB_HASH ;
456         
457         # Add a key/value pair to the file
458         $h{"apple"} = "orange" ;
459         
460         # Check for existence of a key
461         print "Exists\n" if $h{"banana"} ;
462         
463         # Delete 
464         delete $h{"apple"} ;
465         
466         untie %h ;
467
468 =head2 Using BTREE
469
470 Here is sample of code which used BTREE. Just to make life more
471 interesting the default comparision function will not be used. Instead
472 a Perl sub, C<Compare()>, will be used to do a case insensitive
473 comparison.
474
475         use DB_File ;
476         use Fcntl ;
477          
478         sub Compare
479         {
480             my ($key1, $key2) = @_ ;
481         
482             "\L$key1" cmp "\L$key2" ;
483         }
484         
485         $DB_BTREE->{compare} = 'Compare' ;
486          
487         tie %h,  'DB_File', "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE ;
488          
489         # Add a key/value pair to the file
490         $h{'Wall'} = 'Larry' ;
491         $h{'Smith'} = 'John' ;
492         $h{'mouse'} = 'mickey' ;
493         $h{'duck'}   = 'donald' ;
494          
495         # Delete
496         delete $h{"duck"} ;
497          
498         # Cycle through the keys printing them in order.
499         # Note it is not necessary to sort the keys as
500         # the btree will have kept them in order automatically.
501         foreach (keys %h)
502           { print "$_\n" }
503         
504         untie %h ;
505
506 Here is the output from the code above.
507
508         mouse
509         Smith
510         Wall
511
512
513 =head2 Using RECNO
514
515         use DB_File ;
516         use Fcntl ;
517         
518         $DB_RECNO->{psize} = 3000 ;
519         
520         tie @h,  DB_File, "text", O_RDWR|O_CREAT, 0640, $DB_RECNO ;
521         
522         # Add a key/value pair to the file
523         $h[0] = "orange" ;
524         
525         # Check for existence of a key
526         print "Exists\n" if $h[1] ;
527         
528         untie @h ;
529
530
531 =head2 Locking Databases
532
533 Concurrent access of a read-write database by several parties requires
534 them all to use some kind of locking.  Here's an example of Tom's that
535 uses the I<fd> method to get the file descriptor, and then a careful
536 open() to give something Perl will flock() for you.  Run this repeatedly
537 in the background to watch the locks granted in proper order.
538
539     use Fcntl;
540     use DB_File;
541
542     use strict;
543
544     sub LOCK_SH { 1 }
545     sub LOCK_EX { 2 }
546     sub LOCK_NB { 4 }
547     sub LOCK_UN { 8 }
548
549     my($oldval, $fd, $db, %db, $value, $key);
550
551     $key = shift || 'default';
552     $value = shift || 'magic';
553
554     $value .= " $$";
555
556     $db = tie(%db, 'DB_File', '/tmp/foo.db', O_CREAT|O_RDWR, 0644) 
557             || die "dbcreat /tmp/foo.db $!";
558     $fd = $db->fd;
559     print "$$: db fd is $fd\n";
560     open(DB_FH, "+<&=$fd") || die "dup $!";
561
562
563     unless (flock (DB_FH, LOCK_SH | LOCK_NB)) {
564         print "$$: CONTENTION; can't read during write update!
565                     Waiting for read lock ($!) ....";
566         unless (flock (DB_FH, LOCK_SH)) { die "flock: $!" }
567     } 
568     print "$$: Read lock granted\n";
569
570     $oldval = $db{$key};
571     print "$$: Old value was $oldval\n";
572     flock(DB_FH, LOCK_UN);
573
574     unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
575         print "$$: CONTENTION; must have exclusive lock!
576                     Waiting for write lock ($!) ....";
577         unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
578     } 
579
580     print "$$: Write lock granted\n";
581     $db{$key} = $value;
582     sleep 10;
583
584     flock(DB_FH, LOCK_UN);
585     untie %db;
586     close(DB_FH);
587     print "$$: Updated db to $key=$value\n";
588
589 =head1 HISTORY
590
591 =over
592
593 =item 0.1
594
595 First Release.
596
597 =item 0.2
598
599 When B<DB_File> is opening a database file it no longer terminates the
600 process if I<dbopen> returned an error. This allows file protection
601 errors to be caught at run time. Thanks to Judith Grass
602 E<lt>grass@cybercash.comE<gt> for spotting the bug.
603
604 =item 0.3
605
606 Added prototype support for multiple btree compare callbacks.
607
608 =item 1.0
609
610 B<DB_File> has been in use for over a year. To reflect that, the
611 version number has been incremented to 1.0.
612
613 Added complete support for multiple concurrent callbacks.
614
615 Using the I<push> method on an empty list didn't work properly. This
616 has been fixed.
617
618 =item 1.01
619
620 Fixed a core dump problem with SunOS.
621
622 The return value from TIEHASH wasn't set to NULL when dbopen returned
623 an error.
624
625 =head1 WARNINGS
626
627 If you happen find any other functions defined in the source for this
628 module that have not been mentioned in this document -- beware.  I may
629 drop them at a moments notice.
630
631 If you cannot find any, then either you didn't look very hard or the
632 moment has passed and I have dropped them.
633
634 =head1 BUGS
635
636 Some older versions of Berkeley DB had problems with fixed length
637 records using the RECNO file format. The newest version at the time of
638 writing was 1.85 - this seems to have fixed the problems with RECNO.
639
640 I am sure there are bugs in the code. If you do find any, or can
641 suggest any enhancements, I would welcome your comments.
642
643 =head1 AVAILABILITY
644
645 Berkeley DB is available at your nearest CPAN archive (see
646 L<perlmod/"CPAN"> for a list) in F<src/misc/db.1.85.tar.gz>, or via the
647 host F<ftp.cs.berkeley.edu> in F</ucb/4bsd/db.tar.gz>.  It is I<not> under
648 the GPL.
649
650 =head1 SEE ALSO
651
652 L<perl(1)>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)> 
653
654 Berkeley DB is available from F<ftp.cs.berkeley.edu> in the directory
655 F</ucb/4bsd>.
656
657 =head1 AUTHOR
658
659 The DB_File interface was written by Paul Marquess
660 <pmarquess@bfsec.bt.co.uk>.
661 Questions about the DB system itself may be addressed to Keith Bostic
662 <bostic@cs.berkeley.edu>.
663
664 =cut