File Coverage

blib/lib/Module/Mapper.pm

Criterion	Covered	Total	%
statement	128	135	94.8
branch	69	126	54.7
condition	33	63	52.3
subroutine	10	10	100.0
pod	1	1	100.0
total	241	335	71.9

package Module::Mapper;

use Getopt::Long qw(:config no_ignore_case permute);
use File::Spec::Functions qw(splitpath catpath);
use File::Path;
use File::Find;
use Pod::Usage;

use base ('Exporter');

@EXPORT = ('find_sources');
$VERSION = '1.01';

use strict;
use warnings;

sub find_sources {
	my %options = @_;

	my $all = $options{All};
	my $path = $options{Output};
	my $verbose = $options{Verbose};
	my @modules = $options{Modules} ? @{$options{Modules}} : ();
	my @localdirs = $options{Libs} ? @{$options{Libs}} : ();
	my @exes = $options{Scripts} ? @{$options{Scripts}} : ();
	my $useINC = $options{UseINC};
	my $usepod = $options{IncludePOD};
	my $projdir = $options{Project} || '.';

	$@ = "-verbose must be a coderef\n",
	return undef
		if $verbose && (ref $verbose ne 'CODE');
#
#	normalize and test for the directories
#
	foreach (@localdirs) {
		s![/\\]$!!;
		$@ = "Cannot find directory $_, exitting.\n",
		return undef
			unless -d;
	}

	$@ = "Nothing to do, exitting (perhaps you forgot -exes or -modules ?).",
	return undef
		if $useINC && (! scalar @localdirs) && (! scalar @modules) && (! scalar @exes);

	my $havepath = defined $path;
	my @files = ();
	my %exes = ();
	my %modules = ();
	if ((! scalar @modules) && (! scalar @exes)) {
#
#	project mode
#
		$projdir=~s!/$!!;
		$@ = "No local project directories",
		return undef
			unless -d "$projdir/bin" || -d "$projdir/lib";
		$verbose->("Project mode: Scanning $projdir/bin and $projdir/lib...\n") if $verbose;
		if (opendir(INDIR, "$projdir/bin")) {
			while (my $file = readdir(INDIR)) {
				$exes{"$projdir/bin/$file"} = $havepath ? "$path/bin/$file" : 1
					unless -d "$projdir/bin/$file";
			}
			closedir INDIR;
		}

		_collectFiles("$projdir/lib", $usepod, \%modules, "$path/blib", '');

		if ($verbose) {
			if ($havepath) {
				$verbose->("$_ maps to $exes{$_}\n")
					foreach (sort keys %exes);
			}
			else {
				$verbose->("Found $_\n")
					foreach (sort keys %exes);
			}
		}
#
#	trim any empty namespaces
#
		foreach (sort keys %modules) {
			delete $modules{$_},
			next
				unless ($#{$modules{$_}} > -1);
			$verbose->(defined $modules{$_}[0] ?
				($havepath ?
					"$_ found in $modules{$_}[0] maps to $modules{$_}[1]\n" :
					"$_ found in $modules{$_}[0]\n") :
				($havepath ?
					"$_ found in $modules{$_}[2] maps to $modules{$_}[3]\n" :
					"$_ found in $modules{$_}[2]\n"))
					if $verbose;
		}

		$modules{$_} = [ $_, $exes{$_} ]
			foreach (keys %exes);

		return \%modules;
	}
#
#	process exes first
#
	foreach (@exes) {
		$verbose->("$_ not found\n") unless -e || (! $verbose);

		$@ = "$_ not a file\n",
		return undef
			if -d;
		my ($volume, $subdir, $file) = splitpath( $_ );
		$exes{$_} = $havepath ? "$path/bin/$file" : 1;
	}
#
#	now modules
#
	foreach my $module (@modules) {
		my $srcfile = "$module.pm";
		my $podfile = "$module.pod";
		my $root = $module;
		$srcfile=~s!\:\:!/!g;
		$podfile=~s!\:\:!/!g;
		$root=~s!\:\:!/!g;
		my $outroot = $havepath ? "$path/$root" : undef;
		my $hasdir;

		foreach (@localdirs) {
			$verbose->("Scanning $_ for $module...\n") if $verbose;
			$modules{$module} = [ "$_/$srcfile", ($havepath ? "$path/blib/$srcfile" : 1) ]
				if -e "$_/$srcfile";

			$modules{$module} ||= [ undef, undef ],
			push @{$modules{$module}}, "$_/$podfile", ($havepath ? "$path/blib/$podfile" : 1)
				if $usepod && (-e "$_/$podfile");
#
#	might be namespace parent
#
			$modules{$module} ||= []
				if (-d "$_/$root");

			$outroot = "$path/blib/$root",
			$root = "$_/$root",
			last
				if exists $modules{$module};
		}
		if ($useINC && (! exists $modules{$module})) {
			foreach (@INC) {
				$verbose->("Scanning $_ for $module...\n") if $verbose;
				$modules{$module} = [ "$_/$srcfile", ($havepath ? "$path/lib/$srcfile" : 1) ]
					if -e "$_/$srcfile";

				$modules{$module} ||= [ undef, undef ],
				push @{$modules{$module}}, "$_/$podfile", ($havepath ? "$path/lib/$podfile" : 1)
					if $usepod && (-e "$_/$podfile");
#
#	might be namespace parent
#
				$modules{$module} ||= []
					if (-d "$_/$root");
				$outroot = ($havepath ? "$path/lib/$root" : undef),
				$root = "$_/$root",
				last
					if exists $modules{$module} || (-d "$_/$root");
			}
		}
		unless ($all && exists $modules{$module}) {
			$verbose->("$module not found\n") if $verbose;
			next;
		}

		next unless $all;
#
#	recurse into subdirs and collect all the package/pods
#
		$verbose->("$module found, scanning for children...\n") if $verbose;
		_collectFiles($root, $usepod, \%modules, $outroot, $module);
		if ($#{$modules{$module}} == -1) {
#
#	check if any children found
#
			my $childcnt = 0;
			$module .= '::';
			while (my ($m, $c) = each %modules) {
				$childcnt++, last
					if ($#$c > -1) &&
						(length($m) > 2 + length($module)) &&
						(substr($m, 0, length($module)) eq $module);
			}
			$verbose->("$module namespace is empty\n") unless $childcnt || (! $verbose);
		}
	}

	if ($verbose) {
		if ($havepath) {
			$verbose->("$projdir/bin/$_ maps to $exes{$_}\n")
				foreach (sort keys %exes);
		}
		else {
			$verbose->("Found $_ in $projdir/bin\n")
				foreach (sort keys %exes);
		}
	}
	foreach (sort keys %modules) {
#
#	trim any empty namespaces
#
		delete $modules{$_},
		next
			unless ($#{$modules{$_}} > -1);

		$verbose->(defined $modules{$_}[0] ?
			($havepath ?
				"$_ found in $modules{$_}[0]\n\tmaps to $modules{$_}[1]\n" :
				"$_ found in $modules{$_}[0]\n") :
			($havepath ?
				"$_ found in $modules{$_}[2]\n\tmaps to $modules{$_}[3]\n" :
				"$_ found in $modules{$_}[2]\n"))
				if $verbose;
	}

	$modules{$_} = [ $_, $exes{$_} ]
		foreach (keys %exes);

	return \%modules;
}

sub _collectFiles {
	my ($dir, $usepod, $modules, $outpath, $pkgroot) = @_;
	my @children = ();
	opendir(INDIR, $dir) or return $modules;
	while (my $child = readdir(INDIR)) {
		push (@children, $child)
			if (substr($child, 0, 1) ne '.') && -d "$dir/$child";

		next
			if -d "$dir/$child";

		if ((substr($child, -3) eq '.pm') || (substr($child, -4) eq '.pod')) {
			$child=~s/\.(pm|pod)$//;
			my $module = $pkgroot ? "$pkgroot\::$child" : $child;
			$modules->{$module} ||= [];
			if ($1 eq 'pm') {
				$modules->{$module}[0] = "$dir/$child.pm";
				$modules->{$module}[1] = $outpath ? "$outpath/$child.pm" : 1;
			}
			else {
				$modules->{$module}[2] = "$dir/$child.pod";
				$modules->{$module}[3] = $outpath ? "$outpath/$child.pod" : 1;
			}
		}
	}
	closedir INDIR;
	_collectFiles("$dir/$_", $usepod, $modules, ($outpath ? "$outpath/$_" : undef),
		($pkgroot ? "$pkgroot\::$_" : $_) )
		foreach (@children);
	return $modules;
}

1;