The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl
#---------------------------------------------------------------------
# 10-embellish.t
#---------------------------------------------------------------------

use strict;
use warnings;
use Test::More 0.88;            # done_testing

binmode STDOUT, ':utf8';

my $checkWarnings;
BEGIN {
  # RECOMMEND PREREQ: Test::NoWarnings
  $checkWarnings = eval "require Test::NoWarnings; 1";
}

use HTML::Element;

#=====================================================================
sub fmt
{
  my ($html) = @_;

  my $text = $html->as_HTML("<>&", undef, {});
  $text =~ s/[ \t\r\n]+/ /g;  # Convert all whitespace to single space
  $text =~ s/\s*\z/\n/;       # Ensure it ends with a single newline

  return $text;
} # end fmt

#=====================================================================
my (@tests, $source_list);

BEGIN {
my $nb    = chr(0x00A0);
my $sp6   = chr(0x2006);        # SIX-PER-EM SPACE
my $mdash = chr(0x2014);
my $lsquo = chr(0x2018);
my $rsquo = chr(0x2019);
my $ldquo = chr(0x201C);
my $rdquo = chr(0x201D);

$source_list = [
  p => q{"Here we have--in this string--some 'characters' ... to process."}
];

@tests = (
#---------------------------------------------------------------------
  $source_list, [],
  <<"", 'default processing',
<p>${ldquo}Here we have${mdash}in this string${mdash}some ${lsquo}characters${rsquo} .$nb.$nb. to process.$rdquo</p>

#---------------------------------------------------------------------
  $source_list, [ default => 0 ],
  <<"", 'all disabled',
<p>"Here we have--in this string--some 'characters' ... to process."</p>

#---------------------------------------------------------------------
  $source_list, [ dashes => 1, default => 0 ],
  <<"", 'dashes only',
<p>"Here we have${mdash}in this string${mdash}some 'characters' ... to process."</p>

#---------------------------------------------------------------------
  $source_list, [ ellipses => 1, default => 0 ],
  <<"", 'ellipses only',
<p>"Here we have--in this string--some 'characters' .$nb.$nb. to process."</p>

#---------------------------------------------------------------------
  $source_list, [ quotes => 1, default => 0 ],
  <<"", 'quotes only',
<p>${ldquo}Here we have--in this string--some ${lsquo}characters${rsquo} ... to process.$rdquo</p>

#---------------------------------------------------------------------
  [ blockquote =>
    [ a => { href => "dest" }, qq!This isn't "wrong".! ],
    [ blockquote => qq!It should 'work'.! ] ],
  [],
  <<"", 'nested blockquotes',
<blockquote><a href="dest">This isn${rsquo}t ${ldquo}wrong${rdquo}.</a><blockquote>It should ${lsquo}work${rsquo}.</blockquote></blockquote>

#---------------------------------------------------------------------
  [ p => q!"Probably. 'If - '"! ], [],
  <<"", 'Probably If',
<p>${ldquo}Probably. ${lsquo}If - $rsquo$nb$rdquo</p>

#---------------------------------------------------------------------
  [ p => q!"I'm quoting"--not quoted--"in part," he said.! ], [],
  <<"", 'dash quote',
<p>${ldquo}I${rsquo}m quoting${rdquo}${mdash}not quoted${mdash}${ldquo}in part,${rdquo} he said.</p>

#---------------------------------------------------------------------
  [ p => q!She said, "'All the world's a stage,'"--and then--"nonsense."! ],
  [],
  <<"", 'quoted quote dash',
<p>She said, ${ldquo}$nb${lsquo}All the world${rsquo}s a stage,${rsquo}$nb${rdquo}${mdash}and then${mdash}${ldquo}nonsense.${rdquo}</p>

#---------------------------------------------------------------------
  [ p => q!And now . . . some spaces! ],
  [],
  <<"", 'spaced ellipses',
<p>And now .$nb.$nb. some spaces</p>

#---------------------------------------------------------------------
  [ p => q!". . . some spaces . . ."! ],
  [],
  <<"", 'spaced ellipses and quotes',
<p>${ldquo}.$nb.$nb.${nb}some spaces$nb.$nb.$nb.$rdquo</p>

#---------------------------------------------------------------------
  [ p => 'And now . . . ? Or now. . . !' ],
  [ ellipses => 1, default => 0 ],
  <<"", 'ellipses with punctuation',
<p>And now$nb.$nb.$nb.$nb? Or now.$nb.$nb.$nb!</p>

#---------------------------------------------------------------------
  [ p => qq!".$sp6.$sp6. some spaces$sp6.$sp6.$sp6."! ],
  [],
  <<"", 'spaced ellipses and quotes',
<p>${ldquo}.$nb.$nb.${nb}some spaces$nb.$nb.$nb.$rdquo</p>

#---------------------------------------------------------------------
  [ p => "And now .$sp6.$sp6.$sp6? Or now.$sp6.$sp6.$sp6!" ],
  [ ellipses => 1, default => 0 ],
  <<"", 'ellipses with punctuation',
<p>And now$nb.$nb.$nb.$nb? Or now.$nb.$nb.$nb!</p>

#---------------------------------------------------------------------
  [ p => qq!"Hello, Mrs. C.," he said.! ],
  [],
  <<"", 'period comma',
<p>${ldquo}Hello, Mrs. C.,$rdquo he said.</p>

#---------------------------------------------------------------------
); # end @tests

#---------------------------------------------------------------------
{ # This would produce a warning prior to v0.05:
  #   Complex regular subexpression recursion limit (32766) exceeded
  my $long  = ("lorem - ipsum, " x 10) . 'dolor';
  my $longQ = ("$long. " x 10) .
              (qq!${ldquo}$long.$rdquo ! x 50) .
              ("$long. " x 200);

  push @tests, [ p => $longQ ], [], "<p>$longQ</p>\n", 'very long text';
} # end very long text test

#---------------------------------------------------------------------
plan tests => 5 + @tests / 4;

use_ok('HTML::Embellish');
} # end BEGIN


#=====================================================================
# Normal tests

while (@tests) {
  my $source     = shift @tests;
  my $parameters = shift @tests;
  my $expected   = shift @tests;
  my $name       = shift @tests;

  my $html = HTML::Element->new_from_lol($source);

  embellish($html, @$parameters);
  is(fmt($html), $expected, $name);
} # end while @tests

#=====================================================================
# Argument checking:

my $html = HTML::Element->new_from_lol($source_list);

eval { embellish() };
like($@, qr/^First parameter of embellish must be an HTML::Element at \Q$0\E line \d/, 'no parameters');

eval { embellish($html, 'whoops') };
like($@, qr/^Odd number of parameters passed to HTML::Embellish->new at \Q$0\E line \d/, 'odd parameter');

eval { HTML::Embellish->new()->process('whoops') };
like($@, qr/^HTML::Embellish->process must be passed an HTML::Element at \Q$0\E line \d/, 'bad parameter');

SKIP: {
 skip "Test::NoWarnings not installed", 1 unless $checkWarnings;

 Test::NoWarnings::had_no_warnings();
}

done_testing;