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

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.117 by root, Sat Aug 19 02:49:53 2006 UTC vs.
Revision 1.135 by root, Thu Dec 7 15:57:13 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.97';
19		21
20	use XSLoader;	22	use XSLoader;
21	XSLoader::load "CFPlus", $VERSION;	23	XSLoader::load "CFPlus", $VERSION;
22	}	24	}
23		25
24	use utf8;	26	use utf8;
25		27
26	use Carp ();
27	use AnyEvent ();	28	use AnyEvent ();
28	use BerkeleyDB;	29	use BerkeleyDB;
29	use Pod::POM ();	30	use Pod::POM ();
30	use Scalar::Util ();	31	use Scalar::Util ();
		32	use File::Path ();
31	use Storable (); # finally	33	use Storable (); # finally
		34
		35	BEGIN {
		36	use Crossfire::Protocol::Base ();
		37	*to_json = \&Crossfire::Protocol::Base::to_json;
		38	*from_json = \&Crossfire::Protocol::Base::from_json;
		39	}
32		40
33	=item guard { BLOCK }	41	=item guard { BLOCK }
34		42
35	Returns an object that executes the given block as soon as it is destroyed.	43	Returns an object that executes the given block as soon as it is destroyed.
36		44
…		…
40	bless \(my $cb = $_[0]), "CFPlus::Guard"	48	bless \(my $cb = $_[0]), "CFPlus::Guard"
41	}	49	}
42		50
43	sub CFPlus::Guard::DESTROY {	51	sub CFPlus::Guard::DESTROY {
44	${$_[0]}->()	52	${$_[0]}->()
		53	}
		54
		55	=item shorten $string[, $maxlength]
		56
		57	=cut
		58
		59	sub shorten($;$) {
		60	my ($str, $len) = @_;
		61	substr $str, $len, (length $str), "..." if $len + 3 <= length $str;
		62	$str
45	}	63	}
46		64
47	sub asxml($) {	65	sub asxml($) {
48	local $_ = $_[0];	66	local $_ = $_[0];
49		67
50	s/&/&/g;	68	s/&/&/g;
51	s/>/>/g;	69	s/>/>/g;
52	s/</</g;	70	s/</</g;
53		71
54	$_	72	$_
		73	}
		74
		75	sub socketpipe() {
		76	socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
		77	or die "cannot establish bidiretcional pipe: $!\n";
		78
		79	($fh1, $fh2)
		80	}
		81
		82	sub background(&;&) {
		83	my ($bg, $cb) = @_;
		84
		85	my ($fh_r, $fh_w) = CFPlus::socketpipe;
		86
		87	my $pid = fork;
		88
		89	if (defined $pid && !$pid) {
		90	local $SIG{__DIE__};
		91
		92	open STDOUT, ">&", $fh_w;
		93	open STDERR, ">&", $fh_w;
		94	close $fh_r;
		95	close $fh_w;
		96
		97	$\| = 1;
		98
		99	eval { $bg->() };
		100
		101	if ($@) {
		102	my $msg = $@;
		103	$msg =~ s/\n+/\n/;
		104	warn "FATAL: $msg";
		105	CFPlus::_exit 1;
		106	}
		107
		108	# win32 is fucked up, of course. exit will clean stuff up,
		109	# which destroys our database etc. _exit will exit ALL
		110	# forked processes, because of the dreaded fork emulation.
		111	CFPlus::_exit 0;
		112	}
		113
		114	close $fh_w;
		115
		116	my $buffer;
		117
		118	my $w; $w = AnyEvent->io (fh => $fh_r, poll => 'r', cb => sub {
		119	unless (sysread $fh_r, $buffer, 4096, length $buffer) {
		120	undef $w;
		121	$cb->();
		122	return;
		123	}
		124
		125	while ($buffer =~ s/^(.*)\n//) {
		126	my $line = $1;
		127	$line =~ s/\s+$//;
		128	utf8::decode $line;
		129	if ($line =~ /^\x{e877}json_msg (.*)$/s) {
		130	$cb->(from_json $1);
		131	} else {
		132	::message ({
		133	markup => "background($pid): " . CFPlus::asxml $line,
		134	});
		135	}
		136	}
		137	});
		138	}
		139
		140	sub background_msg {
		141	my ($msg) = @_;
		142
		143	$msg = "\x{e877}json_msg " . to_json $msg;
		144	$msg =~ s/\n//g;
		145	utf8::encode $msg;
		146	print $msg, "\n";
55	}	147	}
56		148
57	package CFPlus::Database;	149	package CFPlus::Database;
58		150
59	our @ISA = BerkeleyDB::Btree::;	151	our @ISA = BerkeleyDB::Btree::;
…		…
90	$path = "$_/CFPlus/resources/$_[0]";	182	$path = "$_/CFPlus/resources/$_[0]";
91	return $path if -r $path;	183	return $path if -r $path;
92	}	184	}
93		185
94	die "FATAL: can't find required file $_[0]\n";	186	die "FATAL: can't find required file $_[0]\n";
95	}
96
97	BEGIN {
98	use Crossfire::Protocol::Base ();
99	*to_json = \&Crossfire::Protocol::Base::to_json;
100	*from_json = \&Crossfire::Protocol::Base::from_json;
101	}	187	}
102		188
103	sub read_cfg {	189	sub read_cfg {
104	my ($file) = @_;	190	my ($file) = @_;
105		191
…		…
128	open my $fh, ">:utf8", $file	214	open my $fh, ">:utf8", $file
129	or return;	215	or return;
130	print $fh to_json $::CFG;	216	print $fh to_json $::CFG;
131	}	217	}
132		218
		219	sub http_proxy {
		220	my @proxy = win32_proxy_info;
		221
		222	if (@proxy) {
		223	"http://" . (@proxy < 2 ? "" : @proxy < 3 ? "$proxy[1]\@" : "$proxy[1]:$proxy[2]\@") . $proxy[0]
		224	} elsif (exists $ENV{http_proxy}) {
		225	$ENV{http_proxy}
		226	} else {
		227	()
		228	}
		229	}
		230
		231	sub set_proxy {
		232	my $proxy = http_proxy
		233	or return;
		234
		235	$ENV{http_proxy} = $proxy;
		236	}
		237
		238	sub lwp_useragent {
		239	require LWP::UserAgent;
		240
		241	CFPlus::set_proxy;
		242
		243	my $ua = LWP::UserAgent->new (
		244	agent => "cfplus $VERSION",
		245	keep_alive => 1,
		246	env_proxy => 1,
		247	timeout => 30,
		248	);
		249	}
		250
		251	sub lwp_check($) {
		252	my ($res) = @_;
		253
		254	$res->is_error
		255	and die $res->status_line;
		256
		257	$res
		258	}
		259
