Commit 818c9666f0472dd15c735cc470daa76e650f329c - libberkeleydb-perl

Imported Upstream version 0.29 Marco d'Itri 9 years ago

13 changed file(s) with 701 addition(s) and 52 deletion(s). Raw diff Collapse all Expand all

-2

BerkeleyDB.pm less more

1	1	package BerkeleyDB;
2	2
3	3
4		# Copyright (c) 1997-2005 Paul Marquess. All rights reserved.
	4	# Copyright (c) 1997-2006 Paul Marquess. All rights reserved.
5	5	# This program is free software; you can redistribute it and/or
6	6	# modify it under the same terms as Perl itself.
7	7	#

16	16	use vars qw($VERSION @ISA @EXPORT $AUTOLOAD
17	17	$use_XSLoader);
18	18
19		$VERSION = '0.27';
	19	$VERSION = '0.29';
20	20
21	21	require Exporter;
22	22	#require DynaLoader;

+41

-0

BerkeleyDB.pod less more

43	43	$status = $db->status() ;
44	44	$boolean = $db->byteswapped() ;
45	45	$status = $db->truncate($count) ;
	46	$status = $db->compact($start, $stop, $c_data, $flags, $end);
46	47
47	48	$bool = $env->cds_enabled();
48	49	$bool = $db->cds_enabled();

1435	1436	Truncates the datatabase and returns the number or records deleted
1436	1437	in C<$count>.
1437	1438
	1439	=head2 $status = $db->compact($start, $stop, $c_data, $flags, $end);
	1440
	1441	Compacts the database C<$db>.
	1442
	1443	All the parameters are optional - if only want to make use of some of them,
	1444	use C<undef> for those you don't want. Trailing unusused parameters can be
	1445	omitted. For example, if you only want to use the C<$c_data> parameter to
	1446	set the C<compact_fillpercent>, write you code like this
	1447
	1448	my %hash;
	1449	$hash{compact_fillpercent} = 50;
	1450	$db->commit(undef, undef, \%hash);
	1451
	1452	The parameters operate identically to the C equivalent of this method.
	1453	The C<$c_data> needs a bit of explanation - it must be a hash reference.
	1454	The values of the following keys can be set before calling C<compact> and
	1455	will affect the operation of the compaction.
	1456
	1457	=over 5
	1458	=item * compact_fillpercent
	1459	=item * compact_timeout
	1460
	1461	=back
	1462
	1463	The following keys, along with associated values, will be created in the
	1464	hash reference if the C<compact> operation was successful.
	1465
	1466	=over 5
	1467
	1468	=item * compact_deadlock
	1469	=item * compact_levels
	1470	=item * compact_pages_free
	1471	=item * compact_pages_examine
	1472	=item * compact_pages_truncated
	1473
	1474	=back
	1475
	1476	You need to be running Berkeley DB 4.4 or better if you wan to make use of
	1477	C<compact>.
	1478
1438	1479	=head1 CURSORS
1439	1480
1440	1481	A cursor is used whenever you want to access the contents of a database

+41

-0

BerkeleyDB.pod.P less more

43	43	$status = $db->status() ;
44	44	$boolean = $db->byteswapped() ;
45	45	$status = $db->truncate($count) ;
	46	$status = $db->compact($start, $stop, $c_data, $flags, $end);
46	47
47	48	$bool = $env->cds_enabled();
48	49	$bool = $db->cds_enabled();

1241	1242	Truncates the datatabase and returns the number or records deleted
1242	1243	in C<$count>.
1243	1244
	1245	=head2 $status = $db->compact($start, $stop, $c_data, $flags, $end);
	1246
	1247	Compacts the database C<$db>.
	1248
	1249	All the parameters are optional - if only want to make use of some of them,
	1250	use C<undef> for those you don't want. Trailing unusused parameters can be
	1251	omitted. For example, if you only want to use the C<$c_data> parameter to
	1252	set the C<compact_fillpercent>, write you code like this
	1253
	1254	my %hash;
	1255	$hash{compact_fillpercent} = 50;
	1256	$db->commit(undef, undef, \%hash);
	1257
	1258	The parameters operate identically to the C equivalent of this method.
	1259	The C<$c_data> needs a bit of explanation - it must be a hash reference.
	1260	The values of the following keys can be set before calling C<compact> and
	1261	will affect the operation of the compaction.
	1262
	1263	=over 5
	1264	=item * compact_fillpercent
	1265	=item * compact_timeout
	1266
	1267	=back
	1268
	1269	The following keys, along with associated values, will be created in the
	1270	hash reference if the C<compact> operation was successful.
	1271
	1272	=over 5
	1273
	1274	=item * compact_deadlock
	1275	=item * compact_levels
	1276	=item * compact_pages_free
	1277	=item * compact_pages_examine
	1278	=item * compact_pages_truncated
	1279
	1280	=back
	1281
	1282	You need to be running Berkeley DB 4.4 or better if you wan to make use of
	1283	C<compact>.
	1284
1244	1285	=head1 CURSORS
1245	1286
1246	1287	A cursor is used whenever you want to access the contents of a database

+194

-7

BerkeleyDB.xs less more

