[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.58 by root, Wed Aug 30 12:08:15 2006 UTC vs.
Revision 1.75 by root, Mon Oct 2 00:22:01 2006 UTC

…		…
5	use Storable;	5	use Storable;
6	use Opcode;	6	use Opcode;
7	use Safe;	7	use Safe;
8	use Safe::Hole;	8	use Safe::Hole;
9		9
		10	use YAML::Syck ();
10	use Time::HiRes;	11	use Time::HiRes;
11	use Event;	12	use Event;
12	$Event::Eval = 1; # no idea why this is required, but it is	13	$Event::Eval = 1; # no idea why this is required, but it is
13		14
		15	# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
		16	$YAML::Syck::ImplicitUnicode = 1;
		17
14	use strict;	18	use strict;
15		19
16	_reload_1;	20	_init_vars;
17		21
18	our %COMMAND = ();	22	our %COMMAND = ();
19	our @EVENT;	23	our @EVENT;
20	our %PROP_TYPE;
21	our %PROP_IDX;
22	our $LIBDIR = maps_directory "perl";	24	our $LIBDIR = maps_directory "perl";
23		25
24	our $TICK = MAX_TIME * 1e-6;	26	our $TICK = MAX_TIME * 1e-6;
25	our $TICK_WATCHER;	27	our $TICK_WATCHER;
26	our $NEXT_TICK;	28	our $NEXT_TICK;
		29
		30	our %CFG;
		31
		32	#############################################################################
		33
		34	=head2 GLOBAL VARIABLES
		35
		36	=over 4
		37
		38	=item $cf::LIBDIR
		39
		40	The perl library directory, where extensions and cf-specific modules can
		41	be found. It will be added to C<@INC> automatically.
		42
		43	=item $cf::TICK
		44
		45	The interval between server ticks, in seconds.
		46
		47	=item %cf::CFG
		48
		49	Configuration for the server, loaded from C</etc/crossfire/config>, or
		50	from wherever your confdir points to.
		51
		52	=back
		53
		54	=cut
27		55
28	BEGIN {	56	BEGIN {
29	*CORE::GLOBAL::warn = sub {	57	*CORE::GLOBAL::warn = sub {
30	my $msg = join "", @_;	58	my $msg = join "", @_;
31	$msg .= "\n"	59	$msg .= "\n"
…		…
34	print STDERR "cfperl: $msg";	62	print STDERR "cfperl: $msg";
35	LOG llevError, "cfperl: $msg";	63	LOG llevError, "cfperl: $msg";
36	};	64	};
37	}	65	}
38		66
39	my %ignore_set = (MAP_PROP_PATH => 1); # I hate the plug-in api. Deeply!
40
41	# generate property mutators
42	sub prop_gen {
43	my ($prefix, $class) = @_;
44
45	no strict 'refs';
46
47	for my $prop (keys %PROP_TYPE) {
48	$prop =~ /^\Q$prefix\E_(.*$)/ or next;
49	my $sub = lc $1;
50
51	my $type = $PROP_TYPE{$prop};
52	my $idx = $PROP_IDX {$prop};
53
54	{"$class\::get_$sub"} = {"$class\::$sub"} = sub {
55	$_[0]->get_property ($type, $idx)
56	};
57
58	*{"$class\::set_$sub"} = sub {
59	$_[0]->set_property ($type, $idx, $_[1]);
60	} unless $ignore_set{$prop};
61	}
62	}
63
64	# auto-generate most of the API
65
66	prop_gen OBJECT_PROP => "cf::object";
67	# CFAPI_OBJECT_ANIMATION?
68	prop_gen PLAYER_PROP => "cf::object::player";
69
70	prop_gen MAP_PROP => "cf::map";
71	prop_gen ARCH_PROP => "cf::arch";
72
73	@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';	67	@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';
74		68
75	# we bless all objects into (empty) derived classes to force a method lookup	69	# we bless all objects into (empty) derived classes to force a method lookup
76	# within the Safe compartment.	70	# within the Safe compartment.
77	for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch cf::living)) {	71	for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch cf::living)) {
…		…
87	my @exts;	81	my @exts;
88	my @hook;	82	my @hook;
89	my %command;	83	my %command;
90	my %extcmd;	84	my %extcmd;
91		85
92	#############################################################################	86	=head2 UTILITY FUNCTIONS
93	# utility functions	87
		88	=over 4
		89
		90	=cut
94		91
95	use JSON::Syck (); # TODO# replace by JSON::PC once working	92	use JSON::Syck (); # TODO# replace by JSON::PC once working
		93
		94	=item $ref = cf::from_json $json
		95
		96	Converts a JSON string into the corresponding perl data structure.
		97
		98	=cut
96		99
97	sub from_json($) {	100	sub from_json($) {
98	$JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs	101	$JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs
99	JSON::Syck::Load $_[0]	102	JSON::Syck::Load $_[0]
100	}	103	}
101		104
		105	=item $json = cf::to_json $ref
		106
		107	Converts a perl data structure into its JSON representation.
		108
		109	=cut
		110
102	sub to_json($) {	111	sub to_json($) {
103	$JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs	112	$JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
104	JSON::Syck::Dump $_[0]	113	JSON::Syck::Dump $_[0]
105	}	114	}
106		115
107	#############################################################################	116	=back
108	# "new" plug-in system
109		117
		118	=cut
		119
		120	#############################################################################
		121
110	=head3 EVENTS AND OBJECT ATTACHMENTS	122	=head2 EVENTS AND OBJECT ATTACHMENTS
111		123
112	=over 4	124	=over 4
113		125
114	=item $object->attach ($attachment, key => $value...)	126	=item $object->attach ($attachment, key => $value...)
115		127
…		…
389	for (@$callbacks) {	401	for (@$callbacks) {
390	eval { &{$_->[1]} };	402	eval { &{$_->[1]} };
391		403
392	if ($@) {	404	if ($@) {
393	warn "$@";	405	warn "$@";
394	warn "... while processing $EVENT[$event][0] event, skipping processing altogether.\n";	406	warn "... while processing $EVENT[$event][0](@_) event, skipping processing altogether.\n";
395	override;	407	override;
396	}	408	}
397		409
398	return 1 if $override;	410	return 1 if $override;
399	}	411	}
…		…
415	removed in future versions), and there is no public API to access override	427	removed in future versions), and there is no public API to access override
416	results (if you must, access C<@cf::invoke_results> directly).	428	results (if you must, access C<@cf::invoke_results> directly).
417		429
418	=back	430	=back
419		431
420	=head2 methods valid for all pointers	432	=cut
		433
		434	#############################################################################
		435
		436	=head2 METHODS VALID FOR ALL CORE OBJECTS
