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.142 by root, Fri Jan 5 21:51:42 2007 UTC vs.
Revision 1.153 by root, Mon Jan 8 23:36:16 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';
1071 1072
1072=head2 CORE EXTENSIONS 1073=head2 CORE EXTENSIONS
1073 1074
1074Functions and methods that extend core crossfire objects. 1075Functions and methods that extend core crossfire objects.
1075 1076
1077=cut
1078
1079package cf::player;
1080
1076=head3 cf::player 1081=head3 cf::player
1077 1082
1078=over 4 1083=over 4
1079 1084
1080=item cf::player::exists $login 1085=item cf::player::find $login
1081 1086
1082Returns true when the given account exists. 1087Returns the given player object, loading it if necessary (might block).
1083 1088
1084=cut 1089=cut
1085 1090
1086sub cf::player::exists($) { 1091sub playerdir($) {
1087 cf::player::find $_[0] 1092 cf::localdir
1088 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{$_[0]} || do {
1125 my $pl = load_pl path $login
1126 or return;
1127 $cf::PLAYER{$login} = $pl
1128 }
1129 }
1130}
1131
1132sub save($) {
1133 my ($pl) = @_;
1134
1135 return if $pl->{deny_save};
1136
1137 my $path = path $pl;
1138 my $guard = cf::lock_acquire "user_save:$path";
1139
1140 return if $pl->{deny_save};
1141
1142 Coro::AIO::aio_mkdir playerdir $pl, 0770;
1143 $pl->{last_save} = $cf::RUNTIME;
1144
1145 $pl->save_pl ($path);
1146 Coro::cede;
1147}
1148
1149sub new($) {
1150 my ($login) = @_;
1151
1152 my $self = create;
1153
1154 $self->ob->name ($login);
1155 $self->{deny_save} = 1;
1156
1157 $cf::PLAYER{$login} = $self;
1158
1159 $self
1160}
1161
1162sub quit_character {
1163 my ($pl) = @_;
1164
1165 $pl->{deny_save} = 1;
1166 $pl->password ("*"); # this should lock out the player until we nuked the dir
1167
1168 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1169 $pl->deactivate;
1170 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1171 $pl->ns->destroy if $pl->ns;
1172
1173 my $path = playerdir $pl;
1174 my $temp = "$path~$cf::RUNTIME~deleting~";
1175 Coro::AIO::aio_rename $path, $temp;
1176 delete $cf::PLAYER{$pl->ob->name};
1177 $pl->destroy;
1178 IO::AIO::aio_rmtree $temp;
1089} 1179}
1090 1180
1091=item $player->ext_reply ($msgid, $msgtype, %msg) 1181=item $player->ext_reply ($msgid, $msgtype, %msg)
1092 1182
1093Sends an ext reply to the player. 1183Sends an ext reply to the player.
1094 1184
1095=cut 1185=cut
1096 1186
1097sub cf::player::ext_reply($$$%) { 1187sub ext_reply($$$%) {
1098 my ($self, $id, %msg) = @_; 1188 my ($self, $id, %msg) = @_;
1099 1189
1100 $msg{msgid} = $id; 1190 $msg{msgid} = $id;
1101 1191
1102 $self->send ("ext " . to_json \%msg); 1192 $self->send ("ext " . cf::to_json \%msg);
1103} 1193}
1194
1195package cf;
1104 1196
1105=back 1197=back
1106 1198
1107 1199
1108=head3 cf::map 1200=head3 cf::map
1304 1396
1305 return if $self->{deny_save}; 1397 return if $self->{deny_save};
1306 1398
1307 local $self->{last_access} = $self->last_access;#d# 1399 local $self->{last_access} = $self->last_access;#d#
1308 1400
1401 cf::async {
1402 $_->contr->save for $self->players;
1403 };
1404
1309 if ($uniq) { 1405 if ($uniq) {
1310 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1406 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1311 $self->save_objects ($uniq, cf::IO_UNIQUES); 1407 $self->save_objects ($uniq, cf::IO_UNIQUES);
1312 } else { 1408 } else {
1313 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1409 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1410} 1506}
1411 1507
1412sub emergency_save { 1508sub emergency_save {
1413 my $freeze_guard = cf::freeze_mainloop; 1509 my $freeze_guard = cf::freeze_mainloop;
1414 1510
1415 warn "enter emergency map save\n"; 1511 warn "enter emergency perl save\n";
1416 1512
1417 cf::sync_job { 1513 cf::sync_job {
1514 warn "begin emergency player save\n";
1515 $_->save for values %cf::PLAYER;
1516 warn "end emergency player save\n";
1517
1418 warn "begin emergency map save\n"; 1518 warn "begin emergency map save\n";
1419 $_->save for values %cf::MAP; 1519 $_->save for values %cf::MAP;
1520 warn "end emergency map save\n";
1420 }; 1521 };
1421 1522
1422 warn "end emergency map save\n"; 1523 warn "leave emergency perl save\n";
1423} 1524}
1424 1525
1425package cf; 1526package cf;
1426 1527
1427=back 1528=back
1526 ($x, $y) = ($map->enter_x, $map->enter_y) 1627 ($x, $y) = ($map->enter_x, $map->enter_y)
1527 if $x <=0 && $y <= 0; 1628 if $x <=0 && $y <= 0;
1528 1629
1529 $map->load; 1630 $map->load;
1530 1631
1632 return unless $self->contr->active;
1531 $self->activate_recursive; 1633 $self->activate_recursive;
1532 $self->enter_map ($map, $x, $y); 1634 $self->enter_map ($map, $x, $y);
1533} 1635}
1534 1636
1535cf::player->attach ( 1637cf::player->attach (
1547 my ($pl) = @_; 1649 my ($pl) = @_;
1548 1650
1549 # try to abort aborted map switching on player login :) 1651 # try to abort aborted map switching on player login :)
1550 # should happen only on crashes 1652 # should happen only on crashes
1551 if ($pl->ob->{_link_pos}) { 1653 if ($pl->ob->{_link_pos}) {
1552
1553 $pl->ob->enter_link; 1654 $pl->ob->enter_link;
1554 (async { 1655 (async {
1555 # we need this sleep as the login has a concurrent enter_exit running 1656 # we need this sleep as the login has a concurrent enter_exit running
1556 # and this sleep increases chances of the player not ending up in scorn 1657 # and this sleep increases chances of the player not ending up in scorn
1557 $pl->ob->reply (undef, 1658 $pl->ob->reply (undef,
1570=cut 1671=cut
1571 1672
1572sub cf::object::player::goto { 1673sub cf::object::player::goto {
1573 my ($self, $path, $x, $y) = @_; 1674 my ($self, $path, $x, $y) = @_;
1574 1675
1676 $path = new cf::path $path;
1677 $path ne "/" or Carp::cluck ("oy");#d#
1678
1575 $self->enter_link; 1679 $self->enter_link;
1576 1680
1577 (async { 1681 (async {
1578 $path = new cf::path $path;
1579
1580 my $map = cf::map::find $path->as_string; 1682 my $map = cf::map::find $path->as_string;
1581 $map = $map->customise_for ($self) if $map; 1683 $map = $map->customise_for ($self) if $map;
1582 1684
1583# warn "entering ", $map->path, " at ($x, $y)\n" 1685# warn "entering ", $map->path, " at ($x, $y)\n"
1584# if $map; 1686# if $map;
1585 1687
1586 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1688 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1587 1689
1588 $self->leave_link ($map, $x, $y); 1690 $self->leave_link ($map, $x, $y);
1589 })->prio (1); 1691 })->prio (1);
1590} 1692}
1591 1693
1999 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 2101 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2000 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 2102 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2001 2103
2002 if (exists $CFG{mlockall}) { 2104 if (exists $CFG{mlockall}) {
2003 eval { 2105 eval {
2004 $CFG{mlockall} ? &mlockall : &munlockall 2106 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2005 and die "WARNING: m(un)lockall failed: $!\n"; 2107 and die "WARNING: m(un)lockall failed: $!\n";
2006 }; 2108 };
2007 warn $@ if $@; 2109 warn $@ if $@;
2008 } 2110 }
2009} 2111}
2103 cf::load_extensions; 2205 cf::load_extensions;
2104 2206
2105 # reattach attachments to objects 2207 # reattach attachments to objects
2106 warn "reattach"; 2208 warn "reattach";
2107 _global_reattach; 2209 _global_reattach;
2210 reattach $_ for values %MAP;
2108 }; 2211 };
2109 2212
2110 if ($@) { 2213 if ($@) {
2111 warn $@; 2214 warn $@;
2112 warn "error while reloading, exiting."; 2215 warn "error while reloading, exiting.";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines