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).

if (0) { #test#
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->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;
}

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;

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