#!/usr/local/bin/perl

# Copyright 2002, Paul Johnson (pjcj@cpan.org)

# This software is free.  It is licensed under the same terms as Perl itself.

# The latest version of this software should be available from my homepage:
# http://www.pjcj.net

require 5.6.1;

use strict;
use warnings;

our $VERSION = "0.20";

use Cwd;
use File::Find ();
use Getopt::Long;
use Pod::Usage;

my $Options =
{
    cover_source => "/home/pjcj/g/perl/dev/Devel/Cover",
    directory    => getcwd,
    module       => [],
    outputdir    => getcwd,
};

sub get_options
{
    die "Bad option" unless
    GetOptions($Options,                # Store the options in the Options hash.
               qw(
                   cover_source=s
                   directory=s
                   help|h!
                   info|i!
                   module=s
                   outputdir=s
                   version|v!
                 ));

    print "$0 version $VERSION\n" and exit 0 if $Options->{version};
    pod2usage(-exitval => 0, -verbose => 0)  if $Options->{help};
    pod2usage(-exitval => 0, -verbose => 2)  if $Options->{info};

    push @{$Options->{module}}, @ARGV;
    unless (@{$Options->{module}})
    {
        my $d = $Options->{directory};
        opendir D, $d or die "Can't opendir $d: $!\n";
        @{$Options->{module}} = grep !/^\./ && -e "$d/$_/Makefile.PL",
                                     sort readdir D
            or die "No module directories found\n";
        closedir D or die "Can't closedir $d: $!\n";
    }
}

sub sys
{
    my ($command) = @_;
    print "$command\n";
    system $command;
}

sub read_results
{
    my $f = "$Options->{outputdir}/cover.results";
    my %results;

    if (open S, "<", $f)
    {
        while (<S>)
        {
            my ($mod, $status) = split;
            $results{$mod} = $status;
        }
        close S or die "Can't close $f: $!\n";
    }

    \%results
}

sub get_cover
{
    my ($module) = @_;

    print "\n\n\n**** Checking coverage of $module ****\n\n\n";

    my $d = "$Options->{directory}/$module";
    chdir $d or die "Can't chdir $d: $!\n";

    my $s = $Options->{cover_source};
    my $inc = "-I$s/blib/lib -I$s/blib/arch";
    $ENV{HARNESS_PERL_SWITCHES} =
        "$inc -MDevel::Cover=+inc,$s,-ignore,\\\\bt/,-silent,1";

    # sys "$^X $inc $s/cover -delete";
    # sys "make test";

    my $func = sub
    {
        sys "$^X $inc $s/cover -report html" if -d && /^cover_db\z/s;
    };

    File::Find::find($func, $d);

    my $results = read_results;
    my $f = "$Options->{outputdir}/cover.results";

    $results->{$module} = 1;

    open S, ">", $f or die "Can't open $f: $!\n";
    for my $mod (sort keys %$results)
    {
        print S "$mod $results->{$mod}\n";
    }
    close S or die "Can't close $f: $!\n";
}

sub write_html
{
    my $results = read_results;
    my $f = "$Options->{outputdir}/cpancover.html";
    print "Writing results to $f\n";

    open S, ">", $f or die "Can't open $f: $!\n";
    print S <<'EOH';
<!--

This file was generated by Devel::Cover Version 0.20

Devel::Cover is copyright 2001-2002, Paul Johnson (pjcj@cpan.org)

Devel::Cover is free.  It is licensed under the same terms as Perl itself.

The latest version of Devel::Cover should be available from my homepage:
http://www.pjcj.net

-->

<?xml version="1.0" encoding="utf-8"?>
<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
    "http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US">
<head>
    <title> Coverage Report </title>
</head>
<body>
EOH

    my $func = sub
    {
        if (/^cover_db\.html\z/s)
        {
            my $d = $File::Find::dir;
            $d =~ s|/cover_db$||;
            print S "<a href=$File::Find::name>$d</a><p>\n"
        }
    };

    for my $mod (sort keys %$results)
    {
        File::Find::find($func, $mod);
    }

    print S <<EOH;
</body>
</html>
EOH

    close S or die "Can't close $f: $!\n";
}

sub main
{
    get_options;

    # get_cover($_) for @{$Options->{module}}

    write_html;
}

main

__END__

=head1 NAME

cpancover - report coverage statistics on CPAN modules

=head1 SYNOPSIS

 cpancover -help -info -version

=head1 DESCRIPTION


=head1 OPTIONS

The following command line options are supported:

 -h -help              - show help
 -i -info              - show documentation
 -v -version           - show version

=head1 DETAILS


=head1 EXIT STATUS

The following exit values are returned:

0   All operaions were completed successfully.

>0  An error occurred.

=head1 SEE ALSO

 Devel::Cover

=head1 BUGS

 Incomplete.
 Needs to be redone properly.

=head1 VERSION

Version 0.20 - 5th October 2002

=head1 LICENCE

Copyright 2001-2002, Paul Johnson (pjcj@cpan.org)

This software is free.  It is licensed under the same terms as Perl itself.

The latest version of this software should be available from my homepage:
http://www.pjcj.net

=cut
