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