Commit e05800ac5ec1b63b2588d63560007fed41ab9e46 - libberkeleydb-perl

Merge upstream release v0.23 Marco d'Itri 9 years ago

25 changed file(s) with 1739 addition(s) and 346 deletion(s). Raw diff Collapse all Expand all

+60

-7

BerkeleyDB.pm less more

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

447	447	return \%got ;
448	448	}
449	449
	450	sub parseEncrypt
	451	{
	452	my $got = shift ;
	453
	454
	455	if (defined $got->{Encrypt}) {
	456	croak("Encrypt parameter must be a hash reference")
	457	if !ref $got->{Encrypt} \|\| ref $got->{Encrypt} ne 'HASH' ;
	458
	459	my %config = %{ $got->{Encrypt} } ;
	460
	461	my $p = BerkeleyDB::ParseParameters({
	462	Password => undef,
	463	Flags => undef,
	464	}, %config);
	465
	466	croak("Must specify Password and Flags with Encrypt parameter")
	467	if ! (defined $p->{Password} && defined $p->{Flags});
	468
	469	$got->{"Enc_Passwd"} = $p->{Password};
	470	$got->{"Enc_Flags"} = $p->{Flags};
	471	}
	472	}
	473
450	474	use UNIVERSAL qw( isa ) ;
451	475
452	476	sub env_remove

579	603	# [ -Cachesize => number ]
580	604	# [ -LockDetect => ]
581	605	# [ -Verbose => boolean ]
	606	# [ -Encrypt => { Password => string, Flags => value}
	607	#
582	608	# ;
583	609
584	610	my $pkg = shift ;

594	620	LockDetect => 0,
595	621	Verbose => 0,
596	622	Config => undef,
	623	Encrypt => undef,
597	624	}, @_) ;
598	625
599	626	if (defined $got->{ErrFile}) {

616	643	@BerkeleyDB::a = () ;
617	644	my $k = "" ; my $v = "" ;
618	645	while (($k, $v) = each %config) {
619		if ($BerkeleyDB::db_version >= 3.1 && ! $valid_config_keys{$k} ) {
	646	if ($BerkeleyDB::db_version >= 3.1 && ! $valid_config_keys{$k} ){
620	647	$BerkeleyDB::Error = "illegal name-value pair: $k $v\n" ;
621	648	croak $BerkeleyDB::Error ;
622	649	}

626	653	$got->{"Config"} = pack("p*", @BerkeleyDB::a, undef)
627	654	if @BerkeleyDB::a ;
628	655	}
	656
	657	BerkeleyDB::parseEncrypt($got);
629	658
630	659	my ($addr) = _db_appinit($pkg, $got) ;
631	660	my $obj ;

698	727	Env => undef,
699	728	#Tie => undef,
700	729	Txn => undef,
	730	Encrypt => undef,
701	731
702	732	# Hash specific
703	733	Ffactor => 0,

720	750
721	751	croak("-Tie needs a reference to a hash")
722	752	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
	753
	754	BerkeleyDB::parseEncrypt($got);
723	755
724	756	my ($addr) = _db_open_hash($self, $got);
725	757	my $obj ;

760	792	Env => undef,
761	793	#Tie => undef,
762	794	Txn => undef,
	795	Encrypt => undef,
763	796
764	797	# Btree specific
765	798	Minkey => 0,

776	809
777	810	croak("-Tie needs a reference to a hash")
778	811	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
	812
	813	BerkeleyDB::parseEncrypt($got);
779	814
780	815	my ($addr) = _db_open_btree($self, $got);
781	816	my $obj ;

816	851	Env => undef,
817	852	#Tie => undef,
818	853	Txn => undef,
	854	Encrypt => undef,
819	855
820	856	# Recno specific
821	857	Delim => undef,

837	873	croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}")
838	874	if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ;
839	875
	876
	877	BerkeleyDB::parseEncrypt($got);
840	878
841	879	$got->{Fname} = $got->{Filename} if defined $got->{Filename} ;
842	880

879	917	Env => undef,
880	918	#Tie => undef,
881	919	Txn => undef,
	920	Encrypt => undef,
882	921
883	922	# Queue specific
884	923	Len => undef,

898	937
899	938	croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}")
900	939	if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ;
	940
	941	BerkeleyDB::parseEncrypt($got);
901	942
902	943	$got->{Fname} = $got->{Filename} if defined $got->{Filename} ;
903	944

996	1037	Env => undef,
997	1038	#Tie => undef,
998	1039	Txn => undef,
	1040	Encrypt => undef,
999	1041
1000	1042	}, @_) ;
1001	1043

1007	1049
1008	1050	croak("-Tie needs a reference to a hash")
1009	1051	if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
	1052
	1053	BerkeleyDB::parseEncrypt($got);
1010	1054
1011	1055	my ($addr, $type) = _db_open_unknown($got);
1012	1056	my $obj ;

1103	1147	{
1104	1148	my $self = shift ;
1105	1149	my ($key, $value) = (0, 0) ;
1106		my $cursor = $self->db_cursor() ;
	1150	my $cursor = $self->_db_write_cursor() ;
1107	1151	while ($cursor->c_get($key, $value, BerkeleyDB::DB_PREV()) == 0)
1108	1152	{ $cursor->c_del() }
1109		#1 while $cursor->c_del() == 0 ;
1110		# cursor will self-destruct
1111	1153	}
1112	1154
1113	1155	#sub DESTROY

1383	1425	return $obj ;
1384	1426	}
1385	1427
	1428	sub _db_write_cursor
	1429	{
	1430	my $db = shift ;
	1431	my ($addr) = $db->__db_write_cursor(@_) ;
	1432	my $obj ;
	1433	$obj = bless [$addr, $db] , "BerkeleyDB::Cursor" if $addr ;
	1434	return $obj ;
	1435	}
	1436
