# Copyright 2009-2011, Bartłomiej Syguła (perl@bs502.pl)
#
# This is free software. It is licensed, and can be distributed under the same terms as Perl itself.
#
# For more, see my website: http://bs502.pl/

package Devel::CoverReport::App::ProveCover;

use strict;
use warnings;

our $VERSION = 0.04;

use Devel::CoverReport 0.04;

use App::Prove 3.11;
use Carp;
use Cwd;
use File::Path qw( rmtree );
use Getopt::Long 2.36 qw( GetOptionsFromArray );

=encoding UTF-8

=head1 NAME

Devel::CoverReport::App::ProveCover - Implementation of the C<prove_cover> command

=head1 SYNOPSIS

This module is a base for L<prove_cover> - You can use it to make Your own derivatives of this command, that will suit Your purpose better.

=head1 WARNING

Consider this module to be an early ALPHA. It does the job for me, so it's here.

This is my first CPAN module, so I expect that some things may be a bit rough around edges.

The plan is, to fix both those issues, and remove this warning in next immediate release.

=head1 API

=over

=item main

Main entry point. Executed by C<prove_cover>

=cut
sub main { # {{{
    my @cmd_params = @_;

    # Strip 'our' parameters.
    my %cover_report_options = (
        'no_report' => q{},
        'cover_db'  => q{},
    );

    Getopt::Long::Configure(qw( pass_through no_auto_help ));
    GetOptionsFromArray(
        \@cmd_params,
        \%cover_report_options,
        qw(
            cover_db=s
            no_report
        )
    );

    my $db_path = ( $cover_report_options{'cover_db'} or getcwd() . '/cover_db/' );
    mkdir $db_path;

    # Step 1: Prepare 'prove'
    my $app = App::Prove->new;
    $app->process_args(@cmd_params);
    $app->{'exec'} = q{/usr/bin/perl -MDevel::Cover=-db,} . $db_path;

    # Step 2: Cleanup.
    if (not $app->{'dry'} and not $app->{'help'} and -d $db_path . q{/runs}) {
        rmtree('cover_db', { keep_root => 1, });
    }

    # Step 3: Run 'prove'
    $app->run;

    # Step 4: run 'cover_report'
    if ($cover_report_options{'no_report'}) {
        print "Coverage report was not generated, use cover_report command to do that.\n";
    }
    elsif (not $app->{'dry'} and not $app->{'help'}) {
        if (-d $db_path . q{/runs}) {
            my $cover_report = Devel::CoverReport->new(
                cover_db  => $db_path,
                output    => $db_path,
                formatter => 'Html',

                criterion => { 'statement' => 1, 'branch' => 1, 'condition' => 1, 'path' => 1, 'subroutine' => 1, 'pod' => 1, 'time' => 1, 'runs' => 1 },
                report    => { 'summary'   => 1, 'index'  => 1, 'coverage'  => 1, 'runs' => 1, 'run-details' => 1, vcs => 1,},

                exclude     => [],
                exclude_dir => [],
                exclude_re => [],
                include => [],
                include_dir => [],
                include_re => [ q{.} ],
                mention => [],
                mention_dir => [ @INC ],
                mention_re => [],

                jobs => ( $app->{'jobs'} or 1 ),

                quiet   => 0,
                summary => 1,
                verbose => 0,
            );

            $cover_report->make_report();
        }
        else {
            print "Directory 'cover_db' was not created, coverage report skipped.\n";
        }
    }

    return 0; # Temporarly hard-coded :(
} # }}}

1;

__END__

=back

=head1 LICENCE

Copyright 2009-2011, Bartłomiej Syguła (perl@bs502.pl)

This is free software. It is licensed, and can be distributed under the same terms as Perl itself.

For more, see my website: http://bs502.pl/

=cut

# vim: fdm=marker

