[ViewVC] Diff of: cvs/deliantra/Deliantra-Client/DC/DB.pm

Comparing deliantra/Deliantra-Client/DC/DB.pm (file contents):
Revision 1.28 by root, Wed Dec 26 20:46:39 2007 UTC vs.
Revision 1.41 by root, Wed Dec 24 04:09:27 2008 UTC

…		…
1	=head1 NAME	1	=head1 NAME
2		2
3	dc::DB - async. database and filesystem access for cfplus	3	DC::DB - async. database and filesystem access for deliantra
4		4
5	=head1 SYNOPSIS	5	=head1 SYNOPSIS
6		6
7	use dc::DB;	7	use DC::DB;
8		8
9	=head1 DESCRIPTION	9	=head1 DESCRIPTION
10		10
11	=over 4	11	=over 4
12		12
13	=cut	13	=cut
14		14
15	package dc::DB;	15	package DC::DB;
16		16
17	use strict;	17	use strict;
18	use utf8;	18	use utf8;
19		19
		20	use File::Path ();
20	use Carp ();	21	use Carp ();
21	use Storable ();	22	use Storable ();
22	use Config;	23	use Config;
23	use BDB;	24	use BDB;
24		25
25	use dc;	26	use DC;
26		27
27	our $DBDIR = "cfplus-" . BDB::VERSION . "-$Config{archname}";	28	our $ODBDIR = "cfplus-" . BDB::VERSION_MAJOR . "." . BDB::VERSION_MINOR . "-$Config{archname}";
		29	our $DBDIR = "client-" . BDB::VERSION_MAJOR . "." . BDB::VERSION_MINOR . "-$Config{archname}";
28	our $DB_HOME = "$Deliantra::VARDIR/$DBDIR";	30	our $DB_HOME = "$Deliantra::VARDIR/$DBDIR";
29		31
30	if (!-e $DB_HOME and -e "$Deliantra::OLDDIR/$DBDIR") {	32	sub FIRST_TILE_ID () { 64 }
		33
		34	unless (-d $DB_HOME) {
		35	if (-d "$Deliantra::VARDIR/$ODBDIR") {
		36	rename "$Deliantra::VARDIR/$ODBDIR", $DB_HOME;
		37	print STDERR "INFO: moved old database from $Deliantra::VARDIR/$ODBDIR to $DB_HOME\n";
		38	} elsif (-d "$Deliantra::OLDDIR/$ODBDIR") {
31	rename "$Deliantra::OLDDIR/$DBDIR", $DB_HOME;	39	rename "$Deliantra::OLDDIR/$DBDIR", $DB_HOME;
32	print STDERR "INFO: moved old database from $Deliantra::OLDDIR/$DBDIR to $DB_HOME\n";	40	print STDERR "INFO: moved old database from $Deliantra::OLDDIR/$ODBDIR to $DB_HOME\n";
		41	} else {
		42	File::Path::mkpath [$DB_HOME]
		43	or die "unable to create database directory $DB_HOME: $!";
		44	}
33	}	45	}
		46
		47	BDB::max_poll_time 0.03;
		48	BDB::max_parallel 1;
34		49
35	our $DB_ENV;	50	our $DB_ENV;
36	our $DB_STATE;	51	our $DB_STATE;
37	our %DB_TABLE;	52	our %DB_TABLE;
		53	our $TILE_SEQ;