1386	1437	sub db_join
1387	1438	{
1388		croak 'Usage: $db->BerkeleyDB::Common::db_join([cursors], flags=0)'
	1439	croak 'Usage: $db->BerkeleyDB::db_join([cursors], flags=0)'
1389	1440	if @_ < 2 \|\| @_ > 3 ;
1390	1441	my $db = shift ;
	1442	croak 'db_join: first parameter is not an array reference'
	1443	if ! ref $_[0] \|\| ref $_[0] ne 'ARRAY';
1391	1444	my ($addr) = $db->_db_join(@_) ;
1392	1445	my $obj ;
1393	1446	$obj = bless [$addr, $db, $_[0]] , "BerkeleyDB::Cursor" if $addr ;

+72

-19

BerkeleyDB.pod less more

13	13	$db = tie %hash, 'BerkeleyDB::Btree', [OPTIONS] ;
14	14	$db = new BerkeleyDB::Btree [OPTIONS] ;
15	15
16		$db = tie %hash, 'BerkeleyDB::Recno', [OPTIONS] ;
	16	$db = tie @array, 'BerkeleyDB::Recno', [OPTIONS] ;
17	17	$db = new BerkeleyDB::Recno [OPTIONS] ;
18	18
19		$db = tie %hash, 'BerkeleyDB::Queue', [OPTIONS] ;
	19	$db = tie @array, 'BerkeleyDB::Queue', [OPTIONS] ;
20	20	$db = new BerkeleyDB::Queue [OPTIONS] ;
21	21
22	22	$db = new BerkeleyDB::Unknown [OPTIONS] ;

35	35	$status = $db->db_put() ;
36	36	$status = $db->db_del() ;
37	37	$status = $db->db_sync() ;
38		$status = $db->db_close() ;
39	38	$status = $db->db_close() ;
40	39	$status = $db->db_pget()
41	40	$hash_ref = $db->db_stat() ;

83	82	$status = $env->set_data_dir() ;
84	83	$status = $env->set_tmp_dir() ;
85	84	$status = $env->set_verbose() ;
	85	$db_env_ptr = $env->DB_ENV() ;
86	86
87	87	$BerkeleyDB::Error
88	88	$BerkeleyDB::db_version

128	128	function B<db_appinit> in Berkeley DB 2.x or B<db_env_create> and
129	129	B<DBENV-E<gt>open> in Berkeley DB 3.x/4.x. Its purpose is to initialise a
130	130	number of sub-systems that can then be used in a consistent way in all
131		the databases you make use of the environment.
	131	the databases you make use of in the environment.
132	132
133	133	If you don't intend using transactions, locking or logging, then you
134	134	shouldn't need to make use of B<BerkeleyDB::Env>.
	135
	136	Note that an environment consists of a number of files that Berkeley DB
	137	manages behind the scenes for you. When you first use an environment, it
	138	needs to be explicitly created. This is done by including C<DB_CREATE>
	139	with the C<Flags> parameter, described below.
135	140
136	141	=head2 Synopsis
137	142

146	151	[ -SetFlags => bitmask, ]
147	152	[ -LockDetect => number, ]
148	153	[ -Verbose => boolean, ]
	154	[ -Encrypt => { Password => "string",
	155	Flags => number }, ]
149	156
150	157	=over 5
151	158

181	188
182	189	If present, this parameter should be the hostname of a server that is running
183	190	the Berkeley DB RPC server. All databases will be accessed via the RPC server.
	191
	192	=item -Encrypt
	193
	194	If present, this parameter will enable encryption of all data before
	195	it is written to the database. This parameters must be given a hash
	196	reference. The format is shown below.
	197
	198	-Encrypt => { -Password => "abc", Flags => DB_ENCRYPT_AES }
	199
	200	Valid values for the Flags are 0 or C<DB_ENCRYPT_AES>.
	201
	202	This option requires Berkeley DB 4.1 or better.
184	203
185	204	=item -Cachesize
186	205

334	353
335	354	Returns the status of the last BerkeleyDB::Env method.
336	355
337		=item $env->setmutexlocks()
338
339		Only available in Berkeley Db 3.0 or greater. Calls
340		B<db_env_set_mutexlocks> when used with Berkeley DB 3.1.x. When used with
341		Berkeley DB 3.0 or 3.2 and better it calls B<DBENV-E<gt>set_mutexlocks>.
	356
	357	=item $env->DB_ENV()
	358
	359	Returns a pointer to the underlying DB_ENV data structure that Berkeley
	360	DB uses.
	361
	362	=item $env->status()
	363
	364	Returns the status of the last BerkeleyDB::Env method.
342	365
343	366	=back
344	367

420	443	[ -Pagesize => number,]
421	444	[ -Env => $env,]
422	445	[ -Txn => $txn,]
	446	[ -Encrypt => { Password => "string",
	447	Flags => number }, ],
423	448	# BerkeleyDB::Hash specific
424	449	[ -Ffactor => number,]
425	450	[ -Nelem => number,]

439	464	[ -Pagesize => number,]
440	465	[ -Env => $env,]
441	466	[ -Txn => $txn,]
	467	[ -Encrypt => { Password => "string",
	468	Flags => number }, ],
442	469	# BerkeleyDB::Hash specific
443	470	[ -Ffactor => number,]
444	471	[ -Nelem => number,]

463	490	=item -Property
464	491
465	492	Used to specify extra flags when opening a database. The following
466		flags may be specified by logically OR'ing together one or more of the
	493	flags may be specified by bitwise OR'ing together one or more of the
467	494	following values:
468	495
469	496	B<DB_DUP>

730	757	[ -Pagesize => number,]
731	758	[ -Env => $env,]
732	759	[ -Txn => $txn,]
	760	[ -Encrypt => { Password => "string",
	761	Flags => number }, ],
733	762	# BerkeleyDB::Btree specific
734	763	[ -Minkey => number,]
735	764	[ -Compare => code reference,]

749	778	[ -Pagesize => number,]
750	779	[ -Env => $env,]
751	780	[ -Txn => $txn,]
	781	[ -Encrypt => { Password => "string",
	782	Flags => number }, ],
752	783	# BerkeleyDB::Btree specific
753	784	[ -Minkey => number,]
754	785	[ -Compare => code reference,]

765	796	=item -Property
766	797
767	798	Used to specify extra flags when opening a database. The following
768		flags may be specified by logically OR'ing together one or more of the
	799	flags may be specified by bitwise OR'ing together one or more of the
769	800	following values:
770	801
771	802	B<DB_DUP>

977	1008	[ -Pagesize => number,]
978	1009	[ -Env => $env,]
979	1010	[ -Txn => $txn,]
	1011	[ -Encrypt => { Password => "string",
	1012	Flags => number }, ],
980	1013	# BerkeleyDB::Recno specific
981	1014	[ -Delim => byte,]
982	1015	[ -Len => number,]

996	1029	[ -Pagesize => number,]
997	1030	[ -Env => $env,]
998	1031	[ -Txn => $txn,]
	1032	[ -Encrypt => { Password => "string",
	1033	Flags => number }, ],
999	1034	# BerkeleyDB::Recno specific
1000	1035	[ -Delim => byte,]
1001	1036	[ -Len => number,]

1071	1106	[ -Pagesize => number,]
1072	1107	[ -Env => $env,]
1073	1108	[ -Txn => $txn,]
	1109	[ -Encrypt => { Password => "string",
	1110	Flags => number }, ],
1074	1111	# BerkeleyDB::Queue specific
1075	1112	[ -Len => number,]
1076	1113	[ -Pad => byte,]

1089	1126	[ -Pagesize => number,]
1090	1127	[ -Env => $env,]
1091	1128	[ -Txn => $txn,]
	1129	[ -Encrypt => { Password => "string",
	1130	Flags => number }, ],
1092	1131	# BerkeleyDB::Queue specific
1093	1132	[ -Len => number,]
1094	1133	[ -Pad => byte,]

1115	1154	[ -Pagesize => number,]
1116	1155	[ -Env => $env,]
1117	1156	[ -Txn => $txn,]
	1157	[ -Encrypt => { Password => "string",
	1158	Flags => number }, ],
1118	1159
1119	1160
1120	1161	=head2 An example

1178	1219	When working under a Berkeley DB environment, this parameter
1179	1220
1180	1221	Defaults to no environment.
	1222
	1223	=item -Encrypt
	1224
	1225	If present, this parameter will enable encryption of all data before
	1226	it is written to the database. This parameters must be given a hash
	1227	reference. The format is shown below.
	1228
	1229	-Encrypt => { -Password => "abc", Flags => DB_ENCRYPT_AES }
	1230
	1231	Valid values for the Flags are 0 or C<DB_ENCRYPT_AES>.
	1232
	1233	This option requires Berkeley DB 4.1 or better.
1181	1234
1182	1235	=item -Txn
1183	1236

1214	1267
1215	1268	=back
1216	1269
1217		In addition, the following value may be set by logically OR'ing it into
	1270	In addition, the following value may be set by bitwise OR'ing it into
1218	1271	the B<$flags> parameter:
1219	1272
1220	1273	=over 5

1429	1482
1430	1483	=back
1431	1484
1432		In addition, the following value may be set by logically OR'ing it into
	1485	In addition, the following value may be set by bitwise OR'ing it into
1433	1486	the B<$flags> parameter:
1434	1487
1435	1488	=over 5

1730	1783
1731	1784	Before Berkeley DB 2.x was written there was only one Perl module that
1732	1785	interfaced to Berkeley DB. That module is called B<DB_File>. Although
1733		B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only provides
1734		an interface to the functionality available in Berkeley DB 1.x. That
1735		means that it doesn't support transactions, locking or any of the other
1736		new features available in DB 2.x or better.
	1786	B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only
	1787	provides an interface to the functionality available in Berkeley DB
	1788	1.x. That means that it doesn't support transactions, locking or any of
	1789	the other new features available in DB 2.x or better.
1737	1790
1738	1791	=head2 How do I store Perl data structures with BerkeleyDB?
1739	1792

1753	1806
1754	1807	=head1 COPYRIGHT
1755	1808
1756		Copyright (c) 1997-2002 Paul Marquess. All rights reserved. This program
	1809	Copyright (c) 1997-2003 Paul Marquess. All rights reserved. This program
1757	1810	is free software; you can redistribute it and/or modify it under the
1758	1811	same terms as Perl itself.
1759	1812

1780	1833
1781	1834	=head1 AUTHOR
1782	1835
1783		Paul Marquess E<lt>Paul.Marquess@btinternet.comE<gt>.
	1836	Paul Marquess E<lt>pmqs@cpan.orgE<gt>.
1784	1837
1785	1838	Questions about Berkeley DB may be addressed to E<lt>db@sleepycat.comE<gt>.
1786	1839

+72

-19

BerkeleyDB.pod.P less more

13	13	$db = tie %hash, 'BerkeleyDB::Btree', [OPTIONS] ;
14	14	$db = new BerkeleyDB::Btree [OPTIONS] ;
15	15
16		$db = tie %hash, 'BerkeleyDB::Recno', [OPTIONS] ;
	16	$db = tie @array, 'BerkeleyDB::Recno', [OPTIONS] ;
17	17	$db = new BerkeleyDB::Recno [OPTIONS] ;
18	18
19		$db = tie %hash, 'BerkeleyDB::Queue', [OPTIONS] ;
	19	$db = tie @array, 'BerkeleyDB::Queue', [OPTIONS] ;
20	20	$db = new BerkeleyDB::Queue [OPTIONS] ;
21	21
22	22	$db = new BerkeleyDB::Unknown [OPTIONS] ;

35	35	$status = $db->db_put() ;
36	36	$status = $db->db_del() ;
37	37	$status = $db->db_sync() ;
38		$status = $db->db_close() ;
39	38	$status = $db->db_close() ;
40	39	$status = $db->db_pget()
41	40	$hash_ref = $db->db_stat() ;

83	82	$status = $env->set_data_dir() ;
84	83	$status = $env->set_tmp_dir() ;
85	84	$status = $env->set_verbose() ;
	85	$db_env_ptr = $env->DB_ENV() ;
86	86
87	87	$BerkeleyDB::Error
88	88	$BerkeleyDB::db_version

128	128	function B<db_appinit> in Berkeley DB 2.x or B<db_env_create> and
129	129	B<DBENV-E<gt>open> in Berkeley DB 3.x/4.x. Its purpose is to initialise a
130	130	number of sub-systems that can then be used in a consistent way in all
131		the databases you make use of the environment.
	131	the databases you make use of in the environment.
132	132
133	133	If you don't intend using transactions, locking or logging, then you
134	134	shouldn't need to make use of B<BerkeleyDB::Env>.
	135
	136	Note that an environment consists of a number of files that Berkeley DB
	137	manages behind the scenes for you. When you first use an environment, it
	138	needs to be explicitly created. This is done by including C<DB_CREATE>
	139	with the C<Flags> parameter, described below.
135	140
136	141	=head2 Synopsis
137	142

146	151	[ -SetFlags => bitmask, ]
147	152	[ -LockDetect => number, ]
148	153	[ -Verbose => boolean, ]
	154	[ -Encrypt => { Password => "string",
	155	Flags => number }, ]
149	156
150	157	=over 5
151	158

181	188
182	189	If present, this parameter should be the hostname of a server that is running
183	190	the Berkeley DB RPC server. All databases will be accessed via the RPC server.
	191
	192	=item -Encrypt
	193
	194	If present, this parameter will enable encryption of all data before
	195	it is written to the database. This parameters must be given a hash
	196	reference. The format is shown below.
	197
	198	-Encrypt => { -Password => "abc", Flags => DB_ENCRYPT_AES }
	199
	200	Valid values for the Flags are 0 or C<DB_ENCRYPT_AES>.
	201
	202	This option requires Berkeley DB 4.1 or better.
184	203
185	204	=item -Cachesize
186	205

334	353
335	354	Returns the status of the last BerkeleyDB::Env method.
336	355
337		=item $env->setmutexlocks()
338
339		Only available in Berkeley Db 3.0 or greater. Calls
340		B<db_env_set_mutexlocks> when used with Berkeley DB 3.1.x. When used with
341		Berkeley DB 3.0 or 3.2 and better it calls B<DBENV-E<gt>set_mutexlocks>.
	356
	357	=item $env->DB_ENV()
	358
	359	Returns a pointer to the underlying DB_ENV data structure that Berkeley
	360	DB uses.
	361
	362	=item $env->status()
	363
	364	Returns the status of the last BerkeleyDB::Env method.
342	365
343	366	=back
344	367

420	443	[ -Pagesize => number,]
421	444	[ -Env => $env,]
422	445	[ -Txn => $txn,]
	446	[ -Encrypt => { Password => "string",
	447	Flags => number }, ],
423	448	# BerkeleyDB::Hash specific
424	449	[ -Ffactor => number,]
425	450	[ -Nelem => number,]

439	464	[ -Pagesize => number,]
440	465	[ -Env => $env,]
441	466	[ -Txn => $txn,]
	467	[ -Encrypt => { Password => "string",
	468	Flags => number }, ],
442	469	# BerkeleyDB::Hash specific
443	470	[ -Ffactor => number,]
444	471	[ -Nelem => number,]

463	490	=item -Property
464	491
465	492	Used to specify extra flags when opening a database. The following
466		flags may be specified by logically OR'ing together one or more of the
	493	flags may be specified by bitwise OR'ing together one or more of the
467	494	following values:
468	495
469	496	B<DB_DUP>

622	649	[ -Pagesize => number,]
623	650	[ -Env => $env,]
624	651	[ -Txn => $txn,]
	652	[ -Encrypt => { Password => "string",
	653	Flags => number }, ],
625	654	# BerkeleyDB::Btree specific
626	655	[ -Minkey => number,]
627	656	[ -Compare => code reference,]

641	670	[ -Pagesize => number,]
642	671	[ -Env => $env,]
643	672	[ -Txn => $txn,]
	673	[ -Encrypt => { Password => "string",
	674	Flags => number }, ],
644	675	# BerkeleyDB::Btree specific
645	676	[ -Minkey => number,]
646	677	[ -Compare => code reference,]

657	688	=item -Property
658	689
659	690	Used to specify extra flags when opening a database. The following
660		flags may be specified by logically OR'ing together one or more of the
	691	flags may be specified by bitwise OR'ing together one or more of the
661	692	following values:
662	693
663	694	B<DB_DUP>

816	847	[ -Pagesize => number,]
817	848	[ -Env => $env,]
818	849	[ -Txn => $txn,]
	850	[ -Encrypt => { Password => "string",
	851	Flags => number }, ],
819	852	# BerkeleyDB::Recno specific
820	853	[ -Delim => byte,]
821	854	[ -Len => number,]

835	868	[ -Pagesize => number,]
836	869	[ -Env => $env,]
837	870	[ -Txn => $txn,]
	871	[ -Encrypt => { Password => "string",
	872	Flags => number }, ],
838	873	# BerkeleyDB::Recno specific
839	874	[ -Delim => byte,]
840	875	[ -Len => number,]

877	912	[ -Pagesize => number,]
878	913	[ -Env => $env,]
879	914	[ -Txn => $txn,]
	915	[ -Encrypt => { Password => "string",
	916	Flags => number }, ],
880	917	# BerkeleyDB::Queue specific
881	918	[ -Len => number,]
882	919	[ -Pad => byte,]

895	932	[ -Pagesize => number,]
896	933	[ -Env => $env,]
897	934	[ -Txn => $txn,]
	935	[ -Encrypt => { Password => "string",
	936	Flags => number }, ],
898	937	# BerkeleyDB::Queue specific
899	938	[ -Len => number,]
900	939	[ -Pad => byte,]

921	960	[ -Pagesize => number,]
922	961	[ -Env => $env,]
923	962	[ -Txn => $txn,]
	963	[ -Encrypt => { Password => "string",
	964	Flags => number }, ],
924	965
925	966
926	967	=head2 An example

984	1025	When working under a Berkeley DB environment, this parameter
985	1026
986	1027	Defaults to no environment.
	1028
	1029	=item -Encrypt
	1030
	1031	If present, this parameter will enable encryption of all data before
	1032	it is written to the database. This parameters must be given a hash
	1033	reference. The format is shown below.
	1034
	1035	-Encrypt => { -Password => "abc", Flags => DB_ENCRYPT_AES }
	1036
	1037	Valid values for the Flags are 0 or C<DB_ENCRYPT_AES>.
	1038
	1039	This option requires Berkeley DB 4.1 or better.
987	1040
988	1041	=item -Txn
989	1042

1020	1073
1021	1074	=back
1022	1075
1023		In addition, the following value may be set by logically OR'ing it into
	1076	In addition, the following value may be set by bitwise OR'ing it into
1024	1077	the B<$flags> parameter:
1025	1078
1026	1079	=over 5

1235	1288
1236	1289	=back
1237	1290
1238		In addition, the following value may be set by logically OR'ing it into
	1291	In addition, the following value may be set by bitwise OR'ing it into
1239	1292	the B<$flags> parameter:
1240	1293
1241	1294	=over 5

1497	1550
1498	1551	Before Berkeley DB 2.x was written there was only one Perl module that
1499	1552	interfaced to Berkeley DB. That module is called B<DB_File>. Although
1500		B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only provides
1501		an interface to the functionality available in Berkeley DB 1.x. That
1502		means that it doesn't support transactions, locking or any of the other
1503		new features available in DB 2.x or better.
	1553	B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only
	1554	provides an interface to the functionality available in Berkeley DB
	1555	1.x. That means that it doesn't support transactions, locking or any of
	1556	the other new features available in DB 2.x or better.
1504	1557
1505	1558	=head2 How do I store Perl data structures with BerkeleyDB?
1506	1559

1520	1573
1521	1574	=head1 COPYRIGHT
1522	1575
1523		Copyright (c) 1997-2002 Paul Marquess. All rights reserved. This program
	1576	Copyright (c) 1997-2003 Paul Marquess. All rights reserved. This program
1524	1577	is free software; you can redistribute it and/or modify it under the
1525	1578	same terms as Perl itself.
1526	1579

1547	1600
1548	1601	=head1 AUTHOR
1549	1602
1550		Paul Marquess E<lt>Paul.Marquess@btinternet.comE<gt>.
	1603	Paul Marquess E<lt>pmqs@cpan.orgE<gt>.
1551	1604
1552	1605	Questions about Berkeley DB may be addressed to E<lt>db@sleepycat.comE<gt>.
1553	1606

+247

-63

BerkeleyDB.xs less more

0	0	/*
1	1
2		BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2 & 3
	2	BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2, 3 &4
3	3
4	4	written by Paul Marquess <Paul.Marquess@btinternet.com>
5	5
6	6	All comments/suggestions/problems are welcome
7	7
8		Copyright (c) 1997-2002 Paul Marquess. All rights reserved.
	8	Copyright (c) 1997-2003 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

44	44	# ifdef fclose
45	45	# undef fclose
46	46	# endif
	47	# ifdef rename
	48	# undef rename
	49	# endif
	50	# ifdef open
	51	# undef open
	52	# endif
47	53	#endif
48	54
49	55	/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be

127	133	# define DB_QUEUE 4
128	134	#endif /* DB_VERSION_MAJOR == 2 */
129	135
	136	#if DB_VERSION_MAJOR == 2
	137	# define BackRef internal
	138	#else
	139	# if DB_VERSION_MAJOR == 3 \|\| (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0)
	140	# define BackRef cj_internal
	141	# else
	142	# define BackRef api_internal
	143	# endif
	144	#endif
	145
130	146	#ifdef AT_LEAST_DB_3_2
131	147	# define DB_callback DB * db,
	148	# define getCurrentDB ((BerkeleyDB)db->BackRef)
	149	# define saveCurrentDB(db)
132	150	#else
133	151	# define DB_callback
	152	# define getCurrentDB CurrentDB
	153	# define saveCurrentDB(db) CurrentDB = db
134	154	#endif
135	155
136	156	#if DB_VERSION_MAJOR > 2

180	200	int TxnMgrStatus ;
181	201	int active ;
182	202	bool txn_enabled ;
	203	bool opened ;
	204	bool cdb_enabled;
183	205	} BerkeleyDB_ENV_type ;
184	206
185	207

210	232	u_int32_t dlen ;
211	233	u_int32_t doff ;
212	234	int active ;
	235	bool cdb_enabled;
213	236	#ifdef ALLOW_RECNO_OFFSET
214	237	int array_base ;
215	238	#endif

245	268	u_int32_t dlen ;
246	269	u_int32_t doff ;
247	270	int active ;
	271	bool cdb_enabled;
248	272	#ifdef ALLOW_RECNO_OFFSET
249	273	int array_base ;
250	274	#endif

336	360	# define flagSet(bitmask) ((flags & DB_OPFLAGS_MASK) == (bitmask))
337	361	#endif
338	362
339		#if DB_VERSION_MAJOR == 2
340		# define BackRef internal
341		#else
342		# if DB_VERSION_MAJOR == 3 \|\| (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0)
343		# define BackRef cj_internal
344		# else
345		# define BackRef api_internal
346		# endif
347		#endif
348	363
349	364	#define ERR_BUFF "BerkeleyDB::Error"
350	365

458	473	#define ckActive_Transaction(a) ckActive(a, "Transaction")
459	474	#define ckActive_Database(a) ckActive(a, "Database")
460	475	#define ckActive_Cursor(a) ckActive(a, "Cursor")
	476
	477	#define dieIfEnvOpened(e, m) if (e->opened) softCrash("Cannot call method BerkeleyDB::Env::%s after environment has been opened", m);
461	478
462	479	/* Internal Global Data */
463	480	static db_recno_t Value ;

868	885	PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
869	886	PUTBACK ;
870	887
871		count = perl_call_sv(CurrentDB->compare, G_SCALAR);
	888	count = perl_call_sv(getCurrentDB->compare, G_SCALAR);
872	889
873	890	SPAGAIN ;
874	891

895	912	BerkeleyDB keepDB = CurrentDB ;
896	913
897	914	Trace(("In dup_compare \n")) ;
898		if (!CurrentDB)
	915	if (!getCurrentDB)
899	916	softCrash("Internal Error - No CurrentDB in dup_compare") ;
900		if (CurrentDB->dup_compare == NULL)
901		softCrash("in dup_compare: no callback specified for database '%s'", CurrentDB->filename) ;
	917	if (getCurrentDB->dup_compare == NULL)
	918
	919
	920	softCrash("in dup_compare: no callback specified for database '%s'", getCurrentDB->filename) ;
902	921
903	922	data1 = (char*) key1->data ;
904	923	data2 = (char*) key2->data ;

923	942	PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
924	943	PUTBACK ;
925	944
926		count = perl_call_sv(CurrentDB->dup_compare, G_SCALAR);
	945	count = perl_call_sv(getCurrentDB->dup_compare, G_SCALAR);
927	946
928	947	SPAGAIN ;
929	948

972	991	PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
973	992	PUTBACK ;
974	993
975		count = perl_call_sv(CurrentDB->prefix, G_SCALAR);
	994	count = perl_call_sv(getCurrentDB->prefix, G_SCALAR);
976	995
977	996	SPAGAIN ;
978	997

1010	1029	XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
1011	1030	PUTBACK ;
1012	1031
1013		count = perl_call_sv(CurrentDB->hash, G_SCALAR);
	1032	count = perl_call_sv(getCurrentDB->hash, G_SCALAR);
1014	1033
1015	1034	SPAGAIN ;
1016	1035

1037	1056	int retval ;
1038	1057	int count ;
1039	1058	SV * skey_SV ;
	1059	int skey_len;
	1060	char * skey_ptr ;
