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.104 by root, Sat Dec 30 16:56:16 2006 UTC vs.
Revision 1.107 by root, Sun Dec 31 18:10:40 2006 UTC

… …
13use Coro 3.3; 13use Coro 3.3;
14use Coro::Event; 14use Coro::Event;
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO;
18 19
20use Fcntl;
19use IO::AIO 2.3; 21use IO::AIO 2.31 ();
20use YAML::Syck (); 22use YAML::Syck ();
21use Time::HiRes; 23use Time::HiRes;
22 24
23use Event; $Event::Eval = 1; # no idea why this is required, but it is 25use Event; $Event::Eval = 1; # no idea why this is required, but it is
24 26
… …
172sub to_json($) { 174sub to_json($) {
173 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 175 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
174 JSON::Syck::Dump $_[0] 176 JSON::Syck::Dump $_[0]
175} 177}
176 178
179=item cf::sync_job { BLOCK }
180
181The design of crossfire+ requires that the main coro ($Coro::main) is
182always able to handle events or runnable, as crossfire+ is only partly
183reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
184
185If it must be done, put the blocking parts into C<sync_job>. This will run
186the given BLOCK in another coroutine while waiting for the result. The
187server will be frozen during this time, so the block should either finish
188fast or be very important.
189
190=cut
191
192sub sync_job(&) {
193 my ($job) = @_;
194
195 my $busy = 1;
196 my @res;
197
198 # TODO: use suspend/resume instead
199 local $FREEZE = 1;
200
201 my $coro = Coro::async {
202 @res = eval { $job->() };
203 warn $@ if $@;
204 undef $busy;
205 };
206
207 if ($Coro::current == $Coro::main) {
208 $coro->prio (Coro::PRIO_MAX);
209 while ($busy) {
210 Coro::cede_notself;
211 Event::one_event unless Coro::nready;
212 }
213 } else {
214 $coro->join;
215 }
216
217 wantarray ? @res : $res[0]
218}
219
177=item $coro = cf::coro { BLOCK } 220=item $coro = cf::coro { BLOCK }
178 221
179Creates and returns a new coro. This coro is automcatially being canceled 222Creates and returns a new coro. This coro is automcatially being canceled
180when the extension calling this is being unloaded. 223when the extension calling this is being unloaded.
181 224
… …
563); 606);
564 607
565sub object_freezer_save { 608sub object_freezer_save {
566 my ($filename, $rdata, $objs) = @_; 609 my ($filename, $rdata, $objs) = @_;
567 610
611 sync_job {
568 if (length $$rdata) { 612 if (length $$rdata) {
569 warn sprintf "saving %s (%d,%d)\n", 613 warn sprintf "saving %s (%d,%d)\n",
570 $filename, length $$rdata, scalar @$objs; 614 $filename, length $$rdata, scalar @$objs;
571 615
572 if (open my $fh, ">:raw", "$filename~") { 616 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
573 chmod SAVE_MODE, $fh;
574 syswrite $fh, $$rdata;
575 close $fh;
576
577 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
578 chmod SAVE_MODE, $fh; 617 chmod SAVE_MODE, $fh;
579 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 618 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
619 aio_fsync $fh;
580 close $fh; 620 close $fh;
621
622 if (@$objs) {
623 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
624 chmod SAVE_MODE, $fh;
625 my $data = Storable::nfreeze { version => 1, objs => $objs };
626 aio_write $fh, 0, (length $data), $data, 0;
627 aio_fsync $fh;
628 close $fh;
581 rename "$filename.pst~", "$filename.pst"; 629 aio_rename "$filename.pst~", "$filename.pst";
630 }
631 } else {
632 aio_unlink "$filename.pst";
633 }
634
635 aio_rename "$filename~", $filename;
582 } else { 636 } else {
583 unlink "$filename.pst"; 637 warn "FATAL: $filename~: $!\n";
584 } 638 }
585
586 rename "$filename~", $filename;
587 } else { 639 } else {
588 warn "FATAL: $filename~: $!\n";
589 }
590 } else {
591 unlink $filename; 640 aio_unlink $filename;
592 unlink "$filename.pst"; 641 aio_unlink "$filename.pst";
642 }
593 } 643 }
594} 644}
595 645
596sub object_freezer_as_string { 646sub object_freezer_as_string {
597 my ($rdata, $objs) = @_; 647 my ($rdata, $objs) = @_;
… …
602} 652}
603 653
604sub object_thawer_load { 654sub object_thawer_load {
605 my ($filename) = @_; 655 my ($filename) = @_;
606 656
607 local $/; 657 my ($data, $av);
608 658
609 my $av; 659 (aio_load $filename, $data) >= 0
660 or return;
610 661
611 #TODO: use sysread etc. 662 unless (aio_stat "$filename.pst") {
612 if (open my $data, "<:raw:perlio", $filename) { 663 (aio_load "$filename.pst", $av) >= 0
613 $data = <$data>; 664 or return;
614 if (open my $pst, "<:raw:perlio", "$filename.pst") {
615 $av = eval { (Storable::thaw <$pst>)->{objs} }; 665 $av = eval { (Storable::thaw <$av>)->{objs} };
616 } 666 }
667
617 return ($data, $av); 668 return ($data, $av);
618 }
619
620 ()
621} 669}
622 670
623############################################################################# 671#############################################################################
624# command handling &c 672# command handling &c
625 673
… …
1233} 1281}
1234 1282
1235############################################################################# 1283#############################################################################
1236# initialisation 1284# initialisation
1237 1285
1238sub _perl_reload() { 1286sub perl_reload() {
1287 # can/must only be called in main
1288 if ($Coro::current != $Coro::main) {
1289 warn "can only reload from main coroutine\n";
1290 return;
1291 }
1292
1239 warn "reloading..."; 1293 warn "reloading...";
1240 1294
1295 local $FREEZE = 1;
1296 cf::emergency_save;
1297
1241 eval { 1298 eval {
1242 local $FREEZE = 1; 1299 # if anything goes wrong in here, we should simply crash as we already saved
1243
1244 cf::emergency_save;
1245 1300
1246 # cancel all watchers 1301 # cancel all watchers
1247 for (Event::all_watchers) { 1302 for (Event::all_watchers) {
1248 $_->cancel if $_->data & WF_AUTOCANCEL; 1303 $_->cancel if $_->data & WF_AUTOCANCEL;
1249 } 1304 }
… …
1308 1363
1309 # reattach attachments to objects 1364 # reattach attachments to objects
1310 warn "reattach"; 1365 warn "reattach";
1311 _global_reattach; 1366 _global_reattach;
1312 }; 1367 };
1313 warn $@ if $@;
1314 1368
1315 warn "reloaded"; 1369 if ($@) {
1370 warn $@;
1371 warn "error while reloading, exiting.";
1372 exit 1;
1373 }
1374
1375 warn "reloaded successfully";
1316}; 1376};
1317
1318sub perl_reload() {
1319 _perl_reload;
1320}
1321 1377
1322register "<global>", __PACKAGE__; 1378register "<global>", __PACKAGE__;
1323 1379
1324register_command "perl-reload" => sub { 1380register_command "perl-reload" => sub {
1325 my ($who, $arg) = @_; 1381 my ($who, $arg) = @_;
1326 1382
1327 if ($who->flag (FLAG_WIZ)) { 1383 if ($who->flag (FLAG_WIZ)) {
1328 $who->message ("reloading..."); 1384 $who->message ("start of reload.");
1329 _perl_reload; 1385 perl_reload;
1386 $who->message ("end of reload.");
1330 } 1387 }
1331}; 1388};
1332 1389
1333unshift @INC, $LIBDIR; 1390unshift @INC, $LIBDIR;
1334 1391

Diff Legend

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