421		437
422	=over 4	438	=over 4
423		439
424	=item $object->valid	440	=item $object->valid, $player->valid, $map->valid
425
426	=item $player->valid
427
428	=item $map->valid
429		441
430	Just because you have a perl object does not mean that the corresponding	442	Just because you have a perl object does not mean that the corresponding
431	C-level object still exists. If you try to access an object that has no	443	C-level object still exists. If you try to access an object that has no
432	valid C counterpart anymore you get an exception at runtime. This method	444	valid C counterpart anymore you get an exception at runtime. This method
433	can be used to test for existence of the C object part without causing an	445	can be used to test for existence of the C object part without causing an
…		…
476	}	488	}
477	}	489	}
478	}	490	}
479		491
480	sub object_freezer_save {	492	sub object_freezer_save {
481	my ($filename, $objs) = @_;	493	my ($filename, $rdata, $objs) = @_;
482		494
483	if (@$objs) {	495	if (length $$rdata) {
		496	warn sprintf "saving %s (%d,%d)\n",
		497	$filename, length $$rdata, scalar @$objs;
		498
484	open my $fh, ">:raw", "$filename.pst~";	499	if (open my $fh, ">:raw", "$filename~") {
		500	chmod SAVE_MODE, $fh;
		501	syswrite $fh, $$rdata;
		502	close $fh;
		503
		504	if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
		505	chmod SAVE_MODE, $fh;
485	syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };	506	syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };
486	close $fh;	507	close $fh;
487	chmod SAVE_MODE, "$filename.pst~";
488	rename "$filename.pst~", "$filename.pst";	508	rename "$filename.pst~", "$filename.pst";
		509	} else {
		510	unlink "$filename.pst";
		511	}
		512
		513	rename "$filename~", $filename;
		514	} else {
		515	warn "FATAL: $filename~: $!\n";
		516	}
489	} else {	517	} else {
		518	unlink $filename;
490	unlink "$filename.pst";	519	unlink "$filename.pst";
491	}	520	}
492
493	chmod SAVE_MODE, "$filename~";
494	rename "$filename~", $filename;
495	}	521	}
496		522
497	sub object_thawer_load {	523	sub object_thawer_load {
498	my ($filename) = @_;	524	my ($filename) = @_;
499		525
		526	local $/;
		527
		528	my $av;
		529
		530	#TODO: use sysread etc.
		531	if (open my $data, "<:raw:perlio", $filename) {
		532	$data = <$data>;
500	open my $fh, "<:raw:perlio", "$filename.pst"	533	if (open my $pst, "<:raw:perlio", "$filename.pst") {
501	or return;	534	$av = eval { (Storable::thaw <$pst>)->{objs} };
		535	}
		536	return ($data, $av);
		537	}
502		538
503	eval { local $/; (Storable::thaw <$fh>)->{objs} }	539	()
504	}	540	}
505		541
506	attach_to_objects	542	attach_to_objects
507	prio => -1000000,	543	prio => -1000000,
508	on_clone => sub {	544	on_clone => sub {
…		…
654	load_extension $ext;	690	load_extension $ext;
655	1	691	1
656	} or warn "$ext not loaded: $@";	692	} or warn "$ext not loaded: $@";
657	}	693	}
658	}	694	}
659
660	sub _perl_reload(&) {
661	my ($msg) = @_;
662
663	$msg->("reloading...");
664
665	eval {
666	# 1. cancel all watchers
667	$_->cancel for Event::all_watchers;
668
669	# 2. unload all extensions
670	for (@exts) {
671	$msg->("unloading <$_>");
672	unload_extension $_;
673	}
674
675	# 3. unload all modules loaded from $LIBDIR
676	while (my ($k, $v) = each %INC) {
677	next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
678
679	$msg->("removing <$k>");
680	delete $INC{$k};
681
682	$k =~ s/\.pm$//;
683	$k =~ s/\//::/g;
684
685	if (my $cb = $k->can ("unload_module")) {
686	$cb->();
687	}
688
689	Symbol::delete_package $k;
690	}
691
692	# 4. get rid of safe::, as good as possible
693	Symbol::delete_package "safe::$_"
694	for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
695
696	# 5. remove register_script_function callbacks
697	# TODO
698
699	# 6. unload cf.pm "a bit"
700	delete $INC{"cf.pm"};
701
702	# don't, removes xs symbols, too,
703	# and global variables created in xs
704	#Symbol::delete_package __PACKAGE__;
705
706	# 7. reload cf.pm
707	$msg->("reloading cf.pm");
708	require cf;
709	};
710	$msg->($@) if $@;
711
712	$msg->("reloaded");
713	};
714
715	sub perl_reload() {
716	_perl_reload {
717	warn $_[0];
718	print "$_[0]\n";
719	};
720	}
721
722	register_command "perl-reload", 0, sub {
723	my ($who, $arg) = @_;
724
725	if ($who->flag (FLAG_WIZ)) {
726	_perl_reload {
727	warn $_[0];
728	$who->message ($_[0]);
729	};
730	}
731	};
732		695
733	#############################################################################	696	#############################################################################
734	# extcmd framework, basically convert ext <msg>	697	# extcmd framework, basically convert ext <msg>
735	# into pkg::->on_extcmd_arg1 (...) while shortcutting a few	698	# into pkg::->on_extcmd_arg1 (...) while shortcutting a few
736		699
…		…
773		736
774	sub all_objects(@) {	737	sub all_objects(@) {
775	@_, map all_objects ($_->inv), @_	738	@_, map all_objects ($_->inv), @_
776	}	739	}
777		740
		741	# TODO: compatibility cruft, remove when no longer needed
