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.417 by root, Fri Apr 11 14:09:57 2008 UTC vs.
Revision 1.427 by root, Sat Apr 26 12:25:45 2008 UTC

… …
427 } 427 }
428 } 428 }
429}; 429};
430 430
431sub get_slot($;$$) { 431sub get_slot($;$$) {
432 return if tick_inhibit || $Coro::current == $Coro::main;
433
432 my ($time, $pri, $name) = @_; 434 my ($time, $pri, $name) = @_;
433 435
434 $time = $TICK * .6 if $time > $TICK * .6; 436 $time = $TICK * .6 if $time > $TICK * .6;
435 my $sig = new Coro::Signal; 437 my $sig = new Coro::Signal;
436 438
… …
1139 utf8::decode (my $decname = $filename); 1141 utf8::decode (my $decname = $filename);
1140 warn sprintf "saving %s (%d,%d)\n", 1142 warn sprintf "saving %s (%d,%d)\n",
1141 $decname, length $$rdata, scalar @$objs; 1143 $decname, length $$rdata, scalar @$objs;
1142 1144
1143 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1145 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1144 chmod SAVE_MODE, $fh; 1146 aio_chmod $fh, SAVE_MODE;
1145 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1147 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1146 aio_fsync $fh if $cf::USE_FSYNC; 1148 aio_fsync $fh if $cf::USE_FSYNC;
1147 close $fh; 1149 aio_close $fh;
1148 1150
1149 if (@$objs) { 1151 if (@$objs) {
1150 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) { 1152 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
1151 chmod SAVE_MODE, $fh; 1153 aio_chmod $fh, SAVE_MODE;
1152 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs }; 1154 my $data = Coro::Storable::nfreeze { version => 1, objs => $objs };
1153 aio_write $fh, 0, (length $data), $data, 0; 1155 aio_write $fh, 0, (length $data), $data, 0;
1154 aio_fsync $fh if $cf::USE_FSYNC; 1156 aio_fsync $fh if $cf::USE_FSYNC;
1155 close $fh; 1157 aio_close $fh;
1156 aio_rename "$filename.pst~", "$filename.pst"; 1158 aio_rename "$filename.pst~", "$filename.pst";
1157 } 1159 }
1158 } else { 1160 } else {
1159 aio_unlink "$filename.pst"; 1161 aio_unlink "$filename.pst";
1160 } 1162 }
… …
1454 my $f = new_from_file cf::object::thawer path $login 1456 my $f = new_from_file cf::object::thawer path $login
1455 or return; 1457 or return;
1456 1458
1457 my $pl = cf::player::load_pl $f 1459 my $pl = cf::player::load_pl $f
1458 or return; 1460 or return;
1461
1459 local $cf::PLAYER_LOADING{$login} = $pl; 1462 local $cf::PLAYER_LOADING{$login} = $pl;
1460 $f->resolve_delayed_derefs; 1463 $f->resolve_delayed_derefs;
1461 $cf::PLAYER{$login} = $pl 1464 $cf::PLAYER{$login} = $pl
1462 } 1465 }
1463 } 1466 }
… …
1473 1476
1474 return if $pl->{deny_save}; 1477 return if $pl->{deny_save};
1475 1478
1476 aio_mkdir playerdir $pl, 0770; 1479 aio_mkdir playerdir $pl, 0770;
1477 $pl->{last_save} = $cf::RUNTIME; 1480 $pl->{last_save} = $cf::RUNTIME;
1481
1482 cf::get_slot 0.01;
1478 1483
1479 $pl->save_pl ($path); 1484 $pl->save_pl ($path);
1480 cf::cede_to_tick; 1485 cf::cede_to_tick;
1481} 1486}
1482 1487
… …
1566 1571
1567 for my $login (@$dirs) { 1572 for my $login (@$dirs) {
1568 my $path = path $login; 1573 my $path = path $login;
1569 1574
1570 # a .pst is a dead give-away for a valid player 1575 # a .pst is a dead give-away for a valid player
1571 unless (-e "$path.pst") { 1576 # if no pst file found, open and chekc for blocked users
1577 if (aio_stat "$path.pst") {
1572 my $fh = aio_open $path, Fcntl::O_RDONLY, 0 or next; 1578 my $fh = aio_open $path, Fcntl::O_RDONLY, 0 or next;
1573 aio_read $fh, 0, 512, my $buf, 0 or next; 1579 aio_read $fh, 0, 512, my $buf, 0 or next;
1574 $buf !~ /^password -------------$/m or next; # official not-valid tag 1580 $buf !~ /^password -------------$/m or next; # official not-valid tag
1575 } 1581 }
1576 1582
… …
1775our $MAX_RESET = 3600; 1781our $MAX_RESET = 3600;
1776our $DEFAULT_RESET = 3000; 1782our $DEFAULT_RESET = 3000;
1777 1783
1778sub generate_random_map { 1784sub generate_random_map {
1779 my ($self, $rmp) = @_; 1785 my ($self, $rmp) = @_;
1786
1787 my $lock = cf::lock_acquire "generate_random_map"; # the random map generator is NOT reentrant ATM
1788
1780 # mit "rum" bekleckern, nicht 1789 # mit "rum" bekleckern, nicht
1781 $self->_create_random_map ( 1790 $self->_create_random_map (
1782 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1791 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1783 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1792 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1784 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1793 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
… …
1906 1915
1907# the temporary/swap location 1916# the temporary/swap location
1908sub save_path { 1917sub save_path {
1909 my ($self) = @_; 1918 my ($self) = @_;
1910 1919
1911 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1920 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
1912 "$TMPDIR/$path.map" 1921 "$TMPDIR/$path.map"
1913} 1922}
1914 1923
1915# the unique path, undef == no special unique path 1924# the unique path, undef == no special unique path
1916sub uniq_path { 1925sub uniq_path {
1917 my ($self) = @_; 1926 my ($self) = @_;
1918 1927
1919 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 1928 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
1920 "$UNIQUEDIR/$path" 1929 "$UNIQUEDIR/$path"
1921} 1930}
1922 1931
1923# and all this just because we cannot iterate over 1932# and all this just because we cannot iterate over
1924# all maps in C++... 1933# all maps in C++...
… …
2110 } 2119 }
2111 2120
2112 $self->{last_save} = $cf::RUNTIME; 2121 $self->{last_save} = $cf::RUNTIME;
2113 $self->last_access ($cf::RUNTIME); 2122 $self->last_access ($cf::RUNTIME);
2114 2123
2115 $self->in_memory (cf::MAP_IN_MEMORY); 2124 $self->in_memory (cf::MAP_ACTIVE);
2116 } 2125 }
2117 2126
2118 $self->post_load; 2127 $self->post_load;
2119} 2128}
2120 2129
… …
2178 my ($path, $origin, $load) = @_; 2187 my ($path, $origin, $load) = @_;
2179 2188
2180 $path = normalise $path, $origin && $origin->{path}; 2189 $path = normalise $path, $origin && $origin->{path};
2181 2190
2182 if (my $map = $cf::MAP{$path}) { 2191 if (my $map = $cf::MAP{$path}) {
2183 return $map if !$load || $map->in_memory == cf::MAP_IN_MEMORY; 2192 return $map if !$load || $map->in_memory == cf::MAP_ACTIVE;
2184 } 2193 }
2185 2194
2186 $MAP_PREFETCH{$path} |= $load; 2195 $MAP_PREFETCH{$path} |= $load;
2187 2196
2188 $MAP_PREFETCHER ||= cf::async { 2197 $MAP_PREFETCHER ||= cf::async {
… …
2225 cf::async { 2234 cf::async {
2226 $Coro::current->{desc} = "map player save"; 2235 $Coro::current->{desc} = "map player save";
2227 $_->contr->save for $self->players; 2236 $_->contr->save for $self->players;
2228 }; 2237 };
2229 2238
2239 cf::get_slot 0.02;
2240
2230 if ($uniq) { 2241 if ($uniq) {
2231 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 2242 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
2232 $self->_save_objects ($uniq, cf::IO_UNIQUES); 2243 $self->_save_objects ($uniq, cf::IO_UNIQUES);
2233 } else { 2244 } else {
2234 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 2245 $self->_save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
… …
2242 $self->save; 2253 $self->save;
2243 2254
2244 my $lock = cf::lock_acquire "map_data:$self->{path}"; 2255 my $lock = cf::lock_acquire "map_data:$self->{path}";
2245 2256
2246 return if $self->players; 2257 return if $self->players;
2247 return if $self->in_memory != cf::MAP_IN_MEMORY; 2258 return if $self->in_memory != cf::MAP_ACTIVE;
2248 return if $self->{deny_save}; 2259 return if $self->{deny_save};
2249 2260
2250 $self->in_memory (cf::MAP_SWAPPED); 2261 $self->in_memory (cf::MAP_SWAPPED);
2251 2262
2252 $self->deactivate; 2263 $self->deactivate;
… …
2370 2381
2371sub unique_maps() { 2382sub unique_maps() {
2372 [ 2383 [
2373 map { 2384 map {
2374 utf8::decode $_; 2385 utf8::decode $_;
2375 /\.map$/ 2386 s/\.map$//; # TODO future compatibility hack
2387 /\.pst$/ || !/^$PATH_SEP/o # TODO unique maps apparebntly lack the .map suffix :/
2388 ? ()
2376 ? normalise $_ 2389 : normalise $_
2377 : ()
2378 } @{ aio_readdir $UNIQUEDIR or [] } 2390 } @{ aio_readdir $UNIQUEDIR or [] }
2379 ] 2391 ]
2380} 2392}
2381 2393
2382=back 2394=back
… …
2389 2401
2390=over 4 2402=over 4
2391 2403
2392=item $ob->inv_recursive 2404=item $ob->inv_recursive
2393 2405
2394Returns the inventory of the object _and_ their inventories, recursively. 2406Returns the inventory of the object I<and> their inventories, recursively,
2407but I<not> the object itself.
2395 2408
2396=cut 2409=cut
2397 2410
2398sub inv_recursive_; 2411sub inv_recursive_;
2399sub inv_recursive_ { 2412sub inv_recursive_ {
… …
2404 inv_recursive_ inv $_[0] 2417 inv_recursive_ inv $_[0]
2405} 2418}
2406 2419
2407=item $ref = $ob->ref 2420=item $ref = $ob->ref
2408 2421
2409creates and returns a persistent reference to an objetc that can be stored as a string. 2422Creates and returns a persistent reference to an object that can be stored as a string.
2410 2423
2411=item $ob = cf::object::deref ($refstring) 2424=item $ob = cf::object::deref ($refstring)
2412 2425
2413returns the objetc referenced by refstring. may return undef when it cnanot find the object, 2426returns the objetc referenced by refstring. may return undef when it cnanot find the object,
2414even if the object actually exists. May block. 2427even if the object actually exists. May block.
… …
2688 $rmp->{origin_y} = $exit->y; 2701 $rmp->{origin_y} = $exit->y;
2689 } 2702 }
2690 2703
2691 $rmp->{random_seed} ||= $exit->random_seed; 2704 $rmp->{random_seed} ||= $exit->random_seed;
2692 2705
2693 my $data = cf::encode_json $rmp; 2706 my $data = JSON::XS->new->utf8->pretty->canonical->encode ($rmp);
2694 my $md5 = Digest::MD5::md5_hex $data; 2707 my $md5 = Digest::MD5::md5_hex $data;
2695 my $meta = "$RANDOMDIR/$md5.meta"; 2708 my $meta = "$RANDOMDIR/$md5.meta";
2696 2709
2697 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) { 2710 if (my $fh = aio_open "$meta~", O_WRONLY | O_CREAT, 0666) {
2698 aio_write $fh, 0, (length $data), $data, 0; 2711 aio_write $fh, 0, (length $data), $data, 0;
… …
2821 id => "infobox", 2834 id => "infobox",
2822 title => "Map Info", 2835 title => "Map Info",
2823 reply => undef, 2836 reply => undef,
2824 tooltip => "Information related to the maps", 2837 tooltip => "Information related to the maps",
2825 }, 2838 },
2839 "c/party" => {
2840 id => "party",
2841 title => "Party",
2842 reply => "gsay ",
2843 tooltip => "Messages and chat related to your party",
2844 },
2826); 2845);
2827 2846
2828sub cf::client::send_msg { 2847sub cf::client::send_msg {
2829 my ($self, $channel, $msg, $color, @extra) = @_; 2848 my ($self, $channel, $msg, $color, @extra) = @_;
2830 2849
… …
3067 3086
3068The following functions and methods are available within a safe environment: 3087The following functions and methods are available within a safe environment:
3069 3088
3070 cf::object 3089 cf::object
3071 contr pay_amount pay_player map x y force_find force_add destroy 3090 contr pay_amount pay_player map x y force_find force_add destroy
3072 insert remove name archname title slaying race decrease_ob_nr 3091 insert remove name archname title slaying race decrease split
3073 3092
3074 cf::object::player 3093 cf::object::player
3075 player 3094 player
3076 3095
3077 cf::player 3096 cf::player
… …
3083=cut 3102=cut
3084 3103
3085for ( 3104for (
3086 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y 3105 ["cf::object" => qw(contr pay_amount pay_player map force_find force_add x y
3087 insert remove inv name archname title slaying race 3106 insert remove inv name archname title slaying race
3088 decrease_ob_nr destroy)], 3107 decrease split destroy)],
3089 ["cf::object::player" => qw(player)], 3108 ["cf::object::player" => qw(player)],
3090 ["cf::player" => qw(peaceful)], 3109 ["cf::player" => qw(peaceful)],
3091 ["cf::map" => qw(trigger)], 3110 ["cf::map" => qw(trigger)],
3092) { 3111) {
3093 no strict 'refs'; 3112 no strict 'refs';
… …
3301 while (my ($k, $v) = each %$want) { 3320 while (my ($k, $v) = each %$want) {
3302 $ns->fx_want ($k, $v); 3321 $ns->fx_want ($k, $v);
3303 } 3322 }
3304}; 3323};
3305 3324
3325sub load_resource_file($) {
3326 my $guard = lock_acquire "load_resource_file";
3327
3328 my $status = load_resource_file_ $_[0];
3329 get_slot 0.1, 100;
3330 cf::arch::commit_load;
3331
3332 $status
3333}
3334
3306sub reload_regions { 3335sub reload_regions {
3307 # HACK to clear player env face cache, we need some signal framework 3336 # HACK to clear player env face cache, we need some signal framework
3308 # for this (global event?) 3337 # for this (global event?)
3309 %ext::player_env::MUSIC_FACE_CACHE = (); 3338 %ext::player_env::MUSIC_FACE_CACHE = ();
3310 3339
… …
3323} 3352}
3324 3353
3325sub reload_archetypes { 3354sub reload_archetypes {
3326 load_resource_file "$DATADIR/archetypes" 3355 load_resource_file "$DATADIR/archetypes"
3327 or die "unable to load archetypes\n"; 3356 or die "unable to load archetypes\n";
3328 #d# NEED to laod twice to resolve forward references
3329 # this really needs to be done in an extra post-pass
3330 # (which needs to be synchronous, so solve it differently)
3331 load_resource_file "$DATADIR/archetypes"
3332 or die "unable to load archetypes\n";
3333} 3357}
3334 3358
3335sub reload_treasures { 3359sub reload_treasures {
3336 load_resource_file "$DATADIR/treasures" 3360 load_resource_file "$DATADIR/treasures"
3337 or die "unable to load treasurelists\n"; 3361 or die "unable to load treasurelists\n";
3338} 3362}
3339 3363
3340sub reload_resources { 3364sub reload_resources {
3341 warn "reloading resource files...\n"; 3365 warn "reloading resource files...\n";
3342 3366
3367 reload_facedata;
3368 reload_archetypes;
3343 reload_regions; 3369 reload_regions;
3344 reload_facedata;
3345 #reload_archetypes;#d#
3346 reload_archetypes;
3347 reload_treasures; 3370 reload_treasures;
3348 3371
3349 warn "finished reloading resource files\n"; 3372 warn "finished reloading resource files\n";
3350} 3373}
3351 3374
3352sub init { 3375sub init {
3376 my $guard = freeze_mainloop;
3377
3353 reload_resources; 3378 reload_resources;
3354} 3379}
3355 3380
3356sub reload_config { 3381sub reload_config {
3357 open my $fh, "<:utf8", "$CONFDIR/config" 3382 open my $fh, "<:utf8", "$CONFDIR/config"
… …
3382 $Coro::current->{desc} = "IDLE BUG HANDLER"; 3407 $Coro::current->{desc} = "IDLE BUG HANDLER";
3383 EV::loop EV::LOOP_ONESHOT; 3408 EV::loop EV::LOOP_ONESHOT;
3384 })->prio (Coro::PRIO_MAX); 3409 })->prio (Coro::PRIO_MAX);
3385 }; 3410 };
3386 3411
3412 {
3413 my $guard = freeze_mainloop;
3387 reload_config; 3414 reload_config;
3388 db_init; 3415 db_init;
3389 load_extensions; 3416 load_extensions;
3390 3417
3391 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3418 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3392 evthread_start IO::AIO::poll_fileno; 3419 evthread_start IO::AIO::poll_fileno;
3420 }
3421
3393 EV::loop; 3422 EV::loop;
3394} 3423}
3395 3424
3396############################################################################# 3425#############################################################################
3397# initialisation and cleanup 3426# initialisation and cleanup
… …
3679 3708
3680our @WAIT_FOR_TICK; 3709our @WAIT_FOR_TICK;
3681our @WAIT_FOR_TICK_BEGIN; 3710our @WAIT_FOR_TICK_BEGIN;
3682 3711
3683sub wait_for_tick { 3712sub wait_for_tick {
3684 return if tick_inhibit;
3685 return if $Coro::current == $Coro::main; 3713 return if tick_inhibit || $Coro::current == $Coro::main;
3686 3714
3687 my $signal = new Coro::Signal; 3715 my $signal = new Coro::Signal;
3688 push @WAIT_FOR_TICK, $signal; 3716 push @WAIT_FOR_TICK, $signal;
3689 $signal->wait; 3717 $signal->wait;
3690} 3718}
3691 3719
3692sub wait_for_tick_begin { 3720sub wait_for_tick_begin {
3693 return if tick_inhibit;
3694 return if $Coro::current == $Coro::main; 3721 return if tick_inhibit || $Coro::current == $Coro::main;
3695 3722
3696 my $signal = new Coro::Signal; 3723 my $signal = new Coro::Signal;
3697 push @WAIT_FOR_TICK_BEGIN, $signal; 3724 push @WAIT_FOR_TICK_BEGIN, $signal;
3698 $signal->wait; 3725 $signal->wait;
3699} 3726}

Diff Legend

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