server/ext/map-prefetch.ext

#! perl

# this plug-in prefetches maps. everytime a player enters a map,
# it will asynchronously prefetch files from disk (it will not load them
# into the server, but into the OS cache only).

use Errno ();
use Time::HiRes;
use Fcntl;
use IO::AIO;

# find all potential exit paths, this is slow, so this info is cached
sub find_exits {
   my ($map) = @_;

   my %exit;

   # normal exits
   for my $x (0 .. $map->width - 1) {
      for my $y (0 .. $map->height - 1) {
         for (grep $_->type == 66, $map->at ($x, $y)) {
            my $path = $_->slaying;

            next if 3 > length $path;

            # TODO: improve unique exit detection etc.
            $exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
         }
      }
   }

   # tiled maps
   for (0..3) {
      my $path = $map->tile_path ($_)
         or next;

      $exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
   }

   [keys %exit]
}

my $PREFETCHING;
my @PREFETCH;
my %FILE_TIMEOUT;

sub _prefetch;

my $empty_cb = sub { };

sub load_file {
   my ($path, $cb) = @_;

   my $NOW = Time::HiRes::time;

   aio_open $path, O_RDONLY, 0, sub {
      my $fh = shift
        or return $cb->(), _prefetch;

      aio_readahead $fh, 0, -s $fh, sub {
         my $time = Time::HiRes::time - $NOW;
         warn "LONG PREFETCH $path $time\n" if $time > 0.3;

         $cb->(), _prefetch;
      };
   };
}

sub prefetch($$;$) {
   my ($type, $path, $cb) = @_;

   push @PREFETCH, [$type, $path, $cb || $empty_cb];
   _prefetch unless $PREFETCHING;
}

sub _prefetch {
   $PREFETCHING = 1;

#   while (@PREFETCH) {
#      my ($type, $path, $cb) = @{ shift @PREFETCH };
# 
#      my $NOW = Time::HiRes::time;
#      $cb->(), next if $FILE_TIMEOUT{$path} > $NOW;
#      $FILE_TIMEOUT{$path} = $NOW + 60 + rand 60;
# 
#      if ($type eq "map") {
#         if (my $map = cf::map::find $path) {
#            $cb->(), next if $map->in_memory == cf::MAP_IN_MEMORY;
# 
#            prefetch file => $map->tmpname
#               if $map->in_memory == cf::MAP_SWAPPED;
#         }
#      }
# 
#      load_file $path, $cb;
#      return;
#   }

   $PREFETCHING = 0;
}

my %MAP_EXITS;

sub prefetch_map($) {
   my ($map) = @_;

   my $exit = $MAP_EXITS{$map->path} ||= find_exits $map;
   prefetch map => $_ for @$exit;
}

cf::player->attach (
   prio          => -900,
   on_map_change => sub {
      my ($pl, $new, $x, $x) = @_;

      prefetch_map $new;
   },
);

if (0) { #test#
# prefetch a few players/second
{
   my @players;

   Event->timer (interval => 0.2, data => cf::WF_AUTOCANCEL, cb => sub {
      @players = map $_->ob->name, cf::player::list unless @players;
      my $player = cf::player::find_active pop @players
         or return;

      if (my $map = $player->ob->map) {
         prefetch_map $map;
      }

      prefetch map => +($player->get_savebed)[0];
   });
}

# prefetch all .pl files every few minutes (thats only a "few" megabytes)
Event->timer (after => 1, interval => 600, data => cf::WF_AUTOCANCEL, cb => sub {
   my $playerdir = cf::localdir . "/" . cf::playerdir;

   aio_readdir $playerdir, sub {
      my ($players) = @_;
      my $prefetch; $prefetch = sub {
         my $player = pop @$players
            or return;

         load_file "$playerdir/$player/$player.pl", $prefetch;
      };

      $prefetch->(); $prefetch->();
   };
});
}