5	5
6	6	All comments/suggestions/problems are welcome
7	7
8		Copyright (c) 1997-2005 Paul Marquess. All rights reserved.
	8	Copyright (c) 1997-2006 Paul Marquess. All rights reserved.
9	9	This program is free software; you can redistribute it and/or
10	10	modify it under the same terms as Perl itself.
11	11

126	126
127	127	#if DB_VERSION_MAJOR > 4 \|\| (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 4)
128	128	# define AT_LEAST_DB_4_4
	129	#endif
	130
	131	#if DB_VERSION_MAJOR > 4 \|\| (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 5)
	132	# define AT_LEAST_DB_4_5
129	133	#endif
130	134
131	135	#ifdef __cplusplus

343	347	typedef DBT DBT_B ;
344	348	typedef DBT DBTKEY_B ;
345	349	typedef DBT DBTKEY_Br ;
	350	typedef DBT DBTKEY_Bpr ;
346	351	typedef DBT DBTVALUE ;
347	352	typedef void * PV_or_NULL ;
348	353	typedef PerlIO * IO_or_NULL ;
349	354	typedef int DualType ;
	355	typedef SV SVnull;
350	356
351	357	static void
352	358	hash_delete(char * hash, char * key);

391	397
392	398	#define my_sv_setpvn(sv, d, s) (s ? sv_setpvn(sv, d, s) : sv_setpv(sv, "") )
393	399
	400	#define GetValue_iv(h,k) (((sv = readHash(h, k)) && sv != &PL_sv_undef) \
	401	? SvIV(sv) : 0)
394	402	#define SetValue_iv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
395	403	i = SvIV(sv)
396	404	#define SetValue_io(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \

