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.70 by root, Sun Oct 1 10:55:37 2006 UTC vs.
Revision 1.77 by root, Sun Nov 5 11:13:01 2006 UTC

… …
5use Storable; 5use Storable;
6use Opcode; 6use Opcode;
7use Safe; 7use Safe;
8use Safe::Hole; 8use Safe::Hole;
9 9
10use IO::AIO ();
11use YAML::Syck ();
10use Time::HiRes; 12use Time::HiRes;
11use Event; 13use Event;
12$Event::Eval = 1; # no idea why this is required, but it is 14$Event::Eval = 1; # no idea why this is required, but it is
13 15
16# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
17$YAML::Syck::ImplicitUnicode = 1;
18
14use strict; 19use strict;
15 20
16_init_vars; 21_init_vars;
17 22
18our %COMMAND = (); 23our %COMMAND = ();
… …
22our $TICK = MAX_TIME * 1e-6; 27our $TICK = MAX_TIME * 1e-6;
23our $TICK_WATCHER; 28our $TICK_WATCHER;
24our $NEXT_TICK; 29our $NEXT_TICK;
25 30
26our %CFG; 31our %CFG;
32
33our $uptime;
34
35$uptime ||= time;
27 36
28############################################################################# 37#############################################################################
29 38
30=head2 GLOBAL VARIABLES 39=head2 GLOBAL VARIABLES
31 40
… …
108 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 117 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
109 JSON::Syck::Dump $_[0] 118 JSON::Syck::Dump $_[0]
110} 119}
111 120
112=back 121=back
122
123=cut
113 124
114############################################################################# 125#############################################################################
115 126
116=head2 EVENTS AND OBJECT ATTACHMENTS 127=head2 EVENTS AND OBJECT ATTACHMENTS
117 128
… …
420This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be 431This API is preliminary (most likely, the EVENT_KLASS_xxx prefix will be
421removed in future versions), and there is no public API to access override 432removed in future versions), and there is no public API to access override
422results (if you must, access C<@cf::invoke_results> directly). 433results (if you must, access C<@cf::invoke_results> directly).
423 434
424=back 435=back
436
437=cut
425 438
426############################################################################# 439#############################################################################
427 440
428=head2 METHODS VALID FOR ALL CORE OBJECTS 441=head2 METHODS VALID FOR ALL CORE OBJECTS
429 442
… …
762sub cf::player::exists($) { 775sub cf::player::exists($) {
763 cf::player::find $_[0] 776 cf::player::find $_[0]
764 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 777 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
765} 778}
766 779
767=item $player->reply ($npc, $msg[, $flags]) 780=item $object->reply ($npc, $msg[, $flags])
768 781
769Sends a message to the player, as if the npc C<$npc> replied. C<$npc> 782Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
770can be C<undef>. Does the right thing when the player is currently in a 783can be C<undef>. Does the right thing when the player is currently in a
771dialogue with the given NPC character. 784dialogue with the given NPC character.
772 785
… …
912 *{"safe::$fun"} = $safe_hole->wrap ($cb); 925 *{"safe::$fun"} = $safe_hole->wrap ($cb);
913} 926}
914 927
915=back 928=back
916 929
930=cut
931
917############################################################################# 932#############################################################################
918 933
919=head2 EXTENSION DATABASE SUPPORT 934=head2 EXTENSION DATABASE SUPPORT
920 935
921Crossfire maintains a very simple database for extension use. It can 936Crossfire maintains a very simple database for extension use. It can
… …
1019} 1034}
1020 1035
1021############################################################################# 1036#############################################################################
1022# the server's main() 1037# the server's main()
1023 1038
1039sub cfg_load {
1040 open my $fh, "<:utf8", cf::confdir . "/config"
1041 or return;
1042
1043 local $/;
1044 *CFG = YAML::Syck::Load <$fh>;
1045}
1046
1024sub main { 1047sub main {
1048 cfg_load;
1025 db_load; 1049 db_load;
1026 load_extensions; 1050 load_extensions;
1027 Event::loop; 1051 Event::loop;
1028} 1052}
1029 1053
… …
1081 1105
1082 # reload cf.pm 1106 # reload cf.pm
1083 $msg->("reloading cf.pm"); 1107 $msg->("reloading cf.pm");
1084 require cf; 1108 require cf;
1085 1109
1086 # load database again 1110 # load config and database again
1111 cf::cfg_load;
1087 cf::db_load; 1112 cf::db_load;
1088 1113
1089 # load extensions 1114 # load extensions
1090 $msg->("load extensions"); 1115 $msg->("load extensions");
1091 cf::load_extensions; 1116 cf::load_extensions;
… …
1120register "<global>", __PACKAGE__; 1145register "<global>", __PACKAGE__;
1121 1146
1122unshift @INC, $LIBDIR; 1147unshift @INC, $LIBDIR;
1123 1148
1124$TICK_WATCHER = Event->timer ( 1149$TICK_WATCHER = Event->timer (
1125 prio => 1, 1150 prio => 1,
1151 async => 1,
1126 at => $NEXT_TICK || 1, 1152 at => $NEXT_TICK || 1,
1127 cb => sub { 1153 cb => sub {
1128 cf::server_tick; # one server iteration 1154 cf::server_tick; # one server iteration
1129 1155
1130 my $NOW = Event::time; 1156 my $NOW = Event::time;
1131 $NEXT_TICK += $TICK; 1157 $NEXT_TICK += $TICK;
1132 1158
… …
1136 $TICK_WATCHER->at ($NEXT_TICK); 1162 $TICK_WATCHER->at ($NEXT_TICK);
1137 $TICK_WATCHER->start; 1163 $TICK_WATCHER->start;
1138 }, 1164 },
1139); 1165);
1140 1166
1167IO::AIO::max_poll_time $TICK * 0.2;
1168
1169Event->io (fd => IO::AIO::poll_fileno,
1170 poll => 'r',
1171 prio => 5,
1172 cb => \&IO::AIO::poll_cb);
1173
11411 11741
1142 1175

Diff Legend

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