#!/usr/bin/perl
use strict;
use warnings;

use FindBin;
use File::Find::Rule;
use File::Spec;
use lib File::Spec->catdir($FindBin::Bin, 'lib');

use Getopt::Long;

my ($error, $requires) = (0, 0);
GetOptions('--error' => \$error, '--requires' => \$requires);
Getopt::Long::Configure("bundling"); # allows -e -r

my %result;

for my $path (@INC) {
    next if $path eq '.';
    my $rule = File::Find::Rule->new;
    $rule->file;
    $rule->name( qr/^\w[\w\.]*$/ );
    my @files = $rule->in($path);

    for my $file (@files) {
	next if $file =~ /\W(?:\.svn|CVS)\b/;
	next unless $file =~ m|/Plagger/Plugin/|;
	next unless $file =~ m|^/| or $file =~ m|^Plagger/Plugin|;

        open my $fh, $file or die $!;
	my ($module, $code);
        while (<$fh>) {
	    $code .= $_;
	    if (!$module && /^package (Plagger::Plugin::.*?);/) {
		$module = $1;
	    }
	}
	close($fh);
	next unless $module;

	$result{$module} = {
	    path => $file,
	    error => '',
	    no_requires => [],
	    hooks => [],
	};

	{
	    no strict 'refs';
	    for my $k (keys %main::) {
		if ($k eq 'Plagger::') {
		    for (keys %{$main::{$k}}) {
			delete ${$main::{$k}}{$_} if $_ eq 'Plugin::';
		    }
		}
	    }
	}

	while (1) {
	    eval "$code";
	    if ($@) {
		my $error = $@;
		if ($error =~ /^Can\'t locate (.+?).pm/) {
		    my $name = $1;
		    $name =~ s|/|::|g;
		    $code =~ s/(use $name ?.*?;)/\#$1/g;
		    push(@{ $result{$module}->{no_requires} }, $name);
		    next;
		} elsif ($error =~ /^Base class package "(.+)?" is empty/) {
		    eval "use $1;";
		    next;
		} else {
		    $result{$module}->{error} = $@;
		    last;
		}
	    }

	    eval {
		$module->register(DummyContext->new(sub {
		    my $hook = shift;
		    push(@{ $result{$module}->{hooks} }, $hook);
		}));
	    };
	    last;
	}
	$result{$module}->{code} = $code;
    }
}


for my $name (keys %result) {
    next if $error && !$result{$name}->{error};
    next if $requires && !@{ $result{$name}->{no_requires} };

    print "$name\n";

    printf("%14s: %s\n", 'path', $result{$name}->{path})
	if $result{$name}->{path};
    printf("%14s: %s\n", 'error', $result{$name}->{error})
	if $result{$name}->{error};

    printf("%14s: %s\n", 'hooks', join(',', @{ $result{$name}->{hooks} }))
	if scalar(@{ $result{$name}->{hooks} });
    printf("%14s: %s\n", 'requires', join(',', @{ $result{$name}->{no_requires} }))
	   if scalar(@{ $result{$name}->{no_requires} });

    print "\n";
}


    
package DummyContext;

sub new {
    my ($class, $callback) = @_;
    bless {callback => $callback}, $class;
}

sub register_hook {
    my ($self, $plugin, %hooks) = @_;
    for (keys %hooks) {
	$self->{callback}($_);
    }
    die;
}