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 23rd June 1994
   5 # version 0.1
   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 #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
 174 $DB_BTREE = TIEHASH DB_File::BTREEINFO ;
 175 $DB_HASH  = TIEHASH DB_File::HASHINFO ;
 176 $DB_RECNO = TIEHASH DB_File::RECNOINFO ;
 177
 178 require TieHash;
 179 require Exporter;
 180 require AutoLoader;
 181 require DynaLoader;
 182 @ISA = (TieHash, Exporter, DynaLoader);
 183 @EXPORT = qw(
 184         $DB_BTREE $DB_HASH $DB_RECNO
 185         BTREEMAGIC
 186         BTREEVERSION
 187         DB_LOCK
 188         DB_SHMEM
 189         DB_TXN
 190         HASHMAGIC
 191         HASHVERSION
 192         MAX_PAGE_NUMBER
 193         MAX_PAGE_OFFSET
 194         MAX_REC_NUMBER
 195         RET_ERROR
 196         RET_SPECIAL
 197         RET_SUCCESS
 198         R_CURSOR
 199         R_DUP
 200         R_FIRST
 201         R_FIXEDLEN
 202         R_IAFTER
 203         R_IBEFORE
 204         R_LAST
 205         R_NEXT
 206         R_NOKEY
 207         R_NOOVERWRITE
 208         R_PREV
 209         R_RECNOSYNC
 210         R_SETCURSOR
 211         R_SNAPSHOT
 212         __R_UNUSED
 213 );
 214
 215 sub AUTOLOAD {
 216     if (@_ > 1) {
 217         $AutoLoader::AUTOLOAD = $AUTOLOAD;
 218         goto &AutoLoader::AUTOLOAD;
 219     }
 220     local($constname);
 221     ($constname = $AUTOLOAD) =~ s/.*:://;
 222     $val = constant($constname, @_ ? $_[0] : 0);
 223     if ($! != 0) {
 224         if ($! =~ /Invalid/) {
 225             $AutoLoader::AUTOLOAD = $AUTOLOAD;
 226             goto &AutoLoader::AUTOLOAD;
 227         }
 228         else {
 229             ($pack,$file,$line) = caller;
 230             croak "Your vendor has not defined DB macro $constname, used at $file line $line.
 231 ";
 232         }
 233     }
 234     eval "sub $AUTOLOAD { $val }";
 235     goto &$AUTOLOAD;
 236 }
 237
 238 @liblist = ();
 239 @liblist = split ' ', $Config::Config{"DB_File_loadlibs"}
 240     if defined $Config::Config{"DB_File_loadlibs"};
 241
 242 bootstrap DB_File @liblist;
 243
 244 # Preloaded methods go here.  Autoload methods go after __END__, and are
 245 # processed by the autosplit program.
 246
 247 1;
 248 __END__