package App::ForkProve;

use strict;
use 5.008_001;
use version; our $VERSION = "v0.4.9";

use App::Prove;
use Getopt::Long ':config' => qw(bundling pass_through no_ignore_case);
use Scalar::Util 'openhandle';

use App::ForkProve::SourceHandler;

our @Blacklists = qw( Test::SharedFork );
our %Data;

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

    # Probably have to copy to @ARGV so that App::Prove can mangle it
    # in theory we don't need to, but doing so will make some tests fail
    # even with local @ARGV = () in SourceHandler. Not sure why...
    local @ARGV = @args;

    @ARGV = map { /^(-M)(.+)/ ? ($1,$2) : $_ } @ARGV;

    my @modules;
    my $lib;
    my $blib;
    my @inc;
    Getopt::Long::GetOptions('M=s@', \@modules);
    Getopt::Long::GetOptionsFromArray([@ARGV],
        'l|lib',  \$lib,
        'b|blib', \$blib,
        'I=s@',   \@inc,
    );

    if ($lib) {
        unshift @inc, 'lib';
    }

    if ($blib) {
        unshift @inc, 'blib/lib', 'blib/arch';
    }


    for (@modules) {
        my($module, @import) = split /[=,]/;
        local @INC{map pkg_to_file($_), @Blacklists} = (__FILE__) x scalar(@Blacklists);
        local @INC = (@inc, @INC);

        eval "require $module" or die $@;
        $module->import(@import);
    }

    for my $loaded (keys %INC) {
        next unless $loaded =~ /\.pm$/;

        my $mod = $loaded;
        $mod =~ s{/}{::}g;
        $mod =~ s{\.pm$}{};

        my $fh = do {
            no strict 'refs';
            *{ $mod . '::DATA' }
        };

        $Data{$mod} = [!!openhandle($fh), $INC{$loaded}];
        push @{ $Data{$mod} }, tell($fh)
            if $Data{$mod}[0];
    }

    my $app = App::Prove->new;
    $app->process_args(@ARGV);
    $app->run;
}

sub pkg_to_file {
    local $_ = shift;
    s|::|/|g;
    "$_.pm";
}


1;
__END__

=encoding utf-8

=head1 NAME

App::ForkProve - forking prove

=head1 SYNOPSIS

  use App::ForkProve;
  App::ForkProve->run(@ARGV);

=head1 DESCRIPTION

App::ForkProve is a backend for L<forkprove>.

=head1 AUTHOR

Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>

=head1 COPYRIGHT

Copyright 2012- Tatsuhiko Miyagawa

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<forkprove>

=cut
