More Modules.pl.

[p5sagit/p5-mst-13.2.git] / Porting / Modules

#!/usr/bin/perl -w

#
# Modules - show information about modules and their maintainers
#

use strict;

use FindBin qw($Bin);
require "$Bin/Modules.pl";
use vars qw(%Modules %Maintainers);

use Getopt::Long;
use File::Find;

sub usage {
    print <<__EOF__;
$0: Usage: $0 [[--maintainer M --module M --files]|file ...]
$0 --maintainer M	list all maintainers matching M
$0 --module M		list all modules matching M
$0 --files		list all files of the module
Matching is case-ignoring regexp, author matching is both by
the short id and by the full name and email.
$0 file ...		list the module and maintainer
__EOF__
    exit(0);
}

my $Maintainer;
my $Module;
my $Files;

usage()
    unless
    GetOptions(
	       'maintainer=s'	=> \$Maintainer,
	       'module=s'	=> \$Module,
	       'files'		=> \$Files,
	       );

my @Files = @ARGV;

usage() if @Files && ($Maintainer || $Module || $Files);

for my $mean ($Maintainer, $Module) {
    warn "$0: Did you mean '$0 $mean'?\n"
	if $mean && -e $mean && $mean ne '.';
}

warn "$0: Did you mean '$0 -mo $Maintainer'?\n"
    if defined $Maintainer && exists $Modules{$Maintainer};

warn "$0: Did you mean '$0 -ma $Module'?\n"
    if defined $Module     && exists $Maintainers{$Module};

sub get_module_pat {
    my $m = shift;
    split ' ', $Modules{$m}{FILES};
}

sub get_module_files {
    my $m = shift;
    sort { lc $a cmp lc $b }
    map {
	-f $_ ? # Files as-is.
	    $_ :
	    -d _ ? # Recurse into directories.
	    do {
		my @files;
		find(
		     sub {
			 push @files, $File::Find::name
			     if -f $_;
		     }, $_);
		@files;
	    }
	: glob($_) # The rest are globbable patterns.
	} get_module_pat($m);
}

sub get_maintainer_modules {
    my $m = shift;
    sort { lc $a cmp lc $b }
    grep { $Modules{$_}{MAINTAINER} eq $m }
    keys %Modules;
}

if ($Maintainer) {
    for my $m (sort keys %Maintainers) {
	if ($m =~ /$Maintainer/io) {
	    my @modules = get_maintainer_modules($m);
	    if ($Module) {
		@modules = grep { /$Module/io } @modules;
	    }
	    if ($Files) {
		my @files;
		for my $module (@modules) {
		    push @files, get_module_files($module);
		}
		printf "%-15s @files\n", $m;
	    } else {
		if ($Module) {
		    printf "%-15s @modules\n", $m;
		} else {
		    printf "%-15s $Maintainers{$m}\n", $m;
		}
	    }
	}
    }
} elsif ($Module) {
    for my $m (sort { lc $a cmp lc $b } keys %Modules) {
	if ($m =~ /$Module/io) {
	    if ($Files) {
		my @files = get_module_files($m);
		printf "%-15s @files\n", $m;
	    } else {
		printf "%-15s $Modules{$m}{MAINTAINER}\n", $m;
	    }
	}
    }
} elsif (@Files) {
    my %ModuleByFile;

    @ModuleByFile{@Files} = ();

    # First try fast match.

    my %ModuleByPat;
    for my $module (keys %Modules) {
	for my $pat (get_module_pat($module)) {
	    $ModuleByPat{$pat} = $module;
	}
    }
    # Expand any globs.
    my %ExpModuleByPat;
    for my $pat (keys %ModuleByPat) {
	if (-e $pat) {
	    $ExpModuleByPat{$pat} = $ModuleByPat{$pat};
	} else {
	    for my $exp (glob($pat)) {
		$ExpModuleByPat{$exp} = $ModuleByPat{$pat};
	    }
	}
    }
    %ModuleByPat = %ExpModuleByPat;
    for my $file (@Files) {
	$ModuleByFile{$file} = $ModuleByPat{$file}
	    if exists $ModuleByPat{$file};
    }

    # If still unresolved files..
    if (my @ToDo = grep { !defined $ModuleByFile{$_} } keys %ModuleByFile) {

	# Cannot match what isn't there.
	@ToDo = grep { -e $_ } @ToDo;

	if (@ToDo) {
	    # Try prefix matching.

	    # Remove trailing slashes.
	    for (@ToDo) { s|/$|| }

	    my %ToDo;
	    @ToDo{@ToDo} = ();

	    for my $pat (keys %ModuleByPat) {
		last unless keys %ToDo;
		if (-d $pat) {
		    my @Done;
		    for my $file (keys %ToDo) {
			if ($file =~ m|^$pat|i) {
			    $ModuleByFile{$file} = $ModuleByPat{$pat};
			    push @Done, $file;
			}
		    }
		    delete @ToDo{@Done};
		}
	    }
	}
    }

    for my $file (@Files) {
	if (defined $ModuleByFile{$file}) {
	    my $module     = $ModuleByFile{$file};
	    my $maintainer = $Modules{$ModuleByFile{$file}}{MAINTAINER};
	    printf "%-15s $module $maintainer $Maintainers{$maintainer}\n", $file;
	} else {
	    printf "%-15s ?\n", $file;
	}
    }
}
else {
    usage();
}