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.298 by root, Sun Jul 8 14:50:07 2007 UTC vs.
Revision 1.306 by root, Sat Jul 14 14:33:30 2007 UTC

… …
29use Fcntl; 29use Fcntl;
30use YAML::Syck (); 30use YAML::Syck ();
31use IO::AIO 2.32 (); 31use IO::AIO 2.32 ();
32use Time::HiRes; 32use Time::HiRes;
33use Compress::LZF; 33use Compress::LZF;
34use Digest::MD5 ();
34 35
35# configure various modules to our taste 36# configure various modules to our taste
36# 37#
37$Storable::canonical = 1; # reduce rsync transfers 38$Storable::canonical = 1; # reduce rsync transfers
38Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator 39Coro::State::cctx_stacksize 256000; # 1-2MB stack, for deep recursions in maze generator
… …
409Coro::Storable. May, of course, block. Note that the executed sub may 410Coro::Storable. May, of course, block. Note that the executed sub may
410never block itself or use any form of Event handling. 411never block itself or use any form of Event handling.
411 412
412=cut 413=cut
413 414
415sub _store_scalar {
416 open my $fh, ">", \my $buf
417 or die "fork_call: cannot open fh-to-buf in child : $!";
418 Storable::store_fd $_[0], $fh;
419 close $fh;
420
421 $buf
422}
423
414sub fork_call(&@) { 424sub fork_call(&@) {
415 my ($cb, @args) = @_; 425 my ($cb, @args) = @_;
416 426
417# socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC 427# socketpair my $fh1, my $fh2, Socket::AF_UNIX, Socket::SOCK_STREAM, Socket::PF_UNSPEC
418# or die "socketpair: $!"; 428# or die "socketpair: $!";
… …
433 return wantarray ? @$res : $res->[-1]; 443 return wantarray ? @$res : $res->[-1];
434 } else { 444 } else {
435 reset_signals; 445 reset_signals;
436 local $SIG{__WARN__}; 446 local $SIG{__WARN__};
437 local $SIG{__DIE__}; 447 local $SIG{__DIE__};
448 # just in case, this hack effectively disables event
449 # in the child. cleaner and slower would be canceling all watchers,
450 # but this works for the time being.
438 local $Coro::idle; 451 local $Coro::idle;
439 $Coro::current->prio (Coro::PRIO_MAX); 452 $Coro::current->prio (Coro::PRIO_MAX);
453
440 eval { 454 eval {
441 close $fh1; 455 close $fh1;
442 456
443 my @res = eval { $cb->(@args) }; 457 my @res = eval { $cb->(@args) };
444 458
445 open my $fh, ">", \my $buf 459 syswrite $fh2, _store_scalar $@ ? \"$@" : \@res;
446 or die "fork_call: cannot open fh-to-buf in child : $!";
447 Storable::store_fd +($@ ? \"$@" : \@res), $fh;
448 close $fh;
449
450 warn "writing ", length $buf;
451 my $x;
452 (length $buf) == ($x = syswrite $fh2, $buf)
453 or warn "error writing ".(length $buf)." != $x\n";
454 close $fh2; 460 close $fh2;
455 }; 461 };
456 462
457 warn $@ if $@; 463 warn $@ if $@;
458 _exit 0; 464 _exit 0;
… …
1483 my ($path) = @_; 1489 my ($path) = @_;
1484 1490
1485 my ($match, $specificity); 1491 my ($match, $specificity);
1486 1492
1487 for my $region (list) { 1493 for my $region (list) {
1488 if ($region->match && $path =~ $region->match) { 1494 if ($region->{match} && $path =~ $region->{match}) {
1489 ($match, $specificity) = ($region, $region->specificity) 1495 ($match, $specificity) = ($region, $region->specificity)
1490 if $region->specificity > $specificity; 1496 if $region->specificity > $specificity;
1491 } 1497 }
1492 } 1498 }
1493 1499
… …
2250 2256
2251 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2257 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2252 $self->enter_map ($map, $x, $y); 2258 $self->enter_map ($map, $x, $y);
2253} 2259}
2254 2260
2255=item $player_object->goto ($path, $x, $y[, $check->($map)]) 2261=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]])
2256 2262
2257Moves the player to the given map-path and coordinates by first freezing 2263Moves the player to the given map-path and coordinates by first freezing
2258her, loading and preparing them map, calling the provided $check callback 2264her, loading and preparing them map, calling the provided $check callback
2259that has to return the map if sucecssful, and then unfreezes the player on 2265that has to return the map if sucecssful, and then unfreezes the player on
2260the new (success) or old (failed) map position. 2266the new (success) or old (failed) map position. In either case, $done will
2267be called at the end of this process.
2261 2268
2262=cut 2269=cut
2263 2270
2264our $GOTOGEN; 2271our $GOTOGEN;
2265 2272
2266sub cf::object::player::goto { 2273sub cf::object::player::goto {
2267 my ($self, $path, $x, $y, $check) = @_; 2274 my ($self, $path, $x, $y, $check, $done) = @_;
2268 2275
2269 # do generation counting so two concurrent goto's will be executed in-order 2276 # do generation counting so two concurrent goto's will be executed in-order
2270 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2277 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2271 2278
2272 $self->enter_link; 2279 $self->enter_link;
… …
2292 2299
2293 if ($gen == $self->{_goto_generation}) { 2300 if ($gen == $self->{_goto_generation}) {
2294 delete $self->{_goto_generation}; 2301 delete $self->{_goto_generation};
2295 $self->leave_link ($map, $x, $y); 2302 $self->leave_link ($map, $x, $y);
2296 } 2303 }
2304
2305 $done->() if $done;
2297 })->prio (1); 2306 })->prio (1);
2298} 2307}
2299 2308
2300=item $player_object->enter_exit ($exit_object) 2309=item $player_object->enter_exit ($exit_object)
2301 2310
… …
2459=cut 2468=cut
2460 2469
2461sub cf::client::ext_event($$%) { 2470sub cf::client::ext_event($$%) {
2462 my ($self, $type, %msg) = @_; 2471 my ($self, $type, %msg) = @_;
2463 2472
2473 return unless $self->extcmd;
2474
2464 $msg{msgtype} = "event_$type"; 2475 $msg{msgtype} = "event_$type";
2465 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg)); 2476 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2466} 2477}
2467 2478
2468=item $success = $client->query ($flags, "text", \&cb) 2479=item $success = $client->query ($flags, "text", \&cb)
… …
2714 { 2725 {
2715 my $faces = $facedata->{faceinfo}; 2726 my $faces = $facedata->{faceinfo};
2716 2727
2717 while (my ($face, $info) = each %$faces) { 2728 while (my ($face, $info) = each %$faces) {
2718 my $idx = (cf::face::find $face) || cf::face::alloc $face; 2729 my $idx = (cf::face::find $face) || cf::face::alloc $face;
2719 cf::face::set $idx, $info->{visibility}, $info->{magicmap}; 2730 cf::face::set_visibility $idx, $info->{visibility};
2731 cf::face::set_magicmap $idx, $info->{magicmap};
2720 cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32}; 2732 cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32};
2721 cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64}; 2733 cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64};
2722 Coro::cede; 2734
2735 cf::cede_to_tick;
2723 } 2736 }
2724 2737
2725 while (my ($face, $info) = each %$faces) { 2738 while (my ($face, $info) = each %$faces) {
2726 next unless $info->{smooth}; 2739 next unless $info->{smooth};
2727 my $idx = cf::face::find $face 2740 my $idx = cf::face::find $face
2728 or next; 2741 or next;
2729 if (my $smooth = cf::face::find $info->{smooth}) { 2742 if (my $smooth = cf::face::find $info->{smooth}) {
2743 cf::face::set_smooth $idx, $smooth;
2730 cf::face::set_smooth $idx, $smooth, $info->{smoothlevel}; 2744 cf::face::set_smoothlevel $idx, $info->{smoothlevel};
2731 } else { 2745 } else {
2732 warn "smooth face '$info->{smooth}' not found for face '$face'"; 2746 warn "smooth face '$info->{smooth}' not found for face '$face'";
2733 } 2747 }
2734 Coro::cede; 2748
2749 cf::cede_to_tick;
2735 } 2750 }
2736 } 2751 }
2737 2752
2738 { 2753 {
2739 my $anims = $facedata->{animinfo}; 2754 my $anims = $facedata->{animinfo};
2740 2755
2741 while (my ($anim, $info) = each %$anims) { 2756 while (my ($anim, $info) = each %$anims) {
2742 cf::anim::set $anim, $info->{frames}, $info->{facings}; 2757 cf::anim::set $anim, $info->{frames}, $info->{facings};
2743 Coro::cede; 2758 cf::cede_to_tick;
2744 } 2759 }
2745 2760
2746 cf::anim::invalidate_all; # d'oh 2761 cf::anim::invalidate_all; # d'oh
2762 }
2763
2764 {
2765 # TODO: for gcfclient pleasure, we should give resources
2766 # that gcfclient doesn't grok a >10000 face index.
2767 my $res = $facedata->{resource};
2768 my $enc = JSON::XS->new->utf8->canonical;
2769
2770 while (my ($name, $info) = each %$res) {
2771 my $meta = $enc->encode ({
2772 name => $name,
2773 type => $info->{type},
2774 copyright => $info->{copyright}, #TODO#
2775 });
2776 my $data = pack "(w/a*)*", $meta, $info->{data};
2777 my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
2778
2779 my $idx = (cf::face::find $name) || cf::face::alloc $name;
2780 cf::face::set_type $idx, 1;
2781 cf::face::set_data $idx, 0, $data, $chk;
2782
2783 cf::cede_to_tick;
2784 }
2747 } 2785 }
2748 2786
2749 1 2787 1
2750} 2788}
2751 2789
2752sub reload_regions { 2790sub reload_regions {
2753 load_resource_file "$MAPDIR/regions" 2791 load_resource_file "$MAPDIR/regions"
2754 or die "unable to load regions file\n"; 2792 or die "unable to load regions file\n";
2793
2794 for (cf::region::list) {
2795 $_->{match} = qr/$_->{match}/
2796 if exists $_->{match};
2797 }
2755} 2798}
2756 2799
2757sub reload_facedata { 2800sub reload_facedata {
2758 load_facedata "$DATADIR/facedata" 2801 load_facedata "$DATADIR/facedata"
2759 or die "unable to load facedata\n"; 2802 or die "unable to load facedata\n";

Diff Legend

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