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 23rd June 1994
   7  version 0.1
   8
   9  All comments/suggestions/problems are welcome
  10
  11 */
  12
  13 #include "EXTERN.h"
  14 #include "perl.h"
  15 #include "XSUB.h"
  16
  17 #include <db.h>
  18
  19 #include <fcntl.h>
  20
  21 #ifndef DBXS_HASH_TYPE
  22 #define DBXS_HASH_TYPE u_int32_t
  23 #endif
  24
  25 #ifndef DBXS_PREFIX_TYPE
  26 #define DBXS_PREFIX_TYPE size_t
  27 #endif
  28
  29 typedef DB * DB_File;
  30 typedef DBT DBTKEY ;
  31
  32 union INFO {
  33         HASHINFO        hash ;
  34         RECNOINFO       recno ;
  35         BTREEINFO       btree ;
  36       } ;
  37
  38 typedef struct {
  39             SV *        sub ;
  40         } CallBackInfo ;
  41
  42
  43 /* #define TRACE  */
  44
  45 #define db_DESTROY(db)                  (db->close)(db)
  46 #define db_DELETE(db, key, flags)       (db->del)(db, &key, flags)
  47 #define db_STORE(db, key, value, flags) (db->put)(db, &key, &value, flags)
  48 #define db_FETCH(db, key, flags)        (db->get)(db, &key, &value, flags)
  49
  50 #define db_close(db)                    (db->close)(db)
  51 #define db_del(db, key, flags)          (db->del)(db, &key, flags)
  52 #define db_fd(db)                       (db->fd)(db)
  53 #define db_put(db, key, value, flags)   (db->put)(db, &key, &value, flags)
  54 #define db_get(db, key, value, flags)   (db->get)(db, &key, &value, flags)
  55 #define db_seq(db, key, value, flags)   (db->seq)(db, &key, &value, flags)
  56 #define db_sync(db, flags)              (db->sync)(db, flags)
  57
  58
  59 #define OutputValue(arg, name)  \
  60         { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; }
  61
  62 #define OutputKey(arg, name)                                    \
  63         { if (RETVAL == 0) \
  64           {                                                     \
  65                 if (db->close != DB_recno_close)                \
  66                     sv_setpvn(arg, name.data, name.size);       \
  67                 else                                            \
  68                     sv_setiv(arg, (I32)*(I32*)name.data - 1);   \
  69           }                                                     \
  70         }
  71
  72 /* Internal Global Data */
  73
  74 static recno_t Value ;
  75 static int (*DB_recno_close)() = NULL ;
  76
  77 static CallBackInfo hash_callback       = { 0 } ;
  78 static CallBackInfo compare_callback    = { 0 } ;
  79 static CallBackInfo prefix_callback     = { 0 } ;
  80
  81
  82 static int
  83 btree_compare(key1, key2)
  84 const DBT * key1 ;
  85 const DBT * key2 ;
  86 {
  87     dSP ;
  88     void * data1, * data2 ;
  89     int retval ;
  90     int count ;
  91
  92     data1 = key1->data ;
  93     data2 = key2->data ;
  94
  95     /* As newSVpv will assume that the data pointer is a null terminated C
  96        string if the size parameter is 0, make sure that data points to an
  97        empty string if the length is 0
  98     */
  99     if (key1->size == 0)
 100         data1 = "" ;
 101     if (key2->size == 0)
 102         data2 = "" ;
 103
 104     ENTER ;
 105     SAVETMPS;
 106
 107     PUSHMARK(sp) ;
 108     EXTEND(sp,2) ;
 109     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 110     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 111     PUTBACK ;
 112
 113     count = perl_call_sv(compare_callback.sub, G_SCALAR);
 114
 115     SPAGAIN ;
 116
 117     if (count != 1)
 118         croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ;
 119
 120     retval = POPi ;
 121
 122     PUTBACK ;
 123     FREETMPS ;
 124     LEAVE ;
 125     return (retval) ;
 126
 127 }
 128
 129 static DBXS_PREFIX_TYPE
 130 btree_prefix(key1, key2)
 131 const DBT * key1 ;
 132 const DBT * key2 ;
 133 {
 134     dSP ;
 135     void * data1, * data2 ;
 136     int retval ;
 137     int count ;
 138
 139     data1 = key1->data ;
 140     data2 = key2->data ;
 141
 142     /* As newSVpv will assume that the data pointer is a null terminated C
 143        string if the size parameter is 0, make sure that data points to an
 144        empty string if the length is 0
 145     */
 146     if (key1->size == 0)
 147         data1 = "" ;
 148     if (key2->size == 0)
 149         data2 = "" ;
 150
 151     ENTER ;
 152     SAVETMPS;
 153
 154     PUSHMARK(sp) ;
 155     EXTEND(sp,2) ;
 156     PUSHs(sv_2mortal(newSVpv(data1,key1->size)));
 157     PUSHs(sv_2mortal(newSVpv(data2,key2->size)));
 158     PUTBACK ;
 159
 160     count = perl_call_sv(prefix_callback.sub, G_SCALAR);
 161
 162     SPAGAIN ;
 163
 164     if (count != 1)
 165         croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ;
 166
 167     retval = POPi ;
 168
 169     PUTBACK ;
 170     FREETMPS ;
 171     LEAVE ;
 172
 173     return (retval) ;
 174 }
 175
 176 static DBXS_HASH_TYPE
 177 hash_cb(data, size)
 178 const void * data ;
 179 size_t size ;
 180 {
 181     dSP ;
 182     int retval ;
 183     int count ;
 184
 185     if (size == 0)
 186         data = "" ;
 187
 188     PUSHMARK(sp) ;
 189     XPUSHs(sv_2mortal(newSVpv((char*)data,size)));
 190     PUTBACK ;
 191
 192     count = perl_call_sv(hash_callback.sub, G_SCALAR);
 193
 194     SPAGAIN ;
 195
 196     if (count != 1)
 197         croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ;
 198
 199     retval = POPi ;
 200
 201     PUTBACK ;
 202     FREETMPS ;
 203     LEAVE ;
 204
 205     return (retval) ;
 206 }
 207
 208
 209 #ifdef TRACE
 210
 211 static void
 212 PrintHash(hash)
 213 HASHINFO hash ;
 214 {
 215     printf ("HASH Info\n") ;
 216     printf ("  hash      = %s\n", (hash.hash != NULL ? "redefined" : "default")) ;
 217     printf ("  bsize     = %d\n", hash.bsize) ;
 218     printf ("  ffactor   = %d\n", hash.ffactor) ;
 219     printf ("  nelem     = %d\n", hash.nelem) ;
 220     printf ("  cachesize = %d\n", hash.cachesize) ;
 221     printf ("  lorder    = %d\n", hash.lorder) ;
 222
 223 }
 224
 225 static void
 226 PrintRecno(recno)
 227 RECNOINFO recno ;
 228 {
 229     printf ("RECNO Info\n") ;
 230     printf ("  flags     = %d\n", recno.flags) ;
 231     printf ("  cachesize = %d\n", recno.cachesize) ;
 232     printf ("  psize     = %d\n", recno.psize) ;
 233     printf ("  lorder    = %d\n", recno.lorder) ;
 234     printf ("  reclen    = %d\n", recno.reclen) ;
 235     printf ("  bval      = %d\n", recno.bval) ;
 236     printf ("  bfname    = %s\n", recno.bfname) ;
 237 }
 238
 239 PrintBtree(btree)
 240 BTREEINFO btree ;
 241 {
 242     printf ("BTREE Info\n") ;
 243     printf ("  compare    = %s\n", (btree.compare ? "redefined" : "default")) ;
 244     printf ("  prefix     = %s\n", (btree.prefix ? "redefined" : "default")) ;
 245     printf ("  flags      = %d\n", btree.flags) ;
 246     printf ("  cachesize  = %d\n", btree.cachesize) ;
 247     printf ("  psize      = %d\n", btree.psize) ;
 248     printf ("  maxkeypage = %d\n", btree.maxkeypage) ;
 249     printf ("  minkeypage = %d\n", btree.minkeypage) ;
 250     printf ("  lorder     = %d\n", btree.lorder) ;
 251 }
 252
 253 #else
 254
 255 #define PrintRecno(recno)
 256 #define PrintHash(hash)
 257 #define PrintBtree(btree)
 258
 259 #endif /* TRACE */
 260
 261
 262 static I32
 263 GetArrayLength(db)
 264 DB_File db ;
 265 {
 266     DBT         key ;
 267     DBT         value ;
 268     int         RETVAL ;
 269
 270     RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
 271     if (RETVAL == 0)
 272         RETVAL = *(I32 *)key.data ;
 273     else if (RETVAL == 1) /* No key means empty file */
 274         RETVAL = 0 ;
 275
 276     return (RETVAL) ;
 277 }
 278
 279 static DB_File
 280 ParseOpenInfo(name, flags, mode, sv, string)
 281 char * name ;
 282 int    flags ;
 283 int    mode ;
 284 SV *   sv ;
 285 char * string ;
 286 {
 287     SV **       svp;
 288     HV *        action ;
 289     union INFO  info ;
 290     DB_File     RETVAL ;
 291     void *      openinfo = NULL ;
 292     DBTYPE      type = DB_HASH ;
 293
 294
 295     if (sv)
 296     {
 297         if (! SvROK(sv) )
 298             croak ("type parameter is not a reference") ;
 299
 300         action = (HV*)SvRV(sv);
 301         if (sv_isa(sv, "DB_File::HASHINFO"))
 302         {
 303             type = DB_HASH ;
 304             openinfo = (void*)&info ;
 305
 306             svp = hv_fetch(action, "hash", 4, FALSE);
 307
 308             if (svp && SvOK(*svp))
 309             {
 310                 info.hash.hash = hash_cb ;
 311                 hash_callback.sub = *svp ;
 312             }
 313             else
 314                 info.hash.hash = NULL ;
 315
 316            svp = hv_fetch(action, "bsize", 5, FALSE);
 317            info.hash.bsize = svp ? SvIV(*svp) : 0;
 318
 319            svp = hv_fetch(action, "ffactor", 7, FALSE);
 320            info.hash.ffactor = svp ? SvIV(*svp) : 0;
 321
 322            svp = hv_fetch(action, "nelem", 5, FALSE);
 323            info.hash.nelem = svp ? SvIV(*svp) : 0;
 324
 325            svp = hv_fetch(action, "cachesize", 9, FALSE);
 326            info.hash.cachesize = svp ? SvIV(*svp) : 0;
 327
 328            svp = hv_fetch(action, "lorder", 6, FALSE);
 329            info.hash.lorder = svp ? SvIV(*svp) : 0;
 330
 331            PrintHash(info) ;
 332         }
 333         else if (sv_isa(sv, "DB_File::BTREEINFO"))
 334         {
 335             type = DB_BTREE ;
 336             openinfo = (void*)&info ;
 337
 338             svp = hv_fetch(action, "compare", 7, FALSE);
 339             if (svp && SvOK(*svp))
 340             {
 341                 info.btree.compare = btree_compare ;
 342                 compare_callback.sub = *svp ;
 343             }
 344             else
 345                 info.btree.compare = NULL ;
 346
 347             svp = hv_fetch(action, "prefix", 6, FALSE);
 348             if (svp && SvOK(*svp))
 349             {
 350                 info.btree.prefix = btree_prefix ;
 351                 prefix_callback.sub = *svp ;
 352             }
 353             else
 354                 info.btree.prefix = NULL ;
 355
 356             svp = hv_fetch(action, "flags", 5, FALSE);
 357             info.btree.flags = svp ? SvIV(*svp) : 0;
 358
 359             svp = hv_fetch(action, "cachesize", 9, FALSE);
 360             info.btree.cachesize = svp ? SvIV(*svp) : 0;
 361
 362             svp = hv_fetch(action, "minkeypage", 10, FALSE);
 363             info.btree.minkeypage = svp ? SvIV(*svp) : 0;
 364
 365             svp = hv_fetch(action, "maxkeypage", 10, FALSE);
 366             info.btree.maxkeypage = svp ? SvIV(*svp) : 0;
 367
 368             svp = hv_fetch(action, "psize", 5, FALSE);
 369             info.btree.psize = svp ? SvIV(*svp) : 0;
 370
 371             svp = hv_fetch(action, "lorder", 6, FALSE);
 372             info.btree.lorder = svp ? SvIV(*svp) : 0;
 373
 374             PrintBtree(info) ;
 375
 376         }
 377         else if (sv_isa(sv, "DB_File::RECNOINFO"))
 378         {
 379             type = DB_RECNO ;
 380             openinfo = (void *)&info ;
 381
 382             svp = hv_fetch(action, "flags", 5, FALSE);
 383             info.recno.flags = (u_long) svp ? SvIV(*svp) : 0;
 384
 385             svp = hv_fetch(action, "cachesize", 9, FALSE);
 386             info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0;
 387
 388             svp = hv_fetch(action, "psize", 5, FALSE);
 389             info.recno.psize = (int) svp ? SvIV(*svp) : 0;
 390
 391             svp = hv_fetch(action, "lorder", 6, FALSE);
 392             info.recno.lorder = (int) svp ? SvIV(*svp) : 0;
 393
 394             svp = hv_fetch(action, "reclen", 6, FALSE);
 395             info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0;
 396
 397             svp = hv_fetch(action, "bval", 4, FALSE);
 398             if (svp && SvOK(*svp))
 399             {
 400                 if (SvPOK(*svp))
 401                     info.recno.bval = (u_char)*SvPV(*svp, na) ;
 402                 else
 403                     info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ;
 404             }
 405             else
 406             {
 407                 if (info.recno.flags & R_FIXEDLEN)
 408                     info.recno.bval = (u_char) ' ' ;
 409                 else
 410                     info.recno.bval = (u_char) '\n' ;
 411             }
 412
 413             svp = hv_fetch(action, "bfname", 6, FALSE);
 414             info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0;
 415
 416             PrintRecno(info) ;
 417         }
 418         else
 419             croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
 420     }
 421
 422
 423     RETVAL = dbopen(name, flags, mode, type, openinfo) ;
 424
 425     if (RETVAL == 0)
 426         croak("DB_File::%s failed, reason: %s", string, Strerror(errno)) ;
 427
 428     /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE
 429                        so remember a DB_RECNO by saving the address
 430                        of one of it's internal routines
 431     */
 432     if (type == DB_RECNO)
 433         DB_recno_close = RETVAL->close ;
 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
 722
 723 int
 724 db_DELETE(db, key, flags=0)
 725         DB_File         db
 726         DBTKEY          key
 727         u_int           flags
 728
 729 int
 730 db_FETCH(db, key, flags=0)
 731         DB_File         db
 732         DBTKEY          key
 733         u_int           flags
 734         CODE:
 735         {
 736             DBT         value  ;
 737
 738             RETVAL = (db->get)(db, &key, &value, flags) ;
 739             ST(0) = sv_newmortal();
 740             if (RETVAL == 0)
 741                 sv_setpvn(ST(0), value.data, value.size);
 742         }
 743
 744 int
 745 db_STORE(db, key, value, flags=0)
 746         DB_File         db
 747         DBTKEY          key
 748         DBT             value
 749         u_int           flags
 750
 751
 752 int
 753 db_FIRSTKEY(db)
 754         DB_File         db
 755         CODE:
 756         {
 757             DBTKEY              key ;
 758             DBT         value ;
 759
 760             RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;
 761             ST(0) = sv_newmortal();
 762             if (RETVAL == 0)
 763             {
 764                 if (db->type != DB_RECNO)
 765                     sv_setpvn(ST(0), key.data, key.size);
 766                 else
 767                     sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 768             }
 769         }
 770
 771 int
 772 db_NEXTKEY(db, key)
 773         DB_File         db
 774         DBTKEY          key
 775         CODE:
 776         {
 777             DBT         value ;
 778
 779             RETVAL = (db->seq)(db, &key, &value, R_NEXT) ;
 780             ST(0) = sv_newmortal();
 781             if (RETVAL == 0)
 782             {
 783                 if (db->type != DB_RECNO)
 784                     sv_setpvn(ST(0), key.data, key.size);
 785                 else
 786                     sv_setiv(ST(0), (I32)*(I32*)key.data - 1);
 787             }
 788         }
 789
 790 #
 791 # These would be nice for RECNO
 792 #
 793
 794 int
 795 unshift(db, ...)
 796         DB_File         db
 797         CODE:
 798         {
 799             DBTKEY      key ;
 800             DBT         value ;
 801             int         i ;
 802             int         One ;
 803
 804             RETVAL = -1 ;
 805             for (i = items-1 ; i > 0 ; --i)
 806             {
 807                 value.data = SvPV(ST(i), na) ;
 808                 value.size = na ;
 809                 One = 1 ;
 810                 key.data = &One ;
 811                 key.size = sizeof(int) ;
 812                 RETVAL = (db->put)(db, &key, &value, R_IBEFORE) ;
 813                 if (RETVAL != 0)
 814                     break;
 815             }
 816         }
 817         OUTPUT:
 818             RETVAL
 819
 820 I32
 821 pop(db)
 822         DB_File         db
 823         CODE:
 824         {
 825             DBTKEY      key ;
 826             DBT         value ;
 827
 828             /* First get the final value */
 829             RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
 830             ST(0) = sv_newmortal();
 831             /* Now delete it */
 832             if (RETVAL == 0)
 833             {
 834                 RETVAL = (db->del)(db, &key, R_CURSOR) ;
 835                 if (RETVAL == 0)
 836                     sv_setpvn(ST(0), value.data, value.size);
 837             }
 838         }
 839
 840 I32
 841 shift(db)
 842         DB_File         db
 843         CODE:
 844         {
 845             DBTKEY      key ;
 846             DBT         value ;
 847
 848             /* get the first value */
 849             RETVAL = (db->seq)(db, &key, &value, R_FIRST) ;
 850             ST(0) = sv_newmortal();
 851             /* Now delete it */
 852             if (RETVAL == 0)
 853             {
 854                 RETVAL = (db->del)(db, &key, R_CURSOR) ;
 855                 if (RETVAL == 0)
 856                     sv_setpvn(ST(0), value.data, value.size);
 857             }
 858         }
 859
 860
 861 I32
 862 push(db, ...)
 863         DB_File         db
 864         CODE:
 865         {
 866             DBTKEY      key ;
 867             DBT         value ;
 868             int         i ;
 869
 870             /* Set the Cursor to the Last element */
 871             RETVAL = (db->seq)(db, &key, &value, R_LAST) ;
 872             if (RETVAL == 0)
 873             {
 874             /* for (i = 1 ; i < items ; ++i) */
 875             for (i = items - 1 ; i > 0 ; --i)
 876             {
 877                 value.data = SvPV(ST(i), na) ;
 878                 value.size = na ;
 879                 RETVAL = (db->put)(db, &key, &value, R_IAFTER) ;
 880                 if (RETVAL != 0)
 881                     break;
 882             }
 883             }
 884         }
 885         OUTPUT:
 886             RETVAL
 887
 888
 889 I32
 890 length(db)
 891         DB_File         db
 892         CODE:
 893             RETVAL = GetArrayLength(db) ;
 894         OUTPUT:
 895             RETVAL
 896
 897
 898 #
 899 # Now provide an interface to the rest of the DB functionality
 900 #
 901
 902 int
 903 db_del(db, key, flags=0)
 904         DB_File         db
 905         DBTKEY          key
 906         u_int           flags
 907
 908
 909 int
 910 db_get(db, key, value, flags=0)
 911         DB_File         db
 912         DBTKEY          key
 913         DBT             value
 914         u_int           flags
 915         OUTPUT:
 916           value
 917
 918 int
 919 db_put(db, key, value, flags=0)
 920         DB_File         db
 921         DBTKEY          key
 922         DBT             value
 923         u_int           flags
 924         OUTPUT:
 925           key           if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key);
 926
 927 int
 928 db_fd(db)
 929         DB_File         db
 930
 931 int
 932 db_sync(db, flags=0)
 933         DB_File         db
 934         u_int           flags
 935
 936
 937 int
 938 db_seq(db, key, value, flags)
 939         DB_File         db
 940         DBTKEY          key
 941         DBT             value
 942         u_int           flags
 943         OUTPUT:
 944           key
 945           value