comparison src/database.c @ 448:3078fd1074e8 r21-2-39

Import from CVS: tag r21-2-39
author cvs
date Mon, 13 Aug 2007 11:38:25 +0200
parents 576fb035e263
children ed498ef2108b
comparison
equal deleted inserted replaced
447:4fc5f13f3bd3 448:3078fd1074e8
57 #ifndef DB_VERSION_MAJOR 57 #ifndef DB_VERSION_MAJOR
58 # define DB_VERSION_MAJOR 1 58 # define DB_VERSION_MAJOR 1
59 #endif /* DB_VERSION_MAJOR */ 59 #endif /* DB_VERSION_MAJOR */
60 Lisp_Object Qberkeley_db; 60 Lisp_Object Qberkeley_db;
61 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown; 61 Lisp_Object Qhash, Qbtree, Qrecno, Qunknown;
62 #if DB_VERSION_MAJOR > 2
63 Lisp_Object Qqueue;
64 #endif
62 #endif /* HAVE_BERKELEY_DB */ 65 #endif /* HAVE_BERKELEY_DB */
63 66
64 #ifdef HAVE_DBM 67 #ifdef HAVE_DBM
65 #include <ndbm.h> 68 #include <ndbm.h>
66 Lisp_Object Qdbm; 69 Lisp_Object Qdbm;
367 switch (db->db_handle->type) 370 switch (db->db_handle->type)
368 { 371 {
369 case DB_BTREE: return Qbtree; 372 case DB_BTREE: return Qbtree;
370 case DB_HASH: return Qhash; 373 case DB_HASH: return Qhash;
371 case DB_RECNO: return Qrecno; 374 case DB_RECNO: return Qrecno;
375 #if DB_VERSION_MAJOR > 2
376 case DB_QUEUE: return Qqueue;
377 #endif
372 default: return Qunknown; 378 default: return Qunknown;
373 } 379 }
374 } 380 }
375 381
376 static Lisp_Object 382 static Lisp_Object
642 real_subtype = DB_HASH; 648 real_subtype = DB_HASH;
643 else if (EQ (subtype, Qbtree)) 649 else if (EQ (subtype, Qbtree))
644 real_subtype = DB_BTREE; 650 real_subtype = DB_BTREE;
645 else if (EQ (subtype, Qrecno)) 651 else if (EQ (subtype, Qrecno))
646 real_subtype = DB_RECNO; 652 real_subtype = DB_RECNO;
653 #if DB_VERSION_MAJOR > 2
654 else if (EQ (subtype, Qqueue))
655 real_subtype = DB_QUEUE;
656 #endif
647 else 657 else
648 signal_simple_error ("Unsupported subtype", subtype); 658 signal_simple_error ("Unsupported subtype", subtype);
649 659
650 #if DB_VERSION_MAJOR == 1 660 #if DB_VERSION_MAJOR == 1
651 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL); 661 dbase = dbopen (filename, accessmask, modemask, real_subtype, NULL);
667 accessmask |= DB_CREATE; 677 accessmask |= DB_CREATE;
668 678
669 if (strchr (acc, 'r') && !strchr (acc, 'w')) 679 if (strchr (acc, 'r') && !strchr (acc, 'w'))
670 accessmask |= DB_RDONLY; 680 accessmask |= DB_RDONLY;
671 } 681 }
682 #if DB_VERSION_MAJOR == 2
672 status = db_open (filename, real_subtype, accessmask, 683 status = db_open (filename, real_subtype, accessmask,
673 modemask, NULL , NULL, &dbase); 684 modemask, NULL , NULL, &dbase);
674 if (status) 685 if (status)
675 return Qnil; 686 return Qnil;
687 #else
688 status = db_create (&dbase, NULL, 0);
689 if (status)
690 return Qnil;
691 status = dbase->open (dbase, filename, NULL,
692 real_subtype, accessmask, modemask);
693 if (status)
694 {
695 dbase->close (dbase, 0);
696 return Qnil;
697 }
698 #endif /* DB_VERSION_MAJOR > 2 */
699 /* Normalize into system specific file modes. Only for printing */
700 accessmask = accessmask & DB_RDONLY ? O_RDONLY : O_RDWR;
676 #endif /* DB_VERSION_MAJOR */ 701 #endif /* DB_VERSION_MAJOR */
677 702
678 db = allocate_database (); 703 db = allocate_database ();
679 db->db_handle = dbase; 704 db->db_handle = dbase;
680 db->funcs = &berk_func_block; 705 db->funcs = &berk_func_block;
769 #ifdef HAVE_BERKELEY_DB 794 #ifdef HAVE_BERKELEY_DB
770 defsymbol (&Qberkeley_db, "berkeley-db"); 795 defsymbol (&Qberkeley_db, "berkeley-db");
771 defsymbol (&Qhash, "hash"); 796 defsymbol (&Qhash, "hash");
772 defsymbol (&Qbtree, "btree"); 797 defsymbol (&Qbtree, "btree");
773 defsymbol (&Qrecno, "recno"); 798 defsymbol (&Qrecno, "recno");
799 #if DB_VERSION_MAJOR > 2
800 defsymbol (&Qqueue, "queue");
801 #endif
774 defsymbol (&Qunknown, "unknown"); 802 defsymbol (&Qunknown, "unknown");
775 #endif 803 #endif
776 804
777 DEFSUBR (Fopen_database); 805 DEFSUBR (Fopen_database);
778 DEFSUBR (Fdatabasep); 806 DEFSUBR (Fdatabasep);