package ExtUtils::ModsInstalled;
# Last modified: 26 Sep 2006 at 02:35 AM EDT
#-----------------------------------------------------------------#
# Inherit from ExtUtils::Installed and discover other branches to 
# add to the two subtrees searched for .packlist files.           
# Author: Soren Andersen <somian *AT* cpan -DOT- org>             
# Status: experimental (pre-beta)                                 
# License: As for Perl                                            
#-----------------------------------------------------------------#

use base 'ExtUtils::Installed';
use Config ();
use File::Find 'find';
require ExtUtils::MM;
require VMS::Filespec if $^O eq 'VMS';
use strict;
use warnings;

use vars qw/ @autoparents %Config $VERSION
   @Hardwired_in_Config $OurDbg $MSish /;
$VERSION = '0.01';
*Config = \%Config::Config;
$MSish = ($^O =~ /^((?i:MSWin\d?\d?)|os2|dos|mint)$/);
@Hardwired_in_Config = qw(sitearch vendorarch archlib);
$OurDbg = 0; # Turn off after testing any modifications

{
    no strict 'refs';
    @autoparents =
                   map { s{\\}{/}g if $MSish;
			 ($^O eq 'VMS'
			       ? VMS::Filespec::unixify($_)
			       : File::Spec::Unix->canonpath($_))  }
		   grep {$_} map($Config{"${_}exp"}, @Hardwired_in_Config);
}

my $onlyonce = { map (($_,1),@autoparents) };
unshift @autoparents, $_ for
             grep {$_ && !$onlyonce->{$_}++ && -d "${_}/auto"}
                 map { s{\\}{/}g if $MSish;
		      ($^O eq 'VMS'
			       ? VMS::Filespec::unixify($_)
			       : File::Spec::Unix->canonpath($_)) }
	     grep($_ ne '.',@INC);

if ($OurDbg) {
    printf STDERR "WARNING: %s was not tested with this more ".
       "recent release (%s) of ExtUtils::Installed\n",__PACKAGE__,
           $ExtUtils::Installed::VERSION if 
              $ExtUtils::Installed::VERSION > 0.08;

    print STDERR "Will look for .packlist files under:$/";
    print STDERR $_ for
    map { sprintf qq[%s\n   %s\n],$_, `du -sh "$_/auto"` } @autoparents;
}

# Much of our constructor is just lifted verbatim from EU::Installed 0.08.
sub new {
    my ($class) = @_;
    $class = ref($class) || $class;
    my $self = {};

    my $archlib = $autoparents[$#autoparents];
    # Read the core packlist
    $self->{Perl}{packlist} =
      ExtUtils::Packlist->new( File::Spec->catfile($archlib, '.packlist') );
    $self->{Perl}{version} = $Config{version};

    # Read the individual module packlists
    my $sub = sub {
        # Only process module .packlists
        return if $_ ne ".packlist" || $File::Find::dir eq $archlib;

	my ($fqmodpn, $module, $modname);
        $module = $File::Find::name;
	$module =~ s{\\}{/}g if $MSish;
	$fqmodpn = $module;

        # Behead the pathname & convert what is left to a module name
        for my $instloc (@autoparents) {
	    $module=~ s!\Q${instloc}\E/auto/(.*)/.packlist!$1!s and
	    $modname = $1 and last;
	}
	return unless $modname;

        my $modfile = "$modname.pm";
        $modname =~ s!/!::!g;

        # Find the namespace-top module file in the @INC pathlist
        $self->{$modname}{version} = '';
        foreach my $dir (@INC) {
            my $p = File::Spec->catfile($dir, $modfile);
            if (-r $p) {
                $modname = _module_name($p, $modname) if $^O eq 'VMS';
                $self->{$modname}{version} = MM->parse_version($p);
                last;
            }
        }
        # Read the .packlist
        $self->{$modname}{packlist} = 
          ExtUtils::Packlist->new($fqmodpn);
	warn "No .packlist for $modname?!" unless $self->{$modname}{packlist};
    };

    my(@dirs) = grep { -e } @autoparents;
    find($sub, @dirs) if @dirs;
    return(bless($self, $class));
}

1; # ARRET! (All Real modules must REturn True)
__END__

=head1 NAME

ExtUtils::ModsInstalled - like EU::Installed but discover
other branches to add to the two subtrees searched for .packlist files.

=head1 SYNOPSIS
  From the commandline:

 $ perl -MExtUtils::ModsInstalled -l \
    -e'my $in=ExtUtils::ModsInstalled->new;' \
    -e'push @mods,$_ for grep(/\Q$ARGV[0]/,$in->modules);' \
    -e'print for map{sprintf qq[\n%-56s %s\n].("-"x68).q[%s],$_,$in->version($_),' \
    -e'join("$/   ","",$in->directories($_,"all"))} @mods' \
   Image


=head1 DESCRIPTION

As of version 0.08 the module C<ExtUtils::Installed> misses many
modules installed to the Perl system, it is reported. This class
inherits from ExtUtils::Installed and merely substitutes a different
C<new> constructor in order to cast a wider net (and also fix a few
small nits that to the author's tastes could be purged from
C<ExtUtils::Installed>'s "new()" code). If ExtUtils::Installed is
fixed in the future the need for a hack like this will go away.

Note that 

=head1 SEE ALSO

L<ExtUtils::Installed>, L<ExtUtils::Packlist>

=cut