Commit 5761a3446ffa54236fc5e5bbfb6c9ca897a7dfb6 - libberkeleydb-perl

Imported Upstream version 0.41 Marco d'Itri 9 years ago

7 changed file(s) with 186 addition(s) and 44 deletion(s). Raw diff Collapse all Expand all

+29

-24

BerkeleyDB.pm less more

1	1	package BerkeleyDB;
2	2
3	3
4		# Copyright (c) 1997-2009 Paul Marquess. All rights reserved.
	4	# Copyright (c) 1997-2010 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.39';
	19	$VERSION = '0.41';
20	20
21	21	require Exporter;
22	22	#require DynaLoader;

655	655	}
656	656	}
657	657
658		use UNIVERSAL qw( isa ) ;
	658	use UNIVERSAL ;
659	659
660	660	sub env_remove
661	661	{

705	705	if ! defined $got->{Filename} ;
706	706
707	707	croak("Env not of type BerkeleyDB::Env")
708		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	708	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
709	709
710	710	return _db_remove($got);
711	711	}

723	723	}, @_) ;
724	724
725	725	croak("Env not of type BerkeleyDB::Env")
726		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	726	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
727	727
728	728	croak("Must specify a filename")
729	729	if ! defined $got->{Filename} ;

749	749	}, @_) ;
750	750
751	751	croak("Env not of type BerkeleyDB::Env")
752		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	752	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
753	753
754	754	croak("Must specify a filename")
755	755	if ! defined $got->{Filename} ;

759	759
760	760	package BerkeleyDB::Env ;
761	761
762		use UNIVERSAL qw( isa ) ;
	762	use UNIVERSAL ;
763	763	use Carp ;
764	764	use IO::File;
765	765	use vars qw( %valid_config_keys ) ;

768	768	{
769	769	my $fh = shift ;
770	770
771		return ((isa($fh,'GLOB') or isa(\$fh,'GLOB')) and defined fileno($fh) )
	771	return ((UNIVERSAL::isa($fh,'GLOB') or UNIVERSAL::isa(\$fh,'GLOB')) and defined fileno($fh) )
772	772
773	773	}
774	774

806	806	SetFlags => 0,
807	807	Cachesize => 0,
808	808	LockDetect => 0,
	809	TxMax => 0,
	810	LogConfig => 0,
	811	MaxLockers => 0,
	812	MaxLocks => 0,
	813	MaxObjects => 0,
809	814	Verbose => 0,
810	815	Config => undef,
811	816	Encrypt => undef,

904	909
905	910	use vars qw(@ISA) ;
906	911	@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
907		use UNIVERSAL qw( isa ) ;
	912	use UNIVERSAL ;
908	913	use Carp ;
909	914
910	915	sub new

941	946	}, @_) ;
942	947
943	948	croak("Env not of type BerkeleyDB::Env")
944		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	949	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
945	950
946	951	croak("Txn not of type BerkeleyDB::Txn")
947		if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
	952	if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
948	953
949	954	croak("-Tie needs a reference to a hash")
950	955	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;

969	974
970	975	use vars qw(@ISA) ;
971	976	@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
972		use UNIVERSAL qw( isa ) ;
	977	use UNIVERSAL ;
973	978	use Carp ;
974	979
975	980	sub new

1001	1006	}, @_) ;
1002	1007
1003	1008	croak("Env not of type BerkeleyDB::Env")
1004		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	1009	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
1005	1010
1006	1011	croak("Txn not of type BerkeleyDB::Txn")
1007		if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
	1012	if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
1008	1013
1009	1014	croak("-Tie needs a reference to a hash")
1010	1015	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;

1046	1051
1047	1052	use vars qw(@ISA) ;
1048	1053	@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1049		use UNIVERSAL qw( isa ) ;
	1054	use UNIVERSAL ;
1050	1055	use Carp ;
1051	1056
1052	1057	sub new

1078	1083	}, @_) ;
1079	1084
1080	1085	croak("Env not of type BerkeleyDB::Env")
1081		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	1086	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
1082	1087
1083	1088	croak("Txn not of type BerkeleyDB::Txn")
1084		if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
	1089	if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
1085	1090
1086	1091	croak("Tie needs a reference to an array")
1087	1092	if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ;

1112	1117
1113	1118	use vars qw(@ISA) ;
1114	1119	@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1115		use UNIVERSAL qw( isa ) ;
	1120	use UNIVERSAL ;
1116	1121	use Carp ;
1117	1122
1118	1123	sub new

1143	1148	}, @_) ;
1144	1149
1145	1150	croak("Env not of type BerkeleyDB::Env")
1146		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	1151	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
1147	1152
1148	1153	croak("Txn not of type BerkeleyDB::Txn")
1149		if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
	1154	if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