778	attach_to_players	742	attach_to_players
779	on_load => sub {	743	on_load => sub {
780	my ($pl, $path) = @_;	744	my ($pl, $path) = @_;
781		745
782	for my $o (all_objects $pl->ob) {	746	for my $o (all_objects $pl->ob) {
…		…
788	}	752	}
789	},	753	},
790	;	754	;
791		755
792	#############################################################################	756	#############################################################################
793	# core extensions - in perl	757
		758	=head2 CORE EXTENSIONS
		759
		760	Functions and methods that extend core crossfire objects.
		761
		762	=over 4
794		763
795	=item cf::player::exists $login	764	=item cf::player::exists $login
796		765
797	Returns true when the given account exists.	766	Returns true when the given account exists.
798		767
…		…
801	sub cf::player::exists($) {	770	sub cf::player::exists($) {
802	cf::player::find $_[0]	771	cf::player::find $_[0]
803	or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;	772	or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
804	}	773	}
805		774
806	=item $player->reply ($npc, $msg[, $flags])	775	=item $object->reply ($npc, $msg[, $flags])
807		776
808	Sends a message to the player, as if the npc C<$npc> replied. C<$npc>	777	Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
809	can be C<undef>. Does the right thing when the player is currently in a	778	can be C<undef>. Does the right thing when the player is currently in a
810	dialogue with the given NPC character.	779	dialogue with the given NPC character.
811		780
…		…
838	$msg{msgid} = $id;	807	$msg{msgid} = $id;
839		808
840	$self->send ("ext " . to_json \%msg);	809	$self->send ("ext " . to_json \%msg);
841	}	810	}
842		811
		812	=back
		813
		814	=cut
		815