1040	1061
1041	1062	Trace(("In associate_cb \n")) ;
1042		if (((BerkeleyDB)db->BackRef)->associated == NULL){
	1063	if (getCurrentDB->associated == NULL){
1043	1064	Trace(("No Callback registered\n")) ;
1044	1065	return EINVAL ;
1045	1066	}

1072	1093	PUTBACK ;
1073	1094
1074	1095	Trace(("calling associated cb\n"));
1075		count = perl_call_sv(((BerkeleyDB)db->BackRef)->associated, G_SCALAR);
	1096	count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
1076	1097	Trace(("called associated cb\n"));
1077	1098
1078	1099	SPAGAIN ;

1086	1107
1087	1108	/* retrieve the secondary key */
1088	1109	DBT_clear(*skey);
	1110	skey_ptr = SvPV(skey_SV, skey_len);
1089	1111	skey->flags = DB_DBT_APPMALLOC;
1090		skey->size = SvCUR(skey_SV);
1091		skey->data = (char*)safemalloc(skey->size);
1092		memcpy(skey->data, SvPVX(skey_SV), skey->size);
	1112	/* skey->size = SvCUR(skey_SV); */
	1113	/* skey->data = (char)safemalloc(skey->size); /
	1114	skey->size = skey_len;
	1115	skey->data = (char*)safemalloc(skey_len);
	1116	memcpy(skey->data, skey_ptr, skey_len);
1093	1117	Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1094	1118
1095	1119	FREETMPS ;

1172	1196	DBTYPE type,
1173	1197	int flags,
1174	1198	int mode,
1175		DB_INFO * info
	1199	DB_INFO * info,
	1200	char * password,
	1201	int enc_flags
1176	1202	)
1177	1203	{
1178	1204	DB_ENV * env = NULL ;

1185	1211	dbenv, ref_dbenv, file, subname, type, flags, mode)) ;
1186	1212
1187	1213	CurrentDB = db ;
	1214
1188	1215	if (dbenv)
1189	1216	env = dbenv->Env ;
1190	1217

1198	1225	if (subname)
1199	1226	softCrash("Subname needs Berkeley DB 3 or better") ;
1200	1227	#endif
	1228
	1229	#ifndef AT_LEAST_DB_4_1
	1230	if (password)
	1231	softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
	1232	#endif /* ! AT_LEAST_DB_4_1 */
1201	1233
1202	1234	#if DB_VERSION_MAJOR > 2
1203	1235	Status = db_create(&dbp, env, 0) ;

1205	1237	if (Status)
1206	1238	return RETVAL ;
1207	1239
	1240	#ifdef AT_LEAST_DB_3_2
	1241	dbp->BackRef = db;
	1242	#endif
	1243
1208	1244	#ifdef AT_LEAST_DB_3_3
1209	1245	if (! env) {
1210	1246	dbp->set_alloc(dbp, safemalloc, MyRealloc, safefree) ;
1211	1247	dbp->set_errcall(dbp, db_errcall_cb) ;
1212	1248	}
1213	1249	#endif
	1250
	1251	#ifdef AT_LEAST_DB_4_1
	1252	/* set encryption */
	1253	if (password)
	1254	{
	1255	Status = dbp->set_encrypt(dbp, password, enc_flags);
	1256	Trace(("DB->set_encrypt passwd = %s, flags %d returned %s\n",
	1257	password, enc_flags,
	1258	my_db_strerror(Status))) ;
	1259	if (Status)
	1260	return RETVAL ;
	1261	}
	1262	#endif
1214	1263
1215	1264	if (info->re_source) {
1216	1265	Status = dbp->set_re_source(dbp, info->re_source) ;

1335	1384	if (info->q_extentsize) {
1336	1385	#ifdef AT_LEAST_DB_3_2
1337	1386	Status = dbp->set_q_extentsize(dbp, info->q_extentsize) ;
1338		Trace(("set_flags [%d] returned %s\n",
1339		info->flags, my_db_strerror(Status)));
	1387	Trace(("set_q_extentsize [%d] returned %s\n",
	1388	info->q_extentsize, my_db_strerror(Status)));
1340	1389	if (Status)
1341	1390	return RETVAL ;
1342	1391	#else
1343	1392	softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ;
1344	1393	#endif
1345	1394	}
	1395
1346	1396
1347	1397	#ifdef AT_LEAST_DB_4_1
1348	1398	if ((Status = (dbp->open)(dbp, txnid, file, subname, type, flags, mode)) == 0) {

1354	1404	#endif /* DB_VERSION_MAJOR == 2 */
1355	1405
1356	1406	Trace(("db_opened ok\n"));
1357		#ifdef AT_LEAST_DB_3_3
1358		dbp->BackRef = db;
1359		#endif
1360	1407	RETVAL = db ;
1361	1408	RETVAL->dbp = dbp ;
1362	1409	RETVAL->txn = txnid ;

1377	1424	hash_store_iv("BerkeleyDB::Term::Db", (char *)RETVAL, 1) ;
1378	1425	Trace((" storing %p %p in BerkeleyDB::Term::Db\n", RETVAL, dbp)) ;
1379	1426	if (dbenv) {
	1427	RETVAL->cdb_enabled = dbenv->cdb_enabled ;
1380	1428	RETVAL->parent_env = dbenv ;
1381	1429	dbenv->Status = Status ;
1382	1430	++ dbenv->open_dbs ;

1526	1574	dbenv = env->Env ;
1527	1575	RETVAL = db_create(&dbp, dbenv, 0) ;
1528	1576	if (RETVAL == 0) {
1529		RETVAL = dbp->rename(dbp, db, subdb, newname, flags) ;
	1577	RETVAL = (dbp->rename)(dbp, db, subdb, newname, flags) ;
1530	1578	}
1531	1579	#endif
1532	1580	}

1534	1582	RETVAL
1535	1583
1536	1584	MODULE = BerkeleyDB::Env PACKAGE = BerkeleyDB::Env PREFIX = env_
	1585
	1586	BerkeleyDB::Env::Raw
	1587	create(flags=0)
	1588	u_int32_t flags
	1589	CODE:
	1590	{
	1591	#ifndef AT_LEAST_DB_4_1
	1592	softCrash("$env->create needs Berkeley DB 4.1 or better") ;
	1593	#else
	1594	DB_ENV * env ;
	1595	int status;
	1596	RETVAL = NULL;
	1597	Trace(("in BerkeleyDB::Env::create flags=%d\n", flags)) ;
	1598	status = db_env_create(&env, flags) ;
	1599	Trace(("db_env_create returned %s\n", my_db_strerror(status))) ;
	1600	if (status == 0) {
	1601	ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
	1602	RETVAL->Env = env ;
	1603	RETVAL->active = TRUE ;
	1604	RETVAL->opened = FALSE;
	1605	env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
	1606	env->set_errcall(env, db_errcall_cb) ;
	1607	}
	1608	#endif
	1609	}
	1610	OUTPUT:
	1611	RETVAL
	1612
	1613	int
	1614	open(env, db_home=NULL, flags=0, mode=0777)
	1615	BerkeleyDB::Env env
	1616	char * db_home
	1617	u_int32_t flags
	1618	int mode
	1619	CODE:
	1620	#ifndef AT_LEAST_DB_4_1
	1621	softCrash("$env->create needs Berkeley DB 4.1 or better") ;
	1622	#else
	1623	RETVAL = env->Env->open(env->Env, db_home, flags, mode);
	1624	env->opened = TRUE;
	1625	#endif
	1626	OUTPUT:
	1627	RETVAL
	1628
	1629
	1630	int
	1631	set_encrypt(env, passwd, flags)
	1632	BerkeleyDB::Env env
	1633	const char * passwd
	1634	u_int32_t flags
	1635	CODE:
	1636	#ifndef AT_LEAST_DB_4_1
	1637	softCrash("$env->set_encrypt needs Berkeley DB 4.1 or better") ;
	1638	#else
	1639	dieIfEnvOpened(env, "set_encrypt");
	1640	RETVAL = env->Env->set_encrypt(env->Env, passwd, flags);
	1641	env->opened = TRUE;
	1642	#endif
	1643	OUTPUT:
	1644	RETVAL
	1645
	1646
1537	1647
1538	1648
1539	1649	BerkeleyDB::Env::Raw

1544	1654	{
1545	1655	HV * hash ;
1546	1656	SV * sv ;
	1657	char * enc_passwd = NULL ;
	1658	int enc_flags = 0 ;
1547	1659	char * home = NULL ;
1548	1660	char * errfile = NULL ;
1549	1661	char * server = NULL ;

1559	1671	Trace(("in _db_appinit [%s] %d\n", self, ref)) ;
1560	1672	hash = (HV*) SvRV(ref) ;
1561	1673	SetValue_pv(home, "Home", char *) ;
	1674	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	1675	SetValue_iv(enc_flags, "Enc_Flags") ;
1562	1676	SetValue_pv(config, "Config", char **) ;
1563	1677	SetValue_sv(errprefix, "ErrPrefix") ;
1564	1678	SetValue_iv(flags, "Flags") ;

1574	1688	if (server)
1575	1689	softCrash("-Server needs Berkeley DB 3.1 or better") ;
1576	1690	#endif /* ! AT_LEAST_DB_3_1 */
	1691	#ifndef AT_LEAST_DB_4_1
	1692	if (enc_passwd)
	1693	softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
	1694	#endif /* ! AT_LEAST_DB_4_1 */
1577	1695	Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n",
1578	1696	config, home, errprefix, flags)) ;
1579	1697	#ifdef TRACE

1613	1731	SetValue_iv(env->db_verbose, "Verbose") ;
1614	1732	env->db_errcall = db_errcall_cb ;
1615	1733	RETVAL->active = TRUE ;
	1734	RETVAL->opened = TRUE;
	1735	RETVAL->cdb_enabled = (flags & DB_INIT_CDB != 0 ? TRUE : FALSE) ;
1616	1736	status = db_appinit(home, config, env, flags) ;
	1737	printf(" status = %d errno %d \n", status, errno) ;
1617	1738	Trace((" status = %d env %d Env %d\n", status, RETVAL, env)) ;
1618	1739	if (status == 0)
1619	1740	hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;

1649	1770	Trace(("set_lk_detect [%d] returned %s\n",
1650	1771	lk_detect, my_db_strerror(status)));
1651	1772	}
	1773	#ifdef AT_LEAST_DB_4_1
	1774	/* set encryption */
	1775	if (enc_passwd && status == 0)
	1776	{
	1777	status = env->set_encrypt(env, enc_passwd, enc_flags);
	1778	Trace(("ENV->set_encrypt passwd = %s, flags %d returned %s\n",
	1779	enc_passwd, enc_flags,
	1780	my_db_strerror(status))) ;
	1781	}
	1782	#endif
1652	1783	#ifdef AT_LEAST_DB_4
1653	1784	/* set the server */
1654	1785	if (server && status == 0)

1699	1830	SetValue_iv(mode, "Mode") ;
1700	1831	env->set_errcall(env, db_errcall_cb) ;
1701	1832	RETVAL->active = TRUE ;
	1833	RETVAL->cdb_enabled = (flags & DB_INIT_CDB != 0 ? TRUE : FALSE) ;
1702	1834	#ifdef IS_DB_3_0_x
1703	1835	status = (env->open)(env, home, config, flags, mode) ;
1704	1836	#else /* > 3.0 */
1705	1837	status = (env->open)(env, home, flags, mode) ;
1706	1838	#endif
	1839	Trace(("ENV->open(env=%s,home=%s,flags=%d,mode=%d)\n",env,home,flags,mode)) ;
1707	1840	Trace(("ENV->open returned %s\n", my_db_strerror(status))) ;
1708	1841	}
1709	1842

1719	1852	RETVAL = NULL ;
1720	1853	}
1721	1854	#endif /* DB_VERSION_MAJOR > 2 */
	1855	{
	1856	SV * sv_err = perl_get_sv(ERR_BUFF, FALSE);
	1857	sv_setpv(sv_err, db_strerror(status));
	1858	}
1722	1859	}
1723	1860	OUTPUT:
1724	1861	RETVAL
	1862
	1863	DB_ENV*
	1864	DB_ENV(env)
	1865	BerkeleyDB::Env env
	1866	CODE:
	1867	if (env->active)
	1868	RETVAL = env->Env ;
	1869	else
	1870	RETVAL = NULL;
	1871
1725	1872
1726	1873	void
1727	1874	log_archive(env, flags=0)

2035	2182	#ifndef AT_LEAST_DB_3_1
2036	2183	softCrash("$env->set_data_dir needs Berkeley DB 3.1 or better") ;
2037	2184	#else
	2185	dieIfEnvOpened(env, "set_data_dir");
2038	2186	RETVAL = env->Status = env->Env->set_data_dir(env->Env, dir);
2039	2187	#endif
2040	2188	OUTPUT:

2140	2288	int mode = 0 ;
2141	2289	BerkeleyDB db ;
2142	2290	BerkeleyDB__Txn txn = NULL ;
	2291	char * enc_passwd = NULL ;
	2292	int enc_flags = 0 ;
2143	2293
2144	2294	Trace(("_db_open_hash start\n")) ;
2145	2295	hash = (HV*) SvRV(ref) ;

2150	2300	ref_dbenv = sv ;
2151	2301	SetValue_iv(flags, "Flags") ;
2152	2302	SetValue_iv(mode, "Mode") ;
	2303	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	2304	SetValue_iv(enc_flags, "Enc_Flags") ;
2153	2305
2154	2306	Zero(&info, 1, DB_INFO) ;
2155	2307	SetValue_iv(info.db_cachesize, "Cachesize") ;

2173	2325	croak("DupCompare needs Berkeley DB 2.5.9 or later") ;
2174	2326	#endif
2175	2327	}
2176		RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_HASH, flags, mode, &info) ;
	2328	RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_HASH, flags, mode, &info, enc_passwd, enc_flags) ;
2177	2329	Trace(("_db_open_hash end\n")) ;
2178	2330	}
2179	2331	OUTPUT:

2253	2405	BerkeleyDB RETVAL ;
2254	2406	BerkeleyDB__Txn txn = NULL ;
2255	2407	static char * Names[] = {"", "Btree", "Hash", "Recno"} ;
	2408	char * enc_passwd = NULL ;
	2409	int enc_flags = 0 ;
2256	2410
2257	2411	hash = (HV*) SvRV(ref) ;
2258	2412	SetValue_pv(file, "Filename", char *) ;

2262	2416	ref_dbenv = sv ;
2263	2417	SetValue_iv(flags, "Flags") ;
2264	2418	SetValue_iv(mode, "Mode") ;
	2419	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	2420	SetValue_iv(enc_flags, "Enc_Flags") ;
2265	2421
2266	2422	Zero(&info, 1, DB_INFO) ;
2267	2423	SetValue_iv(info.db_cachesize, "Cachesize") ;

2272	2428	SetValue_iv(info.flags, "Property") ;
2273	2429	ZMALLOC(db, BerkeleyDB_type) ;
2274	2430
2275		RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_UNKNOWN, flags, mode, &info) ;
	2431	RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_UNKNOWN, flags, mode, &info, enc_passwd, enc_flags) ;
2276	2432	XPUSHs(sv_2mortal(newSViv(PTR2IV(RETVAL))));
2277	2433	if (RETVAL)
2278	2434	XPUSHs(sv_2mortal(newSVpv(Names[RETVAL->type], 0))) ;

2301	2457	int mode = 0 ;
2302	2458	BerkeleyDB db ;
2303	2459	BerkeleyDB__Txn txn = NULL ;
	2460	char * enc_passwd = NULL ;
	2461	int enc_flags = 0 ;
2304	2462
2305	2463	Trace(("In _db_open_btree\n"));
2306	2464	hash = (HV*) SvRV(ref) ;

2311	2469	ref_dbenv = sv ;
2312	2470	SetValue_iv(flags, "Flags") ;
2313	2471	SetValue_iv(mode, "Mode") ;
	2472	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	2473	SetValue_iv(enc_flags, "Enc_Flags") ;
2314	2474
2315	2475	Zero(&info, 1, DB_INFO) ;
2316	2476	SetValue_iv(info.db_cachesize, "Cachesize") ;

2341	2501	db->prefix = newSVsv(sv) ;
2342	2502	}
2343	2503
2344		RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_BTREE, flags, mode, &info) ;
	2504	RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_BTREE, flags, mode, &info, enc_passwd, enc_flags) ;
2345	2505	}
2346	2506	OUTPUT:
2347	2507	RETVAL

2431	2591	int mode = 0 ;
2432	2592	BerkeleyDB db ;
2433	2593	BerkeleyDB__Txn txn = NULL ;
	2594	char * enc_passwd = NULL ;
	2595	int enc_flags = 0 ;
2434	2596
2435	2597	hash = (HV*) SvRV(ref) ;
2436	2598	SetValue_pv(file, "Fname", char*) ;
	2599	SetValue_pv(subname, "Subname", char *) ;
2437	2600	SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
2438	2601	ref_dbenv = sv ;
2439	2602	SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
2440	2603	SetValue_iv(flags, "Flags") ;
2441	2604	SetValue_iv(mode, "Mode") ;
	2605	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	2606	SetValue_iv(enc_flags, "Enc_Flags") ;
