ext/DB_File/DB_File.xs

   1 /*
   2
   3  DB_File.xs -- Perl 5 interface to Berkeley DB
   4
   5  written by Paul Marquess (pmarquess@bfsec.bt.co.uk)
   6  last modified 14th November 1995
   7  version 1.01
   8
   9  All comments/suggestions/problems are welcome
  10
  11  Changes:
  12         0.1 -   Initial Release
  13         0.2 -   No longer bombs out if dbopen returns an error.
  14         0.3 -   Added some support for multiple btree compares
  15         1.0 -   Complete support for multiple callbacks added.
  16                 Fixed a problem with pushing a value onto an empty list.
  17         1.01 -  Fixed a SunOS core dump problem.
  18                 The return value from TIEHASH wasn't set to NULL when
  19                 dbopen returned an error.
  20 */
  21
  22 #include "EXTERN.h"
  23 #include "perl.h"
  24 #include "XSUB.h"
  25
  26 #include <db.h>
  27
  28 #include <fcntl.h>
  29
  30 typedef struct {
  31         DBTYPE  type ;
  32         DB *    dbp ;
  33         SV *    compare ;
  34         SV *    prefix ;
  35         SV *    hash ;
  36         } DB_File_type;
  37
  38 typedef DB_File_type * DB_File ;
  39 typedef DBT DBTKEY ;
  40
  41 union INFO {
  42         HASHINFO        hash ;
  43         RECNOINFO       recno ;
  44         BTREEINFO       btree ;
  45       } ;
  46
  47
  48 /* #define TRACE  */
  49
  50 #define db_DESTROY(db)                  ((db->dbp)->close)(db->dbp)
  51 #define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, &key, flags)
  52 #define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, &key, &value, flags)
  53 #define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, &key, &value, flags)
  54
  55 #define db_close(db)                    ((db->dbp)->close)(db->dbp)
  56 #define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
  57 #define db_fd(db)                       ((db->dbp)->fd)(db->dbp)
  58 #define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
  59 #define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, &key, &value, flags)
  60 #define db_seq(db, key, value, flags)   ((db->dbp)->seq)(db->dbp, &key, &value, flags)
  61 #define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
  62
  63
  64 #define OutputValue(arg, name)  \
  65         { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
  66
  67 #define OutputKey(arg, name)                                    \
  68         { if (RETVAL == 0) \
  69           {                                                     \
  70                 if (db->type != DB_RECNO)                       \
  71                     sv_setpvn(arg, name.data, name.size);       \
  72                 else                                            \
  73                     sv_setiv(arg, (I32)*(I32*)name.data - 1);   \
  74           }                                                     \
  75         }
  76
  77 /* Internal Global Data */
  78 static recno_t Value ;
  79 static DB_File CurrentDB ;
  80 static recno_t zero = 0 ;
  81 static DBTKEY empty = { &zero, sizeof(recno_t) } ;
  82
  83
  84 static int
  85 btree_compare(key1, key2)
  86 const DBT * key1 ;
  87 const DBT * key2 ;
  88 {
  89     dSP ;
  90     void * data1, * data2 ;
  91     int retval ;
  92     int count ;
  93
  94     data1 = key1->data ;
  95     data2 = key2->data ;
  96
  97     /* As newSVpv will assume that the data pointer is a null terminated C
  98        string if the size parameter is 0, make sure that data points to an
  99        empty string if the length is 0
 100     */
 101     if (key1->size == 0)
 102         data1 = "" ;
 103     if (key2->size == 0)
 104         data2 = "" ;
 105
 106     ENTER ;
 107     SAVETMPS;
 108
 109     PUSHMARK(sp) ;
 110     EXTEND(sp,2) ;
 111     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 112     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 113     PUTBACK ;
 114
 115     count = perl_call_sv(CurrentDB->compare, G_SCALAR);
 116
 117     SPAGAIN ;
 118
 119     if (count != 1)
 120         croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
 121
 122     retval = POPi ;
 123
 124     PUTBACK ;
 125     FREETMPS ;
 126     LEAVE ;
 127     return (retval) ;
 128
 129 }
 130
 131 static DB_Prefix_t
 132 btree_prefix(key1, key2)
 133 const DBT * key1 ;
 134 const DBT * key2 ;
 135 {
 136     dSP ;
 137     void * data1, * data2 ;
 138     int retval ;
 139     int count ;
 140
 141     data1 = key1->data ;
 142     data2 = key2->data ;
 143
 144     /* As newSVpv will assume that the data pointer is a null terminated C
 145        string if the size parameter is 0, make sure that data points to an
 146        empty string if the length is 0
 147     */
 148     if (key1->size == 0)
 149         data1 = "" ;
 150     if (key2->size == 0)
 151         data2 = "" ;
 152
 153     ENTER ;
 154     SAVETMPS;
 155
 156     PUSHMARK(sp) ;
 157     EXTEND(sp,2) ;
 158     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 159     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 160     PUTBACK ;
 161
 162     count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
 163
 164     SPAGAIN ;
 165
 166     if (count != 1)
 167         croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
 168
 169     retval = POPi ;
 170
 171     PUTBACK ;
 172     FREETMPS ;
 173     LEAVE ;
 174
 175     return (retval) ;
 176 }
 177
 178 static DB_Hash_t
 179 hash_cb(data, size)
 180 const void * data ;
 181 size_t size ;
 182 {
 183     dSP ;
 184     int retval ;
 185     int count ;
 186
 187     if (size == 0)
 188         data = "" ;
 189
 190     PUSHMARK(sp) ;
 191     XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
 192     PUTBACK ;
 193
 194     count = perl_call_sv(CurrentDB->hash, G_SCALAR);
 195
 196     SPAGAIN ;
 197
 198     if (count != 1)
 199         croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
 200
 201     retval = POPi ;
 202
 203     PUTBACK ;
 204     FREETMPS ;
 205     LEAVE ;
 206
 207     return (retval) ;
 208 }
 209
 210
 211 #ifdef TRACE
 212
 213 static void
 214 PrintHash(hash)
 215 HASHINFO hash ;
 216 {
 217     printf ("HASH Info\n") ;
 218     printf ("  hash      = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
 219     printf ("  bsize     = %d\n", hash.bsize) ;
 220     printf ("  ffactor   = %d\n", hash.ffactor) ;
 221     printf ("  nelem     = %d\n", hash.nelem) ;
 222     printf ("  cachesize = %d\n", hash.cachesize) ;
 223     printf ("  lorder    = %d\n", hash.lorder) ;
 224
 225 }
 226
 227 static void
 228 PrintRecno(recno)
 229 RECNOINFO recno ;
 230 {
 231     printf ("RECNO Info\n") ;
 232     printf ("  flags     = %d\n", recno.flags) ;
 233     printf ("  cachesize = %d\n", recno.cachesize) ;
 234     printf ("  psize     = %d\n", recno.psize) ;
 235     printf ("  lorder    = %d\n", recno.lorder) ;
 236     printf ("  reclen    = %d\n", recno.reclen) ;
 237     printf ("  bval      = %d\n", recno.bval) ;
 238     printf ("  bfname    = %s\n", recno.bfname) ;
 239 }
 240
 241 PrintBtree(btree)
 242 BTREEINFO btree ;
 243 {
 244     printf ("BTREE Info\n") ;
 245     printf ("  compare    = %s\n", (btree.compare ? "redefined" : "default")) ;
 246     printf ("  prefix     = %s\n", (btree.prefix ? "redefined" : "default")) ;
 247     printf ("  flags      = %d\n", btree.flags) ;
 248     printf ("  cachesize  = %d\n", btree.cachesize) ;
 249     printf ("  psize      = %d\n", btree.psize) ;
 250     printf ("  maxkeypage = %d\n", btree.maxkeypage) ;
 251     printf ("  minkeypage = %d\n", btree.minkeypage) ;
 252     printf ("  lorder     = %d\n", btree.lorder) ;
 253 }
 254
 255 #else
 256
 257 #define PrintRecno(recno)
 258 #define PrintHash(hash)
 259 #define PrintBtree(btree)
 260
 261 #endif /* TRACE */
 262
 263
 264 static I32
 265 GetArrayLength(db)
 266 DB * db ;
 267 {
 268     DBT         key ;
 269     DBT         value ;
 270     int         RETVAL ;
 271
 272     RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
 273     if (RETVAL == 0)
 274         RETVAL = *(I32 *)key.data ;
 275     else if (RETVAL == 1) /* No key means empty file */
 276         RETVAL = 0 ;
 277
 278     return (RETVAL) ;
 279 }
 280
 281 static DB_File
 282 ParseOpenInfo(name, flags, mode, sv, string)
 283 char * name ;
 284 int    flags ;
 285 int    mode ;
 286 SV *   sv ;
 287 char * string ;
 288 {
 289     SV **       svp;
 290     HV *        action ;
 291     union INFO  info ;
 292     DB_File     RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
 293     void *      openinfo = NULL ;
 294     /* DBTYPE   type = DB_HASH ; */
 295
 296     RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
 297     RETVAL->type = DB_HASH ;
 298
 299     if (sv)
 300     {
 301         if (! SvROK(sv) )
 302             croak ("type parameter is not a reference") ;
 303
 304         action = (HV*)SvRV(sv);
 305         if (sv_isa(sv, "DB_File::HASHINFO"))
 306         {
 307             RETVAL->type = DB_HASH ;
 308             openinfo = (void*)&info ;
 309
 310             svp = hv_fetch(action, "hash", 4, FALSE);
 311
 312             if (svp && SvOK(*svp))
 313             {
 314                 info.hash.hash = hash_cb ;
 315                 RETVAL->hash = newSVsv(*svp) ;
 316             }
 317             else
 318                 info.hash.hash = NULL ;
 319
 320            svp = hv_fetch(action, "bsize", 5, FALSE);
 321            info.hash.bsize = svp ? SvIV(*svp) : 0;
 322
 323            svp = hv_fetch(action, "ffactor", 7, FALSE);
 324            info.hash.ffactor = svp ? SvIV(*svp) : 0;
 325
 326            svp = hv_fetch(action, "nelem", 5, FALSE);
 327            info.hash.nelem = svp ? SvIV(*svp) : 0;
 328
 329            svp = hv_fetch(action, "cachesize", 9, FALSE);
 330            info.hash.cachesize = svp ? SvIV(*svp) : 0;
 331
 332            svp = hv_fetch(action, "lorder", 6, FALSE);
 333            info.hash.lorder = svp ? SvIV(*svp) : 0;
 334
 335            PrintHash(info) ;
 336         }
 337         else if (sv_isa(sv, "DB_File::BTREEINFO"))
 338         {
 339             RETVAL->type = DB_BTREE ;
 340             openinfo = (void*)&info ;
 341
 342             svp = hv_fetch(action, "compare", 7, FALSE);
 343             if (svp && SvOK(*svp))
 344             {
 345                 info.btree.compare = btree_compare ;
 346                 RETVAL->compare = newSVsv(*svp) ;
 347             }
 348             else
 349                 info.btree.compare = NULL ;
 350
 351             svp = hv_fetch(action, "prefix", 6, FALSE);
 352             if (svp && SvOK(*svp))
 353             {
 354                 info.btree.prefix = btree_prefix ;
 355                 RETVAL->prefix = newSVsv(*svp) ;
 356             }
 357             else
 358                 info.btree.prefix = NULL ;
 359
 360             svp = hv_fetch(action, "flags", 5, FALSE);
 361             info.btree.flags = svp ? SvIV(*svp) : 0;
 362
 363             svp = hv_fetch(action, "cachesize", 9, FALSE);
 364             info.btree.cachesize = svp ? SvIV(*svp) : 0;
 365
 366             svp = hv_fetch(action, "minkeypage", 10, FALSE);
 367             info.btree.minkeypage = svp ? SvIV(*svp) : 0;
 368
 369             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
 370             info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
 371
 372             svp = hv_fetch(action, "psize", 5, FALSE);
 373             info.btree.psize = svp ? SvIV(*svp) : 0;
 374
 375             svp = hv_fetch(action, "lorder", 6, FALSE);
 376             info.btree.lorder = svp ? SvIV(*svp) : 0;
 377
 378             PrintBtree(info) ;
 379
 380         }
 381         else if (sv_isa(sv, "DB_File::RECNOINFO"))
 382         {
 383             RETVAL->type = DB_RECNO ;
 384             openinfo = (void *)&info ;
 385
 386             svp = hv_fetch(action, "flags", 5, FALSE);
 387             info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
 388
 389             svp = hv_fetch(action, "cachesize", 9, FALSE);
 390             info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
 391
 392             svp = hv_fetch(action, "psize", 5, FALSE);
 393             info.recno.psize = (int) svp ? SvIV(*svp) : 0;
 394
 395             svp = hv_fetch(action, "lorder", 6, FALSE);
 396             info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
 397
 398             svp = hv_fetch(action, "reclen", 6, FALSE);
 399             info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
 400
 401             svp = hv_fetch(action, "bval", 4, FALSE);
 402             if (svp && SvOK(*svp))
 403             {
 404                 if (SvPOK(*svp))
 405                     info.recno.bval = (u_char)*SvPV(*svp, na) ;
 406                 else
 407                     info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
 408             }
 409             else
 410             {
 411                 if (info.recno.flags & R_FIXEDLEN)
 412                     info.recno.bval = (u_char) ' ' ;
 413                 else
 414                     info.recno.bval = (u_char) '\n' ;
 415             }
 416
 417             svp = hv_fetch(action, "bfname", 6, FALSE);
 418             info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
 419
 420             PrintRecno(info) ;
 421         }
 422         else
 423             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
 424     }
 425
 426
 427     RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ;
 428
 429 #if 0
 430     /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
 431                        so remember a DB_RECNO by saving the address
 432                        of one of it's internal routines
 433     */
 434     if (RETVAL->dbp && type == DB_RECNO)
 435         DB_recno_close = RETVAL->dbp->close ;
 436 #endif
 437
 438
 439     return (RETVAL) ;
 440 }
 441
 442
 443 static int
 444 not_here(s)
 445 char *s;
 446 {
 447     croak("DB_File::%s not implemented on this architecture", s);
 448     return -1;
 449 }
 450
 451 static double
 452 constant(name, arg)
 453 char *name;
 454 int arg;
 455 {
 456     errno = 0;
 457     switch (*name) {
 458     case 'A':
 459         break;
 460     case 'B':
 461         if (strEQ(name, "BTREEMAGIC"))
 462 #ifdef BTREEMAGIC
 463             return BTREEMAGIC;
 464 #else
 465             goto not_there;
 466 #endif
 467         if (strEQ(name, "BTREEVERSION"))
 468 #ifdef BTREEVERSION
 469             return BTREEVERSION;
 470 #else
 471             goto not_there;
 472 #endif
 473         break;
 474     case 'C':
 475         break;
 476     case 'D':
 477         if (strEQ(name, "DB_LOCK"))
 478 #ifdef DB_LOCK
 479             return DB_LOCK;
 480 #else
 481             goto not_there;
 482 #endif
 483         if (strEQ(name, "DB_SHMEM"))
 484 #ifdef DB_SHMEM
 485             return DB_SHMEM;
 486 #else
 487             goto not_there;
 488 #endif
 489         if (strEQ(name, "DB_TXN"))
 490 #ifdef DB_TXN
 491             return (U32)DB_TXN;
 492 #else
 493             goto not_there;
 494 #endif
 495         break;
 496     case 'E':
 497         break;
 498     case 'F':
 499         break;
 500     case 'G':
 501         break;
 502     case 'H':
 503         if (strEQ(name, "HASHMAGIC"))
 504 #ifdef HASHMAGIC
 505             return HASHMAGIC;
 506 #else
 507             goto not_there;
 508 #endif
 509         if (strEQ(name, "HASHVERSION"))
 510 #ifdef HASHVERSION
 511             return HASHVERSION;
 512 #else
 513             goto not_there;
 514 #endif
 515         break;
 516     case 'I':
 517         break;
 518     case 'J':
 519         break;
 520     case 'K':
 521         break;
 522     case 'L':
 523         break;
 524     case 'M':
 525         if (strEQ(name, "MAX_PAGE_NUMBER"))
 526 #ifdef MAX_PAGE_NUMBER
 527             return (U32)MAX_PAGE_NUMBER;
 528 #else
 529             goto not_there;
 530 #endif
 531         if (strEQ(name, "MAX_PAGE_OFFSET"))
 532 #ifdef MAX_PAGE_OFFSET
 533             return MAX_PAGE_OFFSET;
 534 #else
 535             goto not_there;
 536 #endif
 537         if (strEQ(name, "MAX_REC_NUMBER"))
 538 #ifdef MAX_REC_NUMBER
 539             return (U32)MAX_REC_NUMBER;
 540 #else
 541             goto not_there;
 542 #endif
 543         break;
 544     case 'N':
 545         break;
 546     case 'O':
 547         break;
 548     case 'P':
 549         break;
 550     case 'Q':
 551         break;
 552     case 'R':
 553         if (strEQ(name, "RET_ERROR"))
 554 #ifdef RET_ERROR
 555             return RET_ERROR;
 556 #else
 557             goto not_there;
 558 #endif
 559         if (strEQ(name, "RET_SPECIAL"))
 560 #ifdef RET_SPECIAL
 561             return RET_SPECIAL;
 562 #else
 563             goto not_there;
 564 #endif
 565         if (strEQ(name, "RET_SUCCESS"))
 566 #ifdef RET_SUCCESS
 567             return RET_SUCCESS;
 568 #else
 569             goto not_there;
 570 #endif
 571         if (strEQ(name, "R_CURSOR"))
 572 #ifdef R_CURSOR
 573             return R_CURSOR;
 574 #else
 575             goto not_there;
 576 #endif
 577         if (strEQ(name, "R_DUP"))
 578 #ifdef R_DUP
 579             return R_DUP;
 580 #else
 581             goto not_there;
 582 #endif
 583         if (strEQ(name, "R_FIRST"))
 584 #ifdef R_FIRST
 585             return R_FIRST;
 586 #else
 587             goto not_there;
 588 #endif
 589         if (strEQ(name, "R_FIXEDLEN"))
 590 #ifdef R_FIXEDLEN
 591             return R_FIXEDLEN;
 592 #else
 593             goto not_there;
 594 #endif
 595         if (strEQ(name, "R_IAFTER"))
 596 #ifdef R_IAFTER
 597             return R_IAFTER;
 598 #else
 599             goto not_there;
 600 #endif
 601         if (strEQ(name, "R_IBEFORE"))
 602 #ifdef R_IBEFORE
 603             return R_IBEFORE;
 604 #else
 605             goto not_there;
 606 #endif
 607         if (strEQ(name, "R_LAST"))
 608 #ifdef R_LAST
 609             return R_LAST;
 610 #else
 611             goto not_there;
 612 #endif
 613         if (strEQ(name, "R_NEXT"))
 614 #ifdef R_NEXT
 615             return R_NEXT;
 616 #else
 617             goto not_there;
 618 #endif
 619         if (strEQ(name, "R_NOKEY"))
 620 #ifdef R_NOKEY
 621             return R_NOKEY;
 622 #else
 623             goto not_there;
 624 #endif
 625         if (strEQ(name, "R_NOOVERWRITE"))
 626 #ifdef R_NOOVERWRITE
 627             return R_NOOVERWRITE;
 628 #else
 629             goto not_there;
 630 #endif
 631         if (strEQ(name, "R_PREV"))
 632 #ifdef R_PREV
 633             return R_PREV;
 634 #else
 635             goto not_there;
 636 #endif
 637         if (strEQ(name, "R_RECNOSYNC"))
 638 #ifdef R_RECNOSYNC
 639             return R_RECNOSYNC;
 640 #else
 641             goto not_there;
 642 #endif
 643         if (strEQ(name, "R_SETCURSOR"))
 644 #ifdef R_SETCURSOR
 645             return R_SETCURSOR;
 646 #else
 647             goto not_there;
 648 #endif
 649         if (strEQ(name, "R_SNAPSHOT"))
 650 #ifdef R_SNAPSHOT
 651             return R_SNAPSHOT;
 652 #else
 653             goto not_there;
 654 #endif
 655         break;
 656     case 'S':
 657         break;
 658     case 'T':
 659         break;
 660     case 'U':
 661         break;
 662     case 'V':
 663         break;
 664     case 'W':
 665         break;
 666     case 'X':
 667         break;
 668     case 'Y':
 669         break;
 670     case 'Z':
 671         break;
 672     case '_':
 673         if (strEQ(name, "__R_UNUSED"))
 674 #ifdef __R_UNUSED
 675             return __R_UNUSED;
 676 #else
 677             goto not_there;
 678 #endif
 679         break;
 680     }
 681     errno = EINVAL;
 682     return 0;
 683
 684 not_there:
 685     errno = ENOENT;
 686     return 0;
 687 }
 688
 689 MODULE = DB_File        PACKAGE = DB_File       PREFIX = db_
 690
 691 double
 692 constant(name,arg)
 693         char *          name
 694         int             arg
 695
 696
 697 DB_File
 698 db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH)
 699         char *          dbtype
 700         int             flags
 701         int             mode
 702         CODE:
 703         {
 704             char *      name = (char *) NULL ;
 705             SV *        sv = (SV *) NULL ;
 706
 707             if (items >= 2 && SvOK(ST(1)))
 708                 name = (char*) SvPV(ST(1), na) ;
 709
 710             if (items == 5)
 711                 sv = ST(4) ;
 712
 713             RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ;
 714             if (RETVAL->dbp == NULL)
 715                 RETVAL = NULL ;
 716         }
 717         OUTPUT:
 718             RETVAL
 719
 720 BOOT:
 721     newXS("DB_File::TIEARRAY", XS_DB_File_TIEHASH, file);
 722
 723 int
 724 db_DESTROY(db)
 725         DB_File         db
 726         INIT:
 727           CurrentDB = db ;
 728         CLEANUP:
 729           if (db->hash)
 730             SvREFCNT_dec(db->hash) ;
 731           if (db->compare)
 732             SvREFCNT_dec(db->compare) ;
 733           if (db->prefix)
 734             SvREFCNT_dec(db->prefix) ;
 735           Safefree(db) ;
 736
 737
 738 int
 739 db_DELETE(db, key, flags=0)
 740         DB_File         db
 741         DBTKEY          key
 742         u_int           flags
 743         INIT:
 744           CurrentDB = db ;
 745
 746 int
 747 db_FETCH(db, key, flags=0)
 748         DB_File         db
 749         DBTKEY          key
 750         u_int           flags
 751         CODE:
 752         {
 753             DBT         value  ;
 754
 755             CurrentDB = db ;
 756             RETVAL = ((db->dbp)->get)(db->dbp, &key, &value, flags) ;
 757             ST(0) = sv_newmortal();
 758             if (RETVAL == 0)
 759                 sv_setpvn(ST(0), value.data, value.size);
 760         }
 761
 762 int
 763 db_STORE(db, key, value, flags=0)
 764         DB_File         db
 765         DBTKEY          key
 766         DBT             value
 767         u_int           flags
 768         INIT:
 769           CurrentDB = db ;
 770
 771
 772 int
 773 db_FIRSTKEY(db)
 774         DB_File         db
 775         CODE:
 776         {
 777             DBTKEY              key ;
 778             DBT         value ;
 779             DB *        Db = db->dbp ;
 780
 781             CurrentDB = db ;
 782             RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
 783             ST(0) = sv_newmortal();
 784             if (RETVAL == 0)
 785             {
 786                 if (Db->type != DB_RECNO)
 787                     sv_setpvn(ST(0), key.data, key.size);
 788                 else
 789                     sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 790             }
 791         }
 792
 793 int
 794 db_NEXTKEY(db, key)
 795         DB_File         db
 796         DBTKEY          key
 797         CODE:
 798         {
 799             DBT         value ;
 800             DB *        Db = db->dbp ;
 801
 802             CurrentDB = db ;
 803             RETVAL = (Db->seq)(Db, &key, &value, R_NEXT) ;
 804             ST(0) = sv_newmortal();
 805             if (RETVAL == 0)
 806             {
 807                 if (Db->type != DB_RECNO)
 808                     sv_setpvn(ST(0), key.data, key.size);
 809                 else
 810                     sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 811             }
 812         }
 813
 814 #
 815 # These would be nice for RECNO
 816 #
 817
 818 int
 819 unshift(db, ...)
 820         DB_File         db
 821         CODE:
 822         {
 823             DBTKEY      key ;
 824             DBT         value ;
 825             int         i ;
 826             int         One ;
 827             DB *        Db = db->dbp ;
 828
 829             CurrentDB = db ;
 830             RETVAL = -1 ;
 831             for (i = items-1 ; i > 0 ; --i)
 832             {
 833                 value.data = SvPV(ST(i), na) ;
 834                 value.size = na ;
 835                 One = 1 ;
 836                 key.data = &One ;
 837                 key.size = sizeof(int) ;
 838                 RETVAL = (Db->put)(Db, &key, &value, R_IBEFORE) ;
 839                 if (RETVAL != 0)
 840                     break;
 841             }
 842         }
 843         OUTPUT:
 844             RETVAL
 845
 846 I32
 847 pop(db)
 848         DB_File         db
 849         CODE:
 850         {
 851             DBTKEY      key ;
 852             DBT         value ;
 853             DB *        Db = db->dbp ;
 854
 855             CurrentDB = db ;
 856             /* First get the final value */
 857             RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
 858             ST(0) = sv_newmortal();
 859             /* Now delete it */
 860             if (RETVAL == 0)
 861             {
 862                 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
 863                 if (RETVAL == 0)
 864                     sv_setpvn(ST(0), value.data, value.size);
 865             }
 866         }
 867
 868 I32
 869 shift(db)
 870         DB_File         db
 871         CODE:
 872         {
 873             DBTKEY      key ;
 874             DBT         value ;
 875             DB *        Db = db->dbp ;
 876
 877             CurrentDB = db ;
 878             /* get the first value */
 879             RETVAL = (Db->seq)(Db, &key, &value, R_FIRST) ;
 880             ST(0) = sv_newmortal();
 881             /* Now delete it */
 882             if (RETVAL == 0)
 883             {
 884                 RETVAL = (Db->del)(Db, &key, R_CURSOR) ;
 885                 if (RETVAL == 0)
 886                     sv_setpvn(ST(0), value.data, value.size);
 887             }
 888         }
 889
 890
 891 I32
 892 push(db, ...)
 893         DB_File         db
 894         CODE:
 895         {
 896             DBTKEY      key ;
 897             DBTKEY *    keyptr = &key ;
 898             DBT         value ;
 899             DB *        Db = db->dbp ;
 900             int         i ;
 901
 902             CurrentDB = db ;
 903             /* Set the Cursor to the Last element */
 904             RETVAL = (Db->seq)(Db, &key, &value, R_LAST) ;
 905             if (RETVAL >= 0)
 906             {
 907                 if (RETVAL == 1)
 908                     keyptr = &empty ;
 909                 for (i = items - 1 ; i > 0 ; --i)
 910                 {
 911                     value.data = SvPV(ST(i), na) ;
 912                     value.size = na ;
 913                     RETVAL = (Db->put)(Db, keyptr, &value, R_IAFTER) ;
 914                     if (RETVAL != 0)
 915                         break;
 916                 }
 917             }
 918         }
 919         OUTPUT:
 920             RETVAL
 921
 922
 923 I32
 924 length(db)
 925         DB_File         db
 926         CODE:
 927             CurrentDB = db ;
 928             RETVAL = GetArrayLength(db->dbp) ;
 929         OUTPUT:
 930             RETVAL
 931
 932
 933 #
 934 # Now provide an interface to the rest of the DB functionality
 935 #
 936
 937 int
 938 db_del(db, key, flags=0)
 939         DB_File         db
 940         DBTKEY          key
 941         u_int           flags
 942         INIT:
 943           CurrentDB = db ;
 944
 945
 946 int
 947 db_get(db, key, value, flags=0)
 948         DB_File         db
 949         DBTKEY          key
 950         DBT             value
 951         u_int           flags
 952         INIT:
 953           CurrentDB = db ;
 954         OUTPUT:
 955           value
 956
 957 int
 958 db_put(db, key, value, flags=0)
 959         DB_File         db
 960         DBTKEY          key
 961         DBT             value
 962         u_int           flags
 963         INIT:
 964           CurrentDB = db ;
 965         OUTPUT:
 966           key           if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
 967
 968 int
 969 db_fd(db)
 970         DB_File         db
 971         INIT:
 972           CurrentDB = db ;
 973
 974 int
 975 db_sync(db, flags=0)
 976         DB_File         db
 977         u_int           flags
 978         INIT:
 979           CurrentDB = db ;
 980
 981
 982 int
 983 db_seq(db, key, value, flags)
 984         DB_File         db
 985         DBTKEY          key
 986         DBT             value
 987         u_int           flags
 988         INIT:
 989           CurrentDB = db ;
 990         OUTPUT:
 991           key
 992           value