843	#############################################################################	816	#############################################################################
844	# map scripting support	817
		818	=head2 SAFE SCRIPTING
		819
		820	Functions that provide a safe environment to compile and execute
		821	snippets of perl code without them endangering the safety of the server
		822	itself. Looping constructs, I/O operators and other built-in functionality
		823	is not available in the safe scripting environment, and the number of
		824	functions and methods that cna be called is greatly reduced.
		825
		826	=cut
845		827
846	our $safe = new Safe "safe";	828	our $safe = new Safe "safe";
847	our $safe_hole = new Safe::Hole;	829	our $safe_hole = new Safe::Hole;
848		830
849	$SIG{FPE} = 'IGNORE';	831	$SIG{FPE} = 'IGNORE';
850		832
851	$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time));	833	$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time));
852		834
853	# here we export the classes and methods available to script code	835	# here we export the classes and methods available to script code
		836
		837	=pod
		838
		839	The following fucntions and emthods are available within a safe environment:
		840
		841	cf::object contr pay_amount pay_player
		842	cf::object::player player
		843	cf::player peaceful
		844
		845	=cut
854		846
855	for (	847	for (
856	["cf::object" => qw(contr pay_amount pay_player)],	848	["cf::object" => qw(contr pay_amount pay_player)],
857	["cf::object::player" => qw(player)],	849	["cf::object::player" => qw(player)],
858	["cf::player" => qw(peaceful)],	850	["cf::player" => qw(peaceful)],
…		…
861	my ($pkg, @funs) = @$_;	853	my ($pkg, @funs) = @$_;
862	*{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})	854	*{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
863	for @funs;	855	for @funs;
864	}	856	}
865		857
		858	=over 4
		859
		860	=item @retval = safe_eval $code, [var => value, ...]
		861
		862	Compiled and executes the given perl code snippet. additional var/value
		863	pairs result in temporary local (my) scalar variables of the given name
		864	that are available in the code snippet. Example:
		865
		866	my $five = safe_eval '$first + $second', first => 1, second => 4;
		867
		868	=cut
		869
866	sub safe_eval($;@) {	870	sub safe_eval($;@) {
867	my ($code, %vars) = @_;	871	my ($code, %vars) = @_;
868		872
869	my $qcode = $code;	873	my $qcode = $code;
870	$qcode =~ s/"/‟/g; # not allowed in #line filenames	874	$qcode =~ s/"/‟/g; # not allowed in #line filenames
…		…
892	}	896	}
893		897
894	wantarray ? @res : $res[0]	898	wantarray ? @res : $res[0]
895	}	899	}
896		900
		901	=item cf::register_script_function $function => $cb
		902
		903	Register a function that can be called from within map/npc scripts. The
		904	function should be reasonably secure and should be put into a package name
		905	like the extension.
		906
		907	Example: register a function that gets called whenever a map script calls
		908	C<rent::overview>, as used by the C<rent> extension.
		909
		910	cf::register_script_function "rent::overview" => sub {
		911	...
		912	};
		913
		914	=cut
		915
