#
# 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