38		54
39	sub open_db {	55	sub try_open_db {
40	mkdir $DB_HOME, 0777;	56	File::Path::mkpath [$DB_HOME];
41		57
42	$DB_ENV = db_env_create;	58	my $env = db_env_create;
43		59
44	$DB_ENV->set_errfile (\*STDERR);	60	$env->set_errfile (\*STDERR);
45	$DB_ENV->set_msgfile (\*STDERR);	61	$env->set_msgfile (\*STDERR);
46	$DB_ENV->set_verbose (-1, 1);	62	$env->set_verbose (-1, 1);
47		63
48	$DB_ENV->set_flags (BDB::AUTO_COMMIT \| BDB::LOG_AUTOREMOVE \| BDB::TXN_WRITE_NOSYNC);	64	$env->set_flags (BDB::AUTO_COMMIT \| BDB::REGION_INIT);
		65	$env->set_flags (&BDB::LOG_AUTOREMOVE ) if BDB::VERSION v0, v4.7;
		66	$env->log_set_config (&BDB::LOG_AUTO_REMOVE) if BDB::VERSION v4.7;
		67
		68	$env->set_timeout (3, BDB::SET_TXN_TIMEOUT);
		69	$env->set_timeout (3, BDB::SET_LOCK_TIMEOUT);
		70
49	$DB_ENV->set_cachesize (0, 2048 * 1024, 0);	71	$env->set_cachesize (0, 2048 * 1024, 0);
50		72
51	db_env_open $DB_ENV, $DB_HOME,	73	db_env_open $env, $DB_HOME,
52	BDB::CREATE \| BDB::REGISTER \| BDB::RECOVER \| BDB::INIT_MPOOL \| BDB::INIT_LOCK \| BDB::INIT_TXN,	74	BDB::CREATE \| BDB::REGISTER \| BDB::RECOVER \| BDB::INIT_MPOOL \| BDB::INIT_LOCK \| BDB::INIT_TXN,
53	0666;	75	0666;
54		76
55	$! and die "cannot open database environment $DB_HOME: " . BDB::strerror;	77	$! and die "cannot open database environment $DB_HOME: " . BDB::strerror;
		78
		79	$DB_ENV = $env;
56		80
57	1	81	1
58	}	82	}
59		83
60	sub table($) {	84	sub table($) {
61	$DB_TABLE{$_[0]} \|\|= do {	85	$DB_TABLE{$_[0]} \|\|= do {
62	my ($table) = @_;	86	my ($table) = @_;
63		87
64	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;	88	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
65		89
		90	$DB_ENV#d#
		91	or return ::clienterror ("trying to create table $_[0] with empty db_env $DB_ENV" => 1);#d#
		92
66	my $db = db_create $DB_ENV;	93	my $db = db_create $DB_ENV;
67	$db->set_flags (BDB::CHKSUM);	94	$db->set_flags (BDB::CHKSUM);
68		95
69	db_open $db, undef, $table, undef, BDB::BTREE,	96	db_open $db, undef, $table, undef, BDB::BTREE,
70	BDB::AUTO_COMMIT \| BDB::CREATE \| BDB::READ_UNCOMMITTED, 0666;	97	BDB::AUTO_COMMIT \| BDB::CREATE \| BDB::READ_UNCOMMITTED, 0666;
75	}	102	}
76	}	103	}
77		104
78	#############################################################################	105	#############################################################################
79		106
80	unless (eval { open_db }) {	107	our $WATCHER;
81	warn "$@";#d#	108	our $SYNC;
82	eval { File::Path::rmtree $DB_HOME };
83	open_db;
84	}
85
86	our $WATCHER = EV::io BDB::poll_fileno, EV::READ, \&BDB::poll_cb;
87
88	our $SYNC = EV::timer_ns 0, 60, sub {
89	$_[0]->stop;
90	db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
91	};
92
93	our $tilemap;	109	our $facemap;
94		110
95	sub exists($$$) {	111	sub exists($$$) {
96	my ($db, $key, $cb) = @_;	112	my ($db, $key, $cb) = @_;
97		113
98	my $data;	114	my $data;
…		…
140	my ($name, $cb) = @_;	156	my ($name, $cb) = @_;
141		157
142	my $table = table "facemap";	158	my $table = table "facemap";
143	my $id;	159	my $id;
144		160
145	db_get $table, undef, $name, $id, 0;	161	db_get $table, undef, $name => $id, 0;
146	return $cb->($id) unless $!;	162	$! or return $cb->($id);
147		163
148	for (1..100) {	164	unless ($TILE_SEQ) {
149	my $txn = $DB_ENV->txn_begin;	165	$TILE_SEQ = $table->sequence;
150	db_get $table, $txn, id => $id, 0;	166	$TILE_SEQ->initial_value (FIRST_TILE_ID);
		167	$TILE_SEQ->set_cachesize (0);
		168	db_sequence_open $TILE_SEQ, undef, "id", BDB::CREATE;
		169	}
151		170
152	$id = 64 if $id < 64;	171	db_sequence_get $TILE_SEQ, undef, 1, my $id;
153		172
154	++$id;	173	die "unable to allocate tile id: $!"
155		174	if $!;
156	db_put $table, $txn, id => $id, 0;
157	db_txn_finish $txn;
158
159	$SYNC->again unless $SYNC->is_active;
160
161	return $cb->($id) unless $!;
162
163	select undef, undef, undef, 0.01 * rand;
164	}	175
		176	db_put $table, undef, $name => $id, 0;
		177	$cb->($id);
165		178
166	die "maximum number of transaction retries reached - database problems?";
167	}	179	}
168		180
169	sub get_tile_id_sync($) {	181	sub get_tile_id_sync($) {
170	my ($name) = @_;	182	my ($name) = @_;
171		183
172	# fetch the full face table first
173	unless ($tilemap) {
174	do_table facemap => sub {
175	$tilemap = $_[0];
176	delete $tilemap->{id};
177	my %maptile = reverse %$tilemap;#d#
178	if ((scalar keys %$tilemap) != (scalar keys %maptile)) {#d#
179	$tilemap = { };#d#
180	dc::error "FATAL: facemap is not a 1:1 mapping, please report this and delete your $DB_HOME directory!\n";#d#
181	}#d#
182	};
183	BDB::flush;
184	}
185
186	$tilemap->{$name} \|\|= do {	184	$facemap->{$name} \|\|= do {
187	my $id;	185	my $id;
188	do_get_tile_id $name, sub {	186	do_get_tile_id $name, sub {
189	$id = $_[0];	187	$id = $_[0];
190	};	188	};
191	BDB::flush;	189	BDB::flush;
…		…
200	"$DB_HOME/res-data-" . unpack "H*", $_[0]	198	"$DB_HOME/res-data-" . unpack "H*", $_[0]
201	}	199	}
202		200
203	sub sync {	201	sub sync {
204	# for debugging	202	# for debugging
205	#dc::DB::Server::req (sync => sub { });	203	#DC::DB::Server::req (sync => sub { });
206	dc::DB::Server::sync ();	204	DC::DB::Server::sync ();
207	}	205	}
208		206
209	sub unlink($$) {	207	sub unlink($$) {
210	dc::DB::Server::req (unlink => @_);	208	DC::DB::Server::req (unlink => @_);
211	}	209	}
212		210
213	sub read_file($$) {	211	sub read_file($$) {
214	dc::DB::Server::req (read_file => @_);	212	DC::DB::Server::req (read_file => @_);
215	}	213	}
216		214
217	sub write_file($$$) {	215	sub write_file($$$) {
218	dc::DB::Server::req (write_file => @_);	216	DC::DB::Server::req (write_file => @_);
219	}	217	}
220		218
221	sub prefetch_file($$$) {	219	sub prefetch_file($$$) {
222	dc::DB::Server::req (prefetch_file => @_);	220	DC::DB::Server::req (prefetch_file => @_);
223	}	221	}
224		222
225	sub logprint($$$) {	223	sub logprint($$$) {
226	dc::DB::Server::req (logprint => @_);	224	DC::DB::Server::req (logprint => @_);
227	}	225	}
228		226
		227	#############################################################################
		228
229	package dc::DB::Server;	229	package DC::DB::Server;
230		230
231	use strict;	231	use strict;
232		232
233	use EV ();	233	use EV ();
234	use Fcntl;	234	use Fcntl;
…		…
355		355
356	print { $LOG_FH{$path} } "$ts $line\n"	356	print { $LOG_FH{$path} } "$ts $line\n"
357	}	357	}
358		358
359	sub run {	359	sub run {
360	($FH, my $fh) = dc::socketpipe;	360	($FH, my $fh) = DC::socketpipe;
361		361
362	my $oldfh = select $FH; $\| = 1; select $oldfh;	362	my $oldfh = select $FH; $\| = 1; select $oldfh;
363	my $oldfh = select $fh; $\| = 1; select $oldfh;	363	my $oldfh = select $fh; $\| = 1; select $oldfh;
364		364
365	my $pid = fork;	365	my $pid = fork;
366		366
367	if (defined $pid && !$pid) {	367	if (defined $pid && !$pid) {
368	local $SIG{QUIT};	368	local $SIG{QUIT} = "IGNORE";
369	local $SIG{__DIE__};	369	local $SIG{__DIE__};
370	local $SIG{__WARN__};	370	local $SIG{__WARN__};
371	eval {	371	eval {
372	close $FH;	372	close $FH;
373		373
…		…
379	or die "unexpected eof while reading request";	379	or die "unexpected eof while reading request";
380		380
381	$req = Storable::thaw $req;	381	$req = Storable::thaw $req;
382		382
383	my ($id, $type, @args) = @$req;	383	my ($id, $type, @args) = @$req;
384	my $cb = dc::DB::Server->can ("do_$type")	384	my $cb = DC::DB::Server->can ("do_$type")
385	or die "$type: unknown database request type\n";	385	or die "$type: unknown database request type\n";
386	my $res = pack "N/a*", Storable::freeze [$id, $cb->(@args)];	386	my $res = pack "N/a*", Storable::freeze [$id, $cb->(@args)];
387	(syswrite $fh, $res) == length $res	387	(syswrite $fh, $res) == length $res
388	or die "DB::write: $!";	388	or die "DB::write: $!";
389	}	389	}
…		…
396	};	396	};
397		397
398	warn $error	398	warn $error
399	if $error;	399	if $error;
400		400
401	dc::_exit 0;	401	DC::_exit 0;
402	}	402	}
403		403
404	close $fh;	404	close $fh;
405	dc::fh_nonblocking $FH, 1;	405	DC::fh_nonblocking $FH, 1;
406		406
407	$CB{die} = sub { die shift };	407	$CB{die} = sub { die shift };
408		408
409	$fh_r_watcher = EV::io $FH, EV::READ , \&fh_read;	409	$fh_r_watcher = EV::io $FH, EV::READ , \&fh_read;
410	$fh_w_watcher = EV::io $FH, EV::WRITE, \&fh_write;	410	$fh_w_watcher = EV::io $FH, EV::WRITE, \&fh_write;
…		…
412		412
413	sub stop {	413	sub stop {
414	close $FH;	414	close $FH;
415	}	415	}
416		416
		417	package DC::DB;
		418
		419	sub nuke_db {
		420	File::Path::mkpath [$DB_HOME];
		421	eval { File::Path::rmtree $DB_HOME };
		422	}
		423
		424	sub open_db {
		425	unless (eval { try_open_db }) {
		426	warn "$@";#d#
		427	eval { nuke_db };
		428	try_open_db;
		429	}
		430
		431	# fetch the full face table first
		432	unless ($facemap) {
		433	do_table facemap => sub {
		434	$facemap = $_[0];
		435	delete $facemap->{id};
		436	my %maptile = reverse %$facemap;#d#
		437	if ((scalar keys %$facemap) != (scalar keys %maptile)) {#d#
		438	$facemap = { };#d#
		439	DC::error "FATAL: facemap is not a 1:1 mapping, please report this and delete your $DB_HOME directory!\n";#d#
		440	}#d#
		441	};
		442	}
		443
		444	$WATCHER = EV::io BDB::poll_fileno, EV::READ, \&BDB::poll_cb;
		445	$SYNC = EV::timer_ns 0, 60, sub {
		446	$_[0]->stop;
		447	db_env_txn_checkpoint $DB_ENV, 0, 0, 0, sub { };
		448	};
		449	}
		450
		451	END {
		452	db_env_txn_checkpoint $DB_ENV, 0, 0, 0
		453	if $DB_ENV;
		454
		455	undef $TILE_SEQ;
		456	%DB_TABLE = ();
		457	undef $DB_ENV;
		458	}
		459
417	1;	460	1;
418		461
419	=back	462	=back
420		463
421	=head1 AUTHOR	464	=head1 AUTHOR

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing deliantra/Deliantra-Client/DC/DB.pm (file contents): Revision 1.28 by root, Wed Dec 26 20:46:39 2007 UTC vs. Revision 1.41 by root, Wed Dec 24 04:09:27 2008 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC/DB.pm (file contents):
Revision 1.28 by root, Wed Dec 26 20:46:39 2007 UTC vs.
Revision 1.41 by root, Wed Dec 24 04:09:27 2008 UTC