lib/cf/incloader.pm

#
# This file is part of Deliantra, the Roguelike Realtime MMORPG.
#
# Copyright (©) 2005,2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
#
# Deliantra is free software: you can redistribute it and/or modify it under
# the terms of the Affero GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the Affero GNU General Public License
# and the GNU General Public License along with this program. If not, see
# <http://www.gnu.org/licenses/>.
#
# The authors can be reached via e-mail to <support@deliantra.net>
#

package cf::incloader;

use common::sense;

our %FILE; # pre-loaded files
our $S1; # disk-size
our $S2; # memory-size

our $PID = $$;

sub find_inc($) {
   for my $dir (@cf::ORIG_INC) {
      ref $dir and next;

      my $path = "$dir/$_[0]";

      return $path
         unless Coro::AIO::aio_stat $path;
   }

   undef
}

# async inc loader. yay.
sub inc_loader {
   my $mod = $_[1];

   my ($path, $data);

   if (my $file = delete $FILE{$mod}) {
      # we already have it in memory..
      cf::debug "incloader: using preloaded file for $mod";
      $path = $file->[0];
      $data = Compress::LZF::decompress $file->[1];

   } else {
      # we need to load it from disk.

      return if $$ != $PID; # do not do this in child processes

      if (cf::in_main && !cf::tick_inhibit) {
         Carp::cluck "ERROR: attempted synchronous perl module load ($mod)";
         return; # do it blockingly
      } else {
         cf::debug "incloader: loading perl module $mod";
      }

      # find real file
      $path = find_inc $mod;

      defined $path
         or Carp::croak "Can't locate $mod in \@INC";

      0 <= Coro::AIO::aio_load $path, $data
         or next;

      # hackish way to pre-cache .so/.bs files
      if ($path =~ s/\.pm$//) {
         my @c = split /\//, $path;
         for (reverse 2 .. $#c) {
            my $a = join "/", @c[0..$_-1];
            my $b = join "/", @c[$_..$#c];

            Coro::AIO::aio_stat "$a/auto/$b/."
               and next;

            -f _
               or next;

            $path = "$a/auto/$b/";

            cf::debug "incloader: pre-caching $path";

            my $files = Coro::AIO::aio_readdir $path;

            my $grp = IO::AIO::aio_group;

            for my $file (@$files) {
               next if $file =~ /(^\.packlist|\.h$|\.xst$)/;

               add $grp IO::AIO::aio_open "$path/$file", IO::AIO::O_RDONLY, 0, sub {
                  my ($fh) = @_
                     or return;

                  add $grp IO::AIO::aio_stat $fh, sub {
                     my $size = -s _;

                     add $grp IO::AIO::aio_readahead $fh, 0, $size;

                     cf::debug "incloader: pre-caching $path/$file ($size)";
                  };
               };
            }

            Coro::AIO::aio_wait $grp;
            last;
         }
      }
   }

   # avoid upgrade when prepending #line, perlio is bugged
   utf8::downgrade $path, 1;
   $data = "#line 1 $path\n$data";

   open my $fh, "<", \$data or die;

   cf::get_slot 0.1, 10, "\@INC loader" if $PID == $$;

   $fh
}

# load file/directory, so we can load it synchronously
sub preload_($$$) {
   my ($path, $name, $regex) = @_;

   if (exists $INC{$name}) {
      cf::debug "incloader: $name already loaded, not preloading.";
   } else {
      Coro::AIO::aio_stat $path
         and return;

      if (-d _) {
         &preload_ ("$path/$_", "$name/$_", $regex)
            for @{ Coro::AIO::aio_readdir $path };
      } elsif ($name =~ $regex) {
         0 <= Coro::AIO::aio_load $path, my $data
            or die "$path: $!";

         $S1 += length $data;

         $data =~ s/^(?:#[^\n]*\n)+//;
         $data = Compress::LZF::compress $data;
         $S2 += (length $path) + (length $data) + 96;

         $FILE{$name} = [$path, $data];
      }
   }
}

sub preload($;$) {
   my ($name, $regex) = @_;

   my $path = find_inc $name;

   defined $path
      or return;

   preload_ $path, $name, $regex;
}

sub preload_stuff {
   # load some stuff so perl doesn't load it later... :/

   eval { &Storable::nstore_fd };

   preload "utf8_heavy.pl";
   preload "unicore", qr/\.pl$/;

   cf::info "incloader: preloaded $S1 octets from disk, cache now $S2 octets.";
}

sub init {
   # save original @INC
   @cf::ORIG_INC = ($cf::LIBDIR, @INC) unless @cf::ORIG_INC;

   # make sure we can do scalar-opens
   open my $dummy, "<", \my $dummy2;

   preload_stuff;

   @INC = (\&inc_loader, @cf::ORIG_INC); # @ORIG_INC is needed for DynaLoader, AutoLoad etc.

   cf::debug "incloader: module loading will be asynchronous from this point on.";
}

1
Revision:	1.8
Committed:	Wed Nov 21 12:47:04 2012 UTC (13 years, 11 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1
Changes since 1.7:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#
2			# This file is part of Deliantra, the Roguelike Realtime MMORPG.
3	root	1.7	#
4	root	1.6	# Copyright (©) 2005,2006,2007,2008,2009,2010,2011,2012 Marc Alexander Lehmann / Robin Redeker / the Deliantra team
5	root	1.7	#
6	root	1.1	# Deliantra is free software: you can redistribute it and/or modify it under
7			# the terms of the Affero GNU General Public License as published by the
8			# Free Software Foundation, either version 3 of the License, or (at your
9			# option) any later version.
10	root	1.7	#
11	root	1.1	# This program is distributed in the hope that it will be useful,
12			# but WITHOUT ANY WARRANTY; without even the implied warranty of
13			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14			# GNU General Public License for more details.
15	root	1.7	#
16	root	1.1	# You should have received a copy of the Affero GNU General Public License
17			# and the GNU General Public License along with this program. If not, see
18			# <http://www.gnu.org/licenses/>.
19	root	1.7	#
20	root	1.1	# The authors can be reached via e-mail to <support@deliantra.net>
21			#
22
23			package cf::incloader;
24
25			use common::sense;
26
27	root	1.4	our %FILE; # pre-loaded files
28			our $S1; # disk-size
29			our $S2; # memory-size
30
31	root	1.2	our $PID = $$;
32
33	root	1.4	sub find_inc($) {
34			for my $dir (@cf::ORIG_INC) {
35			ref $dir and next;
36
37			my $path = "$dir/$_[0]";
38
39			return $path
40			unless Coro::AIO::aio_stat $path;
41			}
42
43			undef
44			}
45
46	root	1.1	# async inc loader. yay.
47			sub inc_loader {
48			my $mod = $_[1];
49
50	root	1.4	my ($path, $data);
51
52			if (my $file = delete $FILE{$mod}) {
53			# we already have it in memory..
54			cf::debug "incloader: using preloaded file for $mod";
55			$path = $file->[0];
56			$data = Compress::LZF::decompress $file->[1];
57	root	1.2
58	root	1.1	} else {
59	root	1.4	# we need to load it from disk.
60
61			return if $$ != $PID; # do not do this in child processes
62	root	1.1
63	root	1.4	if (cf::in_main && !cf::tick_inhibit) {
64			Carp::cluck "ERROR: attempted synchronous perl module load ($mod)";
65			return; # do it blockingly
66			} else {
67			cf::debug "incloader: loading perl module $mod";
68			}
69	root	1.1
70	root	1.4	# find real file
71			$path = find_inc $mod;
72	root	1.1
73	root	1.4	defined $path
74			or Carp::croak "Can't locate $mod in \@INC";
75	root	1.1
76	root	1.4	0 <= Coro::AIO::aio_load $path, $data
77	root	1.1	or next;
78
79			# hackish way to pre-cache .so/.bs files
80			if ($path =~ s/\.pm$//) {
81			my @c = split /\//, $path;
82			for (reverse 2 .. $#c) {
83			my $a = join "/", @c[0..$_-1];
84			my $b = join "/", @c[$_..$#c];
85
86			Coro::AIO::aio_stat "$a/auto/$b/."
87			and next;
88
89	root	1.4	-f _
90			or next;
91
92	root	1.1	$path = "$a/auto/$b/";
93
94	root	1.4	cf::debug "incloader: pre-caching $path";
95	root	1.1
96			my $files = Coro::AIO::aio_readdir $path;
97
98			my $grp = IO::AIO::aio_group;
99
100			for my $file (@$files) {
101			next if $file =~ /(^\.packlist\|\.h$\|\.xst$)/;
102
103			add $grp IO::AIO::aio_open "$path/$file", IO::AIO::O_RDONLY, 0, sub {
104			my ($fh) = @_
105			or return;
106
107			add $grp IO::AIO::aio_stat $fh, sub {
108			my $size = -s _;
109
110			add $grp IO::AIO::aio_readahead $fh, 0, $size;
111
112	root	1.4	cf::debug "incloader: pre-caching $path/$file ($size)";
113	root	1.1	};
114			};
115			}
116
117			Coro::AIO::aio_wait $grp;
118			last;
119			}
120			}
121	root	1.4	}
122
123			# avoid upgrade when prepending #line, perlio is bugged
124			utf8::downgrade $path, 1;
125			$data = "#line 1 $path\n$data";
126
127			open my $fh, "<", \$data or die;
128	root	1.1
129	root	1.8	cf::get_slot 0.1, 10, "\@INC loader" if $PID == $$;
130	root	1.1
131	root	1.4	$fh
132			}
133
134			# load file/directory, so we can load it synchronously
135			sub preload_($$$) {
136			my ($path, $name, $regex) = @_;
137
138			if (exists $INC{$name}) {
139			cf::debug "incloader: $name already loaded, not preloading.";
140			} else {
141			Coro::AIO::aio_stat $path
142			and return;
143	root	1.1
144	root	1.4	if (-d _) {
145			&preload_ ("$path/$_", "$name/$_", $regex)
146			for @{ Coro::AIO::aio_readdir $path };
147			} elsif ($name =~ $regex) {
148			0 <= Coro::AIO::aio_load $path, my $data
149			or die "$path: $!";
150
151			$S1 += length $data;
152
153			$data =~ s/^(?:#[^\n]*\n)+//;
154			$data = Compress::LZF::compress $data;
155			$S2 += (length $path) + (length $data) + 96;
156
157			$FILE{$name} = [$path, $data];
158			}
159	root	1.1	}
160	root	1.4	}
161
162			sub preload($;$) {
163			my ($name, $regex) = @_;
164	root	1.1
165	root	1.4	my $path = find_inc $name;
166
167			defined $path
168			or return;
169
170			preload_ $path, $name, $regex;
171	root	1.1	}
172
173	root	1.3	sub preload_stuff {
174			# load some stuff so perl doesn't load it later... :/
175
176			eval { &Storable::nstore_fd };
177
178	root	1.4	preload "utf8_heavy.pl";
179			preload "unicore", qr/\.pl$/;
180
181			cf::info "incloader: preloaded $S1 octets from disk, cache now $S2 octets.";
182	root	1.3	}
183
184	root	1.1	sub init {
185			# save original @INC
186			@cf::ORIG_INC = ($cf::LIBDIR, @INC) unless @cf::ORIG_INC;
187
188			# make sure we can do scalar-opens
189			open my $dummy, "<", \my $dummy2;
190
191	root	1.3	preload_stuff;
192	root	1.1
193			@INC = (\&inc_loader, @cf::ORIG_INC); # @ORIG_INC is needed for DynaLoader, AutoLoad etc.
194
195	root	1.4	cf::debug "incloader: module loading will be asynchronous from this point on.";
196	root	1.1	}
197
198			1