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.159 by root, Wed Jan 10 22:50:12 2007 UTC vs.
Revision 1.164 by root, Thu Jan 11 01:24:25 2007 UTC

… …
37our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38 38
39our @EXTS = (); # list of extension package names 39our @EXTS = (); # list of extension package names
40our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions 41our %EXT_CORO = (); # coroutines bound to extensions
42our %EXT_MAP = (); # pluggable maps
42 43
43our @EVENT; 44our @EVENT;
44our $LIBDIR = datadir . "/ext"; 45our $LIBDIR = datadir . "/ext";
45 46
46our $TICK = MAX_TIME * 1e-6; 47our $TICK = MAX_TIME * 1e-6;
… …
371 '""' => \&as_string; 372 '""' => \&as_string;
372 373
373# used to convert map paths into valid unix filenames by repalcing / by ∕ 374# used to convert map paths into valid unix filenames by repalcing / by ∕
374our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 375our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
375 376
377sub register {
378 my ($pkg, $prefix) = @_;
379
380 $EXT_MAP{$prefix} = $pkg;
381}
382
376sub new { 383sub new {
377 my ($class, $path, $base) = @_; 384 my ($class, $path, $base) = @_;
378 385
379 $path = $path->as_string if ref $path; 386 return $path if ref $path;
380 387
381 my $self = bless { }, $class; 388 my $self = {};
382 389
383 # {... are special paths that are not touched 390 # {... are special paths that are not being touched
384 # ?xxx/... are special absolute paths 391 # ?xxx/... are special absolute paths
385 # ?random/... random maps 392 # ?random/... random maps
386 # /! non-realised random map exit 393 # /! non-realised random map exit
387 # /... normal maps 394 # /... normal maps
388 # ~/... per-player maps without a specific player (DO NOT USE) 395 # ~/... per-player maps without a specific player (DO NOT USE)
… …
390 397
391 $path =~ s/$PATH_SEP/\//go; 398 $path =~ s/$PATH_SEP/\//go;
392 399
393 if ($path =~ /^{/) { 400 if ($path =~ /^{/) {
394 # fine as it is 401 # fine as it is
395 } elsif ($path =~ s{^\?random/}{}) {
396 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
397 $self->{random} = cf::from_json $data;
398 } else { 402 } else {
399 if ($path =~ s{^~([^/]+)?}{}) { 403 if ($path =~ s{^~([^/]+)?}{}) {
404 # ~user
400 $self->{user_rel} = 1; 405 $self->{user_rel} = 1;
401 406
402 if (defined $1) { 407 if (defined $1) {
403 $self->{user} = $1; 408 $self->{user} = $1;
404 } elsif ($base =~ m{^~([^/]+)/}) { 409 } elsif ($base =~ m{^~([^/]+)/}) {
405 $self->{user} = $1; 410 $self->{user} = $1;
406 } else { 411 } else {
407 warn "cannot resolve user-relative path without user <$path,$base>\n"; 412 warn "cannot resolve user-relative path without user <$path,$base>\n";
408 } 413 }
414 } elsif ($path =~ s{^\?([^/]+)/}{}) {
415 # ?...
416 $self->{ext} = $1;
417 if (my $ext = $EXT_MAP{$1}) {
418 bless $self, $ext;
419 }
409 } elsif ($path =~ /^\//) { 420 } elsif ($path =~ /^\//) {
421 # /...
410 # already absolute 422 # already absolute
411 } else { 423 } else {
424 # relative
412 $base =~ s{[^/]+/?$}{}; 425 $base =~ s{[^/]+/?$}{};
413 return $class->new ("$base/$path"); 426 return $class->new ("$base/$path");
414 } 427 }
415 428
416 for ($path) { 429 for ($path) {
… …
419 } 432 }
420 } 433 }
421 434
422 $self->{path} = $path; 435 $self->{path} = $path;
423 436
437 if ("HASH" eq ref $self) {
438 bless $self, $class;
439 } else {
440 $self->init;
441 }
442
443 for my $ext (values %EXT_MAP) {
444 if (my $subst = $ext->substitute ($self)) {
445 return $subst;
446 }
447 }
448
424 $self 449 $self
450}
451
452sub init {
453 # nop
454}
455
456sub substitute {
457 ()
425} 458}
426 459
427# the name / primary key / in-game path 460# the name / primary key / in-game path
428sub as_string { 461sub as_string {
429 my ($self) = @_; 462 my ($self) = @_;
430 463
431 $self->{user_rel} ? "~$self->{user}$self->{path}" 464 $self->{user_rel} ? "~$self->{user}$self->{path}"
432 : $self->{random} ? "?random/$self->{path}" 465 : $self->{ext} ? "?$self->{ext}/$self->{path}"
433 : $self->{path} 466 : $self->{path}
434} 467}
435 468
436# the displayed name, this is a one way mapping 469# the displayed name, this is a one way mapping
437sub visible_name { 470sub visible_name {
438 my ($self) = @_; 471 &as_string
439
440# if (my $rmp = $self->{random}) {
441# # todo: be more intelligent about this
442# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
443# } else {
444 $self->as_string
445# }
446} 472}
447 473
448# escape the /'s in the path 474# escape the /'s in the path
449sub _escaped_path { 475sub _escaped_path {
450 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 476 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
477
451 $path 478 $path
452} 479}
453 480
454# the original (read-only) location 481# the original (read-only) location
455sub load_path { 482sub load_path {
… …
460 487
461# the temporary/swap location 488# the temporary/swap location
462sub save_path { 489sub save_path {
463 my ($self) = @_; 490 my ($self) = @_;
464 491
492 $self->{user_rel}
465 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path 493 ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
466 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
467 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path 494 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
468} 495}
469 496
470# the unique path, might be eq to save_path 497# the unique path, undef == no special unique path
471sub uniq_path { 498sub uniq_path {
472 my ($self) = @_; 499 my ($self) = @_;
473 500
474 $self->{user_rel} || $self->{random}
475 ? undef
476 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path 501 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
477}
478
479# return random map parameters, or undef
480sub random_map_params {
481 my ($self) = @_;
482
483 $self->{random}
484} 502}
485 503
486# this is somewhat ugly, but style maps do need special treatment 504# this is somewhat ugly, but style maps do need special treatment
487sub is_style_map { 505sub is_style_map {
488 $_[0]{path} =~ m{^/styles/} 506 $_[0]{path} =~ m{^/styles/}
507}
508
509sub load_orig {
510 my ($self) = @_;
511
512 &cf::map::load_map_header ($self->load_path)
513}
514
515sub load_temp {
516 my ($self) = @_;
517
518 &cf::map::load_map_header ($self->save_path)
519}
520
521sub unlink_save {
522 my ($self) = @_;
523
524 utf8::encode (my $save = $self->save_path);
525 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink $save;
526 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink "$save.pst";
489} 527}
490 528
491package cf; 529package cf;
492 530
493############################################################################# 531#############################################################################
… …
987 my $base = $1; 1025 my $base = $1;
988 my $pkg = $1; 1026 my $pkg = $1;
989 $pkg =~ s/[^[:word:]]/_/g; 1027 $pkg =~ s/[^[:word:]]/_/g;
990 $pkg = "ext::$pkg"; 1028 $pkg = "ext::$pkg";
991 1029
992 warn "loading '$path' into '$pkg'\n"; 1030 warn "... loading '$path' into '$pkg'\n";
993 1031
994 open my $fh, "<:utf8", $path 1032 open my $fh, "<:utf8", $path
995 or die "$path: $!"; 1033 or die "$path: $!";
996 1034
997 my $source = 1035 my $source =
… …
1236 1274
1237sub generate_random_map { 1275sub generate_random_map {
1238 my ($path, $rmp) = @_; 1276 my ($path, $rmp) = @_;
1239 1277
1240 # mit "rum" bekleckern, nicht 1278 # mit "rum" bekleckern, nicht
1241 cf::map::_create_random_map 1279 cf::map::_create_random_map (
1242 $path, 1280 $path,
1243 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1281 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1244 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1282 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1245 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1283 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1246 $rmp->{exit_on_final_map}, 1284 $rmp->{exit_on_final_map},
… …
1248 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1286 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1249 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1287 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1250 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation}, 1288 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1251 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp}, 1289 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1252 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used}, 1290 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1253 (cf::region::find $rmp->{region}) 1291 (cf::region::find $rmp->{region}), $rmp->{custom}
1292 )
1254} 1293}
1255 1294
1256# and all this just because we cannot iterate over 1295# and all this just because we cannot iterate over
1257# all maps in C++... 1296# all maps in C++...
1258sub change_all_map_light { 1297sub change_all_map_light {
… …
1260 1299
1261 $_->change_map_light ($change) 1300 $_->change_map_light ($change)
1262 for grep $_->outdoor, values %cf::MAP; 1301 for grep $_->outdoor, values %cf::MAP;
1263} 1302}
1264 1303
1265sub try_load_header($) { 1304sub load_map_header($) {
1266 my ($path) = @_; 1305 my ($path) = @_;
1267 1306
1268 utf8::encode $path; 1307 utf8::encode $path;
1269 aio_open $path, O_RDONLY, 0 1308 aio_open $path, O_RDONLY, 0
1270 or return; 1309 or return;
1271 1310
1272 my $map = cf::map::new 1311 my $map = cf::map::new
1273 or return; 1312 or return;
1274 1313
1275 # for better error messages only, will be overwritten 1314 # for better error messages only, will be overwritten later
1276 $map->path ($path); 1315 $map->path ($path);
1277 1316
1278 $map->load_header ($path) 1317 $map->load_header ($path)
1279 or return; 1318 or return;
1280 1319
… …
1296 1335
1297 $cf::MAP{$key} || do { 1336 $cf::MAP{$key} || do {
1298 my $guard = cf::lock_acquire "map_find:$key"; 1337 my $guard = cf::lock_acquire "map_find:$key";
1299 1338
1300 # do it the slow way 1339 # do it the slow way
1301 my $map = try_load_header $path->save_path; 1340 my $map = $path->load_temp;
1302 1341
1303 Coro::cede; 1342 Coro::cede;
1304 1343
1305 if ($map) { 1344 if ($map) {
1306 $map->last_access ((delete $map->{last_access}) 1345 $map->last_access ((delete $map->{last_access})
1307 || $cf::RUNTIME); #d# 1346 || $cf::RUNTIME); #d#
1308 # safety 1347 # safety
1309 $map->{instantiate_time} = $cf::RUNTIME 1348 $map->{instantiate_time} = $cf::RUNTIME
1310 if $map->{instantiate_time} > $cf::RUNTIME; 1349 if $map->{instantiate_time} > $cf::RUNTIME;
1311 } else { 1350 } else {
1312 if (my $rmp = $path->random_map_params) { 1351 $map = $path->load_orig
1313 $map = generate_random_map $key, $rmp;
1314 } else {
1315 $map = try_load_header $path->load_path;
1316 }
1317
1318 $map or return; 1352 or return;
1319 1353
1320 $map->{load_original} = 1; 1354 $map->{load_original} = 1;
1321 $map->{instantiate_time} = $cf::RUNTIME; 1355 $map->{instantiate_time} = $cf::RUNTIME;
1322 $map->last_access ($cf::RUNTIME); 1356 $map->last_access ($cf::RUNTIME);
1323 $map->instantiate; 1357 $map->instantiate;
… …
1375 1409
1376 if ($self->{path}->is_style_map) { 1410 if ($self->{path}->is_style_map) {
1377 $self->{deny_save} = 1; 1411 $self->{deny_save} = 1;
1378 $self->{deny_reset} = 1; 1412 $self->{deny_reset} = 1;
1379 } else { 1413 } else {
1414 $self->decay_objects;
1380 $self->fix_auto_apply; 1415 $self->fix_auto_apply;
1381 $self->decay_objects;
1382 $self->update_buttons; 1416 $self->update_buttons;
1383 $self->set_darkness_map; 1417 $self->set_darkness_map;
1384 $self->difficulty ($self->estimate_difficulty) 1418 $self->difficulty ($self->estimate_difficulty)
1385 unless $self->difficulty; 1419 unless $self->difficulty;
1386 $self->activate; 1420 $self->activate;
… …
1522 my ($self) = @_; 1556 my ($self) = @_;
1523 1557
1524 $self->reset_at <= $cf::RUNTIME 1558 $self->reset_at <= $cf::RUNTIME
1525} 1559}
1526 1560
1527sub unlink_save {
1528 my ($self) = @_;
1529
1530 utf8::encode (my $save = $self->{path}->save_path);
1531 aioreq_pri 3; IO::AIO::aio_unlink $save;
1532 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1533}
1534
1535sub rename { 1561sub rename {
1536 my ($self, $new_path) = @_; 1562 my ($self, $new_path) = @_;
1537 1563
1538 $self->unlink_save; 1564 $self->{path}->unlink_save;
1539 1565
1540 delete $cf::MAP{$self->path}; 1566 delete $cf::MAP{$self->path};
1541 $self->{path} = new cf::path $new_path; 1567 $self->{path} = new cf::path $new_path;
1542 $self->path ($self->{path}->as_string); 1568 $self->path ($self->{path}->as_string);
1543 $cf::MAP{$self->path} = $self; 1569 $cf::MAP{$self->path} = $self;
… …
1557 1583
1558 delete $cf::MAP{$self->path}; 1584 delete $cf::MAP{$self->path};
1559 1585
1560 $_->clear_links_to ($self) for values %cf::MAP; 1586 $_->clear_links_to ($self) for values %cf::MAP;
1561 1587
1562 $self->unlink_save; 1588 $self->{path}->unlink_save;
1563 $self->destroy; 1589 $self->destroy;
1564} 1590}
1565 1591
1566my $nuke_counter = "aaaa"; 1592my $nuke_counter = "aaaa";
1567 1593
… …
2314 warn "remove ext commands"; 2340 warn "remove ext commands";
2315 %EXTCMD = (); 2341 %EXTCMD = ();
2316 2342
2317 warn "unload/nuke all extensions"; 2343 warn "unload/nuke all extensions";
2318 for my $pkg (@EXTS) { 2344 for my $pkg (@EXTS) {
2319 warn "unloading <$pkg>"; 2345 warn "... unloading $pkg";
2320 2346
2321 if (my $cb = $pkg->can ("unload")) { 2347 if (my $cb = $pkg->can ("unload")) {
2322 eval { 2348 eval {
2323 $cb->($pkg); 2349 $cb->($pkg);
2324 1 2350 1
2325 } or warn "$pkg unloaded, but with errors: $@"; 2351 } or warn "$pkg unloaded, but with errors: $@";
2326 } 2352 }
2327 2353
2354 warn "... nuking $pkg";
2328 Symbol::delete_package $pkg; 2355 Symbol::delete_package $pkg;
2329 } 2356 }
2330 2357
2331 warn "unload all perl modules loaded from $LIBDIR"; 2358 warn "unload all perl modules loaded from $LIBDIR";
2332 while (my ($k, $v) = each %INC) { 2359 while (my ($k, $v) = each %INC) {
… …
2441 reentrant => 0, 2468 reentrant => 0,
2442 prio => 0, 2469 prio => 0,
2443 at => $NEXT_TICK || $TICK, 2470 at => $NEXT_TICK || $TICK,
2444 data => WF_AUTOCANCEL, 2471 data => WF_AUTOCANCEL,
2445 cb => sub { 2472 cb => sub {
2473 $NOW = Event::time;
2474
2446 cf::server_tick; # one server iteration 2475 cf::server_tick; # one server iteration
2447 $RUNTIME += $TICK; 2476 $RUNTIME += $TICK;
2448 $NEXT_TICK += $TICK; 2477 $NEXT_TICK += $TICK;
2449 2478
2450 $WAIT_FOR_TICK->broadcast; 2479 $WAIT_FOR_TICK->broadcast;

Diff Legend

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