maps/perl/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;

Event->io (fd   => IO::AIO::poll_fileno,
           poll => 'r',
           cb   => \&IO::AIO::poll_cb);

# 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::has_been_loaded $path) {
            $cb->(), next if $map->in_memory == cf::MAP_IN_MEMORY;

            prefetch file => $map->tmppath
               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;
}

sub on_mapenter {
   my ($ob) = @_;

   prefetch_map $ob->map;
}

# prefetch a few players/second
{
   my @players;

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

      prefetch_map $player->ob->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, 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.6
Committed:	Tue Jul 11 15:37:31 2006 UTC (17 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.5:	+99 -30 lines
Log Message:	improve prefetch to include players and savebed paths remove unsupported on_clock handlers and replace them by timers
#	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	root	1.6	Event->io (fd => IO::AIO::poll_fileno,
13			poll => 'r',
14			cb => \&IO::AIO::poll_cb);
15
16	root	1.2	# find all potential exit paths, this is slow, so this info is cached
17	root	1.1	sub find_exits {
18			my ($map) = @_;
19
20			my %exit;
21
22	root	1.6	# normal exits
23	root	1.1	for my $x (0 .. $map->width - 1) {
24			for my $y (0 .. $map->height - 1) {
25			for (grep $_->type == 66, $map->at ($x, $y)) {
26			my $path = $_->slaying;
27
28			next if 3 > length $path;
29
30	root	1.6	# TODO: improve unique exit detection etc.
31			$exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
32	root	1.1	}
33			}
34			}
35
36	root	1.6	# tiled maps
37			for (0..3) {
38			my $path = $map->tile_path ($_)
39			or next;
40
41			$exit{cf::maps_directory cf::path_combine_and_normalize $map->path, $path}++;
42			}
43
44	root	1.1	[keys %exit]
45			}
46
47	root	1.6	my $PREFETCHING;
48	root	1.5	my @PREFETCH;
49	root	1.6	my %FILE_TIMEOUT;
50	root	1.1
51	root	1.6	sub _prefetch;
52	root	1.1
53	root	1.6	my $empty_cb = sub { };
54	root	1.1
55	root	1.6	sub load_file {
56			my ($path, $cb) = @_;
57	root	1.1
58	root	1.6	my $NOW = Time::HiRes::time;
59	root	1.1
60	root	1.6	aio_open $path, O_RDONLY, 0, sub {
61			my $fh = shift
62			or return $cb->(), _prefetch;
63	root	1.1
64	root	1.6	aio_readahead $fh, 0, -s $fh, sub {
65			my $time = Time::HiRes::time - $NOW;
66			warn "LONG PREFETCH $path $time\n" if $time > 0.3;
67	root	1.5
68	root	1.6	$cb->(), _prefetch;
69	root	1.1	};
70	root	1.6	};
71			}
72
73			sub prefetch($$;$) {
74			my ($type, $path, $cb) = @_;
75
76			push @PREFETCH, [$type, $path, $cb \|\| $empty_cb];
77			_prefetch unless $PREFETCHING;
78			}
79
80			sub _prefetch {
81			$PREFETCHING = 1;
82
83			while (@PREFETCH) {
84			my ($type, $path, $cb) = @{ shift @PREFETCH };
85
86			my $NOW = Time::HiRes::time;
87			$cb->(), next if $FILE_TIMEOUT{$path} > $NOW;
88			$FILE_TIMEOUT{$path} = $NOW + 60 + rand 60;
89	root	1.5
90	root	1.6	if ($type eq "map") {
91			if (my $map = cf::map::has_been_loaded $path) {
92			$cb->(), next if $map->in_memory == cf::MAP_IN_MEMORY;
93
94			prefetch file => $map->tmppath
95			if $map->in_memory == cf::MAP_SWAPPED;
96			}
97			}
98
99			load_file $path, $cb;
100			return;
101	root	1.1	}
102	root	1.6
103			$PREFETCHING = 0;
104	root	1.1	}
105
106	root	1.5	my %MAP_EXITS;
107
108	root	1.6	sub prefetch_map {
109			my ($map) = @_;
110
111			my $exit = $MAP_EXITS{$map->path} \|\|= find_exits $map;
112			prefetch map => $_ for @$exit;
113			}
114
115	root	1.5	sub on_mapenter {
116			my ($ob) = @_;
117
118	root	1.6	prefetch_map $ob->map;
119			}
120	root	1.5
121	root	1.6	# prefetch a few players/second
122			{
123			my @players;
124
125			Event->timer (interval => 0.2, cb => sub {
126			@players = map $_->ob->name, cf::player::list unless @players;
127			my $player = cf::player::find pop @players
128			or return;
129
130			prefetch_map $player->ob->map;
131			prefetch map => +($player->get_savebed)[0];
132			});
133	root	1.5	}
134
135	root	1.6	# prefetch all .pl files every few minutes (thats only a "few" megabytes)
136			Event->timer (after => 1, interval => 600, cb => sub {
137			my $playerdir = cf::localdir . "/" . cf::playerdir;
138
139			aio_readdir $playerdir, sub {
140			my ($players) = @_;
141			my $prefetch; $prefetch = sub {
142			my $player = pop @$players
143			or return;
144
145			load_file "$playerdir/$player/$player.pl", $prefetch;
146			};
147
148			$prefetch->(); $prefetch->();
149			};
150			});
151
152	root	1.1
153