133	our $DB_ENV;	260	our $DB_ENV;
134		261	our $DB_STATE;
135	{
136	use strict;
137
138	mkdir "$Crossfire::VARDIR/cfplus", 0777;
139	my $recover = $BerkeleyDB::db_version >= 4.4
140	? eval "DB_REGISTER \| DB_RECOVER"
141	: 0;
142
143	$DB_ENV = new BerkeleyDB::Env
144	-Home => "$Crossfire::VARDIR/cfplus",
145	-Cachesize => 1_000_000,
146	-ErrFile => "$Crossfire::VARDIR/cfplus/errorlog.txt",
147	# -ErrPrefix => "DATABASE",
148	-Verbose => 1,
149	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
150	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
151	or die "unable to create/open database home $Crossfire::VARDIR/cfplus: $BerkeleyDB::Error";
152	}
153		262
154	sub db_table($) {	263	sub db_table($) {
155	my ($table) = @_;	264	my ($table) = @_;
156		265
157	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;	266	$table =~ s/([^a-zA-Z0-9_\-])/sprintf "=%x=", ord $1/ge;
…		…
162	# -Filename => "database",	271	# -Filename => "database",
163	# -Subname => $table,	272	# -Subname => $table,
164	-Property => DB_CHKSUM,	273	-Property => DB_CHKSUM,
165	-Flags => DB_CREATE \| DB_UPGRADE,	274	-Flags => DB_CREATE \| DB_UPGRADE,
166	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"	275	or die "unable to create/open database table $_[0]: $BerkeleyDB::Error"
		276	}
		277
		278	our $DB_HOME = "$Crossfire::VARDIR/cfplus";
		279
		280	sub open_db {
		281	use strict;
		282
		283	mkdir $DB_HOME, 0777;
		284	my $recover = $BerkeleyDB::db_version >= 4.4
		285	? eval "DB_REGISTER \| DB_RECOVER"
		286	: 0;
		287
		288	$DB_ENV = new BerkeleyDB::Env
		289	-Home => $DB_HOME,
		290	-Cachesize => 1_000_000,
		291	-ErrFile => "$DB_HOME/errorlog.txt",
		292	# -ErrPrefix => "DATABASE",
		293	-Verbose => 1,
		294	-Flags => DB_CREATE \| DB_RECOVER \| DB_INIT_MPOOL \| DB_INIT_LOCK \| DB_INIT_TXN \| $recover,
		295	-SetFlags => DB_AUTO_COMMIT \| DB_LOG_AUTOREMOVE,
		296	or die "unable to create/open database home $DB_HOME: $BerkeleyDB::Error";
		297
		298	$DB_STATE = db_table "state";
		299
		300	1
		301	}
		302
		303	unless (eval { open_db }) {
		304	File::Path::rmtree $DB_HOME;
		305	open_db;
167	}	306	}
168		307
169	package CFPlus::Layout;	308	package CFPlus::Layout;
170		309
171	$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {	310	$CFPlus::OpenGL::SHUTDOWN_HOOK{"CFPlus::Layout"} = sub {
…		…
269	} elsif ($ev->{button} == 3) {	408	} elsif ($ev->{button} == 3) {
270	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';	409	my $move_prefix = $::CONN->{open_container} ? 'put' : 'drop';
271	if ($self->{container} == $::CONN->{open_container}) {	410	if ($self->{container} == $::CONN->{open_container}) {
272	$move_prefix = "take";	411	$move_prefix = "take";
273	}	412	}
		413
		414	my $shortname = CFPlus::shorten $self->{name}, 14;
274		415
275	my @menu_items = (	416	my @menu_items = (
276	["examine", sub { $::CONN->send ("examine $self->{tag}") }],	417	["examine", sub { $::CONN->send ("examine $self->{tag}") }],
277	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],	418	["mark", sub { $::CONN->send ("mark ". pack "N", $self->{tag}) }],
278	["ignite/thaw", # first try of an easier use of flint&steel	419	["ignite/thaw", # first try of an easier use of flint&steel
…		…
314	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })	455	do_n_dialog (sub { $::CONN->send ("move $targ $self->{tag} $_[0]") })
315	}	456	}
316	]	457	]
317	)	458	)
318	),	459	),
		460	["bind <i>apply $shortname</i> to a key" => sub { $::BIND_EDITOR->do_quick_binding (["apply $self->{name}"]) }],
319	);	461	);
320		462
321	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);	463	CFPlus::UI::Menu->new (items => \@menu_items)->popup ($ev);
322	}	464	}
323		465

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.117 by root, Sat Aug 19 02:49:53 2006 UTC vs. Revision 1.135 by root, Thu Dec 7 15:57:13 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.117 by root, Sat Aug 19 02:49:53 2006 UTC vs.
Revision 1.135 by root, Thu Dec 7 15:57:13 2006 UTC