1150	1155
1151	1156	croak("Tie needs a reference to an array")
1152	1157	if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ;

1181	1186	##
1182	1187	## use vars qw(@ISA) ;
1183	1188	## @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1184		## use UNIVERSAL qw( isa ) ;
	1189	## use UNIVERSAL ;
1185	1190	## use Carp ;
1186	1191	##
1187	1192	## sub new

1232	1237
1233	1238	use vars qw(@ISA) ;
1234	1239	@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1235		use UNIVERSAL qw( isa ) ;
	1240	use UNIVERSAL ;
1236	1241	use Carp ;
1237	1242
1238	1243	sub new

1258	1263	}, @_) ;
1259	1264
1260	1265	croak("Env not of type BerkeleyDB::Env")
1261		if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
	1266	if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
1262	1267
1263	1268	croak("Txn not of type BerkeleyDB::Txn")
1264		if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
	1269	if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
1265	1270
1266	1271	croak("-Tie needs a reference to a hash")
1267	1272	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;

+30

-0

BerkeleyDB.pod less more

160	160	[ -Flags => number, ]
161	161	[ -SetFlags => bitmask, ]
162	162	[ -LockDetect => number, ]
	163	[ -TxMax => number, ]
	164	[ -LogConfig => number, ]
	165	[ -MaxLockers => number, ]
	166	[ -MaxLocks => number, ]
	167	[ -MaxObjects => number, ]