2442	2607
2443	2608	Zero(&info, 1, DB_INFO) ;
2444	2609	SetValue_iv(info.db_cachesize, "Cachesize") ;

2466	2631	db->array_base = (db->array_base == 0 ? 1 : 0) ;
2467	2632	#endif /* ALLOW_RECNO_OFFSET */
2468	2633
2469		RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_RECNO, flags, mode, &info) ;
	2634	RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_RECNO, flags, mode, &info, enc_passwd, enc_flags) ;
2470	2635	}
2471	2636	OUTPUT:
2472	2637	RETVAL

2494	2659	int mode = 0 ;
2495	2660	BerkeleyDB db ;
2496	2661	BerkeleyDB__Txn txn = NULL ;
	2662	char * enc_passwd = NULL ;
	2663	int enc_flags = 0 ;
2497	2664
2498	2665	hash = (HV*) SvRV(ref) ;
2499	2666	SetValue_pv(file, "Fname", char*) ;
	2667	SetValue_pv(subname, "Subname", char *) ;
2500	2668	SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
2501	2669	ref_dbenv = sv ;
2502	2670	SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
2503	2671	SetValue_iv(flags, "Flags") ;
2504	2672	SetValue_iv(mode, "Mode") ;
	2673	SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
	2674	SetValue_iv(enc_flags, "Enc_Flags") ;
2505	2675
2506	2676	Zero(&info, 1, DB_INFO) ;
2507	2677	SetValue_iv(info.db_cachesize, "Cachesize") ;

2526	2696	db->array_base = (db->array_base == 0 ? 1 : 0) ;
2527	2697	#endif /* ALLOW_RECNO_OFFSET */
2528	2698
2529		RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_QUEUE, flags, mode, &info) ;
	2699	RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_QUEUE, flags, mode, &info, enc_passwd, enc_flags) ;
2530	2700	#endif
2531	2701	}
2532	2702	OUTPUT:

2591	2761	BerkeleyDB::Common db
2592	2762	INIT:
2593	2763	ckActive_Database(db->active) ;
2594		CurrentDB = db ;
	2764	saveCurrentDB(db) ;
2595	2765	CODE:
2596	2766	Trace(("BerkeleyDB::Common::db_close %d\n", db));
2597	2767	#ifdef STRICT_CLOSE

2615	2785	dab__DESTROY(db)
2616	2786	BerkeleyDB::Common db
2617	2787	CODE:
2618		CurrentDB = db ;
	2788	saveCurrentDB(db) ;
2619	2789	Trace(("In BerkeleyDB::Common::_DESTROY db %d dirty=%d\n", db, PL_dirty)) ;
2620	2790	destroyDB(db) ;
2621	2791	Trace(("End of BerkeleyDB::Common::DESTROY \n")) ;

2630	2800	u_int32_t flags
2631	2801	BerkeleyDB::Common db
2632	2802	BerkeleyDB::Cursor RETVAL = NULL ;
	2803	ALIAS: __db_write_cursor = 1
