ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.87 by root, Thu Dec 14 22:45:40 2006 UTC vs.
Revision 1.94 by root, Thu Dec 21 23:02:54 2006 UTC

… …
25our %EXTCMD = (); 25our %EXTCMD = ();
26 26
27_init_vars; 27_init_vars;
28 28
29our @EVENT; 29our @EVENT;
30our $LIBDIR = maps_directory "perl"; 30our $LIBDIR = datadir . "/ext";
31 31
32our $TICK = MAX_TIME * 1e-6; 32our $TICK = MAX_TIME * 1e-6;
33our $TICK_WATCHER; 33our $TICK_WATCHER;
34our $NEXT_TICK; 34our $NEXT_TICK;
35 35
… …
74 print STDERR "cfperl: $msg"; 74 print STDERR "cfperl: $msg";
75 LOG llevError, "cfperl: $msg"; 75 LOG llevError, "cfperl: $msg";
76 }; 76 };
77} 77}
78 78
79@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
80@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
81@safe::cf::player::ISA = @cf::player::ISA = 'cf::attachable';
82@safe::cf::client::ISA = @cf::client::ISA = 'cf::attachable';
83@safe::cf::map::ISA = @cf::map::ISA = 'cf::attachable';
79@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; 84@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';
80 85
81# we bless all objects into (empty) derived classes to force a method lookup 86# we bless all objects into (empty) derived classes to force a method lookup
82# within the Safe compartment. 87# within the Safe compartment.
83for my $pkg (qw( 88for my $pkg (qw(
89 cf::global
84 cf::object cf::object::player 90 cf::object cf::object::player
85 cf::client_socket cf::player 91 cf::client cf::player
86 cf::arch cf::living 92 cf::arch cf::living
87 cf::map cf::party cf::region 93 cf::map cf::party cf::region
88)) { 94)) {
89 no strict 'refs'; 95 no strict 'refs';
90 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg; 96 @{"safe::$pkg\::wrap::ISA"} = @{"$pkg\::wrap::ISA"} = $pkg;
… …
132 138
133=cut 139=cut
134 140
135############################################################################# 141#############################################################################
136 142
137=head2 EVENTS AND OBJECT ATTACHMENTS 143=head2 ATTACHABLE OBJECTS
144
145Many objects in crossfire are so-called attachable objects. That means you can
146attach callbacks/event handlers (a collection of which is called an "attachment")
147to it. All such attachable objects support the following methods.
148
149In the following description, CLASS can be any of C<global>, C<object>
150C<player>, C<client> or C<map> (i.e. the attachable objects in
151crossfire+).
138 152
139=over 4 153=over 4
140 154
141=item $object->attach ($attachment, key => $value...)
142
143=item $object->detach ($attachment)
144
145Attach/detach a pre-registered attachment to an object.
146
147=item $player->attach ($attachment, key => $value...)
148
149=item $player->detach ($attachment)
150
151Attach/detach a pre-registered attachment to a player.
152
153=item $map->attach ($attachment, key => $value...) 155=item $attachable->attach ($attachment, key => $value...)
154 156
155=item $map->detach ($attachment) 157=item $attachable->detach ($attachment)
156 158
157Attach/detach a pre-registered attachment to a map. 159Attach/detach a pre-registered attachment to a specific object and give it
160the specified key/value pairs as arguments.
158 161
159=item $bool = $object->attached ($name) 162Example, attach a minesweeper attachment to the given object, making it a
16310x10 minesweeper game:
160 164
161=item $bool = $player->attached ($name) 165 $obj->attach (minesweeper => width => 10, height => 10);
162 166
163=item $bool = $map->attached ($name) 167=item $bool = $attachable->attached ($name)
164 168
165Checks wether the named attachment is currently attached to the object. 169Checks wether the named attachment is currently attached to the object.
166 170
167=item cf::attach_global ... 171=item cf::CLASS->attach ...
168 172
169Attach handlers for global events. 173=item cf::CLASS->detach ...
170 174
171This and all following C<attach_*>-functions expect any number of the 175Define an anonymous attachment and attach it to all objects of the given
172following handler/hook descriptions: 176CLASS. See the next function for an explanation of its arguments.
177
178You can attach to global events by using the C<cf::global> class.
179
180Example, log all player logins:
181
182 cf::player->attach (
183 on_login => sub {
184 my ($pl) = @_;
185 ...
186 },
187 );
188
189Example, attach to the jeweler skill:
190
191 cf::object->attach (
192 type => cf::SKILL,
193 subtype => cf::SK_JEWELER,
194 on_use_skill => sub {
195 my ($sk, $ob, $part, $dir, $msg) = @_;
196 ...
197 },
198 );
199
200=item cf::CLASS::attachment $name, ...
201
202Register an attachment by C<$name> through which attachable objects of the
203given CLASS can refer to this attachment.
204
205Some classes such as crossfire maps and objects can specify attachments
206that are attached at load/instantiate time, thus the need for a name.
207
208These calls expect any number of the following handler/hook descriptions:
173 209
174=over 4 210=over 4
175 211
176=item prio => $number 212=item prio => $number
177 213
… …
179by another C<prio> setting). Lower priority handlers get executed 215by another C<prio> setting). Lower priority handlers get executed
180earlier. The default priority is C<0>, and many built-in handlers are 216earlier. The default priority is C<0>, and many built-in handlers are
181registered at priority C<-1000>, so lower priorities should not be used 217registered at priority C<-1000>, so lower priorities should not be used
182unless you know what you are doing. 218unless you know what you are doing.
183 219
220=item type => $type
221
222(Only for C<< cf::object->attach >> calls), limits the attachment to the
223given type of objects only (the additional parameter C<subtype> can be
224used to further limit to the given subtype).
225
184=item on_I<event> => \&cb 226=item on_I<event> => \&cb
185 227
186Call the given code reference whenever the named event happens (event is 228Call the given code reference whenever the named event happens (event is
187something like C<instantiate>, C<apply>, C<use_skill> and so on, and which 229something like C<instantiate>, C<apply>, C<use_skill> and so on, and which
188handlers are recognised generally depends on the type of object these 230handlers are recognised generally depends on the type of object these
… …
197package and register them. Only handlers for eevents supported by the 239package and register them. Only handlers for eevents supported by the
198object/class are recognised. 240object/class are recognised.
199 241
200=back 242=back
201 243
202=item cf::attach_to_type $object_type, $subtype, ... 244Example, define an attachment called "sockpuppet" that calls the given
245event handler when a monster attacks:
203 246
204Attach handlers for a specific object type (e.g. TRANSPORT) and 247 cf::object::attachment sockpuppet =>
205subtype. If C<$subtype> is zero or undef, matches all objects of the given 248 on_skill_attack => sub {
206type. 249 my ($self, $victim) = @_;
207 250 ...
208=item cf::attach_to_objects ... 251 }
209 252 }
210Attach handlers to all objects. Do not use this except for debugging or
211very rare events, as handlers are (obviously) called for I<all> objects in
212the game.
213
214=item cf::attach_to_players ...
215
216Attach handlers to all players.
217
218=item cf::attach_to_maps ...
219
220Attach handlers to all maps.
221
222=item cf:register_attachment $name, ...
223
224Register an attachment by name through which objects can refer to this
225attachment.
226
227=item cf:register_player_attachment $name, ...
228
229Register an attachment by name through which players can refer to this
230attachment.
231
232=item cf:register_map_attachment $name, ...
233
234Register an attachment by name through which maps can refer to this
235attachment.
236 253
237=cut 254=cut
238 255
239# the following variables are defined in .xs and must not be re-created 256# the following variables are defined in .xs and must not be re-created
240our @CB_GLOBAL = (); # registry for all global events 257our @CB_GLOBAL = (); # registry for all global events
241our @CB_OBJECT = (); # all objects (should not be used except in emergency) 258our @CB_OBJECT = (); # all objects (should not be used except in emergency)
242our @CB_PLAYER = (); 259our @CB_PLAYER = ();
260our @CB_CLIENT = ();
243our @CB_TYPE = (); # registry for type (cf-object class) based events 261our @CB_TYPE = (); # registry for type (cf-object class) based events
244our @CB_MAP = (); 262our @CB_MAP = ();
245 263
246my %attachment; 264my %attachment;
247 265
248sub _attach_cb($\%$$$) { 266sub _attach_cb($$$$) {
249 my ($registry, $undo, $event, $prio, $cb) = @_; 267 my ($registry, $event, $prio, $cb) = @_;
250 268
251 use sort 'stable'; 269 use sort 'stable';
252 270
253 $cb = [$prio, $cb]; 271 $cb = [$prio, $cb];
254 272
255 @{$registry->[$event]} = sort 273 @{$registry->[$event]} = sort
256 { $a->[0] cmp $b->[0] } 274 { $a->[0] cmp $b->[0] }
257 @{$registry->[$event] || []}, $cb; 275 @{$registry->[$event] || []}, $cb;
258
259 push @{$undo->{cb}}, [$event, $cb];
260} 276}
261 277
262# attach handles attaching event callbacks 278# attach handles attaching event callbacks
263# the only thing the caller has to do is pass the correct 279# the only thing the caller has to do is pass the correct
264# registry (== where the callback attaches to). 280# registry (== where the callback attaches to).
265sub _attach(\@$@) { 281sub _attach {
266 my ($registry, $klass, @arg) = @_; 282 my ($registry, $klass, @arg) = @_;
267 283
284 my $object_type;
268 my $prio = 0; 285 my $prio = 0;
269
270 my %undo = (
271 registry => $registry,
272 cb => [],
273 );
274
275 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT; 286 my %cb_id = map +("on_" . lc $EVENT[$_][0], $_) , grep $EVENT[$_][1] == $klass, 0 .. $#EVENT;
276 287
277 while (@arg) { 288 while (@arg) {
278 my $type = shift @arg; 289 my $type = shift @arg;
279 290
280 if ($type eq "prio") { 291 if ($type eq "prio") {
281 $prio = shift @arg; 292 $prio = shift @arg;
282 293
294 } elsif ($type eq "type") {
295 $object_type = shift @arg;
296 $registry = $CB_TYPE[$object_type] ||= [];
297
298 } elsif ($type eq "subtype") {
299 defined $object_type or Carp::croak "subtype specified without type";
300 my $object_subtype = shift @arg;
301 $registry = $CB_TYPE[$object_type + $object_subtype * NUM_SUBTYPES] ||= [];
302
283 } elsif ($type eq "package") { 303 } elsif ($type eq "package") {
284 my $pkg = shift @arg; 304 my $pkg = shift @arg;
285 305
286 while (my ($name, $id) = each %cb_id) { 306 while (my ($name, $id) = each %cb_id) {
287 if (my $cb = $pkg->can ($name)) { 307 if (my $cb = $pkg->can ($name)) {
288 _attach_cb $registry, %undo, $id, $prio, $cb; 308 _attach_cb $registry, $id, $prio, $cb;
289 } 309 }
290 } 310 }
291 311
292 } elsif (exists $cb_id{$type}) { 312 } elsif (exists $cb_id{$type}) {
293 _attach_cb $registry, %undo, $cb_id{$type}, $prio, shift @arg; 313 _attach_cb $registry, $cb_id{$type}, $prio, shift @arg;
294 314
295 } elsif (ref $type) { 315 } elsif (ref $type) {
296 warn "attaching objects not supported, ignoring.\n"; 316 warn "attaching objects not supported, ignoring.\n";
297 317
298 } else { 318 } else {
299 shift @arg; 319 shift @arg;
300 warn "attach argument '$type' not supported, ignoring.\n"; 320 warn "attach argument '$type' not supported, ignoring.\n";
301 } 321 }
302 } 322 }
303
304 \%undo
305} 323}
306 324
307sub _attach_attachment { 325sub _object_attach {
308 my ($obj, $name, %arg) = @_; 326 my ($obj, $name, %arg) = @_;
309 327
310 return if exists $obj->{_attachment}{$name}; 328 return if exists $obj->{_attachment}{$name};
311
312 my $res;
313 329
314 if (my $attach = $attachment{$name}) { 330 if (my $attach = $attachment{$name}) {
315 my $registry = $obj->registry; 331 my $registry = $obj->registry;
316 332
317 for (@$attach) { 333 for (@$attach) {
318 my ($klass, @attach) = @$_; 334 my ($klass, @attach) = @$_;
319 $res = _attach @$registry, $klass, @attach; 335 _attach $registry, $klass, @attach;
320 } 336 }
321 337
322 $obj->{$name} = \%arg; 338 $obj->{$name} = \%arg;
323 } else { 339 } else {
324 warn "object uses attachment '$name' that is not available, postponing.\n"; 340 warn "object uses attachment '$name' that is not available, postponing.\n";
325 } 341 }
326 342
327 $obj->{_attachment}{$name} = undef; 343 $obj->{_attachment}{$name} = undef;
328
329 $res->{attachment} = $name;
330 $res
331} 344}
332 345
333*cf::object::attach = 346sub cf::attachable::attach {
334*cf::player::attach = 347 if (ref $_[0]) {
335*cf::map::attach = sub { 348 _object_attach @_;
336 my ($obj, $name, %arg) = @_; 349 } else {
337 350 _attach shift->_attach_registry, @_;
338 _attach_attachment $obj, $name, %arg; 351 }
339}; 352};
340 353
341# all those should be optimised 354# all those should be optimised
342*cf::object::detach = 355sub cf::attachable::detach {
343*cf::player::detach =
344*cf::map::detach = sub {
345 my ($obj, $name) = @_; 356 my ($obj, $name) = @_;
346 357
358 if (ref $obj) {
347 delete $obj->{_attachment}{$name}; 359 delete $obj->{_attachment}{$name};
348 reattach ($obj); 360 reattach ($obj);
361 } else {
362 Carp::croak "cannot, currently, detach class attachments";
363 }
349}; 364};
350 365
351*cf::object::attached = 366sub cf::attachable::attached {
352*cf::player::attached =
353*cf::map::attached = sub {
354 my ($obj, $name) = @_; 367 my ($obj, $name) = @_;
355 368
356 exists $obj->{_attachment}{$name} 369 exists $obj->{_attachment}{$name}
357};
358
359sub attach_global {
360 _attach @CB_GLOBAL, KLASS_GLOBAL, @_
361} 370}
362 371
363sub attach_to_type { 372for my $klass (qw(GLOBAL OBJECT PLAYER CLIENT MAP)) {
364 my $type = shift; 373 eval "#line " . __LINE__ . " 'cf.pm'
365 my $subtype = shift; 374 sub cf::\L$klass\E::_attach_registry {
375 (\\\@CB_$klass, KLASS_$klass)
376 }
366 377
367 _attach @{$CB_TYPE[$type + $subtype * NUM_SUBTYPES]}, KLASS_OBJECT, @_ 378 sub cf::\L$klass\E::attachment {
368}
369
370sub attach_to_objects {
371 _attach @CB_OBJECT, KLASS_OBJECT, @_
372}
373
374sub attach_to_players {
375 _attach @CB_PLAYER, KLASS_PLAYER, @_
376}
377
378sub attach_to_maps {
379 _attach @CB_MAP, KLASS_MAP, @_
380}
381
382sub register_attachment {
383 my $name = shift; 379 my \$name = shift;
384 380
385 $attachment{$name} = [[KLASS_OBJECT, @_]];
386}
387
388sub register_player_attachment {
389 my $name = shift;
390
391 $attachment{$name} = [[KLASS_PLAYER, @_]];
392}
393
394sub register_map_attachment {
395 my $name = shift;
396
397 $attachment{$name} = [[KLASS_MAP, @_]]; 381 \$attachment{\$name} = [[KLASS_$klass, \@_]];
382 }
383 ";
384 die if $@;
398} 385}
399 386
400our $override; 387our $override;
401our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals? 388our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
402 389
… …
432 419
433=item $bool = $object->invoke (EVENT_OBJECT_XXX, ...) 420=item $bool = $object->invoke (EVENT_OBJECT_XXX, ...)
434 421
435=item $bool = $player->invoke (EVENT_PLAYER_XXX, ...) 422=item $bool = $player->invoke (EVENT_PLAYER_XXX, ...)
436 423
424=item $bool = $client->invoke (EVENT_CLIENT_XXX, ...)
425
437=item $bool = $map->invoke (EVENT_MAP_XXX, ...) 426=item $bool = $map->invoke (EVENT_MAP_XXX, ...)
438 427
439Generate a global/object/player/map-specific event with the given arguments. 428Generate a global/object/player/map-specific event with the given arguments.
440 429
441This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be 430This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be
… …
446 435
447=cut 436=cut
448 437
449############################################################################# 438#############################################################################
450 439
451=head2 METHODS VALID FOR ALL CORE OBJECTS 440=head2 METHODS VALID FOR ALL ATTACHABLE OBJECTS
441
442Attachable objects includes objects, players, clients and maps.
452 443
453=over 4 444=over 4
454 445
455=item $object->valid, $player->valid, $map->valid 446=item $object->valid
456 447
457Just because you have a perl object does not mean that the corresponding 448Just because you have a perl object does not mean that the corresponding
458C-level object still exists. If you try to access an object that has no 449C-level object still exists. If you try to access an object that has no
459valid C counterpart anymore you get an exception at runtime. This method 450valid C counterpart anymore you get an exception at runtime. This method
460can be used to test for existence of the C object part without causing an 451can be used to test for existence of the C object part without causing an
… …
462 453
463=back 454=back
464 455
465=cut 456=cut
466 457
467*cf::object::valid =
468*cf::player::valid =
469*cf::map::valid = \&cf::_valid;
470
471############################################################################# 458#############################################################################
472# object support 459# object support
473 460
474sub instantiate { 461sub instantiate {
475 my ($obj, $data) = @_; 462 my ($obj, $data) = @_;
… …
494 481
495 for my $name (keys %{ $obj->{_attachment} || {} }) { 482 for my $name (keys %{ $obj->{_attachment} || {} }) {
496 if (my $attach = $attachment{$name}) { 483 if (my $attach = $attachment{$name}) {
497 for (@$attach) { 484 for (@$attach) {
498 my ($klass, @attach) = @$_; 485 my ($klass, @attach) = @$_;
499 _attach @$registry, $klass, @attach; 486 _attach $registry, $klass, @attach;
500 } 487 }
501 } else { 488 } else {
502 warn "object uses attachment '$name' that is not available, postponing.\n"; 489 warn "object uses attachment '$name' that is not available, postponing.\n";
503 } 490 }
504 } 491 }
… …
560 } 547 }
561 548
562 () 549 ()
563} 550}
564 551
565attach_to_objects 552cf::object->attach (
566 prio => -1000000, 553 prio => -1000000,
567 on_clone => sub { 554 on_clone => sub {
568 my ($src, $dst) = @_; 555 my ($src, $dst) = @_;
569 556
570 @{$dst->registry} = @{$src->registry}; 557 @{$dst->registry} = @{$src->registry};
… …
572 %$dst = %$src; 559 %$dst = %$src;
573 560
574 %{$dst->{_attachment}} = %{$src->{_attachment}} 561 %{$dst->{_attachment}} = %{$src->{_attachment}}
575 if exists $src->{_attachment}; 562 if exists $src->{_attachment};
576 }, 563 },
577; 564);
578 565
579############################################################################# 566#############################################################################
580# command handling &c 567# command handling &c
581 568
582=item cf::register_command $name => \&callback($ob,$args); 569=item cf::register_command $name => \&callback($ob,$args);
… …
611 #warn "registering extcmd '$name' to '$caller'"; 598 #warn "registering extcmd '$name' to '$caller'";
612 599
613 $EXTCMD{$name} = [$cb, $caller]; 600 $EXTCMD{$name} = [$cb, $caller];
614} 601}
615 602
616attach_to_players 603cf::player->attach (
617 on_command => sub { 604 on_command => sub {
618 my ($pl, $name, $params) = @_; 605 my ($pl, $name, $params) = @_;
619 606
620 my $cb = $COMMAND{$name} 607 my $cb = $COMMAND{$name}
621 or return; 608 or return;
… …
641 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 628 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
642 } 629 }
643 630
644 cf::override; 631 cf::override;
645 }, 632 },
646; 633);
647 634
648sub register { 635sub register {
649 my ($base, $pkg) = @_; 636 my ($base, $pkg) = @_;
650 637
651 #TODO 638 #TODO
… …
720 707
721 Symbol::delete_package $pkg; 708 Symbol::delete_package $pkg;
722} 709}
723 710
724sub load_extensions { 711sub load_extensions {
725 my $LIBDIR = maps_directory "perl";
726
727 for my $ext (<$LIBDIR/*.ext>) { 712 for my $ext (<$LIBDIR/*.ext>) {
728 next unless -r $ext; 713 next unless -r $ext;
729 eval { 714 eval {
730 load_extension $ext; 715 load_extension $ext;
731 1 716 1
… …
743 defined $path or return; 728 defined $path or return;
744 729
745 unlink "$path.pst"; 730 unlink "$path.pst";
746}; 731};
747 732
748attach_to_maps prio => -10000, package => cf::mapsupport::; 733cf::map->attach (prio => -10000, package => cf::mapsupport::);
749 734
750############################################################################# 735#############################################################################
751# load/save perl data associated with player->ob objects 736# load/save perl data associated with player->ob objects
752 737
753sub all_objects(@) { 738sub all_objects(@) {
754 @_, map all_objects ($_->inv), @_ 739 @_, map all_objects ($_->inv), @_
755} 740}
756 741
757# TODO: compatibility cruft, remove when no longer needed 742# TODO: compatibility cruft, remove when no longer needed
758attach_to_players 743cf::player->attach (
759 on_load => sub { 744 on_load => sub {
760 my ($pl, $path) = @_; 745 my ($pl, $path) = @_;
761 746
762 for my $o (all_objects $pl->ob) { 747 for my $o (all_objects $pl->ob) {
763 if (my $value = $o->get_ob_key_value ("_perl_data")) { 748 if (my $value = $o->get_ob_key_value ("_perl_data")) {
… …
765 750
766 %$o = %{ Storable::thaw pack "H*", $value }; 751 %$o = %{ Storable::thaw pack "H*", $value };
767 } 752 }
768 } 753 }
769 }, 754 },
770; 755);
771 756
772############################################################################# 757#############################################################################
773 758
774=head2 CORE EXTENSIONS 759=head2 CORE EXTENSIONS
775 760
… …
866 851
867=pod 852=pod
868 853
869The following fucntions and emthods are available within a safe environment: 854The following fucntions and emthods are available within a safe environment:
870 855
871 cf::object contr pay_amount pay_player 856 cf::object contr pay_amount pay_player map
872 cf::object::player player 857 cf::object::player player
873 cf::player peaceful 858 cf::player peaceful
859 cf::map trigger
874 860
875=cut 861=cut
876 862
877for ( 863for (
878 ["cf::object" => qw(contr pay_amount pay_player)], 864 ["cf::object" => qw(contr pay_amount pay_player map)],
879 ["cf::object::player" => qw(player)], 865 ["cf::object::player" => qw(player)],
880 ["cf::player" => qw(peaceful)], 866 ["cf::player" => qw(peaceful)],
867 ["cf::map" => qw(trigger)],
881) { 868) {
882 no strict 'refs'; 869 no strict 'refs';
883 my ($pkg, @funs) = @$_; 870 my ($pkg, @funs) = @$_;
884 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 871 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
885 for @funs; 872 for @funs;
… …
1049 $DB->{$_[0]} = $_[1]; 1036 $DB->{$_[0]} = $_[1];
1050 } 1037 }
1051 db_dirty; 1038 db_dirty;
1052 } 1039 }
1053 1040
1054 attach_global 1041 cf::global->attach (
1055 prio => 10000, 1042 prio => 10000,
1056 on_cleanup => sub { 1043 on_cleanup => sub {
1057 db_sync; 1044 db_sync;
1058 }, 1045 },
1059 ; 1046 );
1060} 1047}
1061 1048
1062############################################################################# 1049#############################################################################
1063# the server's main() 1050# the server's main()
1064 1051
… …
1173}; 1160};
1174 1161
1175unshift @INC, $LIBDIR; 1162unshift @INC, $LIBDIR;
1176 1163
1177$TICK_WATCHER = Event->timer ( 1164$TICK_WATCHER = Event->timer (
1178 prio => 1, 1165 prio => 0,
1179 async => 1,
1180 at => $NEXT_TICK || 1, 1166 at => $NEXT_TICK || 1,
1181 data => WF_AUTOCANCEL, 1167 data => WF_AUTOCANCEL,
1182 cb => sub { 1168 cb => sub {
1183 cf::server_tick; # one server iteration 1169 cf::server_tick; # one server iteration
1184 1170

Diff Legend

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