#!/usr/bin/perl -w
use lib "c:/Dokument/Project/Dev/CPAN/Devel-CoverX-Covered/trunk/source/lib";
$|++;
use strict;

use Getopt::Long;
use Pod::Usage;
use File::Basename;
use POSIX;
use Data::Dumper;
use Path::Class;


use lib "../lib", "lib";
use Devel::CoverX::Covered;
use Devel::CoverX::Covered::Db;

=head1 NAME

covered -- Command line interface to L<Devel::CoverX::Covered>


=head1 SYNOPSIS

See L<Devel::CoverX::Covered>

=cut



if($INC{"Devel/Cover.pm"}) {
    print STDERR "$0 shouldn't be run with Devel::Cover enabled.\n";
    POSIX::_exit(1);
}



main();
sub main {
    my @rex_skip_source_file;
    GetOptions(
        "cover_db:s"              => \(my $cover_db = "./cover_db"),
        "source_file:s"           => \(my $source_file = ""),
        "test_file:s"             => \(my $test_file = ""),
        "rex_skip_calling_file:s" => \(my $rex_skip_calling_file),
        "rex_skip_source_file:s"  => \@rex_skip_source_file,
    );
    my $command = $ARGV[0] or syntax("Please specify a command");

    my $db = Devel::CoverX::Covered::Db->new(
        dir         => dir($cover_db)->absolute,
        report_file => sub { print "$_[0]\n" },
    );

    if ($rex_skip_calling_file) {
        $db->rex_skip_calling_file( rex_from_qr($rex_skip_calling_file) );
    }
    
    $db->rex_skip_source_file([ map { rex_from_qr($_) } @rex_skip_source_file ]);
    
    
    if($command eq "runs") {
        $db->collect_runs();
    }
    elsif($command eq "covering") {
        $source_file or syntax("Please specify --source_file");
        print( join("\n", $db->test_files_covering($source_file)) . "\n" );
    }
    elsif($command eq "by") {
        $test_file or syntax("Please specify --test_file");
        print( join("\n", $db->source_files_covered_by($test_file)) . "\n" );
    }
    elsif($command eq "subs") {
        $source_file or syntax("Please specify --source_file");
        print( join("\n", map { join("\t", @$_) } $db->covered_subs($source_file)) . "\n" );
    }
    elsif($command eq "info") {
        print( "* Covered *\nVersion: " . Devel::CoverX::Covered->VERSION . "\n" );
        print("\n");
        print( "* Test files *\n" . join("\n", $db->test_files()) . "\n" );
        print("\n");
        print( "* Covered files *\n" . join("\n", $db->covered_files()) . "\n" );
    }
    else {
        syntax("Unknown command ($command)");
    }

    return(1);
}



# syntax($message)
#
# Die with the syntax text and the $message.
sub syntax {
    my ($message) = @_;
    die q{NAME - covered
SYNOPSIS

* Collect test run statistics

  covered runs
      [--cover_db=./cover_db]
      [--rex_skip_calling_file='/ prove ([.]bat)? $/x']
      [--rex_skip_source_file]

Run this right after the test run, before you run "cover" (because
that will throw away some information).

Avoid collection any information from test files matching
$rex_skip_calling_file (default: the prove command), and from source
files matching any of @rex_skip_source_file.


* List test files covering file

  covered covering --source_file=SOURCE_FILE [--cover_db=./cover_db]

List all test files (usually .t files) that cover any line in
--source_file.


* List source files covered by test

  covered by --test_file=TEST_FILE [--cover_db=./cover_db]

List all source files that are covered by any line in --test_file.


* List subs in --source_file that are covered any test file

  covered subs --source_file=SOURCE_FILE [--cover_db=./cover_db]

List all "sub names \t coverage count" for --source_file.


Error: } . "$message\n";
}



sub rex_from_qr {
    my ($rex_string) = @_;
    my $rex = eval "qr $rex_string";
    $@ and die("Could not parse regexp ($rex_string):
$@
Correct regex syntax is e.g. '/ prove [.] bat /x'
");    
}



__END__

[--row=N] [--sub=SUB] 

If --row (1..) is specified, limit the list to test files that cover
that row in particular.

If --sub is specified, limit the list to test files that cover that
sub in particular.
