home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / ext / DB_File / DB_File.pm < prev    next >
Text File  |  1996-02-12  |  16KB  |  674 lines

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