476	484	{ if (RETVAL == 0) \
477	485	{ \
478	486	if (db->recno_or_queue \|\| db->primary_recno_or_queue \
	487	\|\| (db->type == DB_BTREE && \
	488	flagSet(DB_GET_RECNO))){ \
	489	sv_setiv(arg, (I32)((I32)name.data) - RECNO_BASE); \
	490	} \
	491	else { \
	492	my_sv_setpvn(arg, name.data, name.size); \
	493	} \
	494	DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \
	495	} \
	496	}
	497
	498	#define OutputKey_Bpr(arg, name) \
	499	{ if (RETVAL == 0) \
	500	{ \
	501	if (db->primary_recno_or_queue \
479	502	\|\| (db->type == DB_BTREE && \
480	503	flagSet(DB_GET_RECNO))){ \
481	504	sv_setiv(arg, (I32)((I32)name.data) - RECNO_BASE); \

1142	1165
1143	1166	/* retrieve the secondary key */
1144	1167	DBT_clear(*skey);
	1168
1145	1169	skey_ptr = SvPV(skey_SV, skey_len);
1146	1170	skey->flags = DB_DBT_APPMALLOC;
1147	1171	/* skey->size = SvCUR(skey_SV); */

1150	1174	skey->data = (char*)safemalloc(skey_len);
1151	1175	memcpy(skey->data, skey_ptr, skey_len);
1152	1176	Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
	1177
	1178	FREETMPS ;
	1179	LEAVE ;
	1180
	1181	return (retval) ;
	1182	}
	1183
	1184	static int
	1185	associate_cb_recno(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
	1186	{
	1187	dSP ;
	1188	char * pk_dat, * pd_dat ;
	1189	/* char sk_dat ; /
	1190	int retval ;
	1191	int count ;
	1192	SV * skey_SV ;
	1193	STRLEN skey_len;
	1194	char * skey_ptr ;
	1195	db_recno_t Value;
	1196
	1197	Trace(("In associate_cb_recno \n")) ;
	1198	if (getCurrentDB->associated == NULL){
	1199	Trace(("No Callback registered\n")) ;
	1200	return EINVAL ;
	1201	}
	1202
	1203	skey_SV = newSVpv("",0);
	1204
	1205
	1206	pk_dat = (char*) pkey->data ;
	1207	pd_dat = (char*) pdata->data ;
	1208
	1209	#ifndef newSVpvn
	1210	/* As newSVpv will assume that the data pointer is a null terminated C
	1211	string if the size parameter is 0, make sure that data points to an
	1212	empty string if the length is 0
	1213	*/
	1214	if (pkey->size == 0)
	1215	pk_dat = "" ;
	1216	if (pdata->size == 0)
	1217	pd_dat = "" ;
	1218	#endif
	1219
	1220	ENTER ;
	1221	SAVETMPS;
	1222
	1223	PUSHMARK(SP) ;
	1224	EXTEND(SP,2) ;
	1225	PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
	1226	PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
	1227	PUSHs(sv_2mortal(skey_SV));
	1228	PUTBACK ;
	1229
	1230	Trace(("calling associated cb\n"));
	1231	count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
	1232	Trace(("called associated cb\n"));
	1233
	1234	SPAGAIN ;
	1235
	1236	if (count != 1)
	1237	softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;
	1238
	1239	retval = POPi ;
	1240
	1241	PUTBACK ;
	1242
	1243	/* retrieve the secondary key */
	1244	DBT_clear(*skey);
	1245
	1246	Value = GetRecnoKey(getCurrentDB, SvIV(skey_SV)) ;
	1247	skey->flags = DB_DBT_APPMALLOC;
	1248	skey->size = (int)sizeof(db_recno_t);
	1249	skey->data = (char*)safemalloc(skey->size);
	1250	memcpy(skey->data, &Value, skey->size);
1153	1251
1154	1252	FREETMPS ;
1155	1253	LEAVE ;

1221	1319	hv_store_iv(HV * hash, char * key, IV value)
1222	1320	{
1223	1321	hv_store(hash, key, strlen(key), newSViv(value), 0);
	1322	}
	1323
	1324	#if 0
	1325	static void
	1326	hv_store_uv(HV * hash, char * key, UV value)
	1327	{
	1328	hv_store(hash, key, strlen(key), newSVuv(value), 0);
	1329	}
	1330	#endif
	1331
	1332	static void
	1333	GetKey(BerkeleyDB_type * db, SV * sv, DBTKEY * key)
	1334	{
	1335	if (db->recno_or_queue) {
	1336	Value = GetRecnoKey(db, SvIV(sv)) ;
	1337	key->data = & Value;
	1338	key->size = (int)sizeof(db_recno_t);
	1339	}
	1340	else {
	1341	key->data = SvPV(sv, PL_na);
	1342	key->size = (int)PL_na;
	1343	}
1224	1344	}
1225	1345
1226	1346	static BerkeleyDB

2963	3083	#ifdef AT_LEAST_DB_3_3
2964	3084	RETVAL->associated = db->associated ;
2965	3085	RETVAL->secondary_db = db->secondary_db;
2966		RETVAL->primary_recno_or_queue = db->recno_or_queue ;
	3086	RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
2967	3087	#endif
2968	3088	RETVAL->prefix = db->prefix ;
2969	3089	RETVAL->hash = db->hash ;

3035	3155	#ifdef AT_LEAST_DB_3_3
3036	3156	RETVAL->associated = db->associated ;
3037	3157	RETVAL->secondary_db = db->secondary_db;
3038		RETVAL->primary_recno_or_queue = db->recno_or_queue ;
	3158	RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
3039	3159	#endif
3040	3160	RETVAL->prefix = db->prefix ;
3041	3161	RETVAL->hash = db->hash ;

3266	3386	u_int flags
3267	3387	BerkeleyDB::Common db
3268	3388	DBTKEY_B key
3269		DBTKEY_B pkey = NO_INIT
	3389	DBTKEY_Bpr pkey = NO_INIT
3270	3390	DBT_OPT data
3271	3391	CODE:
3272	3392	#ifndef AT_LEAST_DB_3_3

3424	3544	secondary->primary_recno_or_queue = db->recno_or_queue ;
3425	3545	/* secondary->dbp->app_private = secondary->associated ; */
3426	3546	secondary->secondary_db = TRUE;
3427		RETVAL = db_associate(db, secondary, associate_cb, flags);
	3547	if (secondary->recno_or_queue)
	3548	RETVAL = db_associate(db, secondary, associate_cb_recno, flags);
	3549	else
	3550	RETVAL = db_associate(db, secondary, associate_cb, flags);
3428	3551	#endif
3429	3552	OUTPUT:
3430	3553	RETVAL
	3554
	3555	DualType
	3556	compact(db, start=NULL, stop=NULL, c_data=NULL, flags=0, end=NULL)
	3557	BerkeleyDB::Common db
	3558	SVnull* start
	3559	SVnull* stop
	3560	SVnull* c_data
	3561	u_int32_t flags
	3562	SVnull* end
	3563	INIT:
	3564	DBTKEY end_key;
	3565	CODE:
	3566	{
	3567	#ifndef AT_LEAST_DB_4_4
	3568	softCrash("compact needs Berkeley DB 4.4 or later") ;
	3569	#else
	3570	DBTKEY start_key;
	3571	DBTKEY stop_key;
	3572	DBTKEY* start_p = NULL;
	3573	DBTKEY* stop_p = NULL;
	3574	DBTKEY* end_p = NULL;
	3575	DB_COMPACT cmpt;
	3576	DB_COMPACT* cmpt_p = NULL;
	3577	SV * sv;
	3578	HV* hash = NULL;
	3579
	3580	DBT_clear(start_key);
	3581	DBT_clear(stop_key);
	3582	DBT_clear(end_key);
	3583	Zero(&cmpt, 1, DB_COMPACT) ;
	3584	ckActive_Database(db->active) ;
	3585	saveCurrentDB(db) ;
	3586	if (start && SvOK(start)) {
	3587	start_p = &start_key;
	3588	DBM_ckFilter(start, filter_store_key, "filter_store_key");
	3589	GetKey(db, start, start_p);
	3590	}
	3591	if (stop && SvOK(stop)) {
	3592	stop_p = &stop_key;
	3593	DBM_ckFilter(stop, filter_store_key, "filter_store_key");
	3594	GetKey(db, stop, stop_p);
	3595	}
	3596	if (end) {
	3597	end_p = &end_key;
	3598	}
	3599	if (c_data && SvOK(c_data)) {
	3600	hash = (HV*) SvRV(c_data) ;
	3601	cmpt_p = & cmpt;
	3602	cmpt.compact_fillpercent = GetValue_iv(hash,"compact_fillpercent") ;
	3603	cmpt.compact_timeout = (db_timeout_t) GetValue_iv(hash, "compact_timeout");
	3604	}
	3605	RETVAL = (db->dbp)->compact(db->dbp, db->txn, start_p, stop_p, cmpt_p, flags, end_p);
	3606	if (RETVAL == 0 && hash) {
	3607	hv_store_iv(hash, "compact_deadlock", cmpt.compact_deadlock) ;
	3608	hv_store_iv(hash, "compact_levels", cmpt.compact_levels) ;
	3609	hv_store_iv(hash, "compact_pages_free", cmpt.compact_pages_free) ;
	3610	hv_store_iv(hash, "compact_pages_examine", cmpt.compact_pages_examine) ;
	3611	hv_store_iv(hash, "compact_pages_truncated", cmpt.compact_pages_truncated) ;
	3612	}
	3613	#endif
	3614	}
	3615	OUTPUT:
	3616	RETVAL
	3617	end if (RETVAL == 0 && end) OutputValue_B(ST(5), end_key) ;
3431	3618
3432	3619
3433	3620	MODULE = BerkeleyDB::Cursor PACKAGE = BerkeleyDB::Cursor PREFIX = cu_

3544	3731	cu_c_get(db, key, data, flags=0)
3545	3732	int flags
3546	3733	BerkeleyDB::Cursor db
3547		DBTKEY_Br key
	3734	DBTKEY_B key
3548	3735	DBT_B data
3549	3736	INIT:
3550	3737	Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ;

3565	3752	int flags
3566	3753	BerkeleyDB::Cursor db
3567	3754	DBTKEY_B key
3568		DBTKEY_Br pkey = NO_INIT
	3755	DBTKEY_Bpr pkey = NO_INIT
3569	3756	DBT_B data
3570	3757	CODE:
3571	3758	#ifndef AT_LEAST_DB_3_3

+16

-1

Changes less more

0	0	Revision history for Perl extension BerkeleyDB.
1	1
	2	0.29 2nd July 2006
	3
	4	* Fixes for cursor get from secondary where primary os recno.
	5
	6	* Added db_compact
	7
	8	0.28 11th June 2006
	9
	10	* Fixes for secondary where primary is recno.
	11
	12	* GET_BOTH_RANGE wasn't working. It is now.
	13
	14	* Added FreeBSD hints to README - patch supplied by David Landgren
	15	in #17675 from rt.cpan.org
	16
2	17	0.27 1st Novemver 2005
3	18
4	19	* Added support for Berkeley DB 4.4
5	20
6		* Fixed decondary key issue with recno databases
	21	* Fixed secondary key issue with recno databases
7	22
8	23	* Added libscan to Makefile.PL
9	24

-0

MANIFEST less more

23	23	t/db-3.1.t
24	24	t/db-3.2.t
25	25	t/db-3.3.t
	26	t/db-4.4.t
26	27	t/destroy.t
27	28	t/encrypt.t
28	29	t/env.t

-2

META.yml less more

0	0	# http://module-build.sourceforge.net/META-spec.html
1	1	#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
2	2	name: BerkeleyDB
3		version: 0.25
	3	version: 0.29
4	4	version_from: BerkeleyDB.pm
5	5	installdirs: site
6	6	requires:
7	7
8	8	distribution_type: module
9		generated_by: ExtUtils::MakeMaker version 6.17
	9	generated_by: ExtUtils::MakeMaker version 6.30

+36

-6

README less more

0	0	BerkeleyDB
1	1
2		Version 0.27
3
4		1st Nov 2005
5
6		Copyright (c) 1997-2005 Paul Marquess. All rights reserved. This
	2	Version 0.29
	3
	4	2nd July 2006
	5
	6	Copyright (c) 1997-2006 Paul Marquess. All rights reserved. This
7	7	program is free software; you can redistribute it and/or modify
8	8	it under the same terms as Perl itself.
9	9

57	57
58	58	Step 1 : If you are running Solaris 2.5, 2.7 or HP-UX 10 read either
59	59	the Solaris Notes or HP-UX Notes sections below.
60		If you are running Linux please read the Linux Notes section
	60	If you are running Linux please read the Linux Notes section
61	61	before proceeding.
	62	If you are running FreeBSD read the FreeBSD Notes section
	63	below.
	64
62	65
63	66	Step 2 : Edit the file config.in to suit you local installation.
64	67	Instructions are given in the file.

562	565	3: Build and install the Berkeley DB distribution as usual.
563	566
564	567
	568	FreeBSD Notes
	569	-------------
	570
	571	On FreeBSD 4.x through 6.x, the default db.h is for version 1. The build
	572	will fail with an error similar to:
	573
	574	BerkeleyDB.xs:74: #error db.h is from Berkeley DB 1.x - need at least
	575	Berkeley DB 2.6.4
	576
	577	Later versions of Berkeley DB are usually installed from ports.
	578	The available versions can be found by running a find(1) command:
	579
	580	% find /usr/local/include -name 'db.h'
	581	/usr/local/include/db3/db.h
	582	/usr/local/include/db4/db.h
	583	/usr/local/include/db41/db.h
	584	/usr/local/include/db42/db.h
	585	/usr/local/include/db43/db.h
	586
	587	The desired version of the library must be specified on the command line or
	588	via the config.in file. Make sure both values point to the same version:
	589
	590	INCLUDE = /usr/local/include/db43
	591	LIB = /usr/local/lib/db43
	592
	593
	594
565	595
566	596	FEEDBACK
567	597	--------

+265

-23

t/db-3.3.t less more

17	17
18	18	umask(0);
19	19
20		print "1..44\n";
	20	print "1..130\n";
21	21
22	22	{
23	23	# db->truncate

123	123	ok 23, my $s_cursor = $secondary->db_cursor();
124	124
125	125	# c_get from primary
126		$k = 1;
127		ok 24, $p_cursor->c_get($k, $v, DB_FIRST) == 0;
	126	$k = 'green';
	127	ok 24, $p_cursor->c_get($k, $v, DB_SET) == 0;
	128	ok 25, $k eq 'green';
	129	ok 26, $v eq 'house';
128	130
129	131	# c_get from secondary
130		ok 25, $s_cursor->c_get($k, $v, DB_FIRST) == 0;
	132	$k = 'sea';
	133	ok 27, $s_cursor->c_get($k, $v, DB_SET) == 0;
	134	ok 28, $k eq 'sea';
	135	ok 29, $v eq 'sea';
131	136
132	137	# c_pget from primary database should fail
133	138	$k = 1;
134		ok 26, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
	139	ok 30, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
135	140
136	141	# c_pget from secondary database
137		ok 27, $s_cursor->c_pget($k, $pk, $v, DB_FIRST) == 0;
	142	$k = 'flag';
	143	ok 31, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
	144	ok 32, $k eq 'flag';
	145	ok 33, $pk eq 'red';
	146	ok 34, $v eq 'flag';
138	147
139	148	# check put to secondary is illegal
140		ok 28, $secondary->db_put("tom", "dick") != 0;
141		ok 29, countRecords($secondary) == 3 ;
	149	ok 35, $secondary->db_put("tom", "dick") != 0;
	150	ok 36, countRecords($secondary) == 3 ;
142	151
143	152	# delete from primary
144		ok 30, $primary->db_del("green") == 0 ;
145		ok 31, countRecords($primary) == 2 ;
	153	ok 37, $primary->db_del("green") == 0 ;
	154	ok 38, countRecords($primary) == 2 ;
146	155
147	156	# check has been deleted in secondary
148		ok 32, $secondary->db_get("house", $v) != 0;
149		ok 33, countRecords($secondary) == 2 ;
	157	ok 39, $secondary->db_get("house", $v) != 0;
	158	ok 40, countRecords($secondary) == 2 ;
150	159
151	160	# delete from secondary
152		ok 34, $secondary->db_del('flag') == 0 ;
153		ok 35, countRecords($secondary) == 1 ;
	161	ok 41, $secondary->db_del('flag') == 0 ;
	162	ok 42, countRecords($secondary) == 1 ;
154	163
155	164
156	165	# check deleted from primary
157		ok 36, $primary->db_get("red", $v) != 0;
158		ok 37, countRecords($primary) == 1 ;
	166	ok 43, $primary->db_get("red", $v) != 0;
	167	ok 44, countRecords($primary) == 1 ;
159	168
160	169	}
161	170

186	195	my ($k, $v, $pk) = ('','','');
187	196
188	197	# create primary database
189		ok 38, my $primary = new BerkeleyDB::Btree -Filename => $Dfile1,
	198	ok 45, my $primary = new BerkeleyDB::Btree -Filename => $Dfile1,
190	199	-Compare => sub { return $_[0] cmp $_[1]},
191	200	-Flags => DB_CREATE ;
192	201
193	202	# create secondary database
194		ok 39, my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2,
	203	ok 46, my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2,
195	204	-Compare => sub { return $_[0] <=> $_[1]},
196	205	-Property => DB_DUP,
197	206	-Flags => DB_CREATE ;
198	207
199	208	# associate primary with secondary
200		ok 40, $primary->associate($secondary, \&sec_key2) == 0;
	209	ok 47, $primary->associate($secondary, \&sec_key2) == 0;
201	210
202	211	# add data to the primary
203	212	my %data = (

213	222	#print "put [$r] $BerkeleyDB::Error\n";
214	223	$ret += $r;
215	224	}
216		ok 41, $ret == 0 ;
	225	ok 48, $ret == 0 ;
217	226	#print "ret $ret\n";
218	227
219	228	#print "Primary\n" ; dumpdb($primary) ;
220	229	#print "Secondary\n" ; dumpdb($secondary) ;
221	230
222	231	# check the records in the secondary
223		ok 42, countRecords($secondary) == 4 ;
	232	ok 49, countRecords($secondary) == 4 ;
224	233
225	234	my $p_data = joinkeys($primary, " ");
226	235	#print "primary [$p_data]\n" ;
227		ok 43, $p_data eq join " ", sort { $a cmp $b } keys %data ;
	236	ok 50, $p_data eq join " ", sort { $a cmp $b } keys %data ;
228	237	my $s_data = joinkeys($secondary, " ");
229	238	#print "secondary [$s_data]\n" ;
230		ok 44, $s_data eq join " ", sort { $a <=> $b } map { length } values %data ;
	239	ok 51, $s_data eq join " ", sort { $a <=> $b } map { length } values %data ;
231	240
232	241	}
233	242
	243	{
	244	# db->associate -- primary recno, secondary hash
	245
	246	sub sec_key3
	247	{
	248	#print "in sec_key\n";
	249	my $pkey = shift ;
	250	my $pdata = shift ;
	251
	252	$_[0] = $pdata ;
	253	return 0;
	254	}
	255
	256	my ($Dfile1, $Dfile2);
	257	my $lex = new LexFile $Dfile1, $Dfile2 ;
	258	my %hash ;
	259	my $status;
	260	my ($k, $v, $pk) = ('','','');
	261
	262	# create primary database
	263	ok 52, my $primary = new BerkeleyDB::Recno -Filename => $Dfile1,
	264	-Flags => DB_CREATE ;
	265
	266	# create secondary database
	267	ok 53, my $secondary = new BerkeleyDB::Hash -Filename => $Dfile2,
	268	-Flags => DB_CREATE ;
	269
	270	# associate primary with secondary
	271	ok 54, $primary->associate($secondary, \&sec_key3) == 0;
	272
	273	# add data to the primary
	274	my %data = (
	275	0 => "flag",
	276	1 => "house",
	277	2 => "sea",
	278	) ;
	279
	280	my $ret = 0 ;
	281	while (($k, $v) = each %data) {
	282	my $r = $primary->db_put($k, $v) ;
	283	#print "put $r $BerkeleyDB::Error\n";
	284	$ret += $r;
	285	}
	286	ok 55, $ret == 0 ;
	287
	288	# check the records in the secondary
	289	ok 56, countRecords($secondary) == 3 ;
	290
	291	ok 57, $secondary->db_get("flag", $v) == 0;
	292	ok 58, $v eq "flag";
	293
	294	ok 59, $secondary->db_get("house", $v) == 0;
	295	ok 60, $v eq "house";
	296
	297	ok 61, $secondary->db_get("sea", $v) == 0;
	298	ok 62, $v eq "sea" ;
	299
	300	# pget to primary database is illegal
	301	ok 63, $primary->db_pget(0, $pk, $v) != 0 ;
	302
	303	# pget to secondary database is ok
	304	ok 64, $secondary->db_pget('house', $pk, $v) == 0 ;
	305	ok 65, $pk == 1 ;
	306	ok 66, $v eq 'house';
	307
	308	ok 67, my $p_cursor = $primary->db_cursor();
	309	ok 68, my $s_cursor = $secondary->db_cursor();
	310
	311	# c_get from primary
	312	$k = 1;
	313	ok 69, $p_cursor->c_get($k, $v, DB_SET) == 0;
	314	ok 70, $k == 1;
	315	ok 71, $v eq 'house';
	316
	317	# c_get from secondary
	318	$k = 'sea';
	319	ok 72, $s_cursor->c_get($k, $v, DB_SET) == 0;
	320	ok 73, $k eq 'sea'
	321	or warn "# key [$k]\n";
	322	ok 74, $v eq 'sea';
	323
	324	# c_pget from primary database should fail
	325	$k = 1;
	326	ok 75, $p_cursor->c_pget($k, $pk, $v, DB_FIRST) != 0;
	327
	328	# c_pget from secondary database
	329	$k = 'sea';
	330	ok 76, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
	331	ok 77, $k eq 'sea' ;
	332	ok 78, $pk == 2 ;
	333	ok 79, $v eq 'sea';
	334
	335	# check put to secondary is illegal
	336	ok 80, $secondary->db_put("tom", "dick") != 0;
	337	ok 81, countRecords($secondary) == 3 ;
	338
	339	# delete from primary
	340	ok 82, $primary->db_del(2) == 0 ;
	341	ok 83, countRecords($primary) == 2 ;
	342
	343	# check has been deleted in secondary
	344	ok 84, $secondary->db_get("sea", $v) != 0;
	345	ok 85, countRecords($secondary) == 2 ;
	346
	347	# delete from secondary
	348	ok 86, $secondary->db_del('flag') == 0 ;
	349	ok 87, countRecords($secondary) == 1 ;
	350
	351
	352	# check deleted from primary
	353	ok 88, $primary->db_get(0, $v) != 0;
	354	ok 89, countRecords($primary) == 1 ;
	355
	356	}
	357
	358	{
	359	# db->associate -- primary hash, secondary recno
	360
	361	sub sec_key4
	362	{
	363	#print "in sec_key4\n";
	364	my $pkey = shift ;
	365	my $pdata = shift ;
	366
	367	$_[0] = length $pdata ;
	368	return 0;
	369	}
	370
	371	my ($Dfile1, $Dfile2);
	372	my $lex = new LexFile $Dfile1, $Dfile2 ;
	373	my %hash ;
	374	my $status;
	375	my ($k, $v, $pk) = ('','','');
	376
	377	# create primary database
	378	ok 90, my $primary = new BerkeleyDB::Hash -Filename => $Dfile1,
	379	-Flags => DB_CREATE ;
	380
	381	# create secondary database
	382	ok 91, my $secondary = new BerkeleyDB::Recno -Filename => $Dfile2,
	383	#-Property => DB_DUP,
	384	-Flags => DB_CREATE ;
	385
	386	# associate primary with secondary
	387	ok 92, $primary->associate($secondary, \&sec_key4) == 0;
	388
	389	# add data to the primary
	390	my %data = (
	391	"red" => "flag",
	392	"green" => "house",
	393	"blue" => "sea",
	394	) ;
	395
	396	my $ret = 0 ;
	397	while (($k, $v) = each %data) {
	398	my $r = $primary->db_put($k, $v) ;
	399	#print "put $r $BerkeleyDB::Error\n";
	400	$ret += $r;
	401	}
	402	ok 93, $ret == 0 ;
	403
	404	# check the records in the secondary
	405	ok 94, countRecords($secondary) == 3 ;
	406
	407	ok 95, $secondary->db_get(0, $v) != 0;
	408	ok 96, $secondary->db_get(1, $v) != 0;
	409	ok 97, $secondary->db_get(2, $v) != 0;
	410	ok 98, $secondary->db_get(3, $v) == 0;
	411	ok 99, $v eq "sea";
	412
	413	ok 100, $secondary->db_get(4, $v) == 0;
	414	ok 101, $v eq "flag";
	415
	416	ok 102, $secondary->db_get(5, $v) == 0;
	417	ok 103, $v eq "house";
	418
	419	# pget to primary database is illegal
	420	ok 104, $primary->db_pget(0, $pk, $v) != 0 ;
	421
	422	# pget to secondary database is ok
	423	ok 105, $secondary->db_pget(4, $pk, $v) == 0 ;
	424	ok 106, $pk eq 'red'
	425	or warn "# $pk\n";;
	426	ok 107, $v eq 'flag';
	427
	428	ok 108, my $p_cursor = $primary->db_cursor();
	429	ok 109, my $s_cursor = $secondary->db_cursor();
	430
	431	# c_get from primary
	432	$k = 'green';
	433	ok 110, $p_cursor->c_get($k, $v, DB_SET) == 0;
	434	ok 111, $k eq 'green';
	435	ok 112, $v eq 'house';
	436
	437	# c_get from secondary
	438	$k = 3;
	439	ok 113, $s_cursor->c_get($k, $v, DB_SET) == 0;
	440	ok 114, $k == 3 ;
	441	ok 115, $v eq 'sea';
	442
	443	# c_pget from primary database should fail
	444	$k = 1;
	445	ok 116, $p_cursor->c_pget($k, $pk, $v, DB_SET) != 0;
	446
	447	# c_pget from secondary database
	448	$k = 5;
	449	ok 117, $s_cursor->c_pget($k, $pk, $v, DB_SET) == 0;
	450	ok 118, $k == 5 ;
	451	ok 119, $pk eq 'green';
	452	ok 120, $v eq 'house';
	453
	454	# check put to secondary is illegal
	455	ok 121, $secondary->db_put(77, "dick") != 0;
	456	ok 122, countRecords($secondary) == 3 ;
	457
	458	# delete from primary
	459	ok 123, $primary->db_del("green") == 0 ;
	460	ok 124, countRecords($primary) == 2 ;
	461
	462	# check has been deleted in secondary
	463	ok 125, $secondary->db_get(5, $v) != 0;
	464	ok 126, countRecords($secondary) == 2 ;
	465
	466	# delete from secondary
	467	ok 127, $secondary->db_del(4) == 0 ;
	468	ok 128, countRecords($secondary) == 1 ;
	469
	470
	471	# check deleted from primary
	472	ok 129, $primary->db_get("red", $v) != 0;
	473	ok 130, countRecords($primary) == 1 ;
	474
	475	}

+57

-0

t/db-4.4.t less more

	0	#!./perl -w
	1
	2	use strict ;
	3
	4	use lib 't' ;
	5	use BerkeleyDB;
	6	use Test::More ;
	7	use util (1);
	8
	9	plan(skip_all => "this needs Berkeley DB 4.4.x or better\n" )
	10	if $BerkeleyDB::db_version < 4.4;
	11
	12	plan tests => 5;
	13
	14	{
	15	title "Testing compact";
	16
	17	# db->db_compact
	18
	19	my $Dfile;
	20	my $lex = new LexFile $Dfile ;
	21	my ($k, $v) ;
	22	ok my $db = new BerkeleyDB::Btree -Filename => $Dfile,
	23	-Flags => DB_CREATE ;
	24
	25	# create some data
	26	my %data = (
	27	"red" => 2,
	28	"green" => "house",
	29	"blue" => "sea",
	30	) ;
	31
	32	my $ret = 0 ;
	33	while (($k, $v) = each %data) {
	34	$ret += $db->db_put($k, $v) ;
	35	}
	36	ok $ret == 0, " Created some data" ;
	37
	38	my $key;
	39	my $end;
	40	my %hash;
	41	$hash{compact_filepercent} = 20;
	42
	43	ok $db->compact("red", "green", \%hash, 0, $end) == 0, " Compacted ok";
	44
	45	if (0)
	46	{
	47	diag "end at $end";
	48	for my $key (sort keys %hash)
	49	{
	50	diag "[$key][$hash{$key}]\n";
	51	}
	52	}
	53
	54	ok $db->compact() == 0, " Compacted ok";
	55	}
	56

-3

t/mldbm.t less more

13	13	print "1..0 # Skip: Data::Dumper is not installed on this system.\n";
14	14	exit 0 ;
15	15	}
16		if ($Data::Dumper::VERSION < 2.08) {
17		print "1..0 # Skip: Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).\n";
18		exit 0 ;
	16	{
	17	local ($^W) = 0 ;
	18	if ($Data::Dumper::VERSION < 2.08) {
	19	print "1..0 # Skip: Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).\n";
	20	exit 0 ;
	21	}
19	22	}
20	23	eval { require MLDBM ; };
21	24	if ($@) {

-5

t/util.pm less more

69	69
70	70	sub new
71	71	{
72		my $self = shift ;
	72	my $self = shift ;
73	73	#my @files = () ;
74	74	foreach (@_)
75	75	{
76	76	$_ = $basename ;
77		unlink $basename ;
	77	1 while unlink $basename ;
78	78	push @files, $basename ;
79	79	++ $basename ;
80	80	}
81		bless [ @files ], $self ;
	81	bless [ @files ], $self ;
82	82	}
83	83
84	84	sub DESTROY
85	85	{
86		my $self = shift ;
87		#unlink @{ $self } ;
	86	my $self = shift ;
	87	chmod 0777, @{ $self } ;
	88	for (@$self) { 1 while unlink $_ } ;
88	89	}
89	90
90	91	END

+34

-3

typemap less more

7	7	#
8	8	#
9	9
	10	SVnull* T_SV_NULL
10	11	void * T_PV
11	12	u_int T_U_INT
12	13	u_int32_t T_U_INT

53	54	DBTKEY T_dbtkeydatum
54	55	DBTKEY_B T_dbtkeydatum_btree
55	56	DBTKEY_Br T_dbtkeydatum_btree_r
	57	DBTKEY_Bpr T_dbtkeydatum_btree_pr
56	58	DBTYPE T_U_INT
57	59	DualType T_DUAL
58	60	BerkeleyDB_type * T_IV

88	90	else
89	91	croak(\"$var is not of type ${ntype}\")
90	92
	93	T_SV_NULL
	94	if ($arg == NULL \|\| $arg == &PL_sv_undef)
	95	$var = NULL ;
	96	else
	97	$var = $arg ;
	98
91	99	T_HV_REF_NULL
92	100	if ($arg == &PL_sv_undef)
93	101	$var = NULL ;

214	222	DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
215	223	DBT_clear($var) ;
216	224	SvGETMAGIC($arg) ;
217		if (db->recno_or_queue \|\|
	225	if (db->recno_or_queue \|\|
	226	(db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
	227	Value = GetRecnoKey(db, SvIV(my_sv)) ;
	228	$var.data = & Value;
	229	$var.size = (int)sizeof(db_recno_t);
	230	}
	231	else {
	232	$var.data = SvPV(my_sv, PL_na);
	233	$var.size = (int)PL_na;
	234	}
	235	}
	236
	237	T_dbtkeydatum_btree_pr
	238	{
	239	SV* my_sv = $arg ;
	240	DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
	241	DBT_clear($var) ;
	242	SvGETMAGIC($arg) ;
	243	if (db->recno_or_queue \|\|
218	244	(db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
219	245	Value = GetRecnoKey(db, SvIV(my_sv)) ;
220	246	$var.data = & Value;

241	267
242	268	T_dbtdatum_opt
243	269	DBT_clear($var) ;
244		if (flagSet(DB_GET_BOTH)) {
	270	if (flagSet(DB_GET_BOTH)\|\| flagSet(DB_GET_BOTH)) {
245	271	SV* my_sv = $arg ;
246	272	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
247	273	SvGETMAGIC($arg) ;

254	280
255	281	T_dbtdatum_btree
256	282	DBT_clear($var) ;
257		if (flagSet(DB_GET_BOTH)) {
	283	if (flagSet(DB_GET_BOTH)\|\| flagSet(DB_GET_BOTH)) {
258	284	SV* my_sv = $arg ;
259	285	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
260	286	SvGETMAGIC($arg) ;

268	294
269	295	OUTPUT
270	296
	297	T_SV_NULL
	298	$arg = $var;
	299
271	300	T_RAW
272	301	sv_setiv($arg, PTR2IV($var));
273	302

296	325	OutputKey_B($arg, $var)
297	326	T_dbtkeydatum_btree_r
298	327	OutputKey_Br($arg, $var)
	328	T_dbtkeydatum_btree_pr
	329	OutputKey_Bpr($arg, $var)
299	330	T_dbtkeydatum
300	331	OutputKey($arg, $var)
301	332	T_dbtdatum