897	sub register_script_function {	916	sub register_script_function {
898	my ($fun, $cb) = @_;	917	my ($fun, $cb) = @_;
899		918
900	no strict 'refs';	919	no strict 'refs';
901	*{"safe::$fun"} = $safe_hole->wrap ($cb);	920	*{"safe::$fun"} = $safe_hole->wrap ($cb);
902	}	921	}
903		922
		923	=back
		924
		925	=cut
		926
		927	#############################################################################
		928
		929	=head2 EXTENSION DATABASE SUPPORT
		930
		931	Crossfire maintains a very simple database for extension use. It can
		932	currently store anything that can be serialised using Storable, which
		933	excludes objects.
		934
		935	The parameter C<$family> should best start with the name of the extension
		936	using it, it should be unique.
		937
		938	=over 4
		939
		940	=item $hashref = cf::db_get $family
		941
		942	Return a hashref for use by the extension C<$family>, which can be
		943	modified. After modifications, you have to call C<cf::db_dirty> or
		944	C<cf::db_sync>.
		945
		946	=item $value = cf::db_get $family => $key
		947
		948	Returns a single value from the database
		949
		950	=item cf::db_put $family => $hashref
		951
		952	Stores the given family hashref into the database. Updates are delayed, if
		953	you want the data to be synced to disk immediately, use C<cf::db_sync>.
		954
		955	=item cf::db_put $family => $key => $value
		956
		957	Stores the given C<$value> in the family hash. Updates are delayed, if you
		958	want the data to be synced to disk immediately, use C<cf::db_sync>.
		959
		960	=item cf::db_dirty
		961
		962	Marks the database as dirty, to be updated at a later time.
		963
		964	=item cf::db_sync
		965
		966	Immediately write the database to disk I<if it is dirty>.
		967
		968	=cut
		969
		970	{
		971	my $db;
		972	my $path = cf::localdir . "/database.pst";
		973
		974	sub db_load() {
		975	warn "loading database $path\n";#d# remove later
		976	$db = stat $path ? Storable::retrieve $path : { };
		977	}
		978
		979	my $pid;
		980
		981	sub db_save() {
		982	warn "saving database $path\n";#d# remove later
		983	waitpid $pid, 0 if $pid;
		984	if (0 == ($pid = fork)) {
		985	$db->{_meta}{version} = 1;
		986	Storable::nstore $db, "$path~";
		987	rename "$path~", $path;
		988	cf::_exit 0 if defined $pid;
		989	}
		990	}
		991
		992	my $dirty;
		993
		994	sub db_sync() {
		995	db_save if $dirty;
		996	undef $dirty;
		997	}
		998
		999	my $idle = Event->idle (min => $TICK * 2.8, max => 10, repeat => 0, cb => sub {
		1000	db_sync;
		1001	});
		1002
		1003	sub db_dirty() {
		1004	$dirty = 1;
		1005	$idle->start;
		1006	}
		1007
		1008	sub db_get($;$) {
		1009	@_ >= 2
		1010	? $db->{$_[0]}{$_[1]}
		1011	: ($db->{$_[0]} \|\|= { })
		1012	}
		1013
		1014	sub db_put($$;$) {
		1015	if (@_ >= 3) {
		1016	$db->{$_[0]}{$_[1]} = $_[2];
		1017	} else {
		1018	$db->{$_[0]} = $_[1];
		1019	}
		1020	db_dirty;
		1021	}
		1022
		1023	attach_global
		1024	prio => 10000,
		1025	on_cleanup => sub {
		1026	db_sync;
		1027	},
		1028	;
		1029	}
		1030
904	#############################################################################	1031	#############################################################################
905	# the server's main()	1032	# the server's main()
906		1033
		1034	sub cfg_load {
		1035	open my $fh, "<:utf8", cf::confdir . "/config"
		1036	or return;
		1037
		1038	local $/;
		1039	*CFG = YAML::Syck::Load <$fh>;
		1040	}
		1041
