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.140 by root, Fri Jan 5 20:04:02 2007 UTC vs.
Revision 1.149 by root, Mon Jan 8 14:11:05 2007 UTC

… …
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Digest::MD5; 20use Digest::MD5;
21use Fcntl; 21use Fcntl;
22use IO::AIO 2.31 (); 22use IO::AIO 2.32 ();
23use YAML::Syck (); 23use YAML::Syck ();
24use Time::HiRes; 24use Time::HiRes;
25 25
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 26use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 27
… …
47our %CFG; 47our %CFG;
48 48
49our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 50our $RUNTIME;
51 51
52our %PLAYER; # all users
52our %MAP; # all maps 53our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 54our $LINK_MAP; # the special {link} map
54our $RANDOM_MAPS = cf::localdir . "/random"; 55our $RANDOM_MAPS = cf::localdir . "/random";
55our %EXT_CORO; 56our %EXT_CORO; # coroutines bound to extensions
56 57
57binmode STDOUT; 58binmode STDOUT;
58binmode STDERR; 59binmode STDERR;
59 60
60# read virtual server time, if available 61# read virtual server time, if available
… …
117 utf8::encode $msg; 118 utf8::encode $msg;
118 119
119 $msg .= "\n" 120 $msg .= "\n"
120 unless $msg =~ /\n$/; 121 unless $msg =~ /\n$/;
121 122
122 LOG llevError, "cfperl: $msg"; 123 LOG llevError, $msg;
123 }; 124 };
124} 125}
125 126
126@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
127@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
273 warn $@ if $@; 274 warn $@ if $@;
274 undef $busy; 275 undef $busy;
275 })->prio (Coro::PRIO_MAX); 276 })->prio (Coro::PRIO_MAX);
276 277
277 while ($busy) { 278 while ($busy) {
278 unless (Coro::cede) { 279 Coro::cede or Event::one_event;
279 Coro::nready ? Event::one_event 0 : Event::one_event;
280 Coro::cede_notself unless Coro::cede;
281 }
282 } 280 }
283 281
284 wantarray ? @res : $res[0] 282 wantarray ? @res : $res[0]
285 } else { 283 } else {
286 # we are in another coroutine, how wonderful, everything just works 284 # we are in another coroutine, how wonderful, everything just works
… …
1074 1072
1075=head2 CORE EXTENSIONS 1073=head2 CORE EXTENSIONS
1076 1074
1077Functions and methods that extend core crossfire objects. 1075Functions and methods that extend core crossfire objects.
1078 1076
1077=cut
1078
1079package cf::player;
1080
1079=head3 cf::player 1081=head3 cf::player
1080 1082
1081=over 4 1083=over 4
1082 1084
1083=item cf::player::exists $login 1085=item cf::player::find $login
1084 1086
1085Returns true when the given account exists. 1087Returns the given player object, loading it if necessary (might block).
1086 1088
1087=cut 1089=cut
1088 1090
1089sub cf::player::exists($) { 1091sub playerdir($) {
1090 cf::player::find $_[0] 1092 cf::localdir
1091 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 1093 . "/"
1094 . cf::playerdir
1095 . "/"
1096 . (ref $_[0] ? $_[0]->ob->name : $_[0])
1097}
1098
1099sub path($) {
1100 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1101
1102 (playerdir $login) . "/$login.pl"
1103}
1104
1105sub find_active($) {
1106 $cf::PLAYER{$_[0]}
1107 and $cf::PLAYER{$_[0]}->active
1108 and $cf::PLAYER{$_[0]}
1109}
1110
1111sub exists($) {
1112 my ($login) = @_;
1113
1114 $cf::PLAYER{$login}
1115 or cf::sync_job { !aio_stat $login }
1116}
1117
1118sub find($) {
1119 return $cf::PLAYER{$_[0]} || do {
1120 my $login = $_[0];
1121
1122 my $guard = cf::lock_acquire "user_find:$login";
1123
1124 $cf::PLAYER{$login} ||= (load_pl path $login or return);
1125 };
1126}
1127
1128sub save($) {
1129 my ($pl) = @_;
1130
1131 return if $pl->{deny_save};
1132
1133 my $path = path $pl;
1134 my $guard = cf::lock_acquire "user_save:$path";
1135
1136 return if $pl->{deny_save};
1137
1138 Coro::AIO::aio_mkdir playerdir $pl, 0770;
1139 $pl->{last_save} = $cf::RUNTIME;
1140
1141 $pl->save_pl ($path);
1142 Coro::cede;
1143}
1144
1145sub new($) {
1146 my ($login) = @_;
1147
1148 my $self = create;
1149
1150 $self->ob->name ($login);
1151 $self->{deny_save} = 1;
1152
1153 $cf::PLAYER{$login} = $self;
1154
1155 $self
1156}
1157
1158sub quit_character {
1159 my ($pl) = @_;
1160
1161 $pl->{deny_save} = 1;
1162 $pl->password ("*"); # this should lock out the player until we nuked the dir
1163
1164 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1165 $pl->deactivate;
1166 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1167 $pl->ns->destroy if $pl->ns;
1168
1169 my $path = playerdir $pl;
1170 my $temp = "$path~$cf::RUNTIME~deleting~";
1171 IO::AIO::aio_rename $path, $temp, sub {
1172 delete $cf::PLAYER{$pl->ob->name};
1173 $pl->destroy;
1174
1175 IO::AIO::aio_rmtree $temp;
1176 };
1092} 1177}
1093 1178
1094=item $player->ext_reply ($msgid, $msgtype, %msg) 1179=item $player->ext_reply ($msgid, $msgtype, %msg)
1095 1180
1096Sends an ext reply to the player. 1181Sends an ext reply to the player.
1097 1182
1098=cut 1183=cut
1099 1184
1100sub cf::player::ext_reply($$$%) { 1185sub ext_reply($$$%) {
1101 my ($self, $id, %msg) = @_; 1186 my ($self, $id, %msg) = @_;
1102 1187
1103 $msg{msgid} = $id; 1188 $msg{msgid} = $id;
1104 1189
1105 $self->send ("ext " . to_json \%msg); 1190 $self->send ("ext " . cf::to_json \%msg);
1106} 1191}
1192
1193package cf;
1107 1194
1108=back 1195=back
1109 1196
1110 1197
1111=head3 cf::map 1198=head3 cf::map
… …
1307 1394
1308 return if $self->{deny_save}; 1395 return if $self->{deny_save};
1309 1396
1310 local $self->{last_access} = $self->last_access;#d# 1397 local $self->{last_access} = $self->last_access;#d#
1311 1398
1399 cf::async {
1400 $_->contr->save for $self->players;
1401 };
1402
1312 if ($uniq) { 1403 if ($uniq) {
1313 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1404 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1314 $self->save_objects ($uniq, cf::IO_UNIQUES); 1405 $self->save_objects ($uniq, cf::IO_UNIQUES);
1315 } else { 1406 } else {
1316 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1407 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
… …
1413} 1504}
1414 1505
1415sub emergency_save { 1506sub emergency_save {
1416 my $freeze_guard = cf::freeze_mainloop; 1507 my $freeze_guard = cf::freeze_mainloop;
1417 1508
1418 warn "enter emergency map save\n"; 1509 warn "enter emergency perl save\n";
1419 1510
1420 cf::sync_job { 1511 cf::sync_job {
1512 warn "begin emergency player save\n";
1513 $_->save for values %cf::PLAYER;
1514 warn "end emergency player save\n";
1515
1421 warn "begin emergency map save\n"; 1516 warn "begin emergency map save\n";
1422 $_->save for values %cf::MAP; 1517 $_->save for values %cf::MAP;
1518 warn "end emergency map save\n";
1423 }; 1519 };
1424 1520
1425 warn "end emergency map save\n"; 1521 warn "leave emergency perl save\n";
1426} 1522}
1427 1523
1428package cf; 1524package cf;
1429 1525
1430=back 1526=back
… …
1529 ($x, $y) = ($map->enter_x, $map->enter_y) 1625 ($x, $y) = ($map->enter_x, $map->enter_y)
1530 if $x <=0 && $y <= 0; 1626 if $x <=0 && $y <= 0;
1531 1627
1532 $map->load; 1628 $map->load;
1533 1629
1630 return unless $self->contr->active;
1534 $self->activate_recursive; 1631 $self->activate_recursive;
1535 $self->enter_map ($map, $x, $y); 1632 $self->enter_map ($map, $x, $y);
1536} 1633}
1537 1634
1538cf::player->attach ( 1635cf::player->attach (
… …
1550 my ($pl) = @_; 1647 my ($pl) = @_;
1551 1648
1552 # try to abort aborted map switching on player login :) 1649 # try to abort aborted map switching on player login :)
1553 # should happen only on crashes 1650 # should happen only on crashes
1554 if ($pl->ob->{_link_pos}) { 1651 if ($pl->ob->{_link_pos}) {
1555
1556 $pl->ob->enter_link; 1652 $pl->ob->enter_link;
1557 (async { 1653 (async {
1558 # we need this sleep as the login has a concurrent enter_exit running 1654 # we need this sleep as the login has a concurrent enter_exit running
1559 # and this sleep increases chances of the player not ending up in scorn 1655 # and this sleep increases chances of the player not ending up in scorn
1560 $pl->ob->reply (undef, 1656 $pl->ob->reply (undef,
… …
1584 $map = $map->customise_for ($self) if $map; 1680 $map = $map->customise_for ($self) if $map;
1585 1681
1586# warn "entering ", $map->path, " at ($x, $y)\n" 1682# warn "entering ", $map->path, " at ($x, $y)\n"
1587# if $map; 1683# if $map;
1588 1684
1685 $map or $map->cluck ("oy");#d#
1589 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1686 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1590 1687
1591 $self->leave_link ($map, $x, $y); 1688 $self->leave_link ($map, $x, $y);
1592 })->prio (1); 1689 })->prio (1);
1593} 1690}
1594 1691
… …
2002 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 2099 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2003 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 2100 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2004 2101
2005 if (exists $CFG{mlockall}) { 2102 if (exists $CFG{mlockall}) {
2006 eval { 2103 eval {
2007 $CFG{mlockall} ? &mlockall : &munlockall 2104 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2008 and die "WARNING: m(un)lockall failed: $!\n"; 2105 and die "WARNING: m(un)lockall failed: $!\n";
2009 }; 2106 };
2010 warn $@ if $@; 2107 warn $@ if $@;
2011 } 2108 }
2012} 2109}
… …
2106 cf::load_extensions; 2203 cf::load_extensions;
2107 2204
2108 # reattach attachments to objects 2205 # reattach attachments to objects
2109 warn "reattach"; 2206 warn "reattach";
2110 _global_reattach; 2207 _global_reattach;
2208 reattach $_ for values %MAP;
2111 }; 2209 };
2112 2210
2113 if ($@) { 2211 if ($@) {
2114 warn $@; 2212 warn $@;
2115 warn "error while reloading, exiting."; 2213 warn "error while reloading, exiting.";
… …
2131 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2229 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2132 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2230 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2133 2231
2134 # dirty hack because... archetypes are not yet loaded 2232 # dirty hack because... archetypes are not yet loaded
2135 Event->timer ( 2233 Event->timer (
2136 after => 2, 2234 after => 10,
2137 cb => sub { 2235 cb => sub {
2138 $_[0]->w->cancel; 2236 $_[0]->w->cancel;
2139 2237
2140 # provide some exits "home" 2238 # provide some exits "home"
2141 my $exit = cf::object::new "exit"; 2239 my $exit = cf::object::new "exit";

Diff Legend

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