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.59 by root, Wed Aug 30 16:30: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_reload_1; 21_init_vars;
17 22
18our %COMMAND = (); 23our %COMMAND = ();
19our @EVENT; 24our @EVENT;
20our %PROP_TYPE;
21our %PROP_IDX;
22our $LIBDIR = maps_directory "perl"; 25our $LIBDIR = maps_directory "perl";
23 26
24our $TICK = MAX_TIME * 1e-6; 27our $TICK = MAX_TIME * 1e-6;
25our $TICK_WATCHER; 28our $TICK_WATCHER;
26our $NEXT_TICK; 29our $NEXT_TICK;
30
31our %CFG;
32
33our $uptime;
34
35$uptime ||= time;
36
37#############################################################################
38
39=head2 GLOBAL VARIABLES
40
41=over 4
42
43=item $cf::LIBDIR
44
45The perl library directory, where extensions and cf-specific modules can
46be found. It will be added to C<@INC> automatically.
47
48=item $cf::TICK
49
50The interval between server ticks, in seconds.
51
52=item %cf::CFG
53
54Configuration for the server, loaded from C</etc/crossfire/config>, or
55from wherever your confdir points to.
56
57=back
58
59=cut
27 60
28BEGIN { 61BEGIN {
29 *CORE::GLOBAL::warn = sub { 62 *CORE::GLOBAL::warn = sub {
30 my $msg = join "", @_; 63 my $msg = join "", @_;
31 $msg .= "\n" 64 $msg .= "\n"
34 print STDERR "cfperl: $msg"; 67 print STDERR "cfperl: $msg";
35 LOG llevError, "cfperl: $msg"; 68 LOG llevError, "cfperl: $msg";
36 }; 69 };
37} 70}
38 71
39my %ignore_set = (MAP_PROP_PATH => 1); # I hate the plug-in api. Deeply!
40
41# generate property mutators
42sub prop_gen {
43 my ($prefix, $class) = @_;
44
45 no strict 'refs';
46
47 for my $prop (keys %PROP_TYPE) {
48 $prop =~ /^\Q$prefix\E_(.*$)/ or next;
49 my $sub = lc $1;
50
51 my $type = $PROP_TYPE{$prop};
52 my $idx = $PROP_IDX {$prop};
53
54 *{"$class\::get_$sub"} = *{"$class\::$sub"} = sub {
55 $_[0]->get_property ($type, $idx)
56 };
57
58 *{"$class\::set_$sub"} = sub {
59 $_[0]->set_property ($type, $idx, $_[1]);
60 } unless $ignore_set{$prop};
61 }
62}
63
64# auto-generate most of the API
65
66prop_gen OBJECT_PROP => "cf::object";
67# CFAPI_OBJECT_ANIMATION?
68prop_gen PLAYER_PROP => "cf::object::player";
69
70prop_gen MAP_PROP => "cf::map";
71prop_gen ARCH_PROP => "cf::arch";
72
73@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object'; 72@safe::cf::object::player::ISA = @cf::object::player::ISA = 'cf::object';
74 73
75# we bless all objects into (empty) derived classes to force a method lookup 74# we bless all objects into (empty) derived classes to force a method lookup
76# within the Safe compartment. 75# within the Safe compartment.
77for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch cf::living)) { 76for my $pkg (qw(cf::object cf::object::player cf::player cf::map cf::party cf::region cf::arch cf::living)) {
87my @exts; 86my @exts;
88my @hook; 87my @hook;
89my %command; 88my %command;
90my %extcmd; 89my %extcmd;
91 90
92############################################################################# 91=head2 UTILITY FUNCTIONS
93# utility functions 92
93=over 4
94
95=cut
94 96
95use JSON::Syck (); # TODO# replace by JSON::PC once working 97use JSON::Syck (); # TODO# replace by JSON::PC once working
98
99=item $ref = cf::from_json $json
100
101Converts a JSON string into the corresponding perl data structure.
102
103=cut
96 104
97sub from_json($) { 105sub from_json($) {
98 $JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs 106 $JSON::Syck::ImplicitUnicode = 1; # work around JSON::Syck bugs
99 JSON::Syck::Load $_[0] 107 JSON::Syck::Load $_[0]
100} 108}
101 109
110=item $json = cf::to_json $ref
111
112Converts a perl data structure into its JSON representation.
113
114=cut
115
102sub to_json($) { 116sub to_json($) {
103 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 117 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
104 JSON::Syck::Dump $_[0] 118 JSON::Syck::Dump $_[0]
105} 119}
106 120
107############################################################################# 121=back
108# "new" plug-in system
109 122
123=cut
124
125#############################################################################
126
110=head3 EVENTS AND OBJECT ATTACHMENTS 127=head2 EVENTS AND OBJECT ATTACHMENTS
111 128
112=over 4 129=over 4
113 130
114=item $object->attach ($attachment, key => $value...) 131=item $object->attach ($attachment, key => $value...)
115 132
389 for (@$callbacks) { 406 for (@$callbacks) {
390 eval { &{$_->[1]} }; 407 eval { &{$_->[1]} };
391 408
392 if ($@) { 409 if ($@) {
393 warn "$@"; 410 warn "$@";
394 warn "... while processing $EVENT[$event][0] event, skipping processing altogether.\n"; 411 warn "... while processing $EVENT[$event][0](@_) event, skipping processing altogether.\n";
395 override; 412 override;
396 } 413 }
397 414
398 return 1 if $override; 415 return 1 if $override;
399 } 416 }
415removed 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
416results (if you must, access C<@cf::invoke_results> directly). 433results (if you must, access C<@cf::invoke_results> directly).
417 434
418=back 435=back
419 436
420=head2 methods valid for all pointers 437=cut
438
439#############################################################################
440
441=head2 METHODS VALID FOR ALL CORE OBJECTS
421 442
422=over 4 443=over 4
423 444
424=item $object->valid 445=item $object->valid, $player->valid, $map->valid
425
426=item $player->valid
427
428=item $map->valid
429 446
430Just because you have a perl object does not mean that the corresponding 447Just because you have a perl object does not mean that the corresponding
431C-level object still exists. If you try to access an object that has no 448C-level object still exists. If you try to access an object that has no
432valid C counterpart anymore you get an exception at runtime. This method 449valid C counterpart anymore you get an exception at runtime. This method
433can be used to test for existence of the C object part without causing an 450can be used to test for existence of the C object part without causing an
478} 495}
479 496
480sub object_freezer_save { 497sub object_freezer_save {
481 my ($filename, $rdata, $objs) = @_; 498 my ($filename, $rdata, $objs) = @_;
482 499
500 if (length $$rdata) {
501 warn sprintf "saving %s (%d,%d)\n",
502 $filename, length $$rdata, scalar @$objs;
503
483 if (open my $fh, ">:raw", "$filename~") { 504 if (open my $fh, ">:raw", "$filename~") {
484 chmod SAVE_MODE, $fh;
485 syswrite $fh, $$rdata;
486 close $fh;
487
488 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
489 chmod SAVE_MODE, $fh; 505 chmod SAVE_MODE, $fh;
490 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 506 syswrite $fh, $$rdata;
491 close $fh; 507 close $fh;
508
509 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
510 chmod SAVE_MODE, $fh;
511 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs };
512 close $fh;
492 rename "$filename.pst~", "$filename.pst"; 513 rename "$filename.pst~", "$filename.pst";
514 } else {
515 unlink "$filename.pst";
516 }
517
518 rename "$filename~", $filename;
493 } else { 519 } else {
494 unlink "$filename.pst"; 520 warn "FATAL: $filename~: $!\n";
495 } 521 }
496
497 rename "$filename~", $filename;
498 } else { 522 } else {
499 warn "FATAL: $filename~: $!\n"; 523 unlink $filename;
524 unlink "$filename.pst";
500 } 525 }
501} 526}
502 527
503sub object_thawer_load { 528sub object_thawer_load {
504 my ($filename) = @_; 529 my ($filename) = @_;
505 530
531 local $/;
532
533 my $av;
534
535 #TODO: use sysread etc.
536 if (open my $data, "<:raw:perlio", $filename) {
537 $data = <$data>;
506 open my $fh, "<:raw:perlio", "$filename.pst" 538 if (open my $pst, "<:raw:perlio", "$filename.pst") {
507 or return; 539 $av = eval { (Storable::thaw <$pst>)->{objs} };
540 }
541 return ($data, $av);
542 }
508 543
509 eval { local $/; (Storable::thaw <$fh>)->{objs} } 544 ()
510} 545}
511 546
512attach_to_objects 547attach_to_objects
513 prio => -1000000, 548 prio => -1000000,
514 on_clone => sub { 549 on_clone => sub {
660 load_extension $ext; 695 load_extension $ext;
661 1 696 1
662 } or warn "$ext not loaded: $@"; 697 } or warn "$ext not loaded: $@";
663 } 698 }
664} 699}
665
666sub _perl_reload(&) {
667 my ($msg) = @_;
668
669 $msg->("reloading...");
670
671 eval {
672 # 1. cancel all watchers
673 $_->cancel for Event::all_watchers;
674
675 # 2. unload all extensions
676 for (@exts) {
677 $msg->("unloading <$_>");
678 unload_extension $_;
679 }
680
681 # 3. unload all modules loaded from $LIBDIR
682 while (my ($k, $v) = each %INC) {
683 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
684
685 $msg->("removing <$k>");
686 delete $INC{$k};
687
688 $k =~ s/\.pm$//;
689 $k =~ s/\//::/g;
690
691 if (my $cb = $k->can ("unload_module")) {
692 $cb->();
693 }
694
695 Symbol::delete_package $k;
696 }
697
698 # 4. get rid of safe::, as good as possible
699 Symbol::delete_package "safe::$_"
700 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
701
702 # 5. remove register_script_function callbacks
703 # TODO
704
705 # 6. unload cf.pm "a bit"
706 delete $INC{"cf.pm"};
707
708 # don't, removes xs symbols, too,
709 # and global variables created in xs
710 #Symbol::delete_package __PACKAGE__;
711
712 # 7. reload cf.pm
713 $msg->("reloading cf.pm");
714 require cf;
715 };
716 $msg->($@) if $@;
717
718 $msg->("reloaded");
719};
720
721sub perl_reload() {
722 _perl_reload {
723 warn $_[0];
724 print "$_[0]\n";
725 };
726}
727
728register_command "perl-reload", 0, sub {
729 my ($who, $arg) = @_;
730
731 if ($who->flag (FLAG_WIZ)) {
732 _perl_reload {
733 warn $_[0];
734 $who->message ($_[0]);
735 };
736 }
737};
738 700
739############################################################################# 701#############################################################################
740# extcmd framework, basically convert ext <msg> 702# extcmd framework, basically convert ext <msg>
741# into pkg::->on_extcmd_arg1 (...) while shortcutting a few 703# into pkg::->on_extcmd_arg1 (...) while shortcutting a few
742 704
779 741
780sub all_objects(@) { 742sub all_objects(@) {
781 @_, map all_objects ($_->inv), @_ 743 @_, map all_objects ($_->inv), @_
782} 744}
783 745
746# TODO: compatibility cruft, remove when no longer needed
784attach_to_players 747attach_to_players
785 on_load => sub { 748 on_load => sub {
786 my ($pl, $path) = @_; 749 my ($pl, $path) = @_;
787 750
788 for my $o (all_objects $pl->ob) { 751 for my $o (all_objects $pl->ob) {
794 } 757 }
795 }, 758 },
796; 759;
797 760
798############################################################################# 761#############################################################################
799# core extensions - in perl 762
763=head2 CORE EXTENSIONS
764
765Functions and methods that extend core crossfire objects.
766
767=over 4
800 768
801=item cf::player::exists $login 769=item cf::player::exists $login
802 770
803Returns true when the given account exists. 771Returns true when the given account exists.
804 772
807sub cf::player::exists($) { 775sub cf::player::exists($) {
808 cf::player::find $_[0] 776 cf::player::find $_[0]
809 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;
810} 778}
811 779
812=item $player->reply ($npc, $msg[, $flags]) 780=item $object->reply ($npc, $msg[, $flags])
813 781
814Sends 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>
815can 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
816dialogue with the given NPC character. 784dialogue with the given NPC character.
817 785
844 $msg{msgid} = $id; 812 $msg{msgid} = $id;
845 813
846 $self->send ("ext " . to_json \%msg); 814 $self->send ("ext " . to_json \%msg);
847} 815}
848 816
817=back
818
819=cut
820
849############################################################################# 821#############################################################################
850# map scripting support 822
823=head2 SAFE SCRIPTING
824
825Functions that provide a safe environment to compile and execute
826snippets of perl code without them endangering the safety of the server
827itself. Looping constructs, I/O operators and other built-in functionality
828is not available in the safe scripting environment, and the number of
829functions and methods that cna be called is greatly reduced.
830
831=cut
851 832
852our $safe = new Safe "safe"; 833our $safe = new Safe "safe";
853our $safe_hole = new Safe::Hole; 834our $safe_hole = new Safe::Hole;
854 835
855$SIG{FPE} = 'IGNORE'; 836$SIG{FPE} = 'IGNORE';
856 837
857$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); 838$safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time));
858 839
859# here we export the classes and methods available to script code 840# here we export the classes and methods available to script code
841
842=pod
843
844The following fucntions and emthods are available within a safe environment:
845
846 cf::object contr pay_amount pay_player
847 cf::object::player player
848 cf::player peaceful
849
850=cut
860 851
861for ( 852for (
862 ["cf::object" => qw(contr pay_amount pay_player)], 853 ["cf::object" => qw(contr pay_amount pay_player)],
863 ["cf::object::player" => qw(player)], 854 ["cf::object::player" => qw(player)],
864 ["cf::player" => qw(peaceful)], 855 ["cf::player" => qw(peaceful)],
867 my ($pkg, @funs) = @$_; 858 my ($pkg, @funs) = @$_;
868 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"}) 859 *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
869 for @funs; 860 for @funs;
870} 861}
871 862
863=over 4
864
865=item @retval = safe_eval $code, [var => value, ...]
866
867Compiled and executes the given perl code snippet. additional var/value
868pairs result in temporary local (my) scalar variables of the given name
869that are available in the code snippet. Example:
870
871 my $five = safe_eval '$first + $second', first => 1, second => 4;
872
873=cut
874
872sub safe_eval($;@) { 875sub safe_eval($;@) {
873 my ($code, %vars) = @_; 876 my ($code, %vars) = @_;
874 877
875 my $qcode = $code; 878 my $qcode = $code;
876 $qcode =~ s/"/‟/g; # not allowed in #line filenames 879 $qcode =~ s/"/‟/g; # not allowed in #line filenames
898 } 901 }
899 902
900 wantarray ? @res : $res[0] 903 wantarray ? @res : $res[0]
901} 904}
902 905
906=item cf::register_script_function $function => $cb
907
908Register a function that can be called from within map/npc scripts. The
909function should be reasonably secure and should be put into a package name
910like the extension.
911
912Example: register a function that gets called whenever a map script calls
913C<rent::overview>, as used by the C<rent> extension.
914
915 cf::register_script_function "rent::overview" => sub {
916 ...
917 };
918
919=cut
920
903sub register_script_function { 921sub register_script_function {
904 my ($fun, $cb) = @_; 922 my ($fun, $cb) = @_;
905 923
906 no strict 'refs'; 924 no strict 'refs';
907 *{"safe::$fun"} = $safe_hole->wrap ($cb); 925 *{"safe::$fun"} = $safe_hole->wrap ($cb);
908} 926}
909 927
928=back
929
930=cut
931
932#############################################################################
933
934=head2 EXTENSION DATABASE SUPPORT
935
936Crossfire maintains a very simple database for extension use. It can
937currently store anything that can be serialised using Storable, which
938excludes objects.
939
940The parameter C<$family> should best start with the name of the extension
941using it, it should be unique.
942
943=over 4
944
945=item $hashref = cf::db_get $family
946
947Return a hashref for use by the extension C<$family>, which can be
948modified. After modifications, you have to call C<cf::db_dirty> or
949C<cf::db_sync>.
950
951=item $value = cf::db_get $family => $key
952
953Returns a single value from the database
954
955=item cf::db_put $family => $hashref
956
957Stores the given family hashref into the database. Updates are delayed, if
958you want the data to be synced to disk immediately, use C<cf::db_sync>.
959
960=item cf::db_put $family => $key => $value
961
962Stores the given C<$value> in the family hash. Updates are delayed, if you
963want the data to be synced to disk immediately, use C<cf::db_sync>.
964
965=item cf::db_dirty
966
967Marks the database as dirty, to be updated at a later time.
968
969=item cf::db_sync
970
971Immediately write the database to disk I<if it is dirty>.
972
973=cut
974
975{
976 my $db;
977 my $path = cf::localdir . "/database.pst";
978
979 sub db_load() {
980 warn "loading database $path\n";#d# remove later
981 $db = stat $path ? Storable::retrieve $path : { };
982 }
983
984 my $pid;
985
986 sub db_save() {
987 warn "saving database $path\n";#d# remove later
988 waitpid $pid, 0 if $pid;
989 if (0 == ($pid = fork)) {
990 $db->{_meta}{version} = 1;
991 Storable::nstore $db, "$path~";
992 rename "$path~", $path;
993 cf::_exit 0 if defined $pid;
994 }
995 }
996
997 my $dirty;
998
999 sub db_sync() {
1000 db_save if $dirty;
1001 undef $dirty;
1002 }
1003
1004 my $idle = Event->idle (min => $TICK * 2.8, max => 10, repeat => 0, cb => sub {
1005 db_sync;
1006 });
1007
1008 sub db_dirty() {
1009 $dirty = 1;
1010 $idle->start;
1011 }
1012
1013 sub db_get($;$) {
1014 @_ >= 2
1015 ? $db->{$_[0]}{$_[1]}
1016 : ($db->{$_[0]} ||= { })
1017 }
1018
1019 sub db_put($$;$) {
1020 if (@_ >= 3) {
1021 $db->{$_[0]}{$_[1]} = $_[2];
1022 } else {
1023 $db->{$_[0]} = $_[1];
1024 }
1025 db_dirty;
1026 }
1027
1028 attach_global
1029 prio => 10000,
1030 on_cleanup => sub {
1031 db_sync;
1032 },
1033 ;
1034}
1035
910############################################################################# 1036#############################################################################
911# the server's main() 1037# the server's main()
912 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
913sub main { 1047sub main {
1048 cfg_load;
1049 db_load;
1050 load_extensions;
914 Event::loop; 1051 Event::loop;
915} 1052}
916 1053
917############################################################################# 1054#############################################################################
918# initialisation 1055# initialisation
919 1056
1057sub _perl_reload(&) {
1058 my ($msg) = @_;
1059
1060 $msg->("reloading...");
1061
1062 eval {
1063 # cancel all watchers
1064 $_->cancel for Event::all_watchers;
1065
1066 # unload all extensions
1067 for (@exts) {
1068 $msg->("unloading <$_>");
1069 unload_extension $_;
1070 }
1071
1072 # unload all modules loaded from $LIBDIR
1073 while (my ($k, $v) = each %INC) {
1074 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
1075
1076 $msg->("removing <$k>");
1077 delete $INC{$k};
1078
1079 $k =~ s/\.pm$//;
1080 $k =~ s/\//::/g;
1081
1082 if (my $cb = $k->can ("unload_module")) {
1083 $cb->();
1084 }
1085
1086 Symbol::delete_package $k;
1087 }
1088
1089 # sync database to disk
1090 cf::db_sync;
1091
1092 # get rid of safe::, as good as possible
1093 Symbol::delete_package "safe::$_"
1094 for qw(cf::object cf::object::player cf::player cf::map cf::party cf::region);
1095
1096 # remove register_script_function callbacks
1097 # TODO
1098
1099 # unload cf.pm "a bit"
1100 delete $INC{"cf.pm"};
1101
1102 # don't, removes xs symbols, too,
1103 # and global variables created in xs
1104 #Symbol::delete_package __PACKAGE__;
1105
1106 # reload cf.pm
1107 $msg->("reloading cf.pm");
1108 require cf;
1109
1110 # load config and database again
1111 cf::cfg_load;
1112 cf::db_load;
1113
1114 # load extensions
1115 $msg->("load extensions");
1116 cf::load_extensions;
1117
1118 # reattach attachments to objects
1119 $msg->("reattach");
1120 _global_reattach;
1121 };
1122 $msg->($@) if $@;
1123
1124 $msg->("reloaded");
1125};
1126
1127sub perl_reload() {
1128 _perl_reload {
1129 warn $_[0];
1130 print "$_[0]\n";
1131 };
1132}
1133
1134register_command "perl-reload", 0, sub {
1135 my ($who, $arg) = @_;
1136
1137 if ($who->flag (FLAG_WIZ)) {
1138 _perl_reload {
1139 warn $_[0];
1140 $who->message ($_[0]);
1141 };
1142 }
1143};
1144
920register "<global>", __PACKAGE__; 1145register "<global>", __PACKAGE__;
921 1146
922unshift @INC, $LIBDIR; 1147unshift @INC, $LIBDIR;
923 1148
924load_extensions;
925
926$TICK_WATCHER = Event->timer ( 1149$TICK_WATCHER = Event->timer (
927 prio => 1, 1150 prio => 1,
1151 async => 1,
928 at => $NEXT_TICK || 1, 1152 at => $NEXT_TICK || 1,
929 cb => sub { 1153 cb => sub {
930 cf::server_tick; # one server iteration 1154 cf::server_tick; # one server iteration
931 1155
932 my $NOW = Event::time; 1156 my $NOW = Event::time;
933 $NEXT_TICK += $TICK; 1157 $NEXT_TICK += $TICK;
934 1158
938 $TICK_WATCHER->at ($NEXT_TICK); 1162 $TICK_WATCHER->at ($NEXT_TICK);
939 $TICK_WATCHER->start; 1163 $TICK_WATCHER->start;
940 }, 1164 },
941); 1165);
942 1166
943_reload_2; 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);
944 1173
9451 11741
946 1175

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines