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

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.112 by root, Sun Aug 13 03:20:53 2006 UTC vs.
Revision 1.126 by root, Tue Nov 7 22:41:27 2006 UTC

…		…
12		12
13	=cut	13	=cut
14		14
15	package CFPlus;	15	package CFPlus;
16		16
		17	use Carp ();
		18
17	BEGIN {	19	BEGIN {
18	$VERSION = '0.2';	20	$VERSION = '0.95';
19		21
20	use XSLoader;	22	use XSLoader;
21	XSLoader::load "CFPlus", $VERSION;	23	XSLoader::load "CFPlus", $VERSION;
22	}	24	}
23		25
		26	BEGIN {
		27	$SIG{__DIE__} = sub {
		28	return if CFPlus::in_destruct;
		29	#CFPlus::fatal $_[0];#d#
		30	CFPlus::error Carp::longmess $_[0];#d#
		31	die;#d#
		32	};
		33	}
		34
24	use utf8;	35	use utf8;
25		36
26	use Carp ();
27	use AnyEvent ();	37	use AnyEvent ();
28	use BerkeleyDB;	38	use BerkeleyDB;
29	use Pod::POM ();	39	use Pod::POM ();
30	use Scalar::Util ();	40	use Scalar::Util ();
31	use Storable (); # finally	41	use Storable (); # finally
…		…
52	s/</</g;	62	s/</</g;
53		63
54	$_	64	$_
55	}	65	}
56		66
		67	sub socketpipe() {
		68	socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
		69	or die "cannot establish bidiretcional pipe: $!\n";
		70
		71	($fh1, $fh2)
		72	}
		73
		74	sub background(&) {
		75	my ($cb) = @_;
		76
		77	my ($fh_r, $fh_w) = CFPlus::socketpipe;
		78
		79	my $pid = fork;
		80
		81	if (defined $pid && !$pid) {
		82	local $SIG{__DIE__};
		83
		84	open STDOUT, ">&", $fh_w;
		85	open STDERR, ">&", $fh_w;
		86	close $fh_r;
		87	close $fh_w;
		88
		89	$\| = 1;
		90
		91	eval { $cb->() };
		92
		93	if ($@) {
		94	my $msg = $@;
		95	$msg =~ s/\n+/\n/;
		96	warn "FATAL: $msg";
		97	CFPlus::_exit 1;
		98	}
		99
		100	# win32 is fucked up, of course. exit will clean stuff up,
		101	# which destroys our database etc. _exit will exit ALL
		102	# forked processes, because of the dreaded fork emulation.
		103	CFPlus::_exit 0;
		104	}
		105
		106	close $fh_w;
		107
		108	my $buffer;
		109
		110	my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
		111	unless (sysread $fh_r, $buffer, 4096, length $buffer) {
		112	undef $w;
		113	$buffer .= "done\n";
		114	}
		115
		116	while ($buffer =~ s/^(.*)\n//) {
		117	my $line = $1;
		118	$line =~ s/\s+$//;
		119	utf8::decode $line;
		120	::message ({
		121	markup => "editor($pid): " . CFPlus::asxml $line,
		122	});
		123	}
		124	});
		125	}
		126
57	package CFPlus::Database;	127	package CFPlus::Database;
58		128
59	our @ISA = BerkeleyDB::Btree::;	129	our @ISA = BerkeleyDB::Btree::;
60		130
61	sub get($$) {	131	sub get($$) {
…		…
69	my %DB_SYNC;	139	my %DB_SYNC;
70		140
71	sub put($$$) {	141	sub put($$$) {
72	my ($db, $key, $data) = @_;	142	my ($db, $key, $data) = @_;
73		143
		144	my $hkey = $db + 0;
		145	Scalar::Util::weaken $db;
74	$DB_SYNC{$db} = AnyEvent->timer (after => 5, cb => sub { $db->db_sync });	146	$DB_SYNC{$hkey} \|\|= AnyEvent->timer (after => 5, cb => sub {
		147	delete $DB_SYNC{$hkey};
		148	$db->db_sync if $db;
		149	});
75		150
76	$db->db_put ($key => $data)	151	$db->db_put ($key => $data)
77	}	152	}
78		153
79	package CFPlus;	154	package CFPlus;
…		…
123	open my $fh, ">:utf8", $file	198	open my $fh, ">:utf8", $file
124	or return;	199	or return;
125	print $fh to_json $::CFG;	200	print $fh to_json $::CFG;
126	}	201	}
127		202
		203	sub http_proxy {
		204	my @proxy = win32_proxy_info;
		205
		206	if (@proxy) {
		207	"http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
		208	} elsif (exists $ENV{http_proxy}) {
		209	$ENV{http_proxy}
		210	} else {
		211	()
		212	}
		213	}
		214
		215	sub set_proxy {
		216	my $proxy = http_proxy
		217	or return;
		218
		219	$ENV{http_proxy} = $proxy;
		220	}
		221
