home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / ext / DB_File / DB_File.xs < prev    next >
Text File  |  1996-01-20  |  20KB  |  993 lines
  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_db_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
  993.