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

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

Diff Legend

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

Comparing deliantra/Deliantra-Client/DC.pm (file contents): Revision 1.120 by root, Wed Sep 20 16:01:07 2006 UTC vs. Revision 1.134 by root, Thu Dec 7 03:54:47 2006 UTC

Diff Legend

Comparing deliantra/Deliantra-Client/DC.pm (file contents):
Revision 1.120 by root, Wed Sep 20 16:01:07 2006 UTC vs.
Revision 1.134 by root, Thu Dec 7 03:54:47 2006 UTC