home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / NDBM_File / NDBM_File.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-29  |  5.4 KB  |  275 lines  |  [TEXT/MPS ]
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4. #include <ndbm.h>
  5.  
  6. #ifdef macintosh
  7. extern int dbm_error();
  8. extern int dbm_clearerr();
  9. #endif
  10.  
  11. typedef DBM* NDBM_File;
  12. #define dbm_TIEHASH(dbtype,filename,flags,mode) dbm_open(filename,flags,mode)
  13. #define dbm_FETCH(db,key)            dbm_fetch(db,key)
  14. #define dbm_STORE(db,key,value,flags)        dbm_store(db,key,value,flags)
  15. #define dbm_DELETE(db,key)            dbm_delete(db,key)
  16. #define dbm_FIRSTKEY(db)            dbm_firstkey(db)
  17. #define dbm_NEXTKEY(db,key)            dbm_nextkey(db)
  18.  
  19. XS(XS_NDBM_File_dbm_TIEHASH)
  20. {
  21.     dXSARGS;
  22.     if (items != 4) {
  23.     croak("Usage: NDBM_File::TIEHASH(dbtype, filename, flags, mode)");
  24.     }
  25.     {
  26.     char *    dbtype = (char *)SvPV(ST(0),na);
  27.     char *    filename = (char *)SvPV(ST(1),na);
  28.     int    flags = (int)SvIV(ST(2));
  29.     int    mode = (int)SvIV(ST(3));
  30.     NDBM_File    RETVAL;
  31.  
  32.     RETVAL = dbm_TIEHASH(dbtype, filename, flags, mode);
  33.     ST(0) = sv_newmortal();
  34.     sv_setref_pv(ST(0), "NDBM_File", (void*)RETVAL);
  35.     }
  36.     XSRETURN(1);
  37. }
  38.  
  39. XS(XS_NDBM_File_dbm_DESTROY)
  40. {
  41.     dXSARGS;
  42.     if (items != 1) {
  43.     croak("Usage: NDBM_File::DESTROY(db)");
  44.     }
  45.     {
  46.     NDBM_File    db;
  47.  
  48.     if (SvROK(ST(0))) {
  49.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  50.         db = (NDBM_File) tmp;
  51.     }
  52.     else
  53.         croak("db is not a reference");
  54.     dbm_close(db);
  55.     }
  56.     XSRETURN(1);
  57. }
  58.  
  59. XS(XS_NDBM_File_dbm_FETCH)
  60. {
  61.     dXSARGS;
  62.     if (items != 2) {
  63.     croak("Usage: NDBM_File::FETCH(db, key)");
  64.     }
  65.     {
  66.     NDBM_File    db;
  67.     datum    key;
  68.     datum    RETVAL;
  69.  
  70.     if (sv_isa(ST(0), "NDBM_File")) {
  71.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  72.         db = (NDBM_File) tmp;
  73.     }
  74.     else
  75.         croak("db is not of type NDBM_File");
  76.  
  77.     key.dptr = SvPV(ST(1), na);
  78.     key.dsize = (int)na;;
  79.  
  80.     RETVAL = dbm_FETCH(db, key);
  81.     ST(0) = sv_newmortal();
  82.     sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
  83.     }
  84.     XSRETURN(1);
  85. }
  86.  
  87. XS(XS_NDBM_File_dbm_STORE)
  88. {
  89.     dXSARGS;
  90.     if (items < 3 || items > 4) {
  91.     croak("Usage: NDBM_File::STORE(db, key, value, flags = DBM_REPLACE)");
  92.     }
  93.     {
  94.     NDBM_File    db;
  95.     datum    key;
  96.     datum    value;
  97.     int    flags;
  98.     int    RETVAL;
  99.  
  100.     if (sv_isa(ST(0), "NDBM_File")) {
  101.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  102.         db = (NDBM_File) tmp;
  103.     }
  104.     else
  105.         croak("db is not of type NDBM_File");
  106.  
  107.     key.dptr = SvPV(ST(1), na);
  108.     key.dsize = (int)na;;
  109.  
  110.     value.dptr = SvPV(ST(2), na);
  111.     value.dsize = (int)na;;
  112.  
  113.     if (items < 4)
  114.         flags = DBM_REPLACE;
  115.     else {
  116.         flags = (int)SvIV(ST(3));
  117.     }
  118.  
  119.     RETVAL = dbm_STORE(db, key, value, flags);
  120.     ST(0) = sv_newmortal();
  121.     sv_setiv(ST(0), (IV)RETVAL);
  122.     if (RETVAL) {
  123.         if (RETVAL < 0 && errno == EPERM)
  124.         croak("No write permission to ndbm file");
  125.         warn("ndbm store returned %d, errno %d, key \"%s\"",
  126.             RETVAL,errno,key.dptr);
  127.         dbm_clearerr(db);
  128.     }
  129.     }
  130.     XSRETURN(1);
  131. }
  132.  
  133. XS(XS_NDBM_File_dbm_DELETE)
  134. {
  135.     dXSARGS;
  136.     if (items != 2) {
  137.     croak("Usage: NDBM_File::DELETE(db, key)");
  138.     }
  139.     {
  140.     NDBM_File    db;
  141.     datum    key;
  142.     int    RETVAL;
  143.  
  144.     if (sv_isa(ST(0), "NDBM_File")) {
  145.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  146.         db = (NDBM_File) tmp;
  147.     }
  148.     else
  149.         croak("db is not of type NDBM_File");
  150.  
  151.     key.dptr = SvPV(ST(1), na);
  152.     key.dsize = (int)na;;
  153.  
  154.     RETVAL = dbm_DELETE(db, key);
  155.     ST(0) = sv_newmortal();
  156.     sv_setiv(ST(0), (IV)RETVAL);
  157.     }
  158.     XSRETURN(1);
  159. }
  160.  
  161. XS(XS_NDBM_File_dbm_FIRSTKEY)
  162. {
  163.     dXSARGS;
  164.     if (items != 1) {
  165.     croak("Usage: NDBM_File::FIRSTKEY(db)");
  166.     }
  167.     {
  168.     NDBM_File    db;
  169.     datum    RETVAL;
  170.  
  171.     if (sv_isa(ST(0), "NDBM_File")) {
  172.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  173.         db = (NDBM_File) tmp;
  174.     }
  175.     else
  176.         croak("db is not of type NDBM_File");
  177.  
  178.     RETVAL = dbm_FIRSTKEY(db);
  179.     ST(0) = sv_newmortal();
  180.     sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
  181.     }
  182.     XSRETURN(1);
  183. }
  184.  
  185. XS(XS_NDBM_File_dbm_NEXTKEY)
  186. {
  187.     dXSARGS;
  188.     if (items != 2) {
  189.     croak("Usage: NDBM_File::NEXTKEY(db, key)");
  190.     }
  191.     {
  192.     NDBM_File    db;
  193.     datum    key;
  194.     datum    RETVAL;
  195.  
  196.     if (sv_isa(ST(0), "NDBM_File")) {
  197.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  198.         db = (NDBM_File) tmp;
  199.     }
  200.     else
  201.         croak("db is not of type NDBM_File");
  202.  
  203.     key.dptr = SvPV(ST(1), na);
  204.     key.dsize = (int)na;;
  205.  
  206.     RETVAL = dbm_NEXTKEY(db, key);
  207.     ST(0) = sv_newmortal();
  208.     sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
  209.     }
  210.     XSRETURN(1);
  211. }
  212.  
  213. XS(XS_NDBM_File_dbm_error)
  214. {
  215.     dXSARGS;
  216.     if (items != 1) {
  217.     croak("Usage: NDBM_File::error(db)");
  218.     }
  219.     {
  220.     NDBM_File    db;
  221.     int    RETVAL;
  222.  
  223.     if (sv_isa(ST(0), "NDBM_File")) {
  224.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  225.         db = (NDBM_File) tmp;
  226.     }
  227.     else
  228.         croak("db is not of type NDBM_File");
  229.  
  230.     RETVAL = dbm_error(db);
  231.     ST(0) = sv_newmortal();
  232.     sv_setiv(ST(0), (IV)RETVAL);
  233.     }
  234.     XSRETURN(1);
  235. }
  236.  
  237. XS(XS_NDBM_File_dbm_clearerr)
  238. {
  239.     dXSARGS;
  240.     if (items != 1) {
  241.     croak("Usage: NDBM_File::clearerr(db)");
  242.     }
  243.     {
  244.     NDBM_File    db;
  245.  
  246.     if (sv_isa(ST(0), "NDBM_File")) {
  247.         IV tmp = SvIV((SV*)SvRV(ST(0)));
  248.         db = (NDBM_File) tmp;
  249.     }
  250.     else
  251.         croak("db is not of type NDBM_File");
  252.  
  253.     dbm_clearerr(db);
  254.     }
  255.     XSRETURN(1);
  256. }
  257.  
  258. XS(boot_NDBM_File)
  259. {
  260.     dXSARGS;
  261.     char* file = __FILE__;
  262.  
  263.     newXS("NDBM_File::TIEHASH", XS_NDBM_File_dbm_TIEHASH, file);
  264.     newXS("NDBM_File::DESTROY", XS_NDBM_File_dbm_DESTROY, file);
  265.     newXS("NDBM_File::FETCH", XS_NDBM_File_dbm_FETCH, file);
  266.     newXS("NDBM_File::STORE", XS_NDBM_File_dbm_STORE, file);
  267.     newXS("NDBM_File::DELETE", XS_NDBM_File_dbm_DELETE, file);
  268.     newXS("NDBM_File::FIRSTKEY", XS_NDBM_File_dbm_FIRSTKEY, file);
  269.     newXS("NDBM_File::NEXTKEY", XS_NDBM_File_dbm_NEXTKEY, file);
  270.     newXS("NDBM_File::error", XS_NDBM_File_dbm_error, file);
  271.     newXS("NDBM_File::clearerr", XS_NDBM_File_dbm_clearerr, file);
  272.     ST(0) = &sv_yes;
  273.     XSRETURN(1);
  274. }
  275.