163	168	[ -SharedMemKey => number, ]
164	169	[ -Verbose => boolean, ]
165	170	[ -Encrypt => { Password => "string",

216	221
217	222	If present, this parameter sets the size of the environments shared memory
218	223	buffer pool.
	224
	225	=item -TxMax
	226
	227	If present, this parameter sets the number of simultaneous
	228	transactions that are allowed. Default 100. This default is
	229	definitely too low for programs using the MVCC capabilities.
	230
	231	=item -LogConfig
	232
	233	If present, this parameter is used to configure log options.
	234
	235	=item -MaxLockers
	236
	237	If present, this parameter is used to configure the maximum number of
	238	processes doing locking on the database. Default 1000.
	239
	240	=item -MaxLocks
	241
	242	If present, this parameter is used to configure the maximum number of
	243	locks on the database. Default 1000. This is often lower than required.
	244
	245	=item -MaxObjects
	246
	247	If present, this parameter is used to configure the maximum number of
	248	locked objects. Default 1000. This is often lower than required.
219	249
220	250	=item -SharedMemKey
221	251

+30

-0

BerkeleyDB.pod.P less more

160	160	[ -Flags => number, ]
161	161	[ -SetFlags => bitmask, ]
162	162	[ -LockDetect => number, ]
	163	[ -TxMax => number, ]
	164	[ -LogConfig => number, ]
	165	[ -MaxLockers => number, ]
	166	[ -MaxLocks => number, ]
	167	[ -MaxObjects => number, ]
163	168	[ -SharedMemKey => number, ]
164	169	[ -Verbose => boolean, ]
165	170	[ -Encrypt => { Password => "string",

216	221
217	222	If present, this parameter sets the size of the environments shared memory
218	223	buffer pool.
	224
	225	=item -TxMax
	226
	227	If present, this parameter sets the number of simultaneous
	228	transactions that are allowed. Default 100. This default is
	229	definitely too low for programs using the MVCC capabilities.
	230
	231	=item -LogConfig
	232
	233	If present, this parameter is used to configure log options.
	234
	235	=item -MaxLockers
	236
	237	If present, this parameter is used to configure the maximum number of
	238	processes doing locking on the database. Default 1000.
	239
	240	=item -MaxLocks
	241
	242	If present, this parameter is used to configure the maximum number of
	243	locks on the database. Default 1000. This is often lower than required.
	244
	245	=item -MaxObjects
	246
	247	If present, this parameter is used to configure the maximum number of
	248	locked objects. Default 1000. This is often lower than required.
219	249
220	250	=item -SharedMemKey
221	251

+75

-14

BerkeleyDB.xs less more

5	5
6	6	All comments/suggestions/problems are welcome
7	7
8		Copyright (c) 1997-2009 Paul Marquess. All rights reserved.
	8	Copyright (c) 1997-2010 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

1716	1716	{
1717	1717	SV ** svp;
1718	1718	svp = hv_fetch(hash, key, strlen(key), FALSE);
1719		if (svp && SvOK(*svp))
1720		return *svp ;
	1719
	1720	if (svp) {
	1721	if (SvGMAGICAL(*svp))
	1722	mg_get(*svp);
	1723	if (SvOK(*svp))
	1724	return *svp;
	1725	}
	1726
1721	1727	return NULL ;
1722	1728	}
1723	1729

2345	2351	int setflags = 0 ;
2346	2352	int cachesize = 0 ;
2347	2353	int lk_detect = 0 ;
	2354	int tx_max = 0 ;
	2355	int log_config = 0 ;
	2356	int max_lockers = 0 ;
	2357	int max_locks = 0 ;
	2358	int max_objects = 0 ;
2348	2359	long shm_key = 0 ;
2349	2360	char* data_dir = 0;
2350	2361	char* log_dir = 0;

2367	2378	SetValue_pv(server, "Server", char *) ;
2368	2379	SetValue_iv(cachesize, "Cachesize") ;
2369	2380	SetValue_iv(lk_detect, "LockDetect") ;
	2381	SetValue_iv(tx_max, "TxMax") ;
	2382	SetValue_iv(log_config,"LogConfig") ;
	2383	SetValue_iv(max_lockers,"MaxLockers") ;
	2384	SetValue_iv(max_locks, "MaxLocks") ;
	2385	SetValue_iv(max_objects,"MaxObjects") ;
2370	2386	SetValue_iv(shm_key, "SharedMemKey") ;
2371	2387	SetValue_iv(thread_count, "ThreadCount") ;
2372	2388	SetValue_pv(data_dir, "DB_DATA_DIR", char*) ;

2383	2399	if (server)
2384	2400	softCrash("-Server needs Berkeley DB 3.1 or better") ;
2385	2401	#endif /* ! AT_LEAST_DB_3_1 */
	2402	#ifndef AT_LEAST_DB_3_2
	2403	if (max_lockers)
	2404	softCrash("-MaxLockers needs Berkeley DB 3.2 or better") ;
	2405	if (max_locks)
	2406	softCrash("-MaxLocks needs Berkeley DB 3.2 or better") ;
	2407	if (max_objects)
	2408	softCrash("-MaxObjects needs Berkeley DB 3.2 or better") ;
	2409	#endif /* ! AT_LEAST_DB_3_2 */
2386	2410	#ifndef AT_LEAST_DB_4_1
2387	2411	if (enc_passwd)
2388	2412	softCrash("-Encrypt needs Berkeley DB 4.x or better") ;

2399	2423	if (thread_count)
2400	2424	softCrash("-ThreadCount needs Berkeley DB 4.4 or better") ;
2401	2425	#endif /* ! AT_LEAST_DB_4_4 */
	2426	#ifndef AT_LEAST_DB_4_7
	2427	if (log_config)
	2428	softCrash("-LogConfig needs Berkeley DB 4.7 or better") ;
	2429	#endif /* ! AT_LEAST_DB_4_7 */
2402	2430	Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n",
2403	2431	config, home, errprefix, flags)) ;
2404	2432	#ifdef TRACE

2509	2537	Trace(("set_lk_detect [%d] returned %s\n",
2510	2538	lk_detect, my_db_strerror(status)));
2511	2539	}
	2540
	2541	if (status == 0 && tx_max) {
	2542	status = env->set_tx_max(env, tx_max) ;
	2543	Trace(("set_tx_max [%d] returned %s\n",
	2544	tx_max, my_db_strerror(status)));
	2545	}
	2546	#ifdef AT_LEAST_DB_4_7
	2547	if (status == 0 && log_config) {
	2548	status = env->log_set_config(env, log_config, 1) ;
	2549	Trace(("log_set_config [%d] returned %s\n",
	2550	log_config, my_db_strerror(status)));
	2551	}
	2552	#endif /* AT_LEAST_DB_4_7 */
	2553	#ifdef AT_LEAST_DB_3_2
	2554	if (status == 0 && max_lockers) {
	2555	status = env->set_lk_max_lockers(env, max_lockers) ;
	2556	Trace(("set_lk_max_lockers [%d] returned %s\n",
	2557	max_lockers, my_db_strerror(status)));
	2558	}
	2559
	2560	if (status == 0 && max_locks) {
	2561	status = env->set_lk_max_locks(env, max_locks) ;
	2562	Trace(("set_lk_max_locks [%d] returned %s\n",
	2563	max_locks, my_db_strerror(status)));
	2564	}
	2565
	2566	if (status == 0 && max_objects) {
	2567	status = env->set_lk_max_objects(env, max_objects) ;
	2568	Trace(("set_lk_max_objects [%d] returned %s\n",
	2569	max_objects, my_db_strerror(status)));
	2570	}
	2571	#endif /* AT_LEAST_DB_3_2 */
2512	2572	#ifdef AT_LEAST_DB_4_1
2513	2573	/* set encryption */
2514	2574	if (enc_passwd && status == 0)

4931	4991	RETVAL
4932	4992
4933	4993	int
4934		set_tx_max(txn, max)
4935		BerkeleyDB::Txn txn
	4994	set_tx_max(env, max)
	4995	BerkeleyDB::Env env
4936	4996	u_int32_t max
4937	4997	PREINIT:
4938	4998	dMY_CXT;
4939	4999	INIT:
4940		ckActive_Transaction(txn->active) ;
	5000	ckActive_Database(env->active) ;
4941	5001	CODE:
4942	5002	#ifndef AT_LEAST_DB_2_3
4943	5003	softCrash("$env->set_tx_max needs Berkeley DB 2_3.x or better") ;
4944	5004	#else
4945		RETVAL = txn->Status = txn->txn->set_tx_max(txn->txn, max);
	5005	dieIfEnvOpened(env, "set_tx_max");
	5006	RETVAL = env->Status = env->Env->set_tx_max(env->Env, max);
4946	5007	#endif
4947	5008	OUTPUT:
4948	5009	RETVAL
4949	5010
4950	5011	int
4951		get_tx_max(txn, max)
4952		BerkeleyDB::Txn txn
	5012	get_tx_max(env, max)
	5013	BerkeleyDB::Env env
4953	5014	u_int32_t max = NO_INIT
4954	5015	PREINIT:
4955	5016	dMY_CXT;
4956	5017	INIT:
4957		ckActive_Transaction(txn->active) ;
	5018	ckActive_Database(env->active) ;
4958	5019	CODE:
4959	5020	#ifndef AT_LEAST_DB_2_3
4960	5021	softCrash("$env->get_tx_max needs Berkeley DB 2_3.x or better") ;
4961	5022	#else
4962		RETVAL = txn->Status = txn->txn->get_tx_max(txn->txn, &max);
	5023	RETVAL = env->Status = env->Env->get_tx_max(env->Env, &max);
4963	5024	#endif
4964	5025	OUTPUT:
4965	5026	RETVAL

5222	5283	RETVAL = 0;
5223	5284	if (seq->active) {
5224	5285	-- seq->db->open_sequences;
5225		RETVAL = seq->seq->close(seq->seq, flags);
	5286	RETVAL = (seq->seq->close)(seq->seq, flags);
5226	5287	}
5227	5288	seq->active = FALSE;
5228	5289	#endif

5257	5318	CODE:
5258	5319	#ifdef AT_LEAST_DB_4_3
5259	5320	if (seq->active)
5260		seq->seq->close(seq->seq, 0);
	5321	(seq->seq->close)(seq->seq, 0);
5261	5322	Safefree(seq);
5262	5323	#endif
5263	5324

5414	5475	(void)db_version(&Major, &Minor, &Patch) ;
5415	5476	/* Check that the versions of db.h and libdb.a are the same */
5416	5477	if (Major != DB_VERSION_MAJOR \|\| Minor != DB_VERSION_MINOR
5417		\|\| Patch != DB_VERSION_PATCH)
	5478	\|\| Patch != DB_VERSION_PATCH)
