lib/cf/incloader.pm

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