#!perl

use Pod::Parser;
use warnings;
use strict;
use English qw( -no_match_vars );
use Fatal qw(close);
use Carp;
use Getopt::Long qw(GetOptions);
use Test::More;

my $warnings = 0;
my $options_result = GetOptions( 'warnings' => \$warnings );
Carp::croak("$PROGRAM_NAME options parsing failed")
    unless $options_result;

package Marpa::Test::Display;

@Marpa::Test::Display::ISA       = qw(Exporter);
@Marpa::Test::Display::EXPORT_OK = qw(test_file);

use Text::Diff;
use Carp;
use Fatal qw(close);
use English qw( -no_match_vars );

our $FILE_ERROR = 'No error';

our $PREAMBLE   = q{1};
our $IN_COMMAND = 0;
our @DISPLAY;
our $DEFAULT_CODE             = q{ no_code_defined($_) };
our $CURRENT_CODE             = $DEFAULT_CODE;
our $COLLECTING_FROM_LINE_NUM = -1;
our $COLLECTED_DISPLAY;
our $COMMAND_COUNTDOWN = 0;
our $CURRENT_FILE      = '!!! NO CURRENT FILE !!!';
our $DISPLAY_SKIP      = 0;

sub no_code_defined {
    my $display = shift;
    return 'No code defined to test display:';
}

my %raw                     = ();
my %normalized              = ();
my %raw_display             = ();
my %normalized_display      = ();
my %normalized_display_uses = ();

sub normalize_whitespace {
    my $raw_ref = shift;
    my $text    = ${$raw_ref};
    $text =~ s/\A\s*//xms;
    $text =~ s/\s*\z//xms;
    $text =~ s/\s+/ /gxms;
    return \$text;
}

sub slurp {
    my ($file_name) = @_;
    my $open_result = open my $fh, '<', $file_name;
    if ( not $open_result ) {
        $Marpa::Test::Display::FILE_ERROR = "Cannot open $file_name: $ERRNO";
        return;
    }
    local ($RS) = undef;
    my $result = \<$fh>;
    close $fh;
    return $result;
}

