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.332 by root, Sat Aug 18 17:33:53 2007 UTC vs.
Revision 1.355 by root, Sun Sep 2 12:45:44 2007 UTC

… …
21use Coro::Semaphore; 21use Coro::Semaphore;
22use Coro::AIO; 22use Coro::AIO;
23use Coro::Storable; 23use Coro::Storable;
24use Coro::Util (); 24use Coro::Util ();
25 25
26use JSON::XS 1.4 (); 26use JSON::XS ();
27use BDB (); 27use BDB ();
28use Data::Dumper; 28use Data::Dumper;
29use Digest::MD5; 29use Digest::MD5;
30use Fcntl; 30use Fcntl;
31use YAML::Syck (); 31use YAML::Syck ();
… …
272Wait until the given lock is available and then acquires it and returns 272Wait until the given lock is available and then acquires it and returns
273a Coro::guard object. If the guard object gets destroyed (goes out of scope, 273a Coro::guard object. If the guard object gets destroyed (goes out of scope,
274for example when the coroutine gets canceled), the lock is automatically 274for example when the coroutine gets canceled), the lock is automatically
275returned. 275returned.
276 276
277Locks are *not* recursive, locking from the same coro twice results in a
278deadlocked coro.
279
277Lock names should begin with a unique identifier (for example, cf::map::find 280Lock names should begin with a unique identifier (for example, cf::map::find
278uses map_find and cf::map::load uses map_load). 281uses map_find and cf::map::load uses map_load).
279 282
280=item $locked = cf::lock_active $string 283=item $locked = cf::lock_active $string
281 284
… …
478sub fork_call(&@) { 481sub fork_call(&@) {
479 my ($cb, @args) = @_; 482 my ($cb, @args) = @_;
480 483
481 # 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,
482 # otherwise perl prematurely frees the stuff :/ 485 # otherwise perl prematurely frees the stuff :/
483 # TODO: investigate and fix (liekly this will be rather laborious) 486 # TODO: investigate and fix (likely this will be rather laborious)
484 487
485 my @res = Coro::Util::fork_eval { 488 my @res = Coro::Util::fork_eval {
486 reset_signals; 489 reset_signals;
487 &$cb 490 &$cb
488 }, @args; 491 }, @args;
… …
575 if (1) { 578 if (1) {
576 $md5 = 579 $md5 =
577 join "\x00", 580 join "\x00",
578 $processversion, 581 $processversion,
579 map { 582 map {
580 Coro::cede; 583 cf::cede_to_tick;
581 ($src->[$_], Digest::MD5::md5_hex $data[$_]) 584 ($src->[$_], Digest::MD5::md5_hex $data[$_])
582 } 0.. $#$src; 585 } 0.. $#$src;
583 586
584 587
585 my $dbmd5 = db_get cache => "$id/md5"; 588 my $dbmd5 = db_get cache => "$id/md5";
… …
1149 my ($type, $reply, @payload) = 1152 my ($type, $reply, @payload) =
1150 "ARRAY" eq ref $msg 1153 "ARRAY" eq ref $msg
1151 ? @$msg 1154 ? @$msg
1152 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove 1155 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
1153 1156
1157 my @reply;
1158
1154 if (my $cb = $EXTCMD{$type}) { 1159 if (my $cb = $EXTCMD{$type}) {
1155 my @reply = $cb->($pl, @payload); 1160 @reply = $cb->($pl, @payload);
1156
1157 $pl->ext_reply ($reply, @reply)
1158 if $reply;
1159 } 1161 }
1162
1163 $pl->ext_reply ($reply, @reply)
1164 if $reply;
1165
1160 } else { 1166 } else {
1161 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1167 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
1162 } 1168 }
1163 1169
1164 cf::override; 1170 cf::override;
… …
1319 1325
1320 aio_mkdir playerdir $pl, 0770; 1326 aio_mkdir playerdir $pl, 0770;
1321 $pl->{last_save} = $cf::RUNTIME; 1327 $pl->{last_save} = $cf::RUNTIME;
1322 1328
1323 $pl->save_pl ($path); 1329 $pl->save_pl ($path);
1324 Coro::cede; 1330 cf::cede_to_tick;
1325} 1331}
1326 1332
1327sub new($) { 1333sub new($) {
1328 my ($login) = @_; 1334 my ($login) = @_;
1329 1335
… …
1407 or return []; 1413 or return [];
1408 1414
1409 my @logins; 1415 my @logins;
1410 1416
1411 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") {
1412 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; 1422 my $fh = aio_open $path, Fcntl::O_RDONLY, 0 or next;
1413 aio_read $fh, 0, 512, my $buf, 0 or next; 1423 aio_read $fh, 0, 512, my $buf, 0 or next;
1414 $buf !~ /^password -------------$/m or next; # official not-valid tag 1424 $buf !~ /^password -------------$/m or next; # official not-valid tag
1425 }
1415 1426
1416 utf8::decode $login; 1427 utf8::decode $login;
1417 push @logins, $login; 1428 push @logins, $login;
1418 } 1429 }
1419 1430
… …
1457sub expand_cfpod { 1468sub expand_cfpod {
1458 ((my $self), (local $_)) = @_; 1469 ((my $self), (local $_)) = @_;
1459 1470
1460 # escape & and < 1471 # escape & and <
1461 s/&/&amp;/g; 1472 s/&/&amp;/g;
1462 s/(?<![BIUGH])</&lt;/g; 1473 s/(?<![BIUGHT])</&lt;/g;
1463 1474
1464 # 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
1465 1476
1466 1 while 1477 1 while
1467 # replace B<>, I<>, U<> etc. 1478 # replace B<>, I<>, U<> etc.
1468 s/B<([^\>]*)>/<b>$1<\/b>/ 1479 s/B<([^\>]*)>/<b>$1<\/b>/
1469 || s/I<([^\>]*)>/<i>$1<\/i>/ 1480 || s/I<([^\>]*)>/<i>$1<\/i>/
1470 || s/U<([^\>]*)>/<u>$1<\/u>/ 1481 || s/U<([^\>]*)>/<u>$1<\/u>/
1482 || s/T<([^\>]*)>/<big><b>$1<\/b><\/big>/
1471 # replace G<male|female> tags 1483 # replace G<male|female> tags
1472 || s{G<([^>|]*)\|([^>]*)>}{ 1484 || s{G<([^>|]*)\|([^>]*)>}{
1473 $self->gender ? $2 : $1 1485 $self->gender ? $2 : $1
1474 }ge 1486 }ge
1475 # replace H<hint text> 1487 # replace H<hint text>
… …
1505=cut 1517=cut
1506 1518
1507sub ext_reply($$@) { 1519sub ext_reply($$@) {
1508 my ($self, $id, @msg) = @_; 1520 my ($self, $id, @msg) = @_;
1509 1521
1510 if ($self->ns->extcmd == 2) { 1522 $self->ns->ext_reply ($id, @msg)
1511 $self->send ("ext " . $self->ns->{json_coder}->encode (["reply-$id", @msg]));
1512 } elsif ($self->ns->extcmd == 1) {
1513 #TODO: version 1, remove
1514 unshift @msg, msgtype => "reply", msgid => $id;
1515 $self->send ("ext " . $self->ns->{json_coder}->encode ({@msg}));
1516 }
1517} 1523}
1518 1524
1519=item $player->ext_msg ($type, @msg) 1525=item $player->ext_msg ($type, @msg)
1520 1526
1521Sends an ext event to the client. 1527Sends an ext event to the client.
… …
1852 local $self->{deny_reset} = 1; # loading can take a long time 1858 local $self->{deny_reset} = 1; # loading can take a long time
1853 1859
1854 my $path = $self->{path}; 1860 my $path = $self->{path};
1855 1861
1856 { 1862 {
1863 my $guard1 = cf::lock_acquire "map_data:$path";
1857 my $guard = cf::lock_acquire "map_load:$path"; 1864 my $guard2 = cf::lock_acquire "map_load:$path";
1858 1865
1859 return if $self->in_memory != cf::MAP_SWAPPED; 1866 return if $self->in_memory != cf::MAP_SWAPPED;
1860 1867
1861 $self->in_memory (cf::MAP_LOADING); 1868 $self->in_memory (cf::MAP_LOADING);
1862 1869
1863 $self->alloc; 1870 $self->alloc;
1864 1871
1865 $self->pre_load; 1872 $self->pre_load;
1866 Coro::cede; 1873 cf::cede_to_tick;
1867 1874
1868 $self->_load_objects ($self->{load_path}, 1) 1875 $self->_load_objects ($self->{load_path}, 1)
1869 or return; 1876 or return;
1870 1877
1871 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) 1878 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
… …
1877 $self->clear_unique_items; 1884 $self->clear_unique_items;
1878 $self->_load_objects ($uniq, 0); 1885 $self->_load_objects ($uniq, 0);
1879 } 1886 }
1880 } 1887 }
1881 1888
1882 Coro::cede; 1889 cf::cede_to_tick;
1883 # now do the right thing for maps 1890 # now do the right thing for maps
1884 $self->link_multipart_objects; 1891 $self->link_multipart_objects;
1885 $self->difficulty ($self->estimate_difficulty) 1892 $self->difficulty ($self->estimate_difficulty)
1886 unless $self->difficulty; 1893 unless $self->difficulty;
1887 Coro::cede; 1894 cf::cede_to_tick;
1888 1895
1889 unless ($self->{deny_activate}) { 1896 unless ($self->{deny_activate}) {
1890 $self->decay_objects; 1897 $self->decay_objects;
1891 $self->fix_auto_apply; 1898 $self->fix_auto_apply;
1892 $self->update_buttons; 1899 $self->update_buttons;
1893 Coro::cede; 1900 cf::cede_to_tick;
1894 $self->set_darkness_map; 1901 $self->set_darkness_map;
1895 Coro::cede; 1902 cf::cede_to_tick;
1896 $self->activate; 1903 $self->activate;
1897 } 1904 }
1898 1905
1899 $self->{last_save} = $cf::RUNTIME; 1906 $self->{last_save} = $cf::RUNTIME;
1900 $self->last_access ($cf::RUNTIME); 1907 $self->last_access ($cf::RUNTIME);
… …
1916 1923
1917 $self 1924 $self
1918} 1925}
1919 1926
1920# find and load all maps in the 3x3 area around a map 1927# find and load all maps in the 3x3 area around a map
1921sub load_diag { 1928sub load_neighbours {
1922 my ($map) = @_; 1929 my ($map) = @_;
1923 1930
1924 my @diag; # diagonal neighbours 1931 my @neigh; # diagonal neighbours
1925 1932
1926 for (0 .. 3) { 1933 for (0 .. 3) {
1927 my $neigh = $map->tile_path ($_) 1934 my $neigh = $map->tile_path ($_)
1928 or next; 1935 or next;
1929 $neigh = find $neigh, $map 1936 $neigh = find $neigh, $map
1930 or next; 1937 or next;
1931 $neigh->load; 1938 $neigh->load;
1932 1939
1940 push @neigh,
1933 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh], 1941 [$neigh->tile_path (($_ + 3) % 4), $neigh],
1934 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 1942 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1935 } 1943 }
1936 1944
1937 for (@diag) { 1945 for (grep defined $_->[0], @neigh) {
1946 my ($path, $origin) = @$_;
1938 my $neigh = find @$_ 1947 my $neigh = find $path, $origin
1939 or next; 1948 or next;
1940 $neigh->load; 1949 $neigh->load;
1941 } 1950 }
1942} 1951}
1943 1952
… …
1948} 1957}
1949 1958
1950sub do_load_sync { 1959sub do_load_sync {
1951 my ($map) = @_; 1960 my ($map) = @_;
1952 1961
1962 cf::LOG cf::llevDebug | cf::logBacktrace, "do_load_sync"
1963 if $Coro::current == $Coro::main;
1964
1953 cf::sync_job { $map->load }; 1965 cf::sync_job { $map->load };
1954} 1966}
1955 1967
1956our %MAP_PREFETCH; 1968our %MAP_PREFETCH;
1957our $MAP_PREFETCHER = undef; 1969our $MAP_PREFETCHER = undef;
1958 1970
1959sub find_async { 1971sub find_async {
1960 my ($path, $origin) = @_; 1972 my ($path, $origin, $load) = @_;
1961 1973
1962 $path = normalise $path, $origin && $origin->{path}; 1974 $path = normalise $path, $origin && $origin->{path};
1963 1975
1964 if (my $map = $cf::MAP{$path}) { 1976 if (my $map = $cf::MAP{$path}) {
1965 return $map if $map->in_memory == cf::MAP_IN_MEMORY; 1977 return $map if !$load || $map->in_memory == cf::MAP_IN_MEMORY;
1966 } 1978 }
1967 1979
1968 undef $MAP_PREFETCH{$path}; 1980 $MAP_PREFETCH{$path} |= $load;
1981
1969 $MAP_PREFETCHER ||= cf::async { 1982 $MAP_PREFETCHER ||= cf::async {
1970 while (%MAP_PREFETCH) { 1983 while (%MAP_PREFETCH) {
1971 for my $path (keys %MAP_PREFETCH) { 1984 while (my ($k, $v) = each %MAP_PREFETCH) {
1972 if (my $map = find $path) { 1985 if (my $map = find $k) {
1973 $map->load; 1986 $map->load if $v;
1974 } 1987 }
1975 1988
1976 delete $MAP_PREFETCH{$path}; 1989 delete $MAP_PREFETCH{$k};
1977 } 1990 }
1978 } 1991 }
1979 undef $MAP_PREFETCHER; 1992 undef $MAP_PREFETCHER;
1980 }; 1993 };
1981 $MAP_PREFETCHER->prio (6); 1994 $MAP_PREFETCHER->prio (6);
… …
1984} 1997}
1985 1998
1986sub save { 1999sub save {
1987 my ($self) = @_; 2000 my ($self) = @_;
1988 2001
1989 my $lock = cf::lock_acquire "map_data:" . $self->path; 2002 my $lock = cf::lock_acquire "map_data:$self->{path}";
1990 2003
1991 $self->{last_save} = $cf::RUNTIME; 2004 $self->{last_save} = $cf::RUNTIME;
1992 2005
1993 return unless $self->dirty; 2006 return unless $self->dirty;
1994 2007
… …
2017 my ($self) = @_; 2030 my ($self) = @_;
2018 2031
2019 # save first because save cedes 2032 # save first because save cedes
2020 $self->save; 2033 $self->save;
2021 2034
2022 my $lock = cf::lock_acquire "map_data:" . $self->path; 2035 my $lock = cf::lock_acquire "map_data:$self->{path}";
2023 2036
2024 return if $self->players; 2037 return if $self->players;
2025 return if $self->in_memory != cf::MAP_IN_MEMORY; 2038 return if $self->in_memory != cf::MAP_IN_MEMORY;
2026 return if $self->{deny_save}; 2039 return if $self->{deny_save};
2027 2040
… …
2079my $nuke_counter = "aaaa"; 2092my $nuke_counter = "aaaa";
2080 2093
2081sub nuke { 2094sub nuke {
2082 my ($self) = @_; 2095 my ($self) = @_;
2083 2096
2097 {
2098 my $lock = cf::lock_acquire "map_data:$self->{path}";
2099
2084 delete $cf::MAP{$self->path}; 2100 delete $cf::MAP{$self->path};
2085 2101
2086 $self->unlink_save; 2102 $self->unlink_save;
2087 2103
2088 bless $self, "cf::map"; 2104 bless $self, "cf::map";
2089 delete $self->{deny_reset}; 2105 delete $self->{deny_reset};
2090 $self->{deny_save} = 1; 2106 $self->{deny_save} = 1;
2091 $self->reset_timeout (1); 2107 $self->reset_timeout (1);
2092 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2108 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2093 2109
2094 $cf::MAP{$self->path} = $self; 2110 $cf::MAP{$self->path} = $self;
2111 }
2095 2112
2096 $self->reset; # polite request, might not happen 2113 $self->reset; # polite request, might not happen
2097} 2114}
2098 2115
2099=item $maps = cf::map::tmp_maps 2116=item $maps = cf::map::tmp_maps
… …
2312 # use -1 or undef as default coordinates, not 0, 0 2329 # use -1 or undef as default coordinates, not 0, 0
2313 ($x, $y) = ($map->enter_x, $map->enter_y) 2330 ($x, $y) = ($map->enter_x, $map->enter_y)
2314 if $x <=0 && $y <= 0; 2331 if $x <=0 && $y <= 0;
2315 2332
2316 $map->load; 2333 $map->load;
2317 $map->load_diag; 2334 $map->load_neighbours;
2318 2335
2319 return unless $self->contr->active; 2336 return unless $self->contr->active;
2320 $self->activate_recursive; 2337 $self->activate_recursive;
2321 2338
2322 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2339 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
… …
2493the 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
2494the message unless the client supports the msg packet. 2511the message unless the client supports the msg packet.
2495 2512
2496=cut 2513=cut
2497 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
2498sub cf::client::send_msg { 2530sub cf::client::send_msg {
2499 my ($self, $channel, $msg, $color, @extra) = @_; 2531 my ($self, $channel, $msg, $color, @extra) = @_;
2500 2532
2501 $msg = $self->pl->expand_cfpod ($msg); 2533 $msg = $self->pl->expand_cfpod ($msg);
2502 2534
2503 $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};
2504 2539
2505 if (ref $channel) { 2540 if (ref $channel) {
2506 # send meta info to client, if not yet sent 2541 # send meta info to client, if not yet sent
2507 unless (exists $self->{channel}{$channel->{id}}) { 2542 unless (exists $self->{channel}{$channel->{id}}) {
2508 $self->{channel}{$channel->{id}} = $channel; 2543 $self->{channel}{$channel->{id}} = $channel;
2509 $self->ext_msg (channel_info => $channel); 2544 $self->ext_msg (channel_info => $channel)
2545 if $self->can_msg;
2510 } 2546 }
2511 2547
2512 $channel = $channel->{id}; 2548 $channel = $channel->{id};
2513 } 2549 }
2514 2550
… …
2555=cut 2591=cut
2556 2592
2557sub cf::client::ext_msg($$@) { 2593sub cf::client::ext_msg($$@) {
2558 my ($self, $type, @msg) = @_; 2594 my ($self, $type, @msg) = @_;
2559 2595
2560 my $extcmd = $self->extcmd;
2561
2562 if ($extcmd == 2) { 2596 if ($self->extcmd == 2) {
2563 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg])); 2597 $self->send_packet ("ext " . $self->{json_coder}->encode ([$type, @msg]));
2564 } elsif ($extcmd == 1) { # TODO: remove 2598 } elsif ($self->extcmd == 1) { # TODO: remove
2565 push @msg, msgtype => "event_$type"; 2599 push @msg, msgtype => "event_$type";
2600 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2601 }
2602}
2603
2604=item $client->ext_reply ($msgid, @msg)
2605
2606Sends an ext reply to the client.
2607
2608=cut
2609
2610sub cf::client::ext_reply($$@) {
2611 my ($self, $id, @msg) = @_;
2612
2613 if ($self->extcmd == 2) {
2614 $self->send_packet ("ext " . $self->{json_coder}->encode (["reply-$id", @msg]));
2615 } elsif ($self->extcmd == 1) {
2616 #TODO: version 1, remove
2617 unshift @msg, msgtype => "reply", msgid => $id;
2566 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg})); 2618 $self->send_packet ("ext " . $self->{json_coder}->encode ({@msg}));
2567 } 2619 }
2568} 2620}
2569 2621
2570=item $success = $client->query ($flags, "text", \&cb) 2622=item $success = $client->query ($flags, "text", \&cb)
… …
2632 my ($type, $reply, @payload) = 2684 my ($type, $reply, @payload) =
2633 "ARRAY" eq ref $msg 2685 "ARRAY" eq ref $msg
2634 ? @$msg 2686 ? @$msg
2635 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove 2687 : ($msg->{msgtype}, $msg->{msgid}, %$msg); # TODO: version 1, remove
2636 2688
2689 my @reply;
2690
2637 if (my $cb = $EXTICMD{$type}) { 2691 if (my $cb = $EXTICMD{$type}) {
2638 my @reply = $cb->($ns, @payload); 2692 @reply = $cb->($ns, @payload);
2639
2640 $ns->ext_reply ($reply, @reply)
2641 if $reply;
2642 } 2693 }
2694
2695 $ns->ext_reply ($reply, @reply)
2696 if $reply;
2697
2643 } else { 2698 } else {
2644 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 2699 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
2645 } 2700 }
2646 2701
2647 cf::override; 2702 cf::override;
… …
2708 2763
2709The following functions and methods are available within a safe environment: 2764The following functions and methods are available within a safe environment:
2710 2765
2711 cf::object 2766 cf::object
2712 contr pay_amount pay_player map x y force_find force_add 2767 contr pay_amount pay_player map x y force_find force_add
2713 insert remove name archname title slaying race 2768 insert remove name archname title slaying race decrease_ob_nr
2714 2769
2715 cf::object::player 2770 cf::object::player
2716 player 2771 player
2717 2772
2718 cf::player 2773 cf::player
… …
2723 2778
2724=cut 2779=cut
2725 2780
2726for ( 2781for (
2727 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 2782 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
2728 insert remove inv name archname title slaying race)], 2783 insert remove inv name archname title slaying race
2784 decrease_ob_nr)],
2729 ["cf::object::player" => qw(player)], 2785 ["cf::object::player" => qw(player)],
2730 ["cf::player" => qw(peaceful)], 2786 ["cf::player" => qw(peaceful)],
2731 ["cf::map" => qw(trigger)], 2787 ["cf::map" => qw(trigger)],
2732) { 2788) {
2733 no strict 'refs'; 2789 no strict 'refs';
… …
2809# the server's init and main functions 2865# the server's init and main functions
2810 2866
2811sub load_facedata($) { 2867sub load_facedata($) {
2812 my ($path) = @_; 2868 my ($path) = @_;
2813 2869
2870 # HACK to clear player env face cache, we need some signal framework
2871 # for this (global event?)
2872 %ext::player_env::MUSIC_FACE_CACHE = ();
2873
2874 my $enc = JSON::XS->new->utf8->canonical->relaxed;
2875
2814 warn "loading facedata from $path\n"; 2876 warn "loading facedata from $path\n";
2815 2877
2816 my $facedata; 2878 my $facedata;
2817 0 < aio_load $path, $facedata 2879 0 < aio_load $path, $facedata
2818 or die "$path: $!"; 2880 or die "$path: $!";
2819 2881
2820 $facedata = Coro::Storable::thaw $facedata; 2882 $facedata = Coro::Storable::thaw $facedata;
2821 2883
2822 $facedata->{version} == 2 2884 $facedata->{version} == 2
2823 or cf::cleanup "$path: version mismatch, cannot proceed."; 2885 or cf::cleanup "$path: version mismatch, cannot proceed.";
2886
2887 # patch in the exptable
2888 $facedata->{resource}{"res/exp_table"} = {
2889 type => FT_RSRC,
2890 data => $enc->encode ([map cf::level_to_min_exp $_, 1 .. cf::settings->max_level]),
2891 };
2892 cf::cede_to_tick;
2824 2893
2825 { 2894 {
2826 my $faces = $facedata->{faceinfo}; 2895 my $faces = $facedata->{faceinfo};
2827 2896
2828 while (my ($face, $info) = each %$faces) { 2897 while (my ($face, $info) = each %$faces) {
2829 my $idx = (cf::face::find $face) || cf::face::alloc $face; 2898 my $idx = (cf::face::find $face) || cf::face::alloc $face;
2830 cf::face::set_visibility $idx, $info->{visibility}; 2899 cf::face::set_visibility $idx, $info->{visibility};
2831 cf::face::set_magicmap $idx, $info->{magicmap}; 2900 cf::face::set_magicmap $idx, $info->{magicmap};
2832 cf::face::set_data $idx, 0, $info->{data32}, $info->{chksum32}; 2901 cf::face::set_data $idx, 0, $info->{data32}, Digest::MD5::md5 $info->{data32};
2833 cf::face::set_data $idx, 1, $info->{data64}, $info->{chksum64}; 2902 cf::face::set_data $idx, 1, $info->{data64}, Digest::MD5::md5 $info->{data64};
2834 2903
2835 cf::cede_to_tick; 2904 cf::cede_to_tick;
2836 } 2905 }
2837 2906
2838 while (my ($face, $info) = each %$faces) { 2907 while (my ($face, $info) = each %$faces) {
… …
2863 2932
2864 { 2933 {
2865 # TODO: for gcfclient pleasure, we should give resources 2934 # TODO: for gcfclient pleasure, we should give resources
2866 # that gcfclient doesn't grok a >10000 face index. 2935 # that gcfclient doesn't grok a >10000 face index.
2867 my $res = $facedata->{resource}; 2936 my $res = $facedata->{resource};
2868 my $enc = JSON::XS->new->utf8->canonical;
2869 2937
2870 my $soundconf = delete $res->{"res/sound.conf"}; 2938 my $soundconf = delete $res->{"res/sound.conf"};
2871 2939
2872 while (my ($name, $info) = each %$res) { 2940 while (my ($name, $info) = each %$res) {
2873 my $meta = $enc->encode ({
2874 name => $name,
2875 %{ $info->{meta} || {} },
2876 });
2877
2878 my $idx = (cf::face::find $name) || cf::face::alloc $name; 2941 my $idx = (cf::face::find $name) || cf::face::alloc $name;
2942 my $data;
2879 2943
2880 if ($info->{type} & 1) { 2944 if ($info->{type} & 1) {
2881 # prepend meta info 2945 # prepend meta info
2882 2946
2947 my $meta = $enc->encode ({
2948 name => $name,
2949 %{ $info->{meta} || {} },
2950 });
2951
2883 my $data = pack "(w/a*)*", $meta, $info->{data}; 2952 $data = pack "(w/a*)*", $meta, $info->{data};
2884 my $chk = Digest::MD5::md5 "$info->{chksum},$meta"; # mangle data checksum and metadata
2885
2886 cf::face::set_data $idx, 0, $data, $chk;
2887 } else { 2953 } else {
2888 cf::face::set_data $idx, 0, $info->{data}, $info->{chksum}; 2954 $data = $info->{data};
2889 } 2955 }
2890 2956
2957 cf::face::set_data $idx, 0, $data, Digest::MD5::md5 $data;
2891 cf::face::set_type $idx, $info->{type}; 2958 cf::face::set_type $idx, $info->{type};
2892 2959
2893 cf::cede_to_tick; 2960 cf::cede_to_tick;
2894 } 2961 }
2895 2962
… …
2922 $ns->fx_want ($k, $v); 2989 $ns->fx_want ($k, $v);
2923 } 2990 }
2924}; 2991};
2925 2992
2926sub reload_regions { 2993sub reload_regions {
2994 # HACK to clear player env face cache, we need some signal framework
2995 # for this (global event?)
2996 %ext::player_env::MUSIC_FACE_CACHE = ();
2997
2927 load_resource_file "$MAPDIR/regions" 2998 load_resource_file "$MAPDIR/regions"
2928 or die "unable to load regions file\n"; 2999 or die "unable to load regions file\n";
2929 3000
2930 for (cf::region::list) { 3001 for (cf::region::list) {
2931 $_->{match} = qr/$_->{match}/ 3002 $_->{match} = qr/$_->{match}/
… …
2967 3038
2968sub init { 3039sub init {
2969 reload_resources; 3040 reload_resources;
2970} 3041}
2971 3042
2972sub cfg_load { 3043sub reload_config {
2973 open my $fh, "<:utf8", "$CONFDIR/config" 3044 open my $fh, "<:utf8", "$CONFDIR/config"
2974 or return; 3045 or return;
2975 3046
2976 local $/; 3047 local $/;
2977 *CFG = YAML::Syck::Load <$fh>; 3048 *CFG = YAML::Syck::Load <$fh>;
… …
2997 (async { 3068 (async {
2998 Event::one_event; 3069 Event::one_event;
2999 })->prio (Coro::PRIO_MAX); 3070 })->prio (Coro::PRIO_MAX);
3000 }; 3071 };
3001 3072
3002 cfg_load; 3073 reload_config;
3003 db_init; 3074 db_init;
3004 load_extensions; 3075 load_extensions;
3005 3076
3006 $TICK_WATCHER->start; 3077 $TICK_WATCHER->start;
3007 Event::loop; 3078 Event::loop;
… …
3200 warn "reloading cf.pm"; 3271 warn "reloading cf.pm";
3201 require cf; 3272 require cf;
3202 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 3273 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
3203 3274
3204 warn "loading config and database again"; 3275 warn "loading config and database again";
3205 cf::cfg_load; 3276 cf::reload_config;
3206 3277
3207 warn "loading extensions"; 3278 warn "loading extensions";
3208 cf::load_extensions; 3279 cf::load_extensions;
3209 3280
3210 warn "reattaching attachments to objects/players"; 3281 warn "reattaching attachments to objects/players";

Diff Legend

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