5418	5479	croak("\nBerkeleyDB needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",
5419	5480	DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH,
5420	5481	Major, Minor, Patch) ;

+16

-0

Changes less more

0	0	Revision history for Perl extension BerkeleyDB.
	1
	2	0.41 8th January 2010
	3
	4	* Silence "UNIVERSAL->import is deprecated" in perl 5.11
	5	RT# 53518
	6
	7	0.40 7th January 2010
	8
	9	* Added support for set_tx_max, log_set_config, set_lk_max_lockers,
	10	set_lk_max_locks, set_lk_max_objects via the Env constructor.
	11	Parameter names are TxMax, LogConfig, MaxLockers, MaxLocks &
	12	MaxObjects respectively.
	13	RT# 50456
	14
	15	* seq->seq->close doesn't compile on win32.
	16	RT# 49474
1	17
2	18	0.39 6th June 2009
3	19

-2

META.yml less more

0	0	--- #YAML:1.0
1	1	name: BerkeleyDB
2		version: 0.39
	2	version: 0.41
3	3	abstract: Perl extension for Berkeley DB version 2, 3 or 4
4	4	author:
5	5	- Paul Marquess <pmqs@cpan.org>

14	14	directory:
15	15	- t
16	16	- inc
17		generated_by: ExtUtils::MakeMaker version 6.52
	17	generated_by: ExtUtils::MakeMaker version 6.54
18	18	meta-spec:
19	19	url: http://module-build.sourceforge.net/META-spec-v1.4.html
20	20	version: 1.4

-4

README less more

0	0	BerkeleyDB
1	1
2		Version 0.39
3
4		6th June 2009
	2	Version 0.41
	3
	4	8th January 2010
5	5
6	6
7		Copyright (c) 1997-2009 Paul Marquess. All rights reserved. This
	7	Copyright (c) 1997-2010 Paul Marquess. All rights reserved. This
8	8	program is free software; you can redistribute it and/or modify
9	9	it under the same terms as Perl itself.
10	10