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/ / /g; 117 $output =~ s/\t/&tab;/g; 118 $processed =~ s/ / /g; 119 $processed =~ s/\t/&tab;/g; 120 121 difftest($processed, $output, "Docs test: $test"); 122 } 123} 124 1251; 126