907	sub main {	1042	sub main {
		1043	cfg_load;
		1044	db_load;
		1045	load_extensions;
908	Event::loop;	1046	Event::loop;
909	}	1047	}
910		1048
911	#############################################################################	1049	#############################################################################
912	# initialisation	1050	# initialisation
913		1051
		1052	sub _perl_reload(&) {
		1053	my ($msg) = @_;
		1054
		1055	$msg->("reloading...");
		1056
		1057	eval {
		1058	# cancel all watchers
		1059	$_->cancel for Event::all_watchers;
		1060
		1061	# unload all extensions
		1062	for (@exts) {
		1063	$msg->("unloading <$_>");
		1064	unload_extension $_;
		1065	}
		1066
		1067	# unload all modules loaded from $LIBDIR
		1068	while (my ($k, $v) = each %INC) {
		1069	next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
		1070
		1071	$msg->("removing <$k>");
		1072	delete $INC{$k};
		1073
		1074	$k =~ s/\.pm$//;
		1075	$k =~ s/\//::/g;
		1076
		1077	if (my $cb = $k->can ("unload_module")) {
		1078	$cb->();
		1079	}
		1080
		1081	Symbol::delete_package $k;
		1082	}
		1083
		1084	# sync database to disk
		1085	cf::db_sync;
		1086
		1087	# get rid of safe::, as good as possible
		1088	Symbol::delete_package "safe::$_"
		1089	for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
		1090
		1091	# remove register_script_function callbacks
		1092	# TODO
		1093
		1094	# unload cf.pm "a bit"
		1095	delete $INC{"cf.pm"};
		1096
		1097	# don't, removes xs symbols, too,
		1098	# and global variables created in xs
		1099	#Symbol::delete_package __PACKAGE__;
		1100
		1101	# reload cf.pm
		1102	$msg->("reloading cf.pm");
		1103	require cf;
		1104
		1105	# load config and database again
		1106	cf::cfg_load;
		1107	cf::db_load;
		1108
		1109	# load extensions
		1110	$msg->("load extensions");
		1111	cf::load_extensions;
		1112
		1113	# reattach attachments to objects
		1114	$msg->("reattach");
		1115	_global_reattach;
		1116	};
		1117	$msg->($@) if $@;
		1118
		1119	$msg->("reloaded");
		1120	};
		1121
		1122	sub perl_reload() {
		1123	_perl_reload {
		1124	warn $_[0];
		1125	print "$_[0]\n";
		1126	};
		1127	}
		1128
		1129	register_command "perl-reload", 0, sub {
		1130	my ($who, $arg) = @_;
		1131
		1132	if ($who->flag (FLAG_WIZ)) {
		1133	_perl_reload {
		1134	warn $_[0];
		1135	$who->message ($_[0]);
		1136	};
		1137	}
		1138	};
		1139
914	register "<global>", __PACKAGE__;	1140	register "<global>", __PACKAGE__;
915		1141
916	unshift @INC, $LIBDIR;	1142	unshift @INC, $LIBDIR;
917
918	load_extensions;
919		1143
920	$TICK_WATCHER = Event->timer (	1144	$TICK_WATCHER = Event->timer (
921	prio => 1,	1145	prio => 1,
922	at => $NEXT_TICK \|\| 1,	1146	at => $NEXT_TICK \|\| 1,
923	cb => sub {	1147	cb => sub {
…		…
932	$TICK_WATCHER->at ($NEXT_TICK);	1156	$TICK_WATCHER->at ($NEXT_TICK);
933	$TICK_WATCHER->start;	1157	$TICK_WATCHER->start;
934	},	1158	},
935	);	1159	);
936		1160
937	_reload_2;
938
939	1	1161	1
940		1162

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.58 by root, Wed Aug 30 12:08:15 2006 UTC vs. Revision 1.75 by root, Mon Oct 2 00:22:01 2006 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.58 by root, Wed Aug 30 12:08:15 2006 UTC vs.
Revision 1.75 by root, Mon Oct 2 00:22:01 2006 UTC