1 | #! perl |
1 | #! perl # MANDATORY |
2 | |
2 | |
3 | # login handling |
3 | # login handling |
4 | |
4 | |
5 | use Fcntl; |
5 | use Fcntl; |
6 | use Coro::AIO; |
6 | use Coro::AIO; |
… | |
… | |
55 | } |
55 | } |
56 | |
56 | |
57 | sub check_clean_save { |
57 | sub check_clean_save { |
58 | my ($pl) = @_; |
58 | my ($pl) = @_; |
59 | |
59 | |
60 | unless (delete $pl->{clean_save}) { |
60 | if (my $time = delete $pl->{unclean_save}) { |
|
|
61 | $pl->ns->send_drawinfo ( |
|
|
62 | "You didn't use a savebed to leave this realm. This is very dangerous, " |
|
|
63 | . "as lots of things could happen when you leave by other means, such as cave-ins, " |
|
|
64 | . "or monsters suddenly snapping your body. Better use a savebed next time.", |
|
|
65 | cf::NDI_RED |
|
|
66 | ); |
61 | #d#TODO |
67 | #d#TODO |
62 | } |
68 | } |
63 | } |
69 | } |
64 | |
70 | |
65 | # delete a player directory, be non-blocking AND synchronous... |
71 | # delete a player directory, be non-blocking AND synchronous... |
… | |
… | |
156 | nuke_str $pass; |
162 | nuke_str $pass; |
157 | # password matches, wonderful |
163 | # password matches, wonderful |
158 | my $pl = cf::player::find $user or next; |
164 | my $pl = cf::player::find $user or next; |
159 | $pl->connect ($ns); |
165 | $pl->connect ($ns); |
160 | check_clean_save $pl; |
166 | check_clean_save $pl; |
161 | $pl->{clean_save} = 1; |
|
|
162 | last; |
167 | last; |
163 | } elsif (can_cleanup $pl, $mtime) { |
168 | } elsif (can_cleanup $pl, $mtime) { |
164 | Coro::Timer::sleep 1; |
169 | Coro::Timer::sleep 1; |
165 | |
170 | |
166 | $ns->send_drawinfo ( |
171 | $ns->send_drawinfo ( |
… | |
… | |
294 | |
299 | |
295 | my $pl = $ob->contr; |
300 | my $pl = $ob->contr; |
296 | |
301 | |
297 | # update respawn position |
302 | # update respawn position |
298 | $pl->savebed ($bed->map->path, $bed->x, $bed->y); |
303 | $pl->savebed ($bed->map->path, $bed->x, $bed->y); |
|
|
304 | cf::async { $pl->save }; |
299 | |
305 | |
300 | $pl->killer ("left"); |
306 | $pl->killer ("left"); |
301 | $ob->check_score; |
307 | $ob->check_score; |
302 | |
308 | |
303 | $ob->reply (undef, "In the future, you will wake up here when you die."); |
309 | $ob->reply (undef, "In the future, you will wake up here when you die."); |
… | |
… | |
327 | |
333 | |
328 | if ($cleanly) { |
334 | if ($cleanly) { |
329 | $_->ob->message ("$name left the game.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
335 | $_->ob->message ("$name left the game.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
330 | } else { |
336 | } else { |
331 | $_->ob->message ("$name uncerimoniously disconnected.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
337 | $_->ob->message ("$name uncerimoniously disconnected.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list; |
332 | delete $pl->{clean_save}; |
338 | $pl->{unclean_save} = $cf::RUNTIME; |
333 | } |
339 | } |
334 | }, |
340 | }, |
335 | ); |
341 | ); |
336 | |
342 | |
337 | cf::client->attach ( |
343 | cf::client->attach ( |
338 | on_addme => \&addme, |
344 | on_addme => \&addme, |
339 | ); |
345 | ); |
340 | |
346 | |
341 | ############################################################################# |
347 | ############################################################################# |
342 | |
348 | |
343 | our $SCHEDULE_INTERVAL = 10; # time the player scheduler sleeps between runs |
349 | our $SCHEDULE_INTERVAL = 10; # time the player scheduler sleeps between runs |
344 | our $SAVE_TIMEOUT = 200; # save players every n seconds |
350 | our $SAVE_TIMEOUT = 20; # save players every n seconds |
345 | our $SAVE_INTERVAL = 1.1; # save at max. one player every $SAVE_INTERVAL |
|
|
346 | |
351 | |
347 | our $SCHEDULER = cf::async_ext { |
352 | our $SCHEDULER = cf::async_ext { |
|
|
353 | my $schedule_interval = Coro::Event->timer (after => 1, interval => $SCHEDULE_INTERVAL); |
348 | while () { |
354 | while () { |
349 | Coro::Timer::sleep $SCHEDULE_INTERVAL; |
355 | $schedule_interval->next; |
350 | |
356 | |
351 | # this weird form of iteration over values is used because |
357 | # this weird form of iteration over values is used because |
352 | # the hash changes underneath us frequently, and for |
358 | # the hash changes underneath us frequently, and for |
353 | # keeps a direct reference to the value without (in 5.8 perls) |
359 | # keeps a direct reference to the value without (in 5.8 perls) |
354 | # keeping a reference, so this is prone to crashes or worse. |
360 | # keeping a reference, so this is prone to crashes or worse. |
… | |
… | |
358 | or next; |
364 | or next; |
359 | $pl->valid or next; |
365 | $pl->valid or next; |
360 | |
366 | |
361 | eval { |
367 | eval { |
362 | if ($pl->{last_save} + $SAVE_TIMEOUT <= $cf::RUNTIME) { |
368 | if ($pl->{last_save} + $SAVE_TIMEOUT <= $cf::RUNTIME) { |
|
|
369 | $cf::WAIT_FOR_TICK_ONE->wait; |
363 | $pl->save; |
370 | $pl->save; |
364 | Coro::Timer::sleep $SAVE_INTERVAL; |
|
|
365 | } |
|
|
366 | |
371 | |
367 | unless ($pl->active) { |
372 | unless ($pl->active) { |
368 | # check refcounts, this is tricky and needs to be adjusted to fit server internals |
373 | # check refcounts, this is tricky and needs to be adjusted to fit server internals |
369 | my $ob = $pl->ob; |
374 | my $ob = $pl->ob; |
370 | Scalar::Util::weaken $pl; |
375 | Scalar::Util::weaken $pl; |
371 | Scalar::Util::weaken $ob; |
376 | Scalar::Util::weaken $ob; |
372 | my $a_ = $pl->refcnt; |
377 | my $a_ = $pl->refcnt;#d# |
373 | my $b_ = $ob->refcnt; |
378 | my $b_ = $ob->refcnt;#d# |
374 | my $pl_ref = $pl->refcnt_cnt; |
379 | my $pl_ref = $pl->refcnt_cnt; |
375 | my $ob_ref = $ob->refcnt_cnt; |
380 | my $ob_ref = $ob->refcnt_cnt; |
376 | |
381 | |
377 | if ($pl_ref == 2 && $ob_ref == 1) { |
|
|
378 | warn "player-scheduler destroy ", $ob->name;#d# |
|
|
379 | #delete $cf::PLAYER{$ob->name}; |
|
|
380 | ## pl_ref == one from object + one from cf::PLAYER |
382 | ## pl_ref == one from object + one from cf::PLAYER |
381 | ## ob_ref == one from simply being an object |
383 | ## ob_ref == one from simply being an object |
|
|
384 | if ($pl_ref == 2 && $ob_ref == 1) { |
|
|
385 | warn "player-scheduler destroy ", $ob->name;#d# |
|
|
386 | |
|
|
387 | # remove from sight and get fresh "copies" |
|
|
388 | $pl = delete $cf::PLAYER{$ob->name}; |
|
|
389 | $ob = $pl->ob; |
|
|
390 | |
382 | #$ob->destroy; |
391 | $ob->destroy; |
383 | #$pl->destroy; |
392 | $pl->destroy; |
384 | } else { |
393 | } else { |
385 | warn "player-scheduler refcnt ", $ob->name, " $pl_ref,$a_ $ob_ref,$b_\n";#d# |
394 | warn "player-scheduler refcnt ", $ob->name, " $pl_ref,$a_ $ob_ref,$b_\n";#d# |
|
|
395 | } |
386 | } |
396 | } |
387 | } |
397 | } |
388 | }; |
398 | }; |
389 | warn $@ if $@; |
399 | warn $@ if $@; |
390 | Coro::cede; |
400 | Coro::cede; |