sub parse_displays {
    my $raw_ref = shift;

    my $result = {};
    my @matches = ${$raw_ref} =~ m{
               ^ [ \t]* [#] \h* [#] [\h#]* use [ \t]+ Marpa[:][:]Test[:][:]Display \h+ (\w+(?:\s+\w+)*) \s* \h* $
               (.*?)
               ^ [ \t]* [#] \h* [#] [\h#]* no [ \t]+ Marpa[:][:]Test[:][:]Display \h* $
           }xmsg;
    while (@matches) {
        my $display_name = shift @matches;
        my $display_text = shift @matches;
        $result->{$display_name} = \$display_text;
    }

    return $result;
}

sub read_file {
    my $file_name    = shift;
    my $display_name = shift;

    my $file_ref = $normalized{$file_name};
    if ( not defined $file_ref ) {
        my $raw_ref = $raw{$file_name} = slurp($file_name);
        return if not defined $raw_ref;
        $file_ref = $normalized{$file_name} = normalize_whitespace($raw_ref);
        my $raw_display = $raw_display{$file_name} = parse_displays($raw_ref);
        for my $raw_display_name ( keys %{$raw_display} ) {
            $normalized_display{$file_name}{$raw_display_name} =
                normalize_whitespace( $raw_display->{$raw_display_name} );
        }
    }
    return $file_ref
        if not defined $display_name;
    my $display_ref = $normalized_display{$file_name}{$display_name};
    if ( not defined $display_ref ) {
        Carp::croak("No display named '$display_name' in file: $file_name");
    }
    $normalized_display_uses{$file_name}{$display_name}++;
    return $display_ref;
}

sub in_file {
    my ( $pod_display, $file_name, $display_name ) = @_;

    my $pod_display_ref = normalize_whitespace( \$pod_display );
    my $file_display_ref = read_file( $file_name, $display_name );
    if ( not defined $file_display_ref ) {
        return ( "$Marpa::Test::Display::FILE_ERROR\n", 1 );
    }

    my $location = index ${$file_display_ref}, ${$pod_display_ref};

    return (
        (   $location >= 0
            ? q{}
            : "Display in $Marpa::Test::Display::CURRENT_FILE not in $file_name\n"
                . $pod_display
        ),
        1
    );

}

sub is_file {
    my ( $pod_display, $file_name, $display_name ) = @_;

    my $pod_display_ref = normalize_whitespace( \$pod_display );
    my $file_display_ref = read_file( $file_name, $display_name );
    if ( not defined $file_display_ref ) {
        return ( "$Marpa::Test::Display::FILE_ERROR\n", 1 );
    }

    return q{} if ${$file_display_ref} eq ${$pod_display_ref};

    my $raw_file_display =
        defined $display_name
        ? $raw_display{$file_name}{$display_name}
        : $raw{$file_name};

    $pod_display =~ s/^\h*//gxms;
    ${$raw_file_display} =~ s/^\h*//gxms;

    my $header =
        $display_name
        ? "Display '$display_name'"
        : 'Display';
    $header
        .= " in $Marpa::Test::Display::CURRENT_FILE differs from the one in $file_name";

    return (
        (   $header
                . (
                Text::Diff::diff \$pod_display,
                $raw_file_display,
                { STYLE => 'Table' }
                )
        ),
        1
    );

}

sub test_file {
    my $file = shift;

    $Marpa::Test::Display::CURRENT_FILE      = $file;
    @Marpa::Test::Display::DISPLAY           = ();
    $Marpa::Test::Display::DEFAULT_CODE      = q{ no_code_defined($_) };
    $Marpa::Test::Display::CURRENT_CODE      = $DEFAULT_CODE;
    $Marpa::Test::Display::COMMAND_COUNTDOWN = 0;
    $Marpa::Test::Display::DISPLAY_SKIP      = 0;
    my $mismatch_count = 0;
    my $mismatches     = q{};

    my $parser = MyParser->new();
    $parser->parse_from_file($file);
    ## no critic (BuiltinFunctions::ProhibitStringyEval)
    my $eval_result = eval $PREAMBLE;
    ## use critic
    Carp::croak($EVAL_ERROR) unless $eval_result;

    for my $display_test (@Marpa::Test::Display::DISPLAY) {
        my ( $display, $code, $display_file, $display_line ) =
            @{$display_test}{qw(display code file line)};
        local $_ = $display;
        ## no critic (BuiltinFunctions::ProhibitStringyEval)
        $eval_result = eval '[ do {' . $code . '} ] ';
        ## use critic

        if (my $message =
              $eval_result
            ? $eval_result->[0]
            : $EVAL_ERROR . "Code with problem was:\n$code\n"
            )
        {
            my $do_not_add_display = $eval_result->[1];
            unless ($do_not_add_display) {
                $message .= "\n$display";
            }
            $mismatches .= "=== $message";
            $mismatch_count++;
        }

    }    # $display_test

    return ( $mismatch_count, \$mismatches );

}    # sub test_file

package MyParser;
@MyParser::ISA = qw(Pod::Parser);
use Carp;

sub queue_display {
    my $display  = shift;
    my $line_num = shift;
    push @Marpa::Test::Display::DISPLAY,
        {
        'display' => $display,
        'code'    => $Marpa::Test::Display::CURRENT_CODE,
        'file'    => $Marpa::Test::Display::CURRENT_FILE,
        'line'    => $line_num,
        }
        if not $Marpa::Test::Display::DISPLAY_SKIP;
    $Marpa::Test::Display::COMMAND_COUNTDOWN--;
    if ( $Marpa::Test::Display::COMMAND_COUNTDOWN <= 0 ) {
        $Marpa::Test::Display::CURRENT_CODE =
            $Marpa::Test::Display::DEFAULT_CODE;
        $Marpa::Test::Display::DISPLAY_SKIP = 0;
    }
    return;
}

sub verbatim {
    my ( $parser, $paragraph, $line_num ) = @_;

    if ( defined $Marpa::Test::Display::COLLECTED_DISPLAY ) {
        $Marpa::Test::Display::COLLECTED_DISPLAY .= $paragraph;
        $Marpa::Test::Display::COLLECTING_FROM_LINE_NUM //= $line_num;
        return;
    }
    queue_display( $paragraph, $line_num );
    return;
}

sub process_instruction {
    my $instruction = shift;
    my $code        = shift;
    my $line_num    = shift;

    $instruction =~ s/\s\z//xms;    # eliminate trailing whitespace
    $instruction =~ s/\s/ /gxms;    # normalize whitespace

    if ( $instruction =~ /^ next \s+ display $ /xms ) {
        $Marpa::Test::Display::COMMAND_COUNTDOWN = 1;
        $Marpa::Test::Display::CURRENT_CODE = join "\n", @{$code};
        return;
    }

    if ( $instruction =~ / ^ next \s+ (\d+) \s+ display(s)? $ /xms ) {
        $Marpa::Test::Display::COMMAND_COUNTDOWN = $1;
        Carp::croak(
            "File: $Marpa::Test::Display::CURRENT_FILE  Line: $line_num\n",
            "  'next $Marpa::Test::Display::COMMAND_COUNTDOWN display' has countdown less than one\n"
        ) if $Marpa::Test::Display::COMMAND_COUNTDOWN < 1;
        $Marpa::Test::Display::CURRENT_CODE = join "\n", @{$code};
        return;
    }

    if ( $instruction =~ / ^ default $ /xms ) {
        $Marpa::Test::Display::DEFAULT_CODE = join "\n", @{$code};
        $Marpa::Test::Display::CURRENT_CODE =
            $Marpa::Test::Display::DEFAULT_CODE
            if $Marpa::Test::Display::COMMAND_COUNTDOWN <= 0;
        return;
    }

    if ( $instruction =~ / ^ preamble $ /xms ) {
        $Marpa::Test::Display::PREAMBLE .= join "\n", @{$code};
        return;
    }

    if ( $instruction =~ / ^ skip \s+ display $ /xms ) {
        $Marpa::Test::Display::COMMAND_COUNTDOWN = 1;
        $Marpa::Test::Display::DISPLAY_SKIP++;
        return;
    }

    if ( $instruction =~ / ^ skip \s+ (\d+) \s+ display(s)? $ /xms ) {
        $Marpa::Test::Display::COMMAND_COUNTDOWN = $1;
        Carp::croak(
            "File: $Marpa::Test::Display::CURRENT_FILE  Line: $line_num\n",
            "  'display $Marpa::Test::Display::COMMAND_COUNTDOWN skip' has countdown less than one\n"
        ) if $Marpa::Test::Display::COMMAND_COUNTDOWN < 1;
        $Marpa::Test::Display::DISPLAY_SKIP++;
        return;
    }

    if ( $instruction =~ /^ start \s+ display $/xms ) {
        $Marpa::Test::Display::COLLECTED_DISPLAY = q{};
        return;
    }

    if ( $instruction =~ / ^ end \s+ display $ /xms ) {

        # line num will be set when first part of display is found
        queue_display(
            $Marpa::Test::Display::COLLECTED_DISPLAY,
            $Marpa::Test::Display::COLLECTING_FROM_LINE_NUM
        );
        $Marpa::Test::Display::COLLECTED_DISPLAY        = undef;
        $Marpa::Test::Display::COLLECTING_FROM_LINE_NUM = -1;
        return;
    }

    Carp::croak(
        "Unrecognized instruction in file $Marpa::Test::Display::CURRENT_FILE at line $line_num: $instruction\n"
    );

}

sub textblock {
    my ( $parser, $paragraph, $line_num ) = @_;
    return unless $Marpa::Test::Display::IN_COMMAND;

    ## Translate/Format this block of text; sample actions might be:

    my @lines = split /\n/xms, $paragraph;
    my $found_instruction = 0;
    LINE: while ( my $line = shift @lines ) {
        next LINE if $line =~ /^\s*$/xms;    # skip whitespace
        if ( $line =~ /\A[#][#]/xms ) {
            $line =~ s/\A[#][#]\s*//xms;
            process_instruction( $line, \@lines, $line_num );
            $found_instruction = 1;
            next LINE;
        }
        Carp::croak(
            "File: $Marpa::Test::Display::CURRENT_FILE  Line: $line_num\n",
            "test block doesn't begin with ## instruction\n$paragraph"
        ) if not $found_instruction;
        last LINE;
    }

    return;

}

sub interior_sequence { }

sub command {

    my ( $parser, $command, $paragraph ) = @_;
    if ( $command eq 'begin' ) {
        $Marpa::Test::Display::IN_COMMAND++ if $paragraph =~ m{
                \A
                Marpa[:][:]Test[:][:]Display[:]
                \s* \Z
            }xms;
        $Marpa::Test::Display::IN_COMMAND++ if $paragraph =~ /\Amake:$/xms;
    }
    elsif ( $command eq 'end' ) {
        $Marpa::Test::Display::IN_COMMAND = 0;
    }

    return;

}

package main;

my %exclude = map { ( $_, 1 ) } qw(
    Makefile.PL
);

my @test_files = ();
open my $manifest, '<', 'MANIFEST'
    or Carp::croak("Cannot open MANIFEST: $ERRNO");
FILE: while ( my $file = <$manifest> ) {
    chomp $file;
    $file =~ s/\s*[#].*\z//xms;
    next FILE if $exclude{$file};
    next FILE if -d $file;
    my ($ext) = $file =~ / [.] ([^.]+) \z /xms;
    next FILE unless defined $ext;
    $ext = lc $ext;
    next FILE
        if $ext ne 'pod'
            and $ext ne 'pl'
            and $ext ne 'pm'
            and $ext ne 't';

    push @test_files, $file;
}    # FILE
close $manifest;

Test::More::plan tests => 1 + scalar @test_files;

open my $error_file, '>', 'author.t/display.errs'
    or Carp::croak("Cannot open display.errs: $ERRNO");
FILE: for my $file (@test_files) {
    if ( not -f $file ) {
        Test::More::fail("attempt to test displays in non-file: $file");
        next FILE;
    }

    my ( $mismatch_count, $mismatches ) =
        Marpa::Test::Display::test_file($file);
    my $clean = $mismatch_count == 0;

    my $message =
        $clean
        ? "displays match for $file"
        : "displays in $file has $mismatch_count mismatches";

    Test::More::ok( $clean, $message );
    next FILE if $clean;
    print {$error_file} "=== $file ===\n" . ${$mismatches}
        or Carp::croak("print failed: $ERRNO");
}

my $unused       = q{};
my $unused_count = 0;
while ( my ( $file_name, $displays ) = each %normalized_display_uses ) {
    DISPLAY: while ( my ( $display_name, $uses ) = each %{$displays} ) {
        next DISPLAY if $uses > 0;
        $unused .= "display '$display_name' in $file_name never used\n";
        $unused_count++;
    }
}
if ($unused_count) {
    Test::More::fail('$unused count displays not used');
    print {$error_file} "=== UNUSED DISPLAYS ===\n" . $unused
        or Carp::croak("print failed: $ERRNO");
}
else {
    Test::More::pass('all displays used');
}
close $error_file;