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