#line 1
package Module::Install;

# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
#     1. Makefile.PL calls "use inc::Module::Install"
#     2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
#     3. The installed version of inc::Module::Install loads
#     4. inc::Module::Install calls "require Module::Install"
#     5. The ./inc/ version of Module::Install loads
# } ELSE {
#     1. Makefile.PL calls "use inc::Module::Install"
#     2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
#     3. The ./inc/ version of Module::Install loads
# }

use 5.004;
use strict 'vars';

use vars qw{$VERSION};

BEGIN {
  # All Module::Install core packages now require synchronised versions.
  # This will be used to ensure we don't accidentally load old or
  # different versions of modules.
  # This is not enforced yet, but will be some time in the next few
  # releases once we can make sure it won't clash with custom
  # Module::Install extensions.
  $VERSION = '0.68';
}

# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) {
  die <<"END_DIE";
Please invoke ${\__PACKAGE__} with:

    use inc::${\__PACKAGE__};

not:

    use ${\__PACKAGE__};

END_DIE
}

# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 and ( stat( $0 ) )[9] > time ) {
  die << "END_DIE";
Your installer $0 has a modification time in the future.

This is known to create infinite loops in make.

Please correct this, then run $0 again.

END_DIE
}

use Cwd        ();
use File::Find ();
use File::Path ();
use FindBin;

*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA     = __PACKAGE__;

sub autoload {
  my $self = shift;
  my $who  = $self->_caller;
  my $cwd  = Cwd::cwd();
  my $sym  = "${who}::AUTOLOAD";
  $sym->{$cwd} = sub {
    my $pwd = Cwd::cwd();
    if ( my $code = $sym->{$pwd} ) {
      # delegate back to parent dirs
      goto &$code unless $cwd eq $pwd;
    }
    $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
    unshift @_, ( $self, $1 );
    goto &{ $self->can( 'call' ) } unless uc( $1 ) eq $1;
  };
}

sub import {
  my $class = shift;
  my $self  = $class->new( @_ );
  my $who   = $self->_caller;

  unless ( -f $self->{file} ) {
    require "$self->{path}/$self->{dispatch}.pm";
    File::Path::mkpath( "$self->{prefix}/$self->{author}" );
    $self->{admin}
     = "$self->{name}::$self->{dispatch}"->new( _top => $self );
    $self->{admin}->init;
    @_ = ( $class, _self => $self );
    goto &{"$self->{name}::import"};
  }

  *{"${who}::AUTOLOAD"} = $self->autoload;
  $self->preload;

  # Unregister loader and worker packages so subdirs can use them again
  delete $INC{"$self->{file}"};
  delete $INC{"$self->{path}.pm"};
}

sub preload {
  my ( $self ) = @_;

  unless ( $self->{extensions} ) {
    $self->load_extensions( "$self->{prefix}/$self->{path}", $self );
  }

  my @exts = @{ $self->{extensions} };
  unless ( @exts ) {
    my $admin = $self->{admin};
    @exts = $admin->load_all_extensions;
  }

  my %seen;
  foreach my $obj ( @exts ) {
    while ( my ( $method, $glob ) = each %{ ref( $obj ) . '::' } ) {
      next unless $obj->can( $method );
      next if $method =~ /^_/;
      next if $method eq uc( $method );
      $seen{$method}++;
    }
  }

  my $who = $self->_caller;
  foreach my $name ( sort keys %seen ) {
    *{"${who}::$name"} = sub {
      ${"${who}::AUTOLOAD"} = "${who}::$name";
      goto &{"${who}::AUTOLOAD"};
    };
  }
}

sub new {
  my ( $class, %args ) = @_;

  # ignore the prefix on extension modules built from top level.
  my $base_path = Cwd::abs_path( $FindBin::Bin );
  unless ( Cwd::abs_path( Cwd::cwd() ) eq $base_path ) {
    delete $args{prefix};
  }

  return $args{_self} if $args{_self};

  $args{dispatch} ||= 'Admin';
  $args{prefix}   ||= 'inc';
  $args{author}   ||= ( $^O eq 'VMS' ? '_author' : '.author' );
  $args{bundle}   ||= 'inc/BUNDLES';
  $args{base}     ||= $base_path;
  $class =~ s/^\Q$args{prefix}\E:://;
  $args{name} ||= $class;
  $args{version} ||= $class->VERSION;
  unless ( $args{path} ) {
    $args{path} = $args{name};
    $args{path} =~ s!::!/!g;
  }
  $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";

  bless( \%args, $class );
}

sub call {
  my ( $self, $method ) = @_;
  my $obj = $self->load( $method ) or return;
  splice( @_, 0, 2, $obj );
  goto &{ $obj->can( $method ) };
}

sub load {
  my ( $self, $method ) = @_;

  $self->load_extensions( "$self->{prefix}/$self->{path}", $self )
   unless $self->{extensions};

  foreach my $obj ( @{ $self->{extensions} } ) {
    return $obj if $obj->can( $method );
  }

  my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE

  my $obj = $admin->load( $method, 1 );
  push @{ $self->{extensions} }, $obj;

  $obj;
}

sub load_extensions {
  my ( $self, $path, $top ) = @_;

  unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
    unshift @INC, $self->{prefix};
  }

  foreach my $rv ( $self->find_extensions( $path ) ) {
    my ( $file, $pkg ) = @{$rv};
    next if $self->{pathnames}{$pkg};

    local $@;
    my $new = eval { require $file; $pkg->can( 'new' ) };
    unless ( $new ) {
      warn $@ if $@;
      next;
    }
    $self->{pathnames}{$pkg} = delete $INC{$file};
    push @{ $self->{extensions} }, &{$new}( $pkg, _top => $top );
  }

  $self->{extensions} ||= [];
}

sub find_extensions {
  my ( $self, $path ) = @_;

  my @found;
  File::Find::find(
    sub {
      my $file = $File::Find::name;
      return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
      my $subpath = $1;
      return if lc( $subpath ) eq lc( $self->{dispatch} );

      $file = "$self->{path}/$subpath.pm";
      my $pkg = "$self->{name}::$subpath";
      $pkg =~ s!/!::!g;

# If we have a mixed-case package name, assume case has been preserved
# correctly.  Otherwise, root through the file to locate the case-preserved
# version of the package name.
      if ( $subpath eq lc( $subpath ) || $subpath eq uc( $subpath ) ) {
        open PKGFILE, "<$subpath.pm"
         or die "find_extensions: Can't open $subpath.pm: $!";
        my $in_pod = 0;
        while ( <PKGFILE> ) {
          $in_pod = 1 if /^=\w/;
          $in_pod = 0 if /^=cut/;
          next if ( $in_pod || /^=cut/ );    # skip pod text
          next if /^\s*#/;                   # and comments
          if ( m/^\s*package\s+($pkg)\s*;/i ) {
            $pkg = $1;
            last;
          }
        }
        close PKGFILE;
      }

      push @found, [ $file, $pkg ];
    },
    $path
  ) if -d $path;

  @found;
}

sub _caller {
  my $depth = 0;
  my $call  = caller( $depth );
  while ( $call eq __PACKAGE__ ) {
    $depth++;
    $call = caller( $depth );
  }
  return $call;
}

1;