128	our $DB_ENV;	222	our $DB_ENV;
		223	our $DB_STATE;
		224
		225	sub db_table($) {
		226	my ($table) = @_;
		227
		228	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
		229
		230	new CFPlus::Database
		231	-Env => $DB_ENV,
		232	-Filename => $table,
		233	# -Filename => "database",
		234	# -Subname => $table,
		235	-Property => DB_CHKSUM,
		236	-Flags => DB_CREATE \| DB_UPGRADE,
		237	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
		238	}
129		239
130	{	240	{
131	use strict;	241	use strict;
132		242
133	mkdir "$Crossfire::VARDIR/cfplus", 0777;	243	mkdir "$Crossfire::VARDIR/cfplus", 0777;
…		…
142	# -ErrPrefix => "DATABASE",	252	# -ErrPrefix => "DATABASE",
143	-Verbose => 1,	253	-Verbose => 1,
144	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,	254	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
145	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,	255	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
146	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";	256	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
147	}
148		257
149	sub db_table($) {	258	$DB_STATE = db_table "state";
150	my ($table) = @_;
151
152	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
153
154	new CFPlus::Database
155	-Env => $DB_ENV,
156	-Filename => $table,
157	# -Filename => "database",
158	# -Subname => $table,
159	-Property => DB_CHKSUM,
160	-Flags => DB_CREATE \| DB_UPGRADE,
161	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
162	}	259	}
163		260
164	package CFPlus::Layout;	261	package CFPlus::Layout;
165		262
166	$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {	263	$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
…		…
209	}	306	}
210		307
211	sub do_n_dialog {	308	sub do_n_dialog {
212	my ($cb) = @_;	309	my ($cb) = @_;
213		310
214	my $w = new CFPlus::UI::FancyFrame	311	my $w = new CFPlus::UI::Toplevel
215	on_delete => sub { $_[0]->destroy; 1 },	312	on_delete => sub { $_[0]->destroy; 1 },
216	has_close_button => 1,	313	has_close_button => 1,
217	;	314	;
218		315
219	$w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");	316	$w->add (my $vb = new CFPlus::UI::VBox x => "center", y => "center");
…		…
281	&::open_string_query ("Text to inscribe", sub {	378	&::open_string_query ("Text to inscribe", sub {
282	my ($entry, $txt) = @_;	379	my ($entry, $txt) = @_;
283	$::CONN->send ("mark ". pack "N", $self->{tag});	380	$::CONN->send ("mark ". pack "N", $self->{tag});
284	$::CONN->send ("command use_skill inscription $txt");	381	$::CONN->send ("command use_skill inscription $txt");
285	});	382	});
		383	}
		384	],
		385	["rename", # first try of an easier use of flint&steel
		386	sub {
		387	&::open_string_query ("Rename item to:", sub {
		388	my ($entry, $txt) = @_;
		389	$::CONN->send ("mark ". pack "N", $self->{tag});
		390	$::CONN->send ("command rename to <$txt>");
		391	}, $self->{name},
		392	"If you input no name or erase the current custom name, the custom name will be unset");
286	}	393	}
287	],	394	],
288	["apply", sub { $::CONN->send ("apply $self->{tag}") }],	395	["apply", sub { $::CONN->send ("apply $self->{tag}") }],
289	(	396	(
290	$self->{flags} & F_LOCKED	397	$self->{flags} & F_LOCKED

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.112 by root, Sun Aug 13 03:20:53 2006 UTC vs. Revision 1.126 by root, Tue Nov 7 22:41:27 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.112 by root, Sun Aug 13 03:20:53 2006 UTC vs.
Revision 1.126 by root, Tue Nov 7 22:41:27 2006 UTC