2633	2804	INIT:
2634	2805	ckActive_Database(db->active) ;
2635	2806	CODE:
2636	2807	{
2637		DBC * cursor ;
2638		CurrentDB = db ;
	2808	DBC * cursor ;
	2809	saveCurrentDB(db) ;
	2810	if (ix == 1 && db->cdb_enabled) {
	2811	#ifdef AT_LEAST_DB_3
	2812	flags = DB_WRITECURSOR;
	2813	#else
	2814	flags = DB_RMW;
	2815	#endif
	2816	}
2639	2817	if ((db->Status = db_cursor(db, db->txn, &cursor, flags)) == 0){
2640	2818	ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
2641	2819	db->open_cursors ++ ;

2645	2823	RETVAL->txn = db->txn ;
2646	2824	RETVAL->type = db->type ;
2647	2825	RETVAL->recno_or_queue = db->recno_or_queue ;
	2826	RETVAL->cdb_enabled = db->cdb_enabled ;
2648	2827	RETVAL->filename = my_strdup(db->filename) ;
2649	2828	RETVAL->compare = db->compare ;
2650	2829	RETVAL->dup_compare = db->dup_compare ;

2692	2871	DBC ** cursor_list ;
2693	2872	I32 count = av_len(cursors) + 1 ;
2694	2873	int i ;
2695		CurrentDB = db ;
	2874	saveCurrentDB(db) ;
2696	2875	if (count < 1 )
2697	2876	softCrash("db_join: No cursors in parameter list") ;
2698	2877	cursor_list = (DBC *)safemalloc(sizeof(DBC) * (count + 1));

2700	2879	SV * obj = (SV) av_fetch(cursors, i, FALSE) ;
2701	2880	IV tmp = SvIV(getInnerObject(obj)) ;
2702	2881	BerkeleyDB__Cursor cur = INT2PTR(BerkeleyDB__Cursor, tmp);
	2882	if (cur->dbp == db->dbp)
	2883	softCrash("attempted to do a self-join");
2703	2884	cursor_list[i] = cur->cursor ;
2704	2885	}
2705	2886	cursor_list[i] = NULL ;

2898	3079	INIT:
2899	3080	Trace(("db_del db[%p] in [%p] txn[%p] key[%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
2900	3081	ckActive_Database(db->active) ;
2901		CurrentDB = db ;
	3082	saveCurrentDB(db) ;
2902	3083
2903	3084
2904	3085	#ifdef AT_LEAST_DB_3

2920	3101	DBT_OPT data
2921	3102	CODE:
2922	3103	ckActive_Database(db->active) ;
2923		CurrentDB = db ;
	3104	saveCurrentDB(db) ;
2924	3105	SetPartial(data,db) ;
2925	3106	Trace(("db_get db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
2926	3107	RETVAL = db_get(db, key, data, flags);

2945	3126	#else
2946	3127	Trace(("db_pget db [%p] in [%p] txn [%p] flags [%d]\n", db->dbp, db, db->txn, flags)) ;
2947	3128	ckActive_Database(db->active) ;
2948		CurrentDB = db ;
	3129	saveCurrentDB(db) ;
2949	3130	SetPartial(data,db) ;
2950	3131	DBT_clear(pkey);
2951	3132	RETVAL = db_pget(db, key, pkey, data, flags);

2967	3148	DBT data
2968	3149	CODE:
2969	3150	ckActive_Database(db->active) ;
2970		CurrentDB = db ;
	3151	saveCurrentDB(db) ;
2971	3152	/* SetPartial(data,db) ; */
2972	3153	Trace(("db_put db[%p] in [%p] txn[%p] key[%.s] data [%.s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, data.size, data.data, flags)) ;
2973	3154	RETVAL = db_put(db, key, data, flags);

2994	3175	DB_KEY_RANGE range ;
2995	3176	range.less = range.equal = range.greater = 0.0 ;
2996	3177	ckActive_Database(db->active) ;
2997		CurrentDB = db ;
	3178	saveCurrentDB(db) ;
2998	3179	RETVAL = db_key_range(db, key, range, flags);
2999	3180	if (RETVAL == 0) {
3000	3181	less = range.less ;

3017	3198	INIT:
3018	3199	ckActive_Database(db->active) ;
3019	3200	CODE:
3020		CurrentDB = db ;
	3201	saveCurrentDB(db) ;
3021	3202	db_fd(db, RETVAL) ;
3022	3203	OUTPUT:
3023	3204	RETVAL

3030	3211	BerkeleyDB::Common db
3031	3212	INIT:
3032	3213	ckActive_Database(db->active) ;
3033		CurrentDB = db ;
	3214	saveCurrentDB(db) ;
3034	3215
3035	3216	void
3036	3217	_Txn(db, txn=NULL)

3063	3244	#ifndef AT_LEAST_DB_3_3
3064	3245	softCrash("truncate needs Berkeley DB 3.3 or later") ;
3065	3246	#else
3066		CurrentDB = db ;
	3247	saveCurrentDB(db) ;
3067	3248	RETVAL = db_truncate(db, countp, flags);
3068	3249	#endif
3069	3250	OUTPUT:

3089	3270	#ifndef AT_LEAST_DB_3_3
3090	3271	softCrash("associate needs Berkeley DB 3.3 or later") ;
3091	3272	#else
3092		CurrentDB = db ;
	3273	saveCurrentDB(db) ;
3093	3274	/* db->associated = newSVsv(callback) ; */
3094	3275	secondary->associated = newSVsv(callback) ;
3095	3276	/* secondary->dbp->app_private = secondary->associated ; */

3108	3289	BerkeleyDB::Cursor db
3109	3290	BerkeleyDB::Cursor RETVAL = NULL ;
3110	3291	INIT:
3111		CurrentDB = db->parent_db ;
	3292	saveCurrentDB(db->parent_db);
3112	3293	ckActive_Database(db->active) ;
3113	3294	CODE:
3114	3295	{

3125	3306	RETVAL->dbp = db->dbp ;
3126	3307	RETVAL->type = db->type ;
3127	3308	RETVAL->recno_or_queue = db->recno_or_queue ;
	3309	RETVAL->cdb_enabled = db->cdb_enabled ;
3128	3310	RETVAL->filename = my_strdup(db->filename) ;
3129	3311	RETVAL->compare = db->compare ;
3130	3312	RETVAL->dup_compare = db->dup_compare ;

3159	3341	_c_close(db)
3160	3342	BerkeleyDB::Cursor db
3161	3343	INIT:
3162		CurrentDB = db->parent_db ;
	3344	saveCurrentDB(db->parent_db);
3163	3345	ckActive_Cursor(db->active) ;
3164	3346	hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
3165	3347	CODE:

3175	3357	_DESTROY(db)
3176	3358	BerkeleyDB::Cursor db
3177	3359	CODE:
3178		CurrentDB = db->parent_db ;
	3360	saveCurrentDB(db->parent_db);
3179	3361	Trace(("In BerkeleyDB::Cursor::_DESTROY db %d dirty=%d active=%d\n", db, PL_dirty, db->active));
3180	3362	hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
3181	3363	if (db->active)

3201	3383	int flags
3202	3384	BerkeleyDB::Cursor db
3203	3385	INIT:
3204		CurrentDB = db->parent_db ;
	3386	saveCurrentDB(db->parent_db);
3205	3387	ckActive_Cursor(db->active) ;
3206	3388	OUTPUT:
3207	3389	RETVAL

3212	3394	cu_c_get(db, key, data, flags=0)
3213	3395	int flags
3214	3396	BerkeleyDB::Cursor db
3215		DBTKEY_B key
3216		DBT_B data
	3397	DBTKEY_B key
	3398	DBT_B data
3217	3399	INIT:
3218	3400	Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ;
3219		CurrentDB = db->parent_db ;
	3401	saveCurrentDB(db->parent_db);
3220	3402	ckActive_Cursor(db->active) ;
	3403	/* DBT_clear(key); */
	3404	/* DBT_clear(data); */
3221	3405	SetPartial(data,db) ;
3222	3406	Trace(("c_get end\n")) ;
3223	3407	OUTPUT:

3238	3422	softCrash("db_c_pget needs at least Berkeley DB 3.3");
3239	3423	#else
3240	3424	Trace(("c_pget db [%d] flags [%d]\n", db, flags)) ;
3241		CurrentDB = db->parent_db ;
	3425	saveCurrentDB(db->parent_db);
3242	3426	ckActive_Cursor(db->active) ;
3243	3427	SetPartial(data,db) ;
3244	3428	DBT_clear(pkey);

3249	3433	RETVAL
3250	3434	key
3251	3435	pkey
3252		data if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ;
	3436	data
3253	3437
3254	3438
3255	3439

3261	3445	DBTKEY key
3262	3446	DBT data
3263	3447	INIT:
3264		CurrentDB = db->parent_db ;
	3448	saveCurrentDB(db->parent_db);
3265	3449	ckActive_Cursor(db->active) ;
3266	3450	/* SetPartial(data,db) ; */
3267	3451	OUTPUT:

3278	3462	softCrash("c_count needs at least Berkeley DB 3.1.x");
3279	3463	#else
3280	3464	Trace(("c_get count [%d] flags [%d]\n", db, flags)) ;
3281		CurrentDB = db->parent_db ;
	3465	saveCurrentDB(db->parent_db);
3282	3466	ckActive_Cursor(db->active) ;
3283	3467	RETVAL = cu_c_count(db, count, flags) ;
3284	3468	Trace((" c_count got %d duplicates\n", count)) ;

3548	3732	restore at the end.
3549	3733
3550	3734	*/
3551		CurrentDB = db ;
	3735	saveCurrentDB(db) ;
3552	3736	DBT_clear(key) ;
3553	3737	DBT_clear(value) ;
3554	3738	/* If necessary create a cursor for FIRSTKEY/NEXTKEY use */

3580	3764	{
3581	3765	DBT value ;
3582	3766
3583		CurrentDB = db ;
	3767	saveCurrentDB(db) ;
3584	3768	DBT_clear(key) ;
3585	3769	DBT_clear(value) ;
3586	3770	key.flags = 0 ;

3602	3786	FETCHSIZE(db)
3603	3787	BerkeleyDB::Common db
3604	3788	CODE:
3605		CurrentDB = db ;
	3789	saveCurrentDB(db) ;
3606	3790	RETVAL = GetArrayLength(db) ;
3607	3791	OUTPUT:
3608	3792	RETVAL

+38

-0

Changes less more

0	0	Revision history for Perl extension BerkeleyDB.
	1
	2	0.23 15th June 2003
	3
	4	* Fixed problem where a secondary index would use the same
	5	compare callback as the primary key, regardless of what was
	6	defined for the secondary index.
	7	Problem spotted by Dave Tallman.
	8
	9	* Also fixed a problem with the associate callback. If the value
	10	for the secondary key was not a string, the secondary key was
	11	being set incorrectly. This is now fixed.
	12
	13	* When built with Berkeley DB 3.2 or better, all callbacks now use
	14	the BackRef pointer instead of the global CurrentDB. This was
	15	done partially to fix the secondary index problem, above.
	16
	17	* The test harness was failing under cygwin. Now fixed.
	18
	19	* Previous release broke TRACE. Fixed.
	20
	21	0.22 17th May 2003
	22
	23	* win32 problem with open macro fixed.
	24
	25	0.21 12th May 2003
	26
	27	* adding support for env->set_flags
	28	* adding recursion detection
	29	* win32 problem with rename fixed.
	30	* problem with sub-database name in Recno & Queue fixed.
	31	* fixed the mldbm.t test harness to work with perl 5.8.0
	32	* added a note about not using a network drive when running the
	33	test harness.
	34	* fixed c_pget
	35	* added BerkeleyDB::Env::DB_ENV method
	36	* added support for encryption
	37	* the dbinfo script will now indicate if the database is encrypted
	38	* The CLEAR method is now CDB safe.
1	39
2	40	0.20 2nd September 2002
3	41

-0

MANIFEST less more

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

-1

Makefile.PL less more

114	114
115	115	$INC_DIR = $ENV{'BERKELEYDB_INCLUDE'} \|\| $Info{'INCLUDE'} ;
116	116	$LIB_DIR = $ENV{'BERKELEYDB_LIB'} \|\| $Info{'LIB'} ;
117		$DB_NAME = $Info{'DBNAME'} if defined $Info{'DBNAME'} ;
	117	$DB_NAME = $ENV{BERKELEYDB_NAME} \|\| $Info{'DBNAME'} ;
	118	#$DB_NAME = $ENV{} \|\| $Info{'DBNAME'} if defined $Info{'DBNAME'} ;
	119
118	120	print "Looks Good.\n" ;
119	121
120	122	}

+82

-7

README less more

0	0	BerkeleyDB
1	1
2		Version 0.20
3
4		2nd Sept 2002
5
6		Copyright (c) 1997-2002 Paul Marquess. All rights reserved. This
	2	Version 0.23
	3
	4	15th June 2003
	5
	6	Copyright (c) 1997-2003 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

29	29	Before you can build BerkeleyDB you need to have the following
30	30	installed on your system:
31	31
	32	* To run the test harness for this module, you must make sure that the
	33	directory where you have untarred this module is NOT a network
	34	drive, e.g. NFS or AFS.
	35
32	36	* Perl 5.004_04 or greater.
33	37
34	38	* Berkeley DB Version 2.6.4 or greater

55	59	the Solaris Notes or HP-UX Notes sections below.
56	60	If you are running Linux please read the Linux Notes section
57	61	before proceeding.
58
59	62
60	63	Step 2 : Edit the file config.in to suit you local installation.
61	64	Instructions are given in the file.

278	281	If you are running Linux, please read the Linux Notes section below.
279	282
280	283
	284
	285	Solaris build fails with "language optional software package not installed"
	286	---------------------------------------------------------------------------
	287
	288	If you are trying to build this module under Solaris and you get an
	289	error message like this
	290
	291	/usr/ucb/cc: language optional software package not installed
	292
	293	it means that Perl cannot find the C compiler on your system. The cryptic
	294	message is just Sun's way of telling you that you haven't bought their
	295	C compiler.
	296
	297	When you build a Perl module that needs a C compiler, the Perl build
	298	system tries to use the same C compiler that was used to build perl
	299	itself. In this case your Perl binary was built with a C compiler that
	300	lived in /usr/ucb.
	301
	302	To continue with building this module, you need to get a C compiler,
	303	or tell Perl where your C compiler is, if you already have one.
	304
	305	Assuming you have now got a C compiler, what you do next will be dependant
	306	on what C compiler you have installed. If you have just installed Sun's
	307	C compiler, you shouldn't have to do anything. Just try rebuilding
	308	this module.
	309
	310	If you have installed another C compiler, say gcc, you have to tell perl
	311	how to use it instead of /usr/ucb/cc.
	312
	313	This set of options seems to work if you want to use gcc. Your mileage
	314	may vary.
	315
	316	perl Makefile.PL CC=gcc CCCDLFLAGS=-fPIC OPTIMIZE=" "
	317	make test
	318
	319	If that doesn't work for you, it's time to make changes to the Makefile
	320	by hand. Good luck!
	321
	322
	323	Network Drive
	324	-------------
	325
	326	BerkeleyDB seems to have built correctly, but you get a series of errors
	327	like this when you run the test harness:
	328
	329
	330	t/btree........NOK 178Can't call method "txn_begin" on an undefined value at t/btree.t line 637.
	331	t/btree........dubious
	332	Test returned status 11 (wstat 2816, 0xb00)
	333	DIED. FAILED tests 28, 178-244
	334	Failed 68/244 tests, 72.13% okay
	335	t/db-3.0.......NOK 2Can't call method "set_mutexlocks" on an undefined value at t/db-3.0.t line 39.
	336	t/db-3.0.......dubious
	337	Test returned status 11 (wstat 2816, 0xb00)
	338	DIED. FAILED tests 2-14
	339	Failed 13/14 tests, 7.14% okay
	340	t/db-3.1.......ok
	341	t/db-3.2.......NOK 5Can't call method "set_flags" on an undefined value at t/db-3.2.t line 62.
	342	t/db-3.2.......dubious
	343	Test returned status 11 (wstat 2816, 0xb00)
	344	DIED. FAILED tests 3, 5-6
	345	Failed 3/6 tests, 50.00% okay
	346	t/db-3.3.......ok
	347
	348	This pattern of errors happens if you have built the module in a directory
	349	that is network mounted (e.g. NFS ar AFS).
	350
	351	The solution is to use a local drive. Berkeley DB doesn't support
	352	network drives.
	353
	354
281	355	Linux Notes
282	356	-----------
283	357
284		Newer versions of Linux (e.g. RedHat 6, SuSe 6) ship with a C library
	358	Some versions of Linux (e.g. RedHat 6, SuSe 6) ship with a C library
285	359	that has version 2.x of Berkeley DB linked into it. This makes it
286	360	difficult to build this module with anything other than the version of
287	361	Berkeley DB that shipped with your Linux release. If you do try to use

385	459	To find out if you have the patch installed, the command "showrev -p"
386	460	will display the patches that are currently installed on your system.
387	461
	462
388	463	Solaris 2.7 Notes
389	464	-----------------
390	465

-4

config.in less more

6	6	# Change the path below to point to the directory where db.h is
7	7	# installed on your system.
8	8
9		INCLUDE = /usr/local/include
10		#INCLUDE = /usr/local/BerkeleyDB/include
	9	#INCLUDE = /usr/local/include
	10	INCLUDE = /usr/local/BerkeleyDB/include
11	11
12	12	# 2. Where is libdb?
13	13	#
14	14	# Change the path below to point to the directory where libdb is
15	15	# installed on your system.
16	16
17		LIB = /usr/local/lib
18		#LIB = /usr/local/BerkeleyDB/lib
	17	#LIB = /usr/local/lib
	18	LIB = /usr/local/BerkeleyDB/lib
19	19
20	20	# 3. Is the library called libdb?
21	21	#

+39

-30

dbinfo less more

3	3	# a database file
4	4	#
5	5	# Author: Paul Marquess <Paul.Marquess@btinternet.com>
6		# Version: 1.03
7		# Date 17th September 2000
	6	# Version: 1.04
	7	# Date 7th April 2003
8	8	#
9		# Copyright (c) 1998-2002 Paul Marquess. All rights reserved.
	9	# Copyright (c) 1998-2003 Paul Marquess. All rights reserved.
10	10	# This program is free software; you can redistribute it and/or
11	11	# modify it under the same terms as Perl itself.
12	12

21	21	Type => "Btree",
22	22	Versions =>
23	23	{
24		1 => "Unknown (older than 1.71)",
25		2 => "Unknown (older than 1.71)",
26		3 => "1.71 -> 1.85, 1.86",
27		4 => "Unknown",
28		5 => "2.0.0 -> 2.3.0",
29		6 => "2.3.1 -> 2.7.7",
30		7 => "3.0.x",
31		8 => "3.1.x -> 4.0.x",
32		9 => "4.1.x or greater",
	24	1 => [0, "Unknown (older than 1.71)"],
	25	2 => [0, "Unknown (older than 1.71)"],
	26	3 => [0, "1.71 -> 1.85, 1.86"],
	27	4 => [0, "Unknown"],
	28	5 => [0, "2.0.0 -> 2.3.0"],
	29	6 => [0, "2.3.1 -> 2.7.7"],
	30	7 => [0, "3.0.x"],
	31	8 => [0, "3.1.x -> 4.0.x"],
	32	9 => [1, "4.1.x or greater"],
33	33	}
34	34	},
35	35	0x061561 => {
36	36	Type => "Hash",
37	37	Versions =>
38	38	{
39		1 => "Unknown (older than 1.71)",
40		2 => "1.71 -> 1.85",
41		3 => "1.86",
42		4 => "2.0.0 -> 2.1.0",
43		5 => "2.2.6 -> 2.7.7",
44		6 => "3.0.x",
45		7 => "3.1.x -> 4.0.x",
46		8 => "4.1.x or greater",
	39	1 => [0, "Unknown (older than 1.71)"],
	40	2 => [0, "1.71 -> 1.85"],
	41	3 => [0, "1.86"],
	42	4 => [0, "2.0.0 -> 2.1.0"],
	43	5 => [0, "2.2.6 -> 2.7.7"],
	44	6 => [0, "3.0.x"],
	45	7 => [0, "3.1.x -> 4.0.x"],
	46	8 => [1, "4.1.x or greater"],
47	47	}
48	48	},
49	49	0x042253 => {
50	50	Type => "Queue",
51	51	Versions =>
52	52	{
53		1 => "3.0.x",
54		2 => "3.1.x",
55		3 => "3.2.x -> 4.0.x",
56		4 => "4.1.x or greater",
	53	1 => [0, "3.0.x"],
	54	2 => [0, "3.1.x"],
	55	3 => [0, "3.2.x -> 4.0.x"],
	56	4 => [1, "4.1.x or greater"],
57	57	}
58	58	},
59	59	) ;

64	64	open (F, "<$ARGV[0]") or die "Cannot open file $ARGV[0]: $!\n" ;
65	65
66	66	my $buff ;
67		read F, $buff, 20 ;
	67	read F, $buff, 30 ;
68	68
69		my (@info) = unpack("NNNNN", $buff) ;
70		my (@info1) = unpack("VVVVV", $buff) ;
71		my ($magic, $version, $endian) ;
	69	my (@info) = unpack("NNNNNNC", $buff) ;
	70	my (@info1) = unpack("VVVVVVC", $buff) ;
	71	my ($magic, $version, $endian, $encrypt) ;
72	72
73	73	if ($Data{$info[0]}) # first try DB 1.x format
74	74	{
75	75	$magic = $info[0] ;
76	76	$version = $info[1] ;
77	77	$endian = "Unknown" ;
	78	$encrypt = "Not Supported";
78	79	}
79	80	elsif ($Data{$info[3]}) # next DB 2.x big endian
80	81	{

95	96	$magic = sprintf "%06X", $magic ;
96	97
97	98	my $ver_string = "Unknown" ;
98		$ver_string = $type->{Versions}{$version}
99		if defined $type->{Versions}{$version} ;
	99
	100	if ( defined $type->{Versions}{$version} )
	101	{
	102	$ver_string = $type->{Versions}{$version}[1];
	103	if ($type->{Versions}{$version}[0] )
	104	{ $encrypt = $info[6] ? "Enabled" : "Disabled" }
	105	else
	106	{ $encrypt = "Not Supported" }
	107	}
100	108
101	109	print <<EOM ;
102	110	File Type: Berkeley DB $type->{Type} file.

104	112	Built with Berkeley DB: $ver_string
105	113	Byte Order: $endian
106	114	Magic: $magic
	115	Encryption: $encrypt
107	116	EOM
108	117
109	118	close F ;

+93

-44

patches/5.004 less more

0		diff perl5.004.orig/Configure perl5.004/Configure
1		190a191
2		> perllibs=''
3		9904a9906,9913
4		> : Remove libraries needed only for extensions
5		> : The appropriate ext/Foo/Makefile.PL will add them back in, if
6		> : necessary.
7		> set X `echo " $libs " \|
8		> sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'`
9		> shift
10		> perllibs="$*"
11		>
12		10372a10382
13		> perllibs='$perllibs'
14		diff perl5.004.orig/Makefile.SH perl5.004/Makefile.SH
15		122c122
16		< libs = $libs $cryptlib
17		---
18		> libs = $perllibs $cryptlib
19		Common subdirectories: perl5.004.orig/Porting and perl5.004/Porting
20		Common subdirectories: perl5.004.orig/cygwin32 and perl5.004/cygwin32
21		Common subdirectories: perl5.004.orig/eg and perl5.004/eg
22		Common subdirectories: perl5.004.orig/emacs and perl5.004/emacs
23		Common subdirectories: perl5.004.orig/ext and perl5.004/ext
24		Common subdirectories: perl5.004.orig/h2pl and perl5.004/h2pl
25		Common subdirectories: perl5.004.orig/hints and perl5.004/hints
26		Common subdirectories: perl5.004.orig/lib and perl5.004/lib
27		diff perl5.004.orig/myconfig perl5.004/myconfig
28		38c38
29		< libs=$libs
30		---
31		> libs=$perllibs
32		Common subdirectories: perl5.004.orig/os2 and perl5.004/os2
33		diff perl5.004.orig/patchlevel.h perl5.004/patchlevel.h
34		40a41
35		> ,"NODB-1.0 - remove -ldb from core perl binary."
36		Common subdirectories: perl5.004.orig/plan9 and perl5.004/plan9
37		Common subdirectories: perl5.004.orig/pod and perl5.004/pod
38		Common subdirectories: perl5.004.orig/qnx and perl5.004/qnx
39		Common subdirectories: perl5.004.orig/t and perl5.004/t
40		Common subdirectories: perl5.004.orig/utils and perl5.004/utils
41		Common subdirectories: perl5.004.orig/vms and perl5.004/vms
42		Common subdirectories: perl5.004.orig/win32 and perl5.004/win32
43		Common subdirectories: perl5.004.orig/x2p and perl5.004/x2p
	0	diff -rc perl5.004.orig/Configure perl5.004/Configure
	1	*** perl5.004.orig/Configure 1997-05-13 18:20:34.000000000 +0100
	2	--- perl5.004/Configure 2003-04-26 16:36:53.000000000 +0100
	3	***************
	4	* 188,193 **
	5	--- 188,194 ----
	6	mv=''
	7	nroff=''
	8	perl=''
	9	+ perllibs=''
	10	pg=''
	11	pmake=''
	12	pr=''
	13	***************
	14	* 9902,9907 **
	15	--- 9903,9916 ----
	16	shift
	17	extensions="$*"
	18
	19	+ : Remove libraries needed only for extensions
	20	+ : The appropriate ext/Foo/Makefile.PL will add them back in, if
	21	+ : necessary.
	22	+ set X `echo " $libs " \|
	23	+ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'`
	24	+ shift
	25	+ perllibs="$*"
	26	+
	27	: Remove build directory name from cppstdin so it can be used from
	28	: either the present location or the final installed location.
	29	echo " "
	30	***************
	31	* 10370,10375 **
	32	--- 10379,10385 ----
	33	patchlevel='$patchlevel'
	34	path_sep='$path_sep'
	35	perl='$perl'
	36	+ perllibs='$perllibs'
	37	perladmin='$perladmin'
	38	perlpath='$perlpath'
	39	pg='$pg'
	40	diff -rc perl5.004.orig/Makefile.SH perl5.004/Makefile.SH
	41	*** perl5.004.orig/Makefile.SH 1997-05-01 15:22:39.000000000 +0100
	42	--- perl5.004/Makefile.SH 2003-04-26 16:37:23.000000000 +0100
	43	***************
	44	* 119,125 **
	45	ext = \$(dynamic_ext) \$(static_ext)
	46	DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT)
	47
	48	! libs = $libs $cryptlib
	49
	50	public = perl $suidperl utilities translators
	51
	52	--- 119,125 ----
	53	ext = \$(dynamic_ext) \$(static_ext)
	54	DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT)
	55
	56	! libs = $perllibs $cryptlib
	57
	58	public = perl $suidperl utilities translators
	59
	60	diff -rc perl5.004.orig/myconfig perl5.004/myconfig
	61	*** perl5.004.orig/myconfig 1996-12-21 01:13:20.000000000 +0000
	62	--- perl5.004/myconfig 2003-04-26 16:37:51.000000000 +0100
	63	***************
	64	* 35,41 **
	65	Linker and Libraries:
	66	ld='$ld', ldflags ='$ldflags'
	67	libpth=$libpth
	68	! libs=$libs
	69	libc=$libc, so=$so
	70	useshrplib=$useshrplib, libperl=$libperl
	71	Dynamic Linking:
	72	--- 35,41 ----
	73	Linker and Libraries:
	74	ld='$ld', ldflags ='$ldflags'
	75	libpth=$libpth
	76	! libs=$perllibs
	77	libc=$libc, so=$so
	78	useshrplib=$useshrplib, libperl=$libperl
	79	Dynamic Linking:
	80	diff -rc perl5.004.orig/patchlevel.h perl5.004/patchlevel.h
	81	*** perl5.004.orig/patchlevel.h 1997-05-15 23:15:17.000000000 +0100
	82	--- perl5.004/patchlevel.h 2003-04-26 16:38:11.000000000 +0100
	83	***************
	84	* 38,43 **
	85	--- 38,44 ----
	86	*/
	87	static char *local_patches[] = {
	88	NULL
	89	+ ,"NODB-1.0 - remove -ldb from core perl binary."
	90	,NULL
	91	};
	92

-0

ppport.h less more

304	304
305	305	#define DBM_ckFilter(arg,type,name) \
306	306	if (db->type) { \
	307	/printf("Filtering %s\n", name);/ \
307	308	if (db->filtering) { \
308	309	croak("recursion detected in %s", name) ; \
309	310	} \

312	313	SAVEINT(db->filtering) ; \
313	314	db->filtering = TRUE ; \
314	315	SAVESPTR(DEFSV) ; \
	316	if (1 && name[7] == 's') \
	317	arg = newSVsv(arg); \
315	318	DEFSV = arg ; \
316	319	SvTEMP_off(arg) ; \
317	320	PUSHMARK(SP) ; \

321	324	PUTBACK ; \
322	325	FREETMPS ; \
323	326	LEAVE ; \
	327	if (1 && name[7] == 's'){ \
	328	arg = sv_2mortal(arg); \
	329	} \
	330	SvOKp(arg); \
324	331	}
325	332
326	333	#endif /* DBM_setFilter */

-0

t/btree.t less more

126	126	my ($k, $v) ;
127	127	ok 33, my $db = new BerkeleyDB::Btree -Filename => $Dfile,
128	128	-Flags => DB_CREATE ;
	129	print "[$db] [$!] $BerkeleyDB::Error\n" ;
129	130
130	131	# create some data
131	132	my %data = (

+67

-1

t/db-3.3.t less more

23	23
24	24	umask(0);
25	25
26		print "1..37\n";
	26	print "1..44\n";
27	27
28	28	{
29	29	# db->truncate

171	171
172	172	# db->associate -- same again but when DB_DUP is specified.
173	173
	174
	175	{
	176	# db->associate -- secondary keys, each with a user defined sort
	177
	178	sub sec_key2
	179	{
	180	my $pkey = shift ;
	181	my $pdata = shift ;
	182	#print "in sec_key2 [$pkey][$pdata]\n";
	183
	184	$_[0] = length $pdata ;
	185	return 0;
	186	}
	187
	188	my ($Dfile1, $Dfile2);
	189	my $lex = new LexFile $Dfile1, $Dfile2 ;
	190	my %hash ;
	191	my $status;
	192	my ($k, $v, $pk) = ('','','');
	193
	194	# create primary database
	195	ok 38, my $primary = new BerkeleyDB::Btree -Filename => $Dfile1,
	196	-Compare => sub { return $_[0] cmp $_[1]},
	197	-Flags => DB_CREATE ;
	198
	199	# create secondary database
	200	ok 39, my $secondary = new BerkeleyDB::Btree -Filename => $Dfile2,
	201	-Compare => sub { return $_[0] <=> $_[1]},
	202	-Property => DB_DUP,
	203	-Flags => DB_CREATE ;
	204
	205	# associate primary with secondary
	206	ok 40, $primary->associate($secondary, \&sec_key2) == 0;
	207
	208	# add data to the primary
	209	my %data = (
	210	"red" => "flag",
	211	"orange"=> "custard",
	212	"green" => "house",
	213	"blue" => "sea",
	214	) ;
	215
	216	my $ret = 0 ;
	217	while (($k, $v) = each %data) {
	218	my $r = $primary->db_put($k, $v) ;
	219	#print "put [$r] $BerkeleyDB::Error\n";
	220	$ret += $r;
	221	}
	222	ok 41, $ret == 0 ;
	223	#print "ret $ret\n";
	224
	225	#print "Primary\n" ; dumpdb($primary) ;
	226	#print "Secondary\n" ; dumpdb($secondary) ;
	227
	228	# check the records in the secondary
	229	ok 42, countRecords($secondary) == 4 ;
	230
	231	my $p_data = joinkeys($primary, " ");
	232	#print "primary [$p_data]\n" ;
	233	ok 43, $p_data eq join " ", sort { $a cmp $b } keys %data ;
	234	my $s_data = joinkeys($secondary, " ");
	235	#print "secondary [$s_data]\n" ;
	236	ok 44, $s_data eq join " ", sort { $a <=> $b } map { length } values %data ;
	237
	238	}
	239

+647

-0

t/encrypt.t less more

	0	#!./perl -w
	1
	2	# ID: %I%, %G%
	3
	4	use strict ;
	5
	6	BEGIN {
	7	unless(grep /blib/, @INC) {
	8	chdir 't' if -d 't';
	9	@INC = '../lib' if -d '../lib';
	10	}
	11	}
	12
	13	use BerkeleyDB;
	14	use t::util ;
	15
	16	BEGIN
	17	{
	18	if ($BerkeleyDB::db_version < 4.1) {
	19	print "1..0 # Skip: this needs Berkeley DB 4.1.x or better\n" ;
	20	exit 0 ;
	21	}
	22
	23	# Is encryption available?
	24	my $env = new BerkeleyDB::Env
	25	-Encrypt => {Password => "abc",
	26	Flags => DB_ENCRYPT_AES
	27	};
	28
	29	if ($BerkeleyDB::Error =~ /Operation not supported/)
	30	{
	31	print "1..0 # Skip: encryption support not present\n" ;
	32	exit 0 ;
	33	}
	34	}
	35
	36	umask(0);
	37
	38	print "1..80\n";
	39
	40	{
	41	eval
	42	{
	43	my $env = new BerkeleyDB::Env
	44	-Encrypt => 1,
	45	-Flags => DB_CREATE ;
	46	};
	47	ok 1, $@ =~ /^Encrypt parameter must be a hash reference at/;
	48
	49	eval
	50	{
	51	my $env = new BerkeleyDB::Env
	52	-Encrypt => {},
	53	-Flags => DB_CREATE ;
	54	};
	55	ok 2, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	56
	57	eval
	58	{
	59	my $env = new BerkeleyDB::Env
	60	-Encrypt => {Password => "fred"},
	61	-Flags => DB_CREATE ;
	62	};
	63	ok 3, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	64
	65	eval
	66	{
	67	my $env = new BerkeleyDB::Env
	68	-Encrypt => {Flags => 1},
	69	-Flags => DB_CREATE ;
	70	};
	71	ok 4, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	72
	73	eval
	74	{
	75	my $env = new BerkeleyDB::Env
	76	-Encrypt => {Fred => 1},
	77	-Flags => DB_CREATE ;
	78	};
	79	ok 5, $@ =~ /^\Qunknown key value(s) Fred at/;
	80
	81	}
	82
	83	{
	84	# new BerkeleyDB::Env -Encrypt =>
	85
	86	# create an environment with a Home
	87	my $home = "./fred" ;
	88	#mkdir $home;
	89	ok 6, my $lexD = new LexDir($home) ;
	90	ok 7, my $env = new BerkeleyDB::Env
	91	-Home => $home,
	92	-Encrypt => {Password => "abc",
	93	Flags => DB_ENCRYPT_AES
	94	},
	95	-Flags => DB_CREATE \| DB_INIT_MPOOL ;
	96
	97	print "$BerkeleyDB::Error\n" ;
	98
	99
	100	my $Dfile = "abc.enc";
	101	my $lex = new LexFile $Dfile ;
	102	my %hash ;
	103	my ($k, $v) ;
	104	ok 8, my $db = new BerkeleyDB::Hash -Filename => $Dfile,
	105	-Env => $env,
	106	-Flags => DB_CREATE,
	107	-Property => DB_ENCRYPT ;
	108
	109	# create some data
	110	my %data = (
	111	"red" => 2,
	112	"green" => "house",
	113	"blue" => "sea",
	114	) ;
	115
	116	my $ret = 0 ;
	117	while (($k, $v) = each %data) {
	118	$ret += $db->db_put($k, $v) ;
	119	}
	120	ok 9, $ret == 0 ;
	121
	122	# check there are three records
	123	ok 10, countRecords($db) == 3 ;
	124
	125	undef $db;
	126
	127	# once the database is created, do not need to specify DB_ENCRYPT
	128	ok 11, my $db1 = new BerkeleyDB::Hash -Filename => $Dfile,
	129	-Env => $env,
	130	-Flags => DB_CREATE ;
	131	$v = '';
	132	ok 12, ! $db1->db_get("red", $v) ;
	133	ok 13, $v eq $data{"red"},
	134	undef $db1;
	135	undef $env;
	136
	137	# open a database without specifying encryption
	138	ok 14, ! new BerkeleyDB::Hash -Filename => "$home/$Dfile";
	139
	140	ok 15, ! new BerkeleyDB::Env
	141	-Home => $home,
	142	-Encrypt => {Password => "def",
	143	Flags => DB_ENCRYPT_AES
	144	},
	145	-Flags => DB_CREATE \| DB_INIT_MPOOL ;
	146	}
	147
	148	{
	149	eval
	150	{
	151	my $env = new BerkeleyDB::Hash
	152	-Encrypt => 1,
	153	-Flags => DB_CREATE ;
	154	};
	155	ok 16, $@ =~ /^Encrypt parameter must be a hash reference at/;
	156
	157	eval
	158	{
	159	my $env = new BerkeleyDB::Hash
	160	-Encrypt => {},
	161	-Flags => DB_CREATE ;
	162	};
	163	ok 17, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	164
	165	eval
	166	{
	167	my $env = new BerkeleyDB::Hash
	168	-Encrypt => {Password => "fred"},
	169	-Flags => DB_CREATE ;
	170	};
	171	ok 18, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	172
	173	eval
	174	{
	175	my $env = new BerkeleyDB::Hash
	176	-Encrypt => {Flags => 1},
	177	-Flags => DB_CREATE ;
	178	};
	179	ok 19, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	180
	181	eval
	182	{
	183	my $env = new BerkeleyDB::Hash
	184	-Encrypt => {Fred => 1},
	185	-Flags => DB_CREATE ;
	186	};
	187	ok 20, $@ =~ /^\Qunknown key value(s) Fred at/;
	188
	189	}
	190
	191	{
	192	eval
	193	{
	194	my $env = new BerkeleyDB::Btree
	195	-Encrypt => 1,
	196	-Flags => DB_CREATE ;
	197	};
	198	ok 21, $@ =~ /^Encrypt parameter must be a hash reference at/;
	199
	200	eval
	201	{
	202	my $env = new BerkeleyDB::Btree
	203	-Encrypt => {},
	204	-Flags => DB_CREATE ;
	205	};
	206	ok 22, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	207
	208	eval
	209	{
	210	my $env = new BerkeleyDB::Btree
	211	-Encrypt => {Password => "fred"},
	212	-Flags => DB_CREATE ;
	213	};
	214	ok 23, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	215
	216	eval
	217	{
	218	my $env = new BerkeleyDB::Btree
	219	-Encrypt => {Flags => 1},
	220	-Flags => DB_CREATE ;
	221	};
	222	ok 24, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	223
	224	eval
	225	{
	226	my $env = new BerkeleyDB::Btree
	227	-Encrypt => {Fred => 1},
	228	-Flags => DB_CREATE ;
	229	};
	230	ok 25, $@ =~ /^\Qunknown key value(s) Fred at/;
	231
	232	}
	233
	234	{
	235	eval
	236	{
	237	my $env = new BerkeleyDB::Queue
	238	-Encrypt => 1,
	239	-Flags => DB_CREATE ;
	240	};
	241	ok 26, $@ =~ /^Encrypt parameter must be a hash reference at/;
	242
	243	eval
	244	{
	245	my $env = new BerkeleyDB::Queue
	246	-Encrypt => {},
	247	-Flags => DB_CREATE ;
	248	};
	249	ok 27, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	250
	251	eval
	252	{
	253	my $env = new BerkeleyDB::Queue
	254	-Encrypt => {Password => "fred"},
	255	-Flags => DB_CREATE ;
	256	};
	257	ok 28, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	258
	259	eval
	260	{
	261	my $env = new BerkeleyDB::Queue
	262	-Encrypt => {Flags => 1},
	263	-Flags => DB_CREATE ;
	264	};
	265	ok 29, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	266
	267	eval
	268	{
	269	my $env = new BerkeleyDB::Queue
	270	-Encrypt => {Fred => 1},
	271	-Flags => DB_CREATE ;
	272	};
	273	ok 30, $@ =~ /^\Qunknown key value(s) Fred at/;
	274
	275	}
	276
	277	{
	278	eval
	279	{
	280	my $env = new BerkeleyDB::Recno
	281	-Encrypt => 1,
	282	-Flags => DB_CREATE ;
	283	};
	284	ok 31, $@ =~ /^Encrypt parameter must be a hash reference at/;
	285
	286	eval
	287	{
	288	my $env = new BerkeleyDB::Recno
	289	-Encrypt => {},
	290	-Flags => DB_CREATE ;
	291	};
	292	ok 32, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	293
	294	eval
	295	{
	296	my $env = new BerkeleyDB::Recno
	297	-Encrypt => {Password => "fred"},
	298	-Flags => DB_CREATE ;
	299	};
	300	ok 33, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	301
	302	eval
	303	{
	304	my $env = new BerkeleyDB::Recno
	305	-Encrypt => {Flags => 1},
	306	-Flags => DB_CREATE ;
	307	};
	308	ok 34, $@ =~ /^Must specify Password and Flags with Encrypt parameter at/;
	309
	310	eval
	311	{
	312	my $env = new BerkeleyDB::Recno
	313	-Encrypt => {Fred => 1},
	314	-Flags => DB_CREATE ;
	315	};
	316	ok 35, $@ =~ /^\Qunknown key value(s) Fred at/;
	317
	318	}
	319
	320
	321	{
	322	# new BerkeleyDB::Hash -Encrypt =>
	323
	324	my $Dfile = "abcd.enc";
	325	my $lex = new LexFile $Dfile ;
	326	my %hash ;
	327	my ($k, $v) ;
	328	ok 36, my $db = new BerkeleyDB::Hash
	329	-Filename => $Dfile,
	330	-Flags => DB_CREATE,
	331	-Encrypt => {Password => "beta",
	332	Flags => DB_ENCRYPT_AES
	333	},
	334	-Property => DB_ENCRYPT ;
	335
	336	# create some data
	337	my %data = (
	338	"red" => 2,
	339	"green" => "house",
	340	"blue" => "sea",
	341	) ;
	342
	343	my $ret = 0 ;
	344	while (($k, $v) = each %data) {
	345	$ret += $db->db_put($k, $v) ;
	346	}
	347	ok 37, $ret == 0 ;
	348
	349	# check there are three records
	350	ok 38, countRecords($db) == 3 ;
	351
	352	undef $db;
	353
	354	# attempt to open a database without specifying encryption
	355	ok 39, ! new BerkeleyDB::Hash -Filename => $Dfile,
	356	-Flags => DB_CREATE ;
	357
	358
	359	# try opening with the wrong password
	360	ok 40, ! new BerkeleyDB::Hash -Filename => $Dfile,
	361	-Filename => $Dfile,
	362	-Encrypt => {Password => "def",
	363	Flags => DB_ENCRYPT_AES
	364	},
	365	-Property => DB_ENCRYPT ;
	366
	367
	368	# read the encrypted data
	369	ok 41, my $db1 = new BerkeleyDB::Hash -Filename => $Dfile,
	370	-Filename => $Dfile,
	371	-Encrypt => {Password => "beta",
	372	Flags => DB_ENCRYPT_AES
	373	},
	374	-Property => DB_ENCRYPT ;
	375
	376
	377	$v = '';
	378	ok 42, ! $db1->db_get("red", $v) ;
	379	ok 43, $v eq $data{"red"};
	380	# check there are three records
	381	ok 44, countRecords($db1) == 3 ;
	382	undef $db1;
	383	}
	384
	385	{
	386	# new BerkeleyDB::Btree -Encrypt =>
	387
	388	my $Dfile = "abcd.enc";
	389	my $lex = new LexFile $Dfile ;
	390	my %hash ;
	391	my ($k, $v) ;
	392	ok 45, my $db = new BerkeleyDB::Btree
	393	-Filename => $Dfile,
	394	-Flags => DB_CREATE,
	395	-Encrypt => {Password => "beta",
	396	Flags => DB_ENCRYPT_AES
	397	},
	398	-Property => DB_ENCRYPT ;
	399
	400	# create some data
	401	my %data = (
	402	"red" => 2,
	403	"green" => "house",
	404	"blue" => "sea",
	405	) ;
	406
	407	my $ret = 0 ;
	408	while (($k, $v) = each %data) {
	409	$ret += $db->db_put($k, $v) ;
	410	}
	411	ok 46, $ret == 0 ;
	412
	413	# check there are three records
	414	ok 47, countRecords($db) == 3 ;
	415
	416	undef $db;
	417
	418	# attempt to open a database without specifying encryption
	419	ok 48, ! new BerkeleyDB::Btree -Filename => $Dfile,
	420	-Flags => DB_CREATE ;
	421
	422
	423	# try opening with the wrong password
	424	ok 49, ! new BerkeleyDB::Btree -Filename => $Dfile,
	425	-Filename => $Dfile,
	426	-Encrypt => {Password => "def",
	427	Flags => DB_ENCRYPT_AES
	428	},
	429	-Property => DB_ENCRYPT ;
	430
	431
	432	# read the encrypted data
	433	ok 50, my $db1 = new BerkeleyDB::Btree -Filename => $Dfile,
	434	-Filename => $Dfile,
	435	-Encrypt => {Password => "beta",
	436	Flags => DB_ENCRYPT_AES
	437	},
	438	-Property => DB_ENCRYPT ;
	439
	440
	441	$v = '';
	442	ok 51, ! $db1->db_get("red", $v) ;
	443	ok 52, $v eq $data{"red"};
	444	# check there are three records
	445	ok 53, countRecords($db1) == 3 ;
	446	undef $db1;
	447	}
	448
	449	{
	450	# new BerkeleyDB::Queue -Encrypt =>
	451
	452	my $Dfile = "abcd.enc";
	453	my $lex = new LexFile $Dfile ;
	454	my %hash ;
	455	my ($k, $v) ;
	456	ok 54, my $db = new BerkeleyDB::Queue
	457	-Filename => $Dfile,
	458	-Len => 5,
	459	-Pad => "x",
	460	-Flags => DB_CREATE,
	461	-Encrypt => {Password => "beta",
	462	Flags => DB_ENCRYPT_AES
	463	},
	464	-Property => DB_ENCRYPT ;
	465
	466	# create some data
	467	my %data = (
	468	1 => 2,
	469	2 => "house",
	470	3 => "sea",
	471	) ;
	472
	473	my $ret = 0 ;
	474	while (($k, $v) = each %data) {
	475	$ret += $db->db_put($k, $v) ;
	476	}
	477	ok 55, $ret == 0 ;
	478
	479	# check there are three records
	480	ok 56, countRecords($db) == 3 ;
	481
	482	undef $db;
	483
	484	# attempt to open a database without specifying encryption
	485	ok 57, ! new BerkeleyDB::Queue -Filename => $Dfile,
	486	-Len => 5,
	487	-Pad => "x",
	488	-Flags => DB_CREATE ;
	489
	490
	491	# try opening with the wrong password
	492	ok 58, ! new BerkeleyDB::Queue -Filename => $Dfile,
	493	-Len => 5,
	494	-Pad => "x",
	495	-Encrypt => {Password => "def",
	496	Flags => DB_ENCRYPT_AES
	497	},
	498	-Property => DB_ENCRYPT ;
	499
	500
	501	# read the encrypted data
	502	ok 59, my $db1 = new BerkeleyDB::Queue -Filename => $Dfile,
	503	-Len => 5,
	504	-Pad => "x",
	505	-Encrypt => {Password => "beta",
	506	Flags => DB_ENCRYPT_AES
	507	},
	508	-Property => DB_ENCRYPT ;
	509
	510
	511	$v = '';
	512	ok 60, ! $db1->db_get(3, $v) ;
	513	ok 61, $v eq fillout($data{3}, 5, 'x');
	514	# check there are three records
	515	ok 62, countRecords($db1) == 3 ;
	516	undef $db1;
	517	}
	518
	519	{
	520	# new BerkeleyDB::Recno -Encrypt =>
	521
	522	my $Dfile = "abcd.enc";
	523	my $lex = new LexFile $Dfile ;
	524	my %hash ;
	525	my ($k, $v) ;
	526	ok 63, my $db = new BerkeleyDB::Recno
	527	-Filename => $Dfile,
	528	-Flags => DB_CREATE,
	529	-Encrypt => {Password => "beta",
	530	Flags => DB_ENCRYPT_AES
	531	},
	532	-Property => DB_ENCRYPT ;
	533
	534	# create some data
	535	my %data = (
	536	1 => 2,
	537	2 => "house",
	538	3 => "sea",
	539	) ;
	540
	541	my $ret = 0 ;
	542	while (($k, $v) = each %data) {
	543	$ret += $db->db_put($k, $v) ;
	544	}
	545	ok 64, $ret == 0 ;
	546
	547	# check there are three records
	548	ok 65, countRecords($db) == 3 ;
	549
	550	undef $db;
	551
	552	# attempt to open a database without specifying encryption
	553	ok 66, ! new BerkeleyDB::Recno -Filename => $Dfile,
	554	-Flags => DB_CREATE ;
	555
	556
	557	# try opening with the wrong password
	558	ok 67, ! new BerkeleyDB::Recno -Filename => $Dfile,
	559	-Filename => $Dfile,
	560	-Encrypt => {Password => "def",
	561	Flags => DB_ENCRYPT_AES
	562	},
	563	-Property => DB_ENCRYPT ;
	564
	565
	566	# read the encrypted data
	567	ok 68, my $db1 = new BerkeleyDB::Recno -Filename => $Dfile,
	568	-Filename => $Dfile,
	569	-Encrypt => {Password => "beta",
	570	Flags => DB_ENCRYPT_AES
	571	},
	572	-Property => DB_ENCRYPT ;
	573
	574
	575	$v = '';
	576	ok 69, ! $db1->db_get(3, $v) ;
	577	ok 70, $v eq $data{3};
	578	# check there are three records
	579	ok 71, countRecords($db1) == 3 ;
	580	undef $db1;
	581	}
	582
	583	{
	584	# new BerkeleyDB::Unknown -Encrypt =>
	585
	586	my $Dfile = "abcd.enc";
	587	my $lex = new LexFile $Dfile ;
	588	my %hash ;
	589	my ($k, $v) ;
	590	ok 72, my $db = new BerkeleyDB::Hash
	591	-Filename => $Dfile,
	592	-Flags => DB_CREATE,
	593	-Encrypt => {Password => "beta",
	594	Flags => DB_ENCRYPT_AES
	595	},
	596	-Property => DB_ENCRYPT ;
	597
	598	# create some data
	599	my %data = (
	600	"red" => 2,
	601	"green" => "house",
	602	"blue" => "sea",
	603	) ;
	604
	605	my $ret = 0 ;
	606	while (($k, $v) = each %data) {
	607	$ret += $db->db_put($k, $v) ;
	608	}
	609	ok 73, $ret == 0 ;
	610
	611	# check there are three records
	612	ok 74, countRecords($db) == 3 ;
	613
	614	undef $db;
	615
	616	# attempt to open a database without specifying encryption
	617	ok 75, ! new BerkeleyDB::Unknown -Filename => $Dfile,
	618	-Flags => DB_CREATE ;
	619
	620
	621	# try opening with the wrong password
	622	ok 76, ! new BerkeleyDB::Unknown -Filename => $Dfile,
	623	-Filename => $Dfile,
	624	-Encrypt => {Password => "def",
	625	Flags => DB_ENCRYPT_AES
	626	},
	627	-Property => DB_ENCRYPT ;
	628
	629
	630	# read the encrypted data
	631	ok 77, my $db1 = new BerkeleyDB::Unknown -Filename => $Dfile,
	632	-Filename => $Dfile,
	633	-Encrypt => {Password => "beta",
	634	Flags => DB_ENCRYPT_AES
	635	},
	636	-Property => DB_ENCRYPT ;
	637
	638
	639	$v = '';
	640	ok 78, ! $db1->db_get("red", $v) ;
	641	ok 79, $v eq $data{"red"};
	642	# check there are three records
	643	ok 80, countRecords($db1) == 3 ;
	644	undef $db1;
	645	}
	646

+23

-4

t/env.t less more

13	13	use BerkeleyDB;
14	14	use t::util ;
15	15
16		print "1..47\n";
	16	print "1..50\n";
17	17
18	18	my $Dfile = "dbhash.tmp";
19	19
20	20	umask(0);
	21
	22	my $version_major = 0;
21	23
22	24	{
23	25	# db version stuff
24	26	my ($major, $minor, $patch) = (0, 0, 0) ;
25	27
26	28	ok 1, my $VER = BerkeleyDB::DB_VERSION_STRING ;
27		ok 2, my $ver = BerkeleyDB::db_version($major, $minor, $patch) ;
	29	ok 2, my $ver = BerkeleyDB::db_version($version_major, $minor, $patch) ;
28	30	ok 3, $VER eq $ver ;
29		ok 4, $major > 1 ;
	31	ok 4, $version_major > 1 ;
30	32	ok 5, defined $minor ;
31	33	ok 6, defined $patch ;
32	34	}

42	44
43	45	eval ' $env = new BerkeleyDB::Env (-Config => {"fred" => " "} ) ; ' ;
44	46	ok 9, !$env ;
45		ok 10, $BerkeleyDB::Error =~ /^illegal name-value pair/ ;
	47	ok 10, $BerkeleyDB::Error =~ /^(illegal name-value pair\|Invalid argument)/ ;
	48	#print " $BerkeleyDB::Error\n";
46	49	}
47	50
48	51	{

211	214
212	215	}
213	216
	217	{
	218	# attempt to open a new environment without DB_CREATE
	219	# should fail with Berkeley DB 3.x or better.
	220
	221	my $home = "./fred" ;
	222	ok 48, my $lexD = new LexDir($home) ;
	223	chdir "./fred" ;
	224	my $env = new BerkeleyDB::Env -Home => $home, -Flags => DB_CREATE ;
	225	ok 49, $version_major == 2 ? $env : ! $env ;
	226	ok 50, $version_major == 2 ? 1
	227	: $BerkeleyDB::Error =~ /No such file or directory/ ;
	228	#print " $BerkeleyDB::Error\n";
	229	chdir ".." ;
	230	undef $env ;
	231	}
	232
214	233	# test -Verbose
215	234	# test -Flags
216	235	# db_value_set

-1

t/examples3.t less more

14	14	BEGIN
15	15	{
16	16	if ($BerkeleyDB::db_version < 3) {
17		print "1..0 # Skip: this needs Berkeley DB 3.x or better\n" ;
	17	print "1..0 # Skipping test, this needs Berkeley DB 3.x or better\n" ;
18	18	exit 0 ;
19	19	}
20	20	}

+68

-0

t/filter.t less more

258	258	untie %h;
259	259	unlink $Dfile;
260	260	}
	261
	262	if(0)
	263	{
	264	# Filter without tie
	265	use strict ;
	266	my (%h, $db) ;
	267
	268	unlink $Dfile;
	269	ok 53, $db = tie %h, 'BerkeleyDB::Hash',
	270	-Filename => $Dfile,
	271	-Flags => DB_CREATE;
	272
	273	my %result = () ;
	274
	275	sub INC { return ++ $_[0] }
	276	sub DEC { return -- $_[0] }
	277	$db->filter_fetch_key (sub { warn "FFK $_\n"; $_ = INC($_); warn "XX\n" }) ;
	278	$db->filter_store_key (sub { warn "FSK $_\n"; $_ = DEC($_); warn "XX\n" }) ;
	279	$db->filter_fetch_value (sub { warn "FFV $_\n"; $_ = INC($_); warn "XX\n"}) ;
	280	$db->filter_store_value (sub { warn "FSV $_\n"; $_ = DEC($_); warn "XX\n" }) ;
	281
	282	#$db->filter_fetch_key (sub { warn "FFK $_\n"; $_ = pack("i", $_); warn "XX\n" }) ;
	283	#$db->filter_store_key (sub { warn "FSK $_\n"; $_ = unpack("i", $_); warn "XX\n" }) ;
	284	#$db->filter_fetch_value (sub { warn "FFV $_\n"; $_ = pack("i", $_); warn "XX\n"}) ;
	285	#$db->filter_store_value (sub { warn "FSV $_\n"; $_ = unpack("i", $_); warn "XX\n" }) ;
	286
	287	#$db->filter_fetch_key (sub { ++ $_ }) ;
	288	#$db->filter_store_key (sub { -- $_ }) ;
	289	#$db->filter_fetch_value (sub { ++ $_ }) ;
	290	#$db->filter_store_value (sub { -- $_ }) ;
	291
	292	my ($k, $v) = (0,0);
	293	ok 54, ! $db->db_put(3,5);
	294	exit;
	295	ok 55, ! $db->db_get(3, $v);
	296	ok 56, $v == 5 ;
	297
	298	$h{4} = 7 ;
	299	ok 57, $h{4} == 7;
	300
	301	$k = 10;
	302	$v = 30;
	303	$h{$k} = $v ;
	304	ok 58, $k == 10;
	305	ok 59, $v == 30;
	306	ok 60, $h{$k} == 30;
	307
	308	$k = 3;
	309	ok 61, ! $db->db_get($k, $v, DB_GET_BOTH);
	310	ok 62, $k == 3 ;
	311	ok 63, $v == 5 ;
	312
	313	my $cursor = $db->db_cursor();
	314
	315	my %tmp = ();
	316	while ($cursor->c_get($k, $v, DB_NEXT) == 0)
	317	{
	318	$tmp{$k} = $v;
	319	}
	320
	321	ok 64, keys %tmp == 3 ;
	322	ok 65, $tmp{3} == 5;
	323
	324	undef $cursor ;
	325	undef $db ;
	326	untie %h;
	327	unlink $Dfile;
	328	}

-0

t/hash.t less more

117	117	undef $env ;
118	118	}
119	119
	120
120	121	{
121	122	# override default hash
122	123	my $lex = new LexFile $Dfile ;

+54

-40

t/join.t less more

20	20	}
21	21
22	22
23		print "1..37\n";
	23	print "1..41\n";
24	24
25	25	my $Dfile1 = "dbhash1.tmp";
26	26	my $Dfile2 = "dbhash2.tmp";

45	45
46	46	# no cursors supplied
47	47	eval '$cursor = $db1->db_join() ;' ;
48		ok 2, $@ =~ /Usage: \$db->BerkeleyDB::Common::db_join\Q([cursors], flags=0)/;
	48	ok 2, $@ =~ /Usage: \$db->BerkeleyDB::db_join\Q([cursors], flags=0)/;
49	49
50	50	# empty list
51	51	eval '$cursor = $db1->db_join([]) ;' ;
52	52	ok 3, $@ =~ /db_join: No cursors in parameter list/;
53	53
54		# cursor list, isn't a []
	54	# cursor list, isn not a []
55	55	eval '$cursor = $db1->db_join({}) ;' ;
56		ok 4, $@ =~ /cursors is not an array reference at/ ;
	56	ok 4, $@ =~ /db_join: first parameter is not an array reference/;
57	57
58	58	eval '$cursor = $db1->db_join(\1) ;' ;
59		ok 5, $@ =~ /cursors is not an array reference at/ ;
	59	ok 5, $@ =~ /db_join: first parameter is not an array reference/;
	60
	61	my ($a, $b) = ("a", "b");
	62	$a = bless [], "fred";
	63	$b = bless [], "fred";
	64	eval '$cursor = $db1->db_join($a, $b) ;' ;
	65	ok 6, $@ =~ /db_join: first parameter is not an array reference/;
60	66
61	67	}
62	68

71	77	my $status ;
72	78
73	79	my $home = "./fred" ;
74		ok 6, my $lexD = new LexDir($home);
75		ok 7, my $env = new BerkeleyDB::Env -Home => $home,
	80	ok 7, my $lexD = new LexDir($home);
	81	ok 8, my $env = new BerkeleyDB::Env -Home => $home,
76	82	-Flags => DB_CREATE\|DB_INIT_TXN
77	83	\|DB_INIT_MPOOL;
78	84	#\|DB_INIT_MPOOL\| DB_INIT_LOCK;
79		ok 8, my $txn = $env->txn_begin() ;
80		ok 9, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
	85	ok 9, my $txn = $env->txn_begin() ;
	86	ok 10, my $db1 = tie %hash1, 'BerkeleyDB::Hash',
81	87	-Filename => $Dfile1,
82	88	-Flags => DB_CREATE,
83	89	-DupCompare => sub { $_[0] cmp $_[1] },

86	92	-Txn => $txn ;
87	93	;
88	94
89		ok 10, my $db2 = tie %hash2, 'BerkeleyDB::Hash',
	95	ok 11, my $db2 = tie %hash2, 'BerkeleyDB::Hash',
90	96	-Filename => $Dfile2,
91	97	-Flags => DB_CREATE,
92	98	-DupCompare => sub { $_[0] cmp $_[1] },

94	100	-Env => $env,
95	101	-Txn => $txn ;
96	102
97		ok 11, my $db3 = tie %hash3, 'BerkeleyDB::Btree',
	103	ok 12, my $db3 = tie %hash3, 'BerkeleyDB::Btree',
98	104	-Filename => $Dfile3,
99	105	-Flags => DB_CREATE,
100	106	-DupCompare => sub { $_[0] cmp $_[1] },

103	109	-Txn => $txn ;
104	110
105	111
106		ok 12, addData($db1, qw( apple Convenience
	112	ok 13, addData($db1, qw( apple Convenience
107	113	peach Shopway
108	114	pear Farmer
109	115	raspberry Shopway

112	118	blueberry Farmer
113	119	));
114	120
115		ok 13, addData($db2, qw( red apple
	121	ok 14, addData($db2, qw( red apple
116	122	red raspberry
117	123	red strawberry
118	124	yellow peach

120	126	green gooseberry
121	127	blue blueberry)) ;
122	128
123		ok 14, addData($db3, qw( expensive apple
	129	ok 15, addData($db3, qw( expensive apple
124	130	reasonable raspberry
125	131	expensive strawberry
126	132	reasonable peach

128	134	expensive gooseberry
129	135	reasonable blueberry)) ;
130	136
131		ok 15, my $cursor2 = $db2->db_cursor() ;
	137	ok 16, my $cursor2 = $db2->db_cursor() ;
132	138	my $k = "red" ;
133	139	my $v = "" ;
134		ok 16, $cursor2->c_get($k, $v, DB_SET) == 0 ;
	140	ok 17, $cursor2->c_get($k, $v, DB_SET) == 0 ;
135	141
136	142	# Two way Join
137		ok 17, my $cursor1 = $db1->db_join([$cursor2]) ;
	143	ok 18, my $cursor1 = $db1->db_join([$cursor2]) ;
138	144
139	145	my %expected = qw( apple Convenience
140	146	raspberry Shopway

147	153	if defined $expected{$k} && $expected{$k} eq $v ;
148	154	#print "[$k] [$v]\n" ;
149	155	}
150		ok 18, keys %expected == 0 ;
151		ok 19, $cursor1->status() == DB_NOTFOUND ;
	156	ok 19, keys %expected == 0 ;
	157	ok 20, $cursor1->status() == DB_NOTFOUND ;
152	158
153	159	# Three way Join
154		ok 20, $cursor2 = $db2->db_cursor() ;
	160	ok 21, $cursor2 = $db2->db_cursor() ;
155	161	$k = "red" ;
156	162	$v = "" ;
157		ok 21, $cursor2->c_get($k, $v, DB_SET) == 0 ;
158
159		ok 22, my $cursor3 = $db3->db_cursor() ;
	163	ok 22, $cursor2->c_get($k, $v, DB_SET) == 0 ;
	164
	165	ok 23, my $cursor3 = $db3->db_cursor() ;
160	166	$k = "expensive" ;
161	167	$v = "" ;
162		ok 23, $cursor3->c_get($k, $v, DB_SET) == 0 ;
163		ok 24, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
	168	ok 24, $cursor3->c_get($k, $v, DB_SET) == 0 ;
	169	ok 25, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
164	170
165	171	%expected = qw( apple Convenience
166	172	strawberry Shopway

172	178	if defined $expected{$k} && $expected{$k} eq $v ;
173	179	#print "[$k] [$v]\n" ;
174	180	}
175		ok 25, keys %expected == 0 ;
176		ok 26, $cursor1->status() == DB_NOTFOUND ;
	181	ok 26, keys %expected == 0 ;
	182	ok 27, $cursor1->status() == DB_NOTFOUND ;
177	183
178	184	# test DB_JOIN_ITEM
179	185	# #################
180		ok 27, $cursor2 = $db2->db_cursor() ;
	186	ok 28, $cursor2 = $db2->db_cursor() ;
181	187	$k = "red" ;
182	188	$v = "" ;
183		ok 28, $cursor2->c_get($k, $v, DB_SET) == 0 ;
	189	ok 29, $cursor2->c_get($k, $v, DB_SET) == 0 ;
184	190
185		ok 29, $cursor3 = $db3->db_cursor() ;
	191	ok 30, $cursor3 = $db3->db_cursor() ;
186	192	$k = "expensive" ;
187	193	$v = "" ;
188		ok 30, $cursor3->c_get($k, $v, DB_SET) == 0 ;
189		ok 31, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
	194	ok 31, $cursor3->c_get($k, $v, DB_SET) == 0 ;
	195	ok 32, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ;
190	196
191	197	%expected = qw( apple 1
192	198	strawberry 1

200	206	if defined $expected{$k} ;
201	207	#print "[$k]\n" ;
202	208	}
203		ok 32, keys %expected == 0 ;
204		ok 33, $cursor1->status() == DB_NOTFOUND ;
205
206		ok 34, $cursor1->c_close() == 0 ;
207		ok 35, $cursor2->c_close() == 0 ;
208		ok 36, $cursor3->c_close() == 0 ;
209
210		ok 37, ($status = $txn->txn_commit) == 0;
	209	ok 33, keys %expected == 0 ;
	210	ok 34, $cursor1->status() == DB_NOTFOUND ;
	211
	212	ok 35, $cursor1->c_close() == 0 ;
	213	ok 36, $cursor2->c_close() == 0 ;
	214	ok 37, $cursor3->c_close() == 0 ;
	215
	216	ok 38, ($status = $txn->txn_commit) == 0;
211	217
212	218	undef $txn ;
	219
	220	ok 39, my $cursor1a = $db1->db_cursor() ;
	221	eval { $cursor1 = $db1->db_join([$cursor1a]) };
	222	ok 40, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
	223	eval { $cursor1 = $db1->db_join([$cursor1]) } ;
	224	ok 41, $@ =~ /BerkeleyDB Aborting: attempted to do a self-join at/;
	225
	226	undef $cursor1a;
213	227	#undef $cursor1;
214	228	#undef $cursor2;
215	229	#undef $cursor3;

-59

t/mldbm.t less more

56	56	$o{d} = "{once upon a time}";
57	57	$o{e} = 1024;
58	58	$o{f} = 1024.1024;
59		my $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump;
60		my $second = <<'EOT';
61		$a = [
62		1,
63		{
64		a => $a,
65		b => $a->[1],
66		c => [
67		\'c'
68		]
69		},
70		$a->[1]{c}
71		];
72		$b = {
73		a => [
74		1,
75		$b,
76		[
77		\'c'
78		]
79		],
80		b => $b,
81		c => $b->{a}[2]
82		};
83		$c = [
84		\'c'
85		];
86		EOT
87
88		::ok 3, 1 \|\| $first eq $second ;
	59
	60	my $struct = [@o{qw(a b c)}];
	61	::ok 3, ::_compare([$a, $b, $c], $struct);
89	62	::ok 4, $o{d} eq "{once upon a time}" ;
90	63	::ok 5, $o{e} == 1024 ;
91	64	::ok 6, $o{f} eq 1024.1024 ;

123	96	$o{d} = "{once upon a time}";
124	97	$o{e} = 1024;
125	98	$o{f} = 1024.1024;
126		my $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump;
127		my $second = <<'EOT';
128		$a = [
129		1,
130		{
131		a => $a,
132		b => $a->[1],
133		c => [
134		\'c'
135		]
136		},
137		$a->[1]{c}
138		];
139		$b = {
140		a => [
141		1,
142		$b,
143		[
144		\'c'
145		]
146		],
147		b => $b,
148		c => $b->{a}[2]
149		};
150		$c = [
151		\'c'
152		];
153		EOT
154	99
155		::ok 9, 1 \|\| $first eq $second ;
	100	my $struct = [@o{qw(a b c)}];
	101	::ok 9, ::_compare([$a, $b, $c], $struct);
156	102	::ok 10, $o{d} eq "{once upon a time}" ;
157	103	::ok 11, $o{e} == 1024 ;
158	104	::ok 12, $o{f} eq 1024.1024 ;

-10

t/queue.t less more

23	23
24	24	print "1..201\n";
25	25
26		sub fillout
27		{
28		my $var = shift ;
29		my $length = shift ;
30		my $pad = shift \|\| " " ;
31		my $template = $pad x $length ;
32		substr($template, 0, length($var)) = $var ;
33		return $template ;
34		}
35
36	26	my $Dfile = "dbhash.tmp";
37	27	my $Dfile2 = "dbhash2.tmp";
38	28	my $Dfile3 = "dbhash3.tmp";

-0

t/strict.t less more

112	112	eval { $db->db_close() ; } ;
113	113	ok 24, $@ =~ /BerkeleyDB Aborting: attempted to close a database while a transaction was still open at/ ;
114	114	#print "[$@]\n" ;
	115	$txn->txn_abort();
	116	$db->db_close();
115	117	}
116	118
117	119	{

146	148	my $lex = new LexFile $Dfile ;
147	149	my %hash ;
148	150	my $status ;
	151	my $home = 'fred1';
149	152
150	153	ok 33, my $lexD = new LexDir($home);
151	154	ok 34, my $env = new BerkeleyDB::Env -Home => $home,

+102

-0

t/util.pm less more

121	121	}
122	122	}
123	123
	124	sub normalise
	125	{
	126	my $data = shift ;
	127	$data =~ s#\r\n#\n#g
	128	if $^O eq 'cygwin' ;
	129
	130	return $data ;
	131	}
	132
	133
124	134	sub docat
125	135	{
126	136	my $file = shift;

128	138	open(CAT,$file) \|\| die "Cannot open $file:$!";
129	139	my $result = <CAT>;
130	140	close(CAT);
	141	$result = normalise($result);
131	142	return $result;
132	143	}
133	144

139	150	my $result = <CAT> \|\| "" ;
140	151	close(CAT);
141	152	unlink $file ;
	153	$result = normalise($result);
142	154	return $result;
143	155	}
144	156

173	185	}
174	186
175	187	(scalar(@data), join($sep, @data)) ;
	188	}
	189
	190	sub joinkeys
	191	{
	192	my $db = shift ;
	193	my $sep = shift \|\| " " ;
	194	my ($k, $v) = (0, "") ;
	195	my @data = () ;
	196
	197	my $cursor = $db->db_cursor() or return () ;
	198	for ( my $status = $cursor->c_get($k, $v, DB_FIRST) ;
	199	$status == 0 ;
	200	$status = $cursor->c_get($k, $v, DB_NEXT)) {
	201	push @data, $k ;
	202	}
	203
	204	return join($sep, @data) ;
	205
	206	}
	207
	208	sub dumpdb
	209	{
	210	my $db = shift ;
	211	my $sep = shift \|\| " " ;
	212	my ($k, $v) = (0, "") ;
	213	my @data = () ;
	214
	215	my $cursor = $db->db_cursor() or return () ;
	216	for ( my $status = $cursor->c_get($k, $v, DB_FIRST) ;
	217	$status == 0 ;
	218	$status = $cursor->c_get($k, $v, DB_NEXT)) {
	219	print " [$k][$v]\n" ;
	220	}
	221
	222
176	223	}
177	224
178	225	sub countRecords

216	263	}
217	264
218	265
	266	# These two subs lifted directly from MLDBM.pm
	267	#
	268	sub _compare {
	269	use vars qw(%compared);
	270	local %compared;
	271	return _cmp(@_);
	272	}
	273
	274	sub _cmp {
	275	my($a, $b) = @_;
	276
	277	# catch circular loops
	278	return(1) if $compared{$a.'&&&&&*'.$b}++;
	279	# print "$a $b\n";
	280	# print &Data::Dumper::Dumper($a, $b);
	281
	282	if(ref($a) and ref($a) eq ref($b)) {
	283	if(eval { @$a }) {
	284	# print "HERE ".@$a." ".@$b."\n";
	285	@$a == @$b or return 0;
	286	# print @$a, ' ', @$b, "\n";
	287	# print "HERE2\n";
	288
	289	for(0..@$a-1) {
	290	&_cmp($a->[$_], $b->[$_]) or return 0;
	291	}
	292	} elsif(eval { %$a }) {
	293	keys %$a == keys %$b or return 0;
	294	for (keys %$a) {
	295	&_cmp($a->{$_}, $b->{$_}) or return 0;
	296	}
	297	} elsif(eval { $$a }) {
	298	&_cmp($$a, $$b) or return 0;
	299	} else {
	300	die("data $a $b not handled");
	301	}
	302	return 1;
	303	} elsif(! ref($a) and ! ref($b)) {
	304	return ($a eq $b);
	305	} else {
	306	return 0;
	307	}
	308
	309	}
	310
	311	sub fillout
	312	{
	313	my $var = shift ;
	314	my $length = shift ;
	315	my $pad = shift \|\| " " ;
	316	my $template = $pad x $length ;
	317	substr($template, 0, length($var)) = $var ;
	318	return $template ;
	319	}
	320
219	321	1;

+49

-37

typemap less more

60	60	BerkeleyDB_Txn_type * T_IV
61	61	BerkeleyDB__Cursor_type * T_IV
62	62	DB * T_IV
	63	DB_ENV * T_IV
63	64
64	65	INPUT
65	66

172	173	croak(\"$var is not of type ${ntype}\")
173	174
174	175	T_dbtkeydatum
175		DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
176		DBT_clear($var) ;
177		if (db->recno_or_queue) {
178		Value = GetRecnoKey(db, SvIV($arg)) ;
179		$var.data = & Value;
180		$var.size = (int)sizeof(db_recno_t);
181		}
182		else {
183		$var.data = SvPV($arg, PL_na);
	176	{
	177	SV* my_sv = $arg ;
	178	DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
	179	DBT_clear($var) ;
	180	if (db->recno_or_queue) {
	181	Value = GetRecnoKey(db, SvIV(my_sv)) ;
	182	$var.data = & Value;
	183	$var.size = (int)sizeof(db_recno_t);
	184	}
	185	else {
	186	$var.data = SvPV(my_sv, PL_na);
	187	$var.size = (int)PL_na;
	188	}
	189	}
	190
	191	T_dbtkeydatum_btree
	192	{
	193	SV* my_sv = $arg ;
	194	DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
	195	DBT_clear($var) ;
	196	if (db->recno_or_queue \|\|
	197	(db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
	198	Value = GetRecnoKey(db, SvIV(my_sv)) ;
	199	$var.data = & Value;
	200	$var.size = (int)sizeof(db_recno_t);
	201	}
	202	else {
	203	$var.data = SvPV(my_sv, PL_na);
	204	$var.size = (int)PL_na;
	205	}
	206	}
	207
	208	T_dbtdatum
	209	{
	210	SV* my_sv = $arg ;
	211	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
	212	DBT_clear($var) ;
	213	$var.data = SvPV(my_sv, PL_na);
184	214	$var.size = (int)PL_na;
185		}
186
187		T_dbtkeydatum_btree
188		DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
189		DBT_clear($var) ;
190		if (db->recno_or_queue \|\|
191		(db->type == DB_BTREE && flagSet(DB_SET_RECNO))) {
192		Value = GetRecnoKey(db, SvIV($arg)) ;
193		$var.data = & Value;
194		$var.size = (int)sizeof(db_recno_t);
195		}
196		else {
197		$var.data = SvPV($arg, PL_na);
198		$var.size = (int)PL_na;
199		}
200
201		T_dbtdatum
202		DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
203		DBT_clear($var) ;
204		$var.data = SvPV($arg, PL_na);
205		$var.size = (int)PL_na;
206		$var.flags = db->partial ;
207		$var.dlen = db->dlen ;
208		$var.doff = db->doff ;
	215	$var.flags = db->partial ;
	216	$var.dlen = db->dlen ;
	217	$var.doff = db->doff ;
	218	}
209	219
210	220	T_dbtdatum_opt
211	221	DBT_clear($var) ;
212	222	if (flagSet(DB_GET_BOTH)) {
213		DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
214		$var.data = SvPV($arg, PL_na);
	223	SV* my_sv = $arg ;
	224	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
	225	$var.data = SvPV(my_sv, PL_na);
215	226	$var.size = (int)PL_na;
216	227	$var.flags = db->partial ;
217	228	$var.dlen = db->dlen ;

221	232	T_dbtdatum_btree
222	233	DBT_clear($var) ;
223	234	if (flagSet(DB_GET_BOTH)) {
224		DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
225		$var.data = SvPV($arg, PL_na);
	235	SV* my_sv = $arg ;
	236	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
	237	$var.data = SvPV(my_sv, PL_na);
226	238	$var.size = (int)PL_na;
227	239	$var.flags = db->partial ;
228	240	$var.dlen = db->dlen ;