1use strict;
2use warnings;
3use Test::More;
4use FindBin qw($Bin);
5use List::MoreUtils qw(uniq);
6use Encode;
7
8our $TIDY = 0;
9
10### Generate difftest subroutine, pretty prints diffs if you have Text::Diff, use uses
11### Test::More::is otherwise.
12
13eval {
14    require Text::Diff;
15};
16if (!$@) {
17    *difftest = sub {
18        my ($got, $expected, $testname) = @_;
19        $got .= "\n";
20        $expected .= "\n";
21        if ($got eq $expected) {
22            pass($testname);
23            return;
24        }
25        print "=" x 80 . "\nDIFFERENCES: + = processed version from .text, - = template from .html\n";
26        print encode('utf8', Text::Diff::diff(\$expected => \$got, { STYLE => "Unified" }) . "\n");
27        fail($testname);
28    };
29}
30else {
31    warn("Install Text::Diff for more helpful failure messages! ($@)");
32    *difftest = \&Test::More::is;
33}
34
35sub tidy {
36    $TIDY = 1;
37    eval "use HTML::Tidy; ";
38    if ($@) {
39        plan skip_all => 'This test needs HTML::Tidy installed to pass correctly, skipping';
40        exit;
41    }
42}
43
44### Actual code for this test - unless(caller) stops it
45### being run when this file is required by other tests
46
47unless (caller) {
48    my $docsdir = "$Bin/Text-MultiMarkdown.mdtest";
49    my @files = get_files($docsdir);
50
51    plan tests => scalar(@files) + 2;
52
53    use_ok('Text::MultiMarkdown');
54
55    my $m = Text::MultiMarkdown->new(
56        use_metadata  => 1,
57    );
58    {
59        my $has_warned = 0;
60        local $SIG{__WARN__} = sub {
61            $has_warned++;
62            warn(@_);
63        };
64        run_tests($m, $docsdir, @files);
65        is($has_warned, 0, 'No warnings expected');
66    };
67}
68
69sub get_files {
70    my ($docsdir) = @_;
71    my $DH;
72    opendir($DH, $docsdir) or die("Could not open $docsdir");
73    my @files = uniq map { s/\.(xhtml|html|text)$// ? $_ : (); } readdir($DH);
74    closedir($DH);
75    return @files;
76}
77
78sub slurp {
79    my ($filename) = @_;
80    open my $file, '<', $filename or die "Couldn't open $filename: $!";
81    local $/ = undef;
82    return <$file>;
83}
84
85sub run_tests {
86    my ($m, $docsdir, @files) = @_;
87    foreach my $test (@files) {
88        my ($input, $output);
89        eval {
90            if (-f "$docsdir/$test.html") {
91                $output = slurp("$docsdir/$test.html");
92            }
93            else {
94                $output = slurp("$docsdir/$test.xhtml");
95            }
96            $input  = slurp("$docsdir/$test.text");
97        };
98        $input .= "\n\n";
99        $output .= "\n\n";
100        if ($@) {
101            fail("1 part of test file not found: $@");
102            next;
103        }
104        $output =~ s/\s+\z//; # trim trailing whitespace
105        my $processed = $m->markdown($input);
106        $processed =~ s/\s+\z//; # trim trailing whitespace
107
108        if ($TIDY) {
109            local $SIG{__WARN__} = sub {};
110            my $t = HTML::Tidy->new;
111            $output = $t->clean($output);
112            $processed = $t->clean($processed);
113        }
114
115        # Un-comment for debugging if you have space diffs you can't see..
116        $output =~ s/ /&nbsp;/g;
117        $output =~ s/\t/&tab;/g;
118        $processed =~ s/ /&nbsp;/g;
119        $processed =~ s/\t/&tab;/g;
120
121        difftest($processed, $output, "Docs test: $test");
122    }
123}
124
1251;
126