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.348 by root, Thu Aug 30 08:34:40 2007 UTC vs.
Revision 1.355 by root, Sun Sep 2 12:45:44 2007 UTC

… …
481sub fork_call(&@) { 481sub fork_call(&@) {
482 my ($cb, @args) = @_; 482 my ($cb, @args) = @_;
483 483
484 # we seemingly have to make a local copy of the whole thing, 484 # we seemingly have to make a local copy of the whole thing,
485 # otherwise perl prematurely frees the stuff :/ 485 # otherwise perl prematurely frees the stuff :/
486 # TODO: investigate and fix (liekly this will be rather laborious) 486 # TODO: investigate and fix (likely this will be rather laborious)
487 487
488 my @res = Coro::Util::fork_eval { 488 my @res = Coro::Util::fork_eval {
489 reset_signals; 489 reset_signals;
490 &$cb 490 &$cb
491 }, @args; 491 }, @args;
… …
1413 or return []; 1413 or return [];
1414 1414
1415 my @logins; 1415 my @logins;
1416 1416
1417 for my $login (@$dirs) { 1417 for my $login (@$dirs) {
1418 my $path = path $login;
1419
1420 # a .pst is a dead give-away for a valid player
1421 unless (-e "$path.pst") {
1418 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; 1422 my $fh = aio_open $path, Fcntl::O_RDONLY, 0 or next;
1419 aio_read $fh, 0, 512, my $buf, 0 or next; 1423 aio_read $fh, 0, 512, my $buf, 0 or next;
1420 $buf !~ /^password -------------$/m or next; # official not-valid tag 1424 $buf !~ /^password -------------$/m or next; # official not-valid tag
1425 }
1421 1426
1422 utf8::decode $login; 1427 utf8::decode $login;
1423 push @logins, $login; 1428 push @logins, $login;
1424 } 1429 }
1425 1430
… …
1463sub expand_cfpod { 1468sub expand_cfpod {
1464 ((my $self), (local $_)) = @_; 1469 ((my $self), (local $_)) = @_;
1465 1470
1466 # escape & and < 1471 # escape & and <
1467 s/&/&amp;/g; 1472 s/&/&amp;/g;
1468 s/(?<![BIUGH])</&lt;/g; 1473 s/(?<![BIUGHT])</&lt;/g;
1469 1474
1470 # this is buggy, it needs to properly take care of nested <'s 1475 # this is buggy, it needs to properly take care of nested <'s
1471 1476
1472 1 while 1477 1 while
1473 # replace B<>, I<>, U<> etc. 1478 # replace B<>, I<>, U<> etc.
1474 s/B<([^\>]*)>/<b>$1<\/b>/ 1479 s/B<([^\>]*)>/<b>$1<\/b>/
1475 || s/I<([^\>]*)>/<i>$1<\/i>/ 1480 || s/I<([^\>]*)>/<i>$1<\/i>/
1476 || s/U<([^\>]*)>/<u>$1<\/u>/ 1481 || s/U<([^\>]*)>/<u>$1<\/u>/
1482 || s/T<([^\>]*)>/<big><b>$1<\/b><\/big>/
1477 # replace G<male|female> tags 1483 # replace G<male|female> tags
1478 || s{G<([^>|]*)\|([^>]*)>}{ 1484 || s{G<([^>|]*)\|([^>]*)>}{
1479 $self->gender ? $2 : $1 1485 $self->gender ? $2 : $1
1480 }ge 1486 }ge
1481 # replace H<hint text> 1487 # replace H<hint text>
… …
2086my $nuke_counter = "aaaa"; 2092my $nuke_counter = "aaaa";
2087 2093
2088sub nuke { 2094sub nuke {
2089 my ($self) = @_; 2095 my ($self) = @_;
2090 2096
2097 {
2098 my $lock = cf::lock_acquire "map_data:$self->{path}";
2099
2091 delete $cf::MAP{$self->path}; 2100 delete $cf::MAP{$self->path};
2092 2101
2093 $self->unlink_save; 2102 $self->unlink_save;
2094 2103
2095 bless $self, "cf::map"; 2104 bless $self, "cf::map";
2096 delete $self->{deny_reset}; 2105 delete $self->{deny_reset};
2097 $self->{deny_save} = 1; 2106 $self->{deny_save} = 1;
2098 $self->reset_timeout (1); 2107 $self->reset_timeout (1);
2099 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2108 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2100 2109
2101 $cf::MAP{$self->path} = $self; 2110 $cf::MAP{$self->path} = $self;
2111 }
2102 2112
2103 $self->reset; # polite request, might not happen 2113 $self->reset; # polite request, might not happen
2104} 2114}
2105 2115
2106=item $maps = cf::map::tmp_maps 2116=item $maps = cf::map::tmp_maps
… …
2500the message, with C<log> being the default. If C<$color> is negative, suppress 2510the message, with C<log> being the default. If C<$color> is negative, suppress
2501the message unless the client supports the msg packet. 2511the message unless the client supports the msg packet.
2502 2512
2503=cut 2513=cut
2504 2514
2515our %CHANNEL = (
2516 "c/identify" => {
2517 id => "identify",
2518 title => "Identify",
2519 reply => undef,
2520 tooltip => "Items recently identified",
2521 },
2522 "c/examine" => {
2523 id => "examine",
2524 title => "Examine",
2525 reply => undef,
2526 tooltip => "Signs and other items you examined",
2527 },
2528);
2529
2505sub cf::client::send_msg { 2530sub cf::client::send_msg {
2506 my ($self, $channel, $msg, $color, @extra) = @_; 2531 my ($self, $channel, $msg, $color, @extra) = @_;
2507 2532
2508 $msg = $self->pl->expand_cfpod ($msg); 2533 $msg = $self->pl->expand_cfpod ($msg);
2509 2534
2510 $color &= cf::NDI_CLIENT_MASK; # just in case... 2535 $color &= cf::NDI_CLIENT_MASK; # just in case...
2536
2537 # check predefined channels, for the benefit of C
2538 $channel = $CHANNEL{$channel} if $CHANNEL{$channel};
2511 2539
2512 if (ref $channel) { 2540 if (ref $channel) {
2513 # send meta info to client, if not yet sent 2541 # send meta info to client, if not yet sent
2514 unless (exists $self->{channel}{$channel->{id}}) { 2542 unless (exists $self->{channel}{$channel->{id}}) {
2515 $self->{channel}{$channel->{id}} = $channel; 2543 $self->{channel}{$channel->{id}} = $channel;
2516 $self->ext_msg (channel_info => $channel); 2544 $self->ext_msg (channel_info => $channel)
2545 if $self->can_msg;
2517 } 2546 }
2518 2547
2519 $channel = $channel->{id}; 2548 $channel = $channel->{id};
2520 } 2549 }
2521 2550

Diff Legend

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