Revision:	1.5
Committed:	Mon Jan 8 20:59:15 2007 UTC (17 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.4:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	some dirty hacks^Wfixes, also remove dthe now obsolete map-prefetch plugin
#	User	Rev	Content
1	root	1.1	#! perl
2
3			# this plug-in prefetches maps. everytime a player enters a map,
4			# it will asynchronously prefetch files from disk (it will not load them
5			# into the server, but into the OS cache only).
6
7			use Errno ();
8			use Time::HiRes;
9			use Fcntl;
10			use IO::AIO;
11
12			# find all potential exit paths, this is slow, so this info is cached
13			sub find_exits {
14			my ($map) = @_;
15
16			my %exit;
17
18			# normal exits
19			for my $x (0 .. $map->width - 1) {
20			for my $y (0 .. $map->height - 1) {
21			for (grep $_->type == 66, $map->at ($x, $y)) {
22			my $path = $_->slaying;
23
24			next if 3 > length $path;
25
26			# TODO: improve unique exit detection etc.
27			$exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
28			}
29			}
30			}
31
32			# tiled maps
33			for (0..3) {
34			my $path = $map->tile_path ($_)
35			or next;
36
37			$exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
38			}
39
40			[keys %exit]
41			}
42
43			my $PREFETCHING;
44			my @PREFETCH;
45			my %FILE_TIMEOUT;
46
47			sub _prefetch;
48
49			my $empty_cb = sub { };
50
51			sub load_file {
52			my ($path, $cb) = @_;
53
54			my $NOW = Time::HiRes::time;
55
56			aio_open $path, O_RDONLY, 0, sub {
57			my $fh = shift
58			or return $cb->(), _prefetch;
59
60			aio_readahead $fh, 0, -s $fh, sub {
61			my $time = Time::HiRes::time - $NOW;
62			warn "LONG PREFETCH $path $time\n" if $time > 0.3;
63
64			$cb->(), _prefetch;
65			};
66			};
67			}
68
69			sub prefetch($$;$) {
70			my ($type, $path, $cb) = @_;
71
72			push @PREFETCH, [$type, $path, $cb \|\| $empty_cb];
73			_prefetch unless $PREFETCHING;
74			}
75
76			sub _prefetch {
77			$PREFETCHING = 1;
78
79	root	1.3	# while (@PREFETCH) {
80			# my ($type, $path, $cb) = @{ shift @PREFETCH };
81			#
82			# my $NOW = Time::HiRes::time;
83			# $cb->(), next if $FILE_TIMEOUT{$path} > $NOW;
84			# $FILE_TIMEOUT{$path} = $NOW + 60 + rand 60;
85			#
86			# if ($type eq "map") {
87			# if (my $map = cf::map::find $path) {
88			# $cb->(), next if $map->in_memory == cf::MAP_IN_MEMORY;
89			#
90			# prefetch file => $map->tmpname
91			# if $map->in_memory == cf::MAP_SWAPPED;
92			# }
93			# }
94			#
95			# load_file $path, $cb;
96			# return;
97			# }
98	root	1.1
99			$PREFETCHING = 0;
100			}
101
102			my %MAP_EXITS;
103
104			sub prefetch_map($) {
105			my ($map) = @_;
106
107			my $exit = $MAP_EXITS{$map->path} \|\|= find_exits $map;
108			prefetch map => $_ for @$exit;
109			}
110
111	root	1.2	cf::player->attach (
112			prio => -900,
113	root	1.1	on_map_change => sub {
114			my ($pl, $new, $x, $x) = @_;
115
116			prefetch_map $new;
117			},
118	root	1.2	);
119	root	1.1
120			if (0) { #test#
121			# prefetch a few players/second
122			{
123			my @players;
124
125			Event->timer (interval => 0.2, data => cf::WF_AUTOCANCEL, cb => sub {
126			@players = map $_->ob->name, cf::player::list unless @players;
127	root	1.4	my $player = cf::player::find_active pop @players
128	root	1.1	or return;
129
130			if (my $map = $player->ob->map) {
131			prefetch_map $map;
132			}
133
134			prefetch map => +($player->get_savebed)[0];
135			});
136			}
137
138			# prefetch all .pl files every few minutes (thats only a "few" megabytes)
139			Event->timer (after => 1, interval => 600, data => cf::WF_AUTOCANCEL, cb => sub {
140			my $playerdir = cf::localdir . "/" . cf::playerdir;
141
142			aio_readdir $playerdir, sub {
143			my ($players) = @_;
144			my $prefetch; $prefetch = sub {
145			my $player = pop @$players
146			or return;
147
148			load_file "$playerdir/$player/$player.pl", $prefetch;
149			};
150
151			$prefetch->(); $prefetch->();
152			};
153			});
154			}
155
156
157