1256a93a4Safresh1package Testing; 2256a93a4Safresh1use 5.10.0; 3256a93a4Safresh1use warnings; 4256a93a4Safresh1use Exporter 'import'; 5*5486feefSafresh1our $VERSION = 1.35; # Let's keep this same as lib/Pod/Html.pm 6256a93a4Safresh1$VERSION = eval $VERSION; 7256a93a4Safresh1our @EXPORT_OK = qw( 8256a93a4Safresh1 setup_testing_dir 9256a93a4Safresh1 xconvert 10256a93a4Safresh1 record_state_of_cache 11256a93a4Safresh1); 12256a93a4Safresh1use Cwd; 13256a93a4Safresh1use Pod::Html; 14256a93a4Safresh1use Config; 15256a93a4Safresh1use File::Basename; 16256a93a4Safresh1use File::Copy; 17256a93a4Safresh1use File::Path ( qw| make_path | ); 18256a93a4Safresh1use File::Spec::Functions ':ALL'; 19256a93a4Safresh1use File::Temp ( qw| tempdir | ); 20256a93a4Safresh1use Data::Dumper;$Data::Dumper::Sortkeys=1; 21256a93a4Safresh1use Pod::Html::Util qw( 22256a93a4Safresh1 unixify 23256a93a4Safresh1); 24256a93a4Safresh1 25256a93a4Safresh1*ok = \&Test::More::ok; 26256a93a4Safresh1*is = \&Test::More::is; 27256a93a4Safresh1 28256a93a4Safresh1our @no_arg_switches = ( qw| 29256a93a4Safresh1 flush recurse norecurse 30256a93a4Safresh1 quiet noquiet verbose noverbose 31256a93a4Safresh1 index noindex backlink nobacklink 32256a93a4Safresh1 header noheader poderrors nopoderrors 33256a93a4Safresh1| ); 34256a93a4Safresh1 35256a93a4Safresh1=head1 NAME 36256a93a4Safresh1 37256a93a4Safresh1Testing - Helper functions for testing Pod-Html 38256a93a4Safresh1 39256a93a4Safresh1=head1 SYNOPSIS 40256a93a4Safresh1 41256a93a4Safresh1 use Testing qw( setup_testing_dir xconvert ); 42256a93a4Safresh1 43256a93a4Safresh1 my $tdir = setup_testing_dir( { 44256a93a4Safresh1 debug => $debug, 45256a93a4Safresh1 } ); 46256a93a4Safresh1 47256a93a4Safresh1 $args = { 48256a93a4Safresh1 podstub => "htmldir1", 49256a93a4Safresh1 description => "test --htmldir and --htmlroot 1a", 50256a93a4Safresh1 expect => $expect_raw, 51256a93a4Safresh1 p2h => { 52256a93a4Safresh1 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 53256a93a4Safresh1 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 54256a93a4Safresh1 podroot => catpath($v, '/', ''), 55256a93a4Safresh1 htmldir => 't', 56256a93a4Safresh1 quiet => 1, 57256a93a4Safresh1 }, 58256a93a4Safresh1 debug => $debug, 59256a93a4Safresh1 }; 60256a93a4Safresh1 xconvert($args); 61256a93a4Safresh1 62256a93a4Safresh1=head1 DESCRIPTION 63256a93a4Safresh1 64256a93a4Safresh1This module exports, upon request only, 2 subroutines which are used in most 65256a93a4Safresh1of the files in the core distribution test suite for Pod-HTML 66256a93a4Safresh1(F<ext/Pod-Html/t/*.t>). In the future we may add additional subroutines, 67256a93a4Safresh1particularly to better diagnose problems with Pod-Html. 68256a93a4Safresh1 69256a93a4Safresh1=head2 Pod-Html's Testing Structure 70256a93a4Safresh1 71256a93a4Safresh1As of version 1.26 of this module (early 2021), the testing structure consists 72256a93a4Safresh1of 16 F<.pod> files and 18 F<.t> files located in two subdirectories, 73256a93a4Safresh1F<corpus/> and F<t/>. Let's analyze these by directory. 74256a93a4Safresh1 75256a93a4Safresh1=head3 Files in F<corpus/> 76256a93a4Safresh1 77256a93a4Safresh1There are currently 2 F<.pod> files in F<corpus/> both of which are old 78256a93a4Safresh1versions of F<pod/*.pod> files selected to give some complexity to the test 79256a93a4Safresh1suite. Since we don't actually attempt to make HTML out of their POD, we 80256a93a4Safresh1don't need to discuss them further. 81256a93a4Safresh1 82256a93a4Safresh1=head3 Files in F<t/> 83256a93a4Safresh1 84256a93a4Safresh1There are currently 14 F<.pod> files and 18 F<.t> files in F<t/>. Both of 85256a93a4Safresh1these numbers may change in the future. 86256a93a4Safresh1 87256a93a4Safresh1Currently there are 2 F<t/.t> files (F<t/anchorify.t> and F<t/eol.t>) which 88256a93a4Safresh1exercise certain functionality of F<Pod::Html> but which do not require 89256a93a4Safresh1F<t/*.pod> files as data input. These files do not make use of the 90256a93a4Safresh1subroutines exported by this module. We may add more test files like this in 91256a93a4Safresh1the future to ensure high test coverage, but don't need to discuss them 92256a93a4Safresh1further here. 93256a93a4Safresh1 94256a93a4Safresh1The remaining 16 F<t/*.t> test programs make use of the testing subroutines 95256a93a4Safresh1exported by this module. Most, but not all, of these test programs make use 96256a93a4Safresh1of the F<t/*.pod> files. Each such test program makes use of only 1 97256a93a4Safresh1F<t/*.pod> file at a time, though there are several cases where several, 98256a93a4Safresh1similarly named, test programs make use of the same F<t/*.pod> file for data 99256a93a4Safresh1input. For example, 100256a93a4Safresh1 101256a93a4Safresh1 t/crossref.t 102256a93a4Safresh1 t/crossref2.t 103256a93a4Safresh1 t/crossref3.t 104256a93a4Safresh1 105256a93a4Safresh1all make use of 106256a93a4Safresh1 107256a93a4Safresh1 t/crossref.pod 108256a93a4Safresh1 109256a93a4Safresh1Each F<t/*.pod> file consists solely of simple documentation in POD format. 110256a93a4Safresh1 111256a93a4Safresh1=head3 High-level description of programs which use F<.pod> files as input 112256a93a4Safresh1 113256a93a4Safresh1Each of the F<t/*.t> programs which makes use of a given F<t/*.pod> file 114256a93a4Safresh1slurps the text of a single such F<t/*.pod> file into memory. The test 115256a93a4Safresh1program holds text in a C<DATA> handle which serves as a B<template> for the 116256a93a4Safresh1HTML expected to be generated by running the F<t/*.pod> file through 117256a93a4Safresh1C<Pod::Html::pod2html()>. The HTML output by C<Pod::Html::pod2html()> can 118256a93a4Safresh1vary greatly, particularly with respect to links, depending on the arguments 119256a93a4Safresh1passed to that function. The HTML output will also be affected by the 120256a93a4Safresh1underlying operating system, I<e.g.,> with respect to path separators. Hence, 121256a93a4Safresh1we cannot hard-code the expected HTML output into the C<DATA> template or any 122256a93a4Safresh1place else. We have to allow C<Pod::Html::pod2html()> to massage the template 123256a93a4Safresh1data to get an "expected output" against which we match the "actual output" 124f2a19305Safresh1which comes from running C<Pod::Html::pod2html()> over the text originally 125256a93a4Safresh1slurped into memory from the F<t/*.pod> file. 126256a93a4Safresh1 127256a93a4Safresh1Granted, there is a certain amount of circularity in this testing regimen. On 128256a93a4Safresh1a given operating system, with a given F<t/*.pod> file as raw input, a given 129256a93a4Safresh1POD parser invoked within C<Pod::Html::pod2html()> and a given set of 130256a93a4Safresh1arguments passed to C<pod2html()>, there can and should be only one possible 131256a93a4Safresh1HTML string generated as output. What we currently have in a given test 132256a93a4Safresh1program's C<DATA> handle is merely that HTML string retrofitted with certain 133256a93a4Safresh1template elements as needed to make the "got" and the "expected" identical. 134256a93a4Safresh1We're not testing whether we're generating "good" HTML. We're simply testing 135256a93a4Safresh1that we get consistent results out of C<pod2html()> year after year. 136256a93a4Safresh1 137256a93a4Safresh1=head3 How a test program works step-by-step 138256a93a4Safresh1 139256a93a4Safresh1Here we continue to focus on those test programs which make use of the testing 140256a93a4Safresh1functions exported by F<Testing> and which take a F<t/*.pod> file as input. 141256a93a4Safresh1 142f2a19305Safresh1We assume that we begin our tests from the top level of the Perl 5 core 143f2a19305Safresh1distribution and are using F<t/harness>. Hence, to run the test files we say: 144256a93a4Safresh1 145256a93a4Safresh1 cd t; ./perl harness ../ext/Pod-Html/t/*.t; cd - 146256a93a4Safresh1 147256a93a4Safresh1The program then slurps contents of the C<DATA> handle into memory. 148256a93a4Safresh1 149256a93a4Safresh1The program then calls C<setup_testing_dir()> from this module to create a 150256a93a4Safresh1temporary directory and populate it as needed. C<setup_testing_dir()> returns 151f2a19305Safresh1the absolute path to that directory, but at the point where that subroutine 152f2a19305Safresh1returns you are actually located two levels beneath the temporary directory in 153f2a19305Safresh1a directory whose relative path is F<ext/Pod-Html/>. (This is equivalent to 154f2a19305Safresh1being in F<toplevel/ext/Pod-Html/> for tests in versions of Pod-Html 155f2a19305Safresh1distributed with earlier versions of F<perl>.) 156256a93a4Safresh1 157f2a19305Safresh1Note that this means that at the end of the program you will have to switch 158f2a19305Safresh1back to your starting directory so that the tempdir can automatically be 159f2a19305Safresh1cleaned up. We automate this via an C<END> block. 160256a93a4Safresh1 161256a93a4Safresh1You then prepare arguments for our principal testing function, C<xconvert()> 162256a93a4Safresh1(which supersedes the former C<convert_n_test()>. These arguments take the 163256a93a4Safresh1form of a single hash reference. One customary but optional element in that 164256a93a4Safresh1hashref, C<p2h>, is itself a hashref of key-value pairs corresponding to 165256a93a4Safresh1switches passed to the F<pod2html> command-line utility or to 166256a93a4Safresh1C<Pod::Html::pod2html()>. The other elements in the hashref passed to 167256a93a4Safresh1C<xconvert()> include the stub of the basename of the F<t/*.pod> file being 168256a93a4Safresh1used, the text of that file (which we've already slurped into memory), the 169256a93a4Safresh1test description, and whether we want extra debugging output or not. The 170256a93a4Safresh1program then adds a key-value pair to indicate whether we're running via core 171256a93a4Safresh1distribution test harness or not. 172256a93a4Safresh1 173256a93a4Safresh1The hashref is then passed to C<xconvert()> which internally generates an 174256a93a4Safresh1expected HTML output string by massaging the text read in from the C<DATA> 175256a93a4Safresh1handle. C<xconvert()> reads in the relevant F<t/*.pod> file and passes it to 176256a93a4Safresh1C<Pod::Html::pod2html()>, which parses the POD and generates the actual HTML 177256a93a4Safresh1output. If "got" matches "expected", a PASS is recorded for this instance of 178256a93a4Safresh1C<xconvert()>. 179256a93a4Safresh1 180256a93a4Safresh1As the example of F<t/htmldir1.t> illustrates: 181256a93a4Safresh1 182256a93a4Safresh1=over 4 183256a93a4Safresh1 184256a93a4Safresh1=item * 185256a93a4Safresh1 186256a93a4Safresh1The user can define a variety of arguments to be passed through to C<Pod::Html::pod2html()>. 187256a93a4Safresh1 188256a93a4Safresh1 my ($v, $d) = splitpath(cwd(), 1); 189256a93a4Safresh1 my @dirs = splitdir($d); 190256a93a4Safresh1 shift @dirs if $dirs[0] eq ''; 191256a93a4Safresh1 my $relcwd = join '/', @dirs; 192256a93a4Safresh1 193256a93a4Safresh1 $args = { 194256a93a4Safresh1 ... 195256a93a4Safresh1 p2h => { 196256a93a4Safresh1 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 197256a93a4Safresh1 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 198256a93a4Safresh1 podroot => catpath($v, '/', ''), 199256a93a4Safresh1 htmldir => 't', 200256a93a4Safresh1 quiet => 1, 201256a93a4Safresh1 }, 202256a93a4Safresh1 ... 203256a93a4Safresh1 }; 204256a93a4Safresh1 205256a93a4Safresh1=item * 206256a93a4Safresh1 207256a93a4Safresh1The user can try out a variety of different arguments in the C<p2h> element 208256a93a4Safresh1and end up with the same HTML output as predicted by the C<DATA> template by 209256a93a4Safresh1calling C<xconvert()> more than once per file. 210256a93a4Safresh1 211256a93a4Safresh1 $args = { 212256a93a4Safresh1 podstub => "htmldir1", 213256a93a4Safresh1 description => "test --htmldir and --htmlroot 1a", 214256a93a4Safresh1 expect => $expect_raw, 215256a93a4Safresh1 p2h => { 216256a93a4Safresh1 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 217256a93a4Safresh1 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 218256a93a4Safresh1 podroot => catpath($v, '/', ''), 219256a93a4Safresh1 htmldir => 't', 220256a93a4Safresh1 quiet => 1, 221256a93a4Safresh1 }, 222256a93a4Safresh1 }; 223256a93a4Safresh1 xconvert($args); 224256a93a4Safresh1 225256a93a4Safresh1 $args = { 226256a93a4Safresh1 podstub => "htmldir1", 227256a93a4Safresh1 description => "test --htmldir and --htmlroot 1b", 228256a93a4Safresh1 expect => $expect_raw, 229256a93a4Safresh1 p2h => { 230256a93a4Safresh1 podpath => $relcwd, 231256a93a4Safresh1 podroot => catpath($v, '/', ''), 232256a93a4Safresh1 htmldir => catdir($relcwd, 't'), 233256a93a4Safresh1 htmlroot => '/', 234256a93a4Safresh1 quiet => 1, 235256a93a4Safresh1 }, 236256a93a4Safresh1 }; 237256a93a4Safresh1 xconvert($args); 238256a93a4Safresh1 239256a93a4Safresh1Note that in the two "runs" above, the values for C<podstub> are the 240256a93a4Safresh1same, but the arguments to C<p2h> differ; we've distinguished the two runs 241256a93a4Safresh1by different values for C<description>. 242256a93a4Safresh1 243256a93a4Safresh1=back 244256a93a4Safresh1 245256a93a4Safresh1Note that all runs within an individual F<t/*.t> program share the same 246256a93a4Safresh1temporary directory. Since C<Pod::Html::pod2html()> typically caches its 247256a93a4Safresh1understanding of where F<.pod> files are located, there is a possibility that 248256a93a4Safresh1the contents of the cache may affect the generated HTML output in an adverse 249256a93a4Safresh1way. This possibility will be addressed in an upcoming version of this 250256a93a4Safresh1program. 251256a93a4Safresh1 252256a93a4Safresh1When all runs have been completed (as noted above), the C<END> block brings us 253256a93a4Safresh1back to the directory we started from to permit the temporary directory and 254256a93a4Safresh1its contents to be cleanly deleted. 255256a93a4Safresh1 256256a93a4Safresh1=head1 SUBROUTINES 257256a93a4Safresh1 258256a93a4Safresh1=head2 C<setup_testing_dir()> 259256a93a4Safresh1 260256a93a4Safresh1=over 4 261256a93a4Safresh1 262256a93a4Safresh1=item * Purpose 263256a93a4Safresh1 264256a93a4Safresh1Create and populate a temporary directory to hold all activity for a single F<t/*.t> program. 265256a93a4Safresh1 266256a93a4Safresh1=item * Arguments 267256a93a4Safresh1 268256a93a4Safresh1 $tdir = setup_testing_dir( { 269256a93a4Safresh1 startdir => $startdir, 270256a93a4Safresh1 debug => $debug, 271256a93a4Safresh1 } ); 272256a93a4Safresh1 273256a93a4Safresh1Single hash reference with two possible elements. 274256a93a4Safresh1 275256a93a4Safresh1=over 4 276256a93a4Safresh1 277256a93a4Safresh1=item * C<debug> 278256a93a4Safresh1 279256a93a4Safresh1A Boolean which you will typically set at the start of your program. A 280256a93a4Safresh1Perl-true value prints out your location and creates a temporary directory 281256a93a4Safresh1which is B<not> cleaned up at the program's completion, thereby permitting you 282256a93a4Safresh1to examine the intermediate files created by the program. 283256a93a4Safresh1 284256a93a4Safresh1=back 285256a93a4Safresh1 286256a93a4Safresh1=item * Return Value 287256a93a4Safresh1 288256a93a4Safresh1String holding the absolute path of the temporary directory. 289256a93a4Safresh1 290256a93a4Safresh1=item * Comments 291256a93a4Safresh1 292256a93a4Safresh1The function C<chdir>s internally and leaves you in a directory called 293256a93a4Safresh1F<ext/Pod-Html> beneath the temporary directory found in the return value. 294256a93a4Safresh1 295256a93a4Safresh1The function is somewhat equivalent to testing helper function 296256a93a4Safresh1C<make_test_dir> in F<t/pod2html-lib.pl> in versions of Pod-Html shipped with 297256a93a4Safresh1versions of F<perl> up through 5.32. 298256a93a4Safresh1 299256a93a4Safresh1=back 300256a93a4Safresh1 301256a93a4Safresh1=cut 302256a93a4Safresh1 303256a93a4Safresh1sub setup_testing_dir { 304256a93a4Safresh1 my $args = shift; 305256a93a4Safresh1 my $cwd = cwd(); 306256a93a4Safresh1 my $toptempdir = $args->{debug} ? tempdir() : tempdir( CLEANUP => 1 ); 307256a93a4Safresh1 if ($args->{debug}) { 308256a93a4Safresh1 print STDERR "toptempdir: $toptempdir\n"; 309256a93a4Safresh1 } 310256a93a4Safresh1 chdir $toptempdir or die "Unable to change to $toptempdir: $!"; 311256a93a4Safresh1 312256a93a4Safresh1 my $ephdir = catdir($toptempdir, 'ext', 'Pod-Html'); 313256a93a4Safresh1 my ($fromdir, $targetdir, $pod_glob, @testfiles); 314256a93a4Safresh1 315256a93a4Safresh1 # Copy ext/Pod-Html/t/*.pod files into position under tempdir 316256a93a4Safresh1 $fromdir = catdir($cwd, 't'); 317256a93a4Safresh1 # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy 318256a93a4Safresh1 $pod_glob = catfile($fromdir, '*.pod'); 319256a93a4Safresh1 @testfiles = glob($pod_glob); 320256a93a4Safresh1 321256a93a4Safresh1 $targetdir = catdir($ephdir, 't'); 322256a93a4Safresh1 make_path($targetdir) or die("Cannot mkdir $targetdir for testing: $!"); 323256a93a4Safresh1 for my $f (@testfiles) { 324256a93a4Safresh1 copy $f => $targetdir or die "Unable to copy: $!"; 325256a93a4Safresh1 } 326256a93a4Safresh1 327256a93a4Safresh1 # Copy ext/Pod-Html/corpus/*.pod files into position under tempdir 328256a93a4Safresh1 $fromdir = catdir($cwd, 'corpus'); 329256a93a4Safresh1 # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy 330256a93a4Safresh1 $pod_glob = catfile($fromdir, '*.pod'); 331256a93a4Safresh1 @testfiles = glob($pod_glob); 332256a93a4Safresh1 333256a93a4Safresh1 $targetdir = catdir($ephdir, 'corpus', 'test.lib'); 334256a93a4Safresh1 make_path($targetdir) or die "Could not make $targetdir for testing: $!"; 335256a93a4Safresh1 336256a93a4Safresh1 my %copying = (); 337256a93a4Safresh1 for my $g (@testfiles) { 338256a93a4Safresh1 my $basename = basename($g); 339256a93a4Safresh1 my ($stub) = $basename =~ m{^(.*)\.pod}; 340256a93a4Safresh1 $stub =~ s{^perl(.*)}{$1}; 341256a93a4Safresh1 $copying{$stub} = { 342256a93a4Safresh1 source => $g, 343256a93a4Safresh1 target => catfile($targetdir, "${stub}.pod") 344256a93a4Safresh1 }; 345256a93a4Safresh1 } 346256a93a4Safresh1 347256a93a4Safresh1 for my $k (keys %copying) { 348256a93a4Safresh1 copy $copying{$k}{source} => $copying{$k}{target} 349256a93a4Safresh1 or die "Unable to copy: $!"; 350256a93a4Safresh1 } 351256a93a4Safresh1 352256a93a4Safresh1 # Move into tempdir/ext/Pod-Html 353256a93a4Safresh1 chdir $ephdir or die "Unable to change to $ephdir: $!"; 354256a93a4Safresh1 return $toptempdir; 355256a93a4Safresh1} 356256a93a4Safresh1 357256a93a4Safresh1=head2 C<xconvert()> 358256a93a4Safresh1 359256a93a4Safresh1=over 4 360256a93a4Safresh1 361256a93a4Safresh1=item * Purpose 362256a93a4Safresh1 363256a93a4Safresh1Compare whether the HTML generated by C<Pod::Html::pod2html()>'s parsing of a 364256a93a4Safresh1F<.pod> file matches the expectation generated by parsing the C<DATA> block 365256a93a4Safresh1within the test file. 366256a93a4Safresh1 367256a93a4Safresh1=item * Arguments 368256a93a4Safresh1 369256a93a4Safresh1Single hash reference. 370256a93a4Safresh1 371256a93a4Safresh1 $args = { 372256a93a4Safresh1 podstub => "htmldir5", 373256a93a4Safresh1 description => "test --htmldir and --htmlroot 5", 374256a93a4Safresh1 expect => $expect_raw, 375256a93a4Safresh1 p2h => { 376256a93a4Safresh1 podpath => 't:corpus/test.lib', 377256a93a4Safresh1 podroot => $cwd, 378256a93a4Safresh1 htmldir => $cwd, 379256a93a4Safresh1 htmlroot => '/', 380256a93a4Safresh1 quiet => 1, 381256a93a4Safresh1 }, 382256a93a4Safresh1 debug => $debug, 383256a93a4Safresh1 }; 384256a93a4Safresh1 $args->{core} = 1 if $ENV{PERL_CORE}; 385256a93a4Safresh1 386256a93a4Safresh1Elements are as follows: 387256a93a4Safresh1 388256a93a4Safresh1=over 4 389256a93a4Safresh1 390256a93a4Safresh1=item * C<podstub> 391256a93a4Safresh1 392256a93a4Safresh1String holding the stub (or stem) of the F<.pod> file being used as input. 393256a93a4Safresh1The stub is the basename of the file less the file extension or suffix. 394256a93a4Safresh1(Equivalent to the first argument passed to the former C<convert_and_test> 395256a93a4Safresh1test helper routine.) Required. 396256a93a4Safresh1 397256a93a4Safresh1=item * C<description> 398256a93a4Safresh1 399256a93a4Safresh1String holding the description (or name or label) in typical TAP syntax. 400256a93a4Safresh1(Equivalent to the second argument passed to the former C<convert_and_test> 401256a93a4Safresh1helper routine.) Required. 402256a93a4Safresh1 403256a93a4Safresh1=item * C<expect> 404256a93a4Safresh1 405256a93a4Safresh1String holding the "raw" expectations read in from the C<DATA> handle. Each 406256a93a4Safresh1run of C<xconvert()> within a given test file should have the same value for 407256a93a4Safresh1this key. Required. 408256a93a4Safresh1 409256a93a4Safresh1=item * C<p2h> 410256a93a4Safresh1 411256a93a4Safresh1Hash reference holding arguments passed to C<Pod::Html::pod2html()> (though 412256a93a4Safresh1without the leading double hyphens (C<-->). See documentation for 413256a93a4Safresh1F<Pod::Html>. Optional, but mostly necessary. In particular, if a F<.pod> 414256a93a4Safresh1file contains any C<LE<lt>E<gt>> tags, a C<podpath> element almost always 415256a93a4Safresh1needs to be supplied with a colon-delimited list of directories from which to 416256a93a4Safresh1begin a search for files containing POD. 417256a93a4Safresh1 418256a93a4Safresh1=item * C<debug> 419256a93a4Safresh1 420256a93a4Safresh1Boolean, generally set once at the program's top. When Perl-true, displays 421256a93a4Safresh1extra debugging output, including turning on C<Pod::Html::pod2html()>'s 422256a93a4Safresh1C<verbose> option. Optional. 423256a93a4Safresh1 424256a93a4Safresh1=item * C<core> 425256a93a4Safresh1 426256a93a4Safresh1Boolean. This should be set to a Perl-true value when the file is to be run 427256a93a4Safresh1from the test harness rather than from the top-level of the repository. 428256a93a4Safresh1 429256a93a4Safresh1=back 430256a93a4Safresh1 431256a93a4Safresh1=item * Return Value 432256a93a4Safresh1 433256a93a4Safresh1Not explicitly defined, but should return a Perl-true value upon completion. 434256a93a4Safresh1 435256a93a4Safresh1=item * Comment 436256a93a4Safresh1 437f2a19305Safresh1This function essentially asks, "Are we getting the same HTML output the last 438f2a19305Safresh1time we tinkered with the code in this distribution?" Hence, it is dependent 439f2a19305Safresh1on the particular parsing and HTML composition functionality found within 440f2a19305Safresh1C<Pod::Html::pod2html()>, which is a somewhat customized subclass of 441f2a19305Safresh1F<Pod::Simple::XHTML>. If, in the future, we offer functionality based on 442f2a19305Safresh1other parsing classes, then the C<DATA> sections of the F<t/*.t> files will 443f2a19305Safresh1have to be revised and perhaps the guts of C<xconvert()> as well. 444256a93a4Safresh1 445f2a19305Safresh1This function is roughly equivalent to test helper function 446f2a19305Safresh1C<convert_n_test()> in earlier versions of Pod-Html. 447256a93a4Safresh1 448256a93a4Safresh1=back 449256a93a4Safresh1 450256a93a4Safresh1=cut 451256a93a4Safresh1 452256a93a4Safresh1sub xconvert { 453256a93a4Safresh1 my $args = shift; 454256a93a4Safresh1 for my $k ('podstub', 'description', 'expect') { 455256a93a4Safresh1 die("convert_n_test() must have $k element") 456256a93a4Safresh1 unless length($args->{$k}); 457256a93a4Safresh1 } 458256a93a4Safresh1 my $podstub = $args->{podstub}; 459256a93a4Safresh1 my $description = $args->{description}; 460256a93a4Safresh1 my $debug = $args->{debug} // 0; 461256a93a4Safresh1 $args->{expect_fail} //= 0; 462256a93a4Safresh1 if (defined $args->{p2h}) { 463256a93a4Safresh1 die "Value for 'p2h' must be hashref" 464256a93a4Safresh1 unless ref($args->{p2h}) eq 'HASH'; # TEST ME 465256a93a4Safresh1 } 466256a93a4Safresh1 my $cwd = unixify( Cwd::cwd() ); 467256a93a4Safresh1 my ($vol, $dir) = splitpath($cwd, 1); 468256a93a4Safresh1 my @dirs = splitdir($dir); 469256a93a4Safresh1 shift @dirs if $dirs[0] eq ''; 470256a93a4Safresh1 my $relcwd = join '/', @dirs; 471256a93a4Safresh1 472256a93a4Safresh1 my $new_dir = catdir $dir, "t"; 473256a93a4Safresh1 my $infile = catpath $vol, $new_dir, "$podstub.pod"; 474256a93a4Safresh1 my $outfile = catpath $vol, $new_dir, "$podstub.html"; 475256a93a4Safresh1 476256a93a4Safresh1 my $args_table = _prepare_argstable( { 477256a93a4Safresh1 infile => $infile, 478256a93a4Safresh1 outfile => $outfile, 479256a93a4Safresh1 cwd => $cwd, 480256a93a4Safresh1 p2h => $args->{p2h}, 481256a93a4Safresh1 } ); 482256a93a4Safresh1 my @args_list = _prepare_argslist($args_table); 483256a93a4Safresh1 Pod::Html::pod2html( @args_list ); 484256a93a4Safresh1 485256a93a4Safresh1 $cwd =~ s|\/$||; 486256a93a4Safresh1 487256a93a4Safresh1 my $expect = _set_expected_html($args->{expect}, $relcwd, $cwd); 488256a93a4Safresh1 my $result = _get_html($outfile); 489256a93a4Safresh1 490256a93a4Safresh1 _process_diff( { 491256a93a4Safresh1 expect => $expect, 492256a93a4Safresh1 result => $result, 493256a93a4Safresh1 description => $description, 494256a93a4Safresh1 podstub => $podstub, 495256a93a4Safresh1 outfile => $outfile, 496256a93a4Safresh1 debug => $debug, 497256a93a4Safresh1 expect_fail => $args->{expect_fail}, 498256a93a4Safresh1 } ); 499256a93a4Safresh1 500256a93a4Safresh1 # pod2html creates these 501256a93a4Safresh1 unless ($debug) { 502256a93a4Safresh1 1 while unlink $outfile; 503256a93a4Safresh1 1 while unlink "pod2htmd.tmp"; 504256a93a4Safresh1 } 505256a93a4Safresh1} 506256a93a4Safresh1 507256a93a4Safresh1sub _prepare_argstable { 508256a93a4Safresh1 my $args = shift; 509256a93a4Safresh1 my %args_table = ( 510256a93a4Safresh1 infile => $args->{infile}, 511256a93a4Safresh1 outfile => $args->{outfile}, 512256a93a4Safresh1 ); 513256a93a4Safresh1 my %no_arg_switches = map { $_ => 1 } @no_arg_switches; 514256a93a4Safresh1 if (defined $args->{p2h}) { 515256a93a4Safresh1 for my $sw (keys %{$args->{p2h}}) { 516256a93a4Safresh1 if ($no_arg_switches{$sw}) { 517256a93a4Safresh1 $args_table{$sw} = undef; 518256a93a4Safresh1 } 519256a93a4Safresh1 else { 520256a93a4Safresh1 $args_table{$sw} = $args->{p2h}->{$sw}; 521256a93a4Safresh1 } 522256a93a4Safresh1 } 523256a93a4Safresh1 } 524256a93a4Safresh1 return \%args_table; 525256a93a4Safresh1} 526256a93a4Safresh1 527256a93a4Safresh1sub _prepare_argslist { 528256a93a4Safresh1 my $args_table = shift; 529256a93a4Safresh1 my @args_list = (); 530256a93a4Safresh1 for my $k (keys %{$args_table}) { 531256a93a4Safresh1 if (defined $args_table->{$k}) { 532256a93a4Safresh1 push @args_list, "--" . $k . "=" . $args_table->{$k}; 533256a93a4Safresh1 } 534256a93a4Safresh1 else { 535256a93a4Safresh1 push @args_list, "--" . $k; 536256a93a4Safresh1 } 537256a93a4Safresh1 } 538256a93a4Safresh1 return @args_list; 539256a93a4Safresh1} 540256a93a4Safresh1 541256a93a4Safresh1sub _set_expected_html { 542256a93a4Safresh1 my ($expect, $relcwd, $cwd) = @_; 543256a93a4Safresh1 $expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/; 544256a93a4Safresh1 $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$relcwd/g; 545256a93a4Safresh1 $expect =~ s/\[ABSCURRENTWORKINGDIRECTORY\]/$cwd/g; 546256a93a4Safresh1 if (ord("A") == 193) { # EBCDIC. 547256a93a4Safresh1 $expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/; 548256a93a4Safresh1 } 549256a93a4Safresh1 $expect =~ s/\n\n(some html)/$1/m; 550256a93a4Safresh1 $expect =~ s{(TESTING FOR AND BEGIN</h1>)\n\n}{$1}m; 551256a93a4Safresh1 return $expect; 552256a93a4Safresh1} 553256a93a4Safresh1 554256a93a4Safresh1sub _get_html { 555256a93a4Safresh1 my $outfile = shift; 556256a93a4Safresh1 local $/; 557256a93a4Safresh1 558256a93a4Safresh1 open my $in, '<', $outfile or die "cannot open $outfile: $!"; 559256a93a4Safresh1 my $result = <$in>; 560256a93a4Safresh1 close $in; 561256a93a4Safresh1 return $result; 562256a93a4Safresh1} 563256a93a4Safresh1 564256a93a4Safresh1sub _process_diff { 565256a93a4Safresh1 my $args = shift; 566256a93a4Safresh1 die("process_diff() takes hash ref") unless ref($args) eq 'HASH'; 567256a93a4Safresh1 my %keys_needed = map { $_ => 1 } (qw| expect result description podstub outfile |); 568256a93a4Safresh1 my %keys_seen = map { $_ => 1 } ( keys %{$args} ); 569256a93a4Safresh1 my @keys_missing = (); 570256a93a4Safresh1 for my $kn (keys %keys_needed) { 571256a93a4Safresh1 push @keys_missing, $kn unless exists $keys_seen{$kn}; 572256a93a4Safresh1 } 573256a93a4Safresh1 die("process_diff() arguments missing: @keys_missing") if @keys_missing; 574256a93a4Safresh1 575256a93a4Safresh1 my $diff = '/bin/diff'; 576256a93a4Safresh1 -x $diff or $diff = '/usr/bin/diff'; 577256a93a4Safresh1 -x $diff or $diff = undef; 578256a93a4Safresh1 my $diffopt = $diff ? $^O =~ m/(linux|darwin)/ ? '-u' : '-c' 579256a93a4Safresh1 : ''; 580256a93a4Safresh1 $diff = 'fc/n' if $^O =~ /^MSWin/; 581256a93a4Safresh1 $diff = 'differences' if $^O eq 'VMS'; 582256a93a4Safresh1 if ($diff) { 583256a93a4Safresh1 my $outcome = $args->{expect} eq $args->{result}; 584256a93a4Safresh1 if ($outcome) { 585256a93a4Safresh1 ok($outcome, $args->{description}); 586256a93a4Safresh1 } 587256a93a4Safresh1 else { 588256a93a4Safresh1 if ($args->{expect_fail}) { 589256a93a4Safresh1 ok(! $outcome, $args->{description}); 590256a93a4Safresh1 } 591256a93a4Safresh1 else { 592256a93a4Safresh1 ok($outcome, $args->{description}) or do { 593256a93a4Safresh1 my $expectfile = $args->{podstub} . "_expected.tmp"; 594256a93a4Safresh1 open my $tmpfile, ">", $expectfile or die $!; 595256a93a4Safresh1 print $tmpfile $args->{expect}, "\n"; 596256a93a4Safresh1 close $tmpfile; 597256a93a4Safresh1 open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" 598256a93a4Safresh1 or die("problem diffing: $!"); 599256a93a4Safresh1 print STDERR "# $_" while <$diff_fh>; 600256a93a4Safresh1 close $diff_fh; 601256a93a4Safresh1 unlink $expectfile unless $args->{debug}; 602256a93a4Safresh1 }; 603256a93a4Safresh1 } 604256a93a4Safresh1 } 605256a93a4Safresh1 } 606256a93a4Safresh1 else { 607256a93a4Safresh1 # This is fairly evil, but lets us get detailed failure modes 608256a93a4Safresh1 # anywhere that we've failed to identify a diff program. 609256a93a4Safresh1 is($args->{expect}, $args->{result}, $args->{description}); 610256a93a4Safresh1 } 611256a93a4Safresh1 return 1; 612256a93a4Safresh1} 613256a93a4Safresh1 614256a93a4Safresh1=head2 C<record_state_of_cache()> 615256a93a4Safresh1 616256a93a4Safresh1=over 4 617256a93a4Safresh1 618256a93a4Safresh1=item * Purpose 619256a93a4Safresh1 620256a93a4Safresh1During debugging, enable developer to examine the state of the Pod-Html cache 621256a93a4Safresh1after each call to C<xconvert()>. 622256a93a4Safresh1 623256a93a4Safresh1=item * Arguments 624256a93a4Safresh1 625256a93a4Safresh1Single hash reference. 626256a93a4Safresh1 627256a93a4Safresh1 record_state_of_cache( { 628256a93a4Safresh1 outdir => "$ENV{P5P_DIR}/pod-html", 629256a93a4Safresh1 stub => $args->{podstub}, 630256a93a4Safresh1 run => 1, 631256a93a4Safresh1 } ); 632256a93a4Safresh1 633256a93a4Safresh1Hash reference has the following key-value pairs: 634256a93a4Safresh1 635256a93a4Safresh1=over 4 636256a93a4Safresh1 637256a93a4Safresh1=item * C<outdir> 638256a93a4Safresh1 639256a93a4Safresh1Any directory of your system to which you want a sorted copy of the cache to 640256a93a4Safresh1be printed. 641256a93a4Safresh1 642256a93a4Safresh1=item * C<stub> 643256a93a4Safresh1 644256a93a4Safresh1The same value you passed in C<$args> to C<xconvert()>. 645256a93a4Safresh1 646256a93a4Safresh1=item * C<run> 647256a93a4Safresh1 648256a93a4Safresh1Integer which you set manually to distinguish among multiple runs of this 649256a93a4Safresh1function within the same test file (presumably corresponding to multiple 650256a93a4Safresh1invocations of C<xconvert()>). 651256a93a4Safresh1 652256a93a4Safresh1=back 653256a93a4Safresh1 654256a93a4Safresh1=item * Return Value 655256a93a4Safresh1 656256a93a4Safresh1Implicitly returns Perl-true value. 657256a93a4Safresh1 658256a93a4Safresh1=item * Comment 659256a93a4Safresh1 660256a93a4Safresh1Function will print out location of cache files and other information. 661256a93a4Safresh1 662256a93a4Safresh1=back 663256a93a4Safresh1 664256a93a4Safresh1=cut 665256a93a4Safresh1 666256a93a4Safresh1sub record_state_of_cache { 667256a93a4Safresh1 my $args = shift; 668256a93a4Safresh1 die("record_state_of_cache() takes hash reference") 669256a93a4Safresh1 unless ref($args) eq 'HASH'; 670256a93a4Safresh1 for my $k ( qw| outdir stub run | ) { 671256a93a4Safresh1 die("Argument to record_state_of_cache() lacks defined $k element") 672256a93a4Safresh1 unless defined $args->{$k}; 673256a93a4Safresh1 } 674256a93a4Safresh1 my $cwd = cwd(); 675256a93a4Safresh1 my $cache = catfile($cwd, 'pod2htmd.tmp'); 676256a93a4Safresh1 die("Could not locate file $cache") unless -f $cache; 677256a93a4Safresh1 die("Could not locate directory $args->{outdir}") unless -d $args->{outdir}; 678256a93a4Safresh1 die("'run' element takes integer") unless $args->{run} =~ m/^\d+$/; 679256a93a4Safresh1 680256a93a4Safresh1 my @cachelines = (); 681256a93a4Safresh1 open my $in, '<', $cache or die "Unable to open $cache for reading"; 682256a93a4Safresh1 while (my $l = <$in>) { 683256a93a4Safresh1 chomp $l; 684256a93a4Safresh1 push @cachelines, $l; 685256a93a4Safresh1 } 686256a93a4Safresh1 close $in or die "Unable to close $cache after reading"; 687256a93a4Safresh1 688256a93a4Safresh1 my $outfile = catfile($args->{outdir}, "$args->{run}.cache.$args->{stub}.$$.txt"); 689256a93a4Safresh1 die("$outfile already exists; did you remember to increment the 'run' argument?") 690256a93a4Safresh1 if -f $outfile; 691256a93a4Safresh1 open my $out, '>', $outfile or die "Unable to open $outfile for writing"; 692256a93a4Safresh1 print $out "$_\n" for (sort @cachelines); 693256a93a4Safresh1 close $out or die "Unable to close after writing"; 694256a93a4Safresh1 print STDERR "XXX: cache (sorted): $outfile\n"; 695256a93a4Safresh1} 696256a93a4Safresh1 697256a93a4Safresh1=head1 AUTHORS 698256a93a4Safresh1 699256a93a4Safresh1The testing code reworked into its present form has many authors and dates 700256a93a4Safresh1back to the dawn of Perl 5, perhaps beyond. The documentation was written by 701256a93a4Safresh1James E Keenan in March 2021. 702256a93a4Safresh1 703256a93a4Safresh1=cut 704256a93a4Safresh1 705256a93a4Safresh11; 706