--- deliantra/server/lib/cf.pm 2008/12/23 06:58:23 1.462 +++ deliantra/server/lib/cf.pm 2009/06/26 16:32:10 1.473 @@ -23,7 +23,7 @@ use 5.10.0; use utf8; -use strict "vars", "subs"; +use strict qw(vars subs); use Symbol; use List::Util; @@ -107,13 +107,15 @@ our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) our $NEXT_RUNTIME_WRITE; # when should the runtime file be written our $NEXT_TICK; -our $USE_FSYNC = 1; # use fsync to write maps - default off +our $USE_FSYNC = 1; # use fsync to write maps - default on our $BDB_DEADLOCK_WATCHER; our $BDB_CHECKPOINT_WATCHER; our $BDB_TRICKLE_WATCHER; our $DB_ENV; +our @EXTRA_MODULES = qw(pod mapscript); + our %CFG; our $UPTIME; $UPTIME ||= time; @@ -146,6 +148,8 @@ $RUNTIME = <$fh> + 0.; } +eval "sub TICK() { $TICK } 1" or die; + mkdir $_ for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR; @@ -1149,7 +1153,10 @@ if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { aio_chmod $fh, SAVE_MODE; aio_write $fh, 0, (length $$rdata), $$rdata, 0; - aio_fsync $fh if $cf::USE_FSYNC; + if ($cf::USE_FSYNC) { + aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER; + aio_fsync $fh; + } aio_close $fh; if (@$objs) { @@ -1157,7 +1164,10 @@ aio_chmod $fh, SAVE_MODE; my $data = Coro::Storable::nfreeze { version => 1, objs => $objs }; aio_write $fh, 0, (length $data), $data, 0; - aio_fsync $fh if $cf::USE_FSYNC; + if ($cf::USE_FSYNC) { + aio_sync_file_range $fh, 0, 0, IO::AIO::SYNC_FILE_RANGE_WAIT_BEFORE | IO::AIO::SYNC_FILE_RANGE_WRITE | IO::AIO::SYNC_FILE_RANGE_WAIT_AFTER; + aio_fsync $fh; + } aio_close $fh; aio_rename "$filename.pst~", "$filename.pst"; } @@ -1318,7 +1328,7 @@ sub cache_extensions { my $grp = IO::AIO::aio_group; - add $grp IO::AIO::aio_readdir $LIBDIR, sub { + add $grp IO::AIO::aio_readdirx $LIBDIR, IO::AIO::READDIR_STAT_ORDER, sub { for (grep /\.ext$/, @{$_[0]}) { add $grp IO::AIO::aio_load "$LIBDIR/$_", my $data; } @@ -2386,7 +2396,7 @@ id => "say", title => "Map", reply => "say ", - tooltip => "Things said to and replied from npcs near you and other players on the same map only.", + tooltip => "Things said to and replied from NPCs near you and other players on the same map only.", }; our $CHAT_CHANNEL = { @@ -2771,12 +2781,42 @@ reply => undef, tooltip => "Shows which body parts you posess and are available", }, + "c/statistics" => { + id => "infobox", + title => "Statistics", + reply => undef, + tooltip => "Shows your primary statistics", + }, "c/skills" => { id => "infobox", title => "Skills", reply => undef, tooltip => "Shows your experience per skill and item power", }, + "c/shopitems" => { + id => "infobox", + title => "Shop Items", + reply => undef, + tooltip => "Shows the items currently for sale in this shop", + }, + "c/resistances" => { + id => "infobox", + title => "Resistances", + reply => undef, + tooltip => "Shows your resistances", + }, + "c/pets" => { + id => "infobox", + title => "Pets", + reply => undef, + tooltip => "Shows information abotu your pets/a specific pet", + }, + "c/perceiveself" => { + id => "infobox", + title => "Perceive Self", + reply => undef, + tooltip => "You gained detailed knowledge about yourself", + }, "c/uptime" => { id => "infobox", title => "Uptime", @@ -2795,6 +2835,12 @@ reply => "gsay ", tooltip => "Messages and chat related to your party", }, + "c/death" => { + id => "death", + title => "Death", + reply => undef, + tooltip => "Reason for and more info about your most recent death", + }, "c/say" => $SAY_CHANNEL, "c/chat" => $CHAT_CHANNEL, ); @@ -2811,17 +2857,14 @@ if ($CHANNEL{$channel}) { $channel = $CHANNEL{$channel}; - $self->ext_msg (channel_info => $channel) - if $self->can_msg; - + $self->ext_msg (channel_info => $channel); $channel = $channel->{id}; } elsif (ref $channel) { # send meta info to client, if not yet sent unless (exists $self->{channel}{$channel->{id}}) { $self->{channel}{$channel->{id}} = $channel; - $self->ext_msg (channel_info => $channel) - if $self->can_msg; + $self->ext_msg (channel_info => $channel); } $channel = $channel->{id}; @@ -2829,52 +2872,26 @@ return unless @extra || length $msg; - if ($self->can_msg) { - # default colour, mask it out - $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) - if $color & cf::NDI_DEF; - - my $pkt = "msg " - . $self->{json_coder}->encode ( - [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] - ); - - # try lzf for large packets - $pkt = "lzf " . Compress::LZF::compress $pkt - if 1024 <= length $pkt and $self->{can_lzf}; - - # split very large packets - if (8192 < length $pkt and $self->{can_lzf}) { - $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt; - $pkt = "frag"; - } - - $self->send_packet ($pkt); - } else { - if ($color >= 0) { - # replace some tags by gcfclient-compatible ones - for ($msg) { - 1 while - s/([^<]*)<\/b>/[b]${1}[\/b]/ - || s/([^<]*)<\/i>/[i]${1}[\/i]/ - || s/([^<]*)<\/u>/[ul]${1}[\/ul]/ - || s/([^<]*)<\/tt>/[fixed]${1}[\/fixed]/ - || s/([^<]*)<\/fg>/[color=$1]${2}[\/color]/; - } - - $color &= cf::NDI_COLOR_MASK; - - utf8::encode $msg; - - if (0 && $msg =~ /\[/) { - # COMMAND/INFO - $self->send_packet ("drawextinfo $color 10 8 $msg") - } else { - $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g; - $self->send_packet ("drawinfo $color $msg") - } - } + # default colour, mask it out + $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) + if $color & cf::NDI_DEF; + + my $pkt = "msg " + . $self->{json_coder}->encode ( + [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] + ); + + # try lzf for large packets + $pkt = "lzf " . Compress::LZF::compress $pkt + if 1024 <= length $pkt and $self->{can_lzf}; + + # split very large packets + if (8192 < length $pkt and $self->{can_lzf}) { + $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt; + $pkt = "frag"; } + + $self->send_packet ($pkt); } =item $client->ext_msg ($type, @msg) @@ -3059,6 +3076,7 @@ cf::object contr pay_amount pay_player map x y force_find force_add destroy insert remove name archname title slaying race decrease split + value cf::object::player player @@ -3074,9 +3092,9 @@ for ( ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y insert remove inv nrof name archname title slaying race - decrease split destroy change_exp)], + decrease split destroy change_exp value msg lore send_msg)], ["cf::object::player" => qw(player)], - ["cf::player" => qw(peaceful)], + ["cf::player" => qw(peaceful send_msg)], ["cf::map" => qw(trigger)], ) { no strict 'refs'; @@ -3104,6 +3122,8 @@ $qcode =~ s/"/‟/g; # not allowed in #line filenames $qcode =~ s/\n/\\n/g; + %vars = (_dummy => 0) unless %vars; + local $_; local @safe::cf::_safe_eval_args = values %vars; @@ -3700,7 +3720,7 @@ warn "unloading cf.pm \"a bit\""; delete $INC{"cf.pm"}; - delete $INC{"cf/pod.pm"}; + delete $INC{"cf/$_.pm"} for @EXTRA_MODULES; # don't, removes xs symbols, too, # and global variables created in xs @@ -3927,7 +3947,7 @@ } # load additional modules -use cf::pod; +require "cf/$_.pm" for @EXTRA_MODULES; END { cf::emergency_save }