1package Testing; 2use 5.10.0; 3use warnings; 4use Exporter 'import'; 5our $VERSION = 1.35; # Let's keep this same as lib/Pod/Html.pm 6$VERSION = eval $VERSION; 7our @EXPORT_OK = qw( 8 setup_testing_dir 9 xconvert 10 record_state_of_cache 11); 12use Cwd; 13use Pod::Html; 14use Config; 15use File::Basename; 16use File::Copy; 17use File::Path ( qw| make_path | ); 18use File::Spec::Functions ':ALL'; 19use File::Temp ( qw| tempdir | ); 20use Data::Dumper;$Data::Dumper::Sortkeys=1; 21use Pod::Html::Util qw( 22 unixify 23); 24 25*ok = \&Test::More::ok; 26*is = \&Test::More::is; 27 28our @no_arg_switches = ( qw| 29 flush recurse norecurse 30 quiet noquiet verbose noverbose 31 index noindex backlink nobacklink 32 header noheader poderrors nopoderrors 33| ); 34 35=head1 NAME 36 37Testing - Helper functions for testing Pod-Html 38 39=head1 SYNOPSIS 40 41 use Testing qw( setup_testing_dir xconvert ); 42 43 my $tdir = setup_testing_dir( { 44 debug => $debug, 45 } ); 46 47 $args = { 48 podstub => "htmldir1", 49 description => "test --htmldir and --htmlroot 1a", 50 expect => $expect_raw, 51 p2h => { 52 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 53 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 54 podroot => catpath($v, '/', ''), 55 htmldir => 't', 56 quiet => 1, 57 }, 58 debug => $debug, 59 }; 60 xconvert($args); 61 62=head1 DESCRIPTION 63 64This module exports, upon request only, 2 subroutines which are used in most 65of the files in the core distribution test suite for Pod-HTML 66(F<ext/Pod-Html/t/*.t>). In the future we may add additional subroutines, 67particularly to better diagnose problems with Pod-Html. 68 69=head2 Pod-Html's Testing Structure 70 71As of version 1.26 of this module (early 2021), the testing structure consists 72of 16 F<.pod> files and 18 F<.t> files located in two subdirectories, 73F<corpus/> and F<t/>. Let's analyze these by directory. 74 75=head3 Files in F<corpus/> 76 77There are currently 2 F<.pod> files in F<corpus/> both of which are old 78versions of F<pod/*.pod> files selected to give some complexity to the test 79suite. Since we don't actually attempt to make HTML out of their POD, we 80don't need to discuss them further. 81 82=head3 Files in F<t/> 83 84There are currently 14 F<.pod> files and 18 F<.t> files in F<t/>. Both of 85these numbers may change in the future. 86 87Currently there are 2 F<t/.t> files (F<t/anchorify.t> and F<t/eol.t>) which 88exercise certain functionality of F<Pod::Html> but which do not require 89F<t/*.pod> files as data input. These files do not make use of the 90subroutines exported by this module. We may add more test files like this in 91the future to ensure high test coverage, but don't need to discuss them 92further here. 93 94The remaining 16 F<t/*.t> test programs make use of the testing subroutines 95exported by this module. Most, but not all, of these test programs make use 96of the F<t/*.pod> files. Each such test program makes use of only 1 97F<t/*.pod> file at a time, though there are several cases where several, 98similarly named, test programs make use of the same F<t/*.pod> file for data 99input. For example, 100 101 t/crossref.t 102 t/crossref2.t 103 t/crossref3.t 104 105all make use of 106 107 t/crossref.pod 108 109Each F<t/*.pod> file consists solely of simple documentation in POD format. 110 111=head3 High-level description of programs which use F<.pod> files as input 112 113Each of the F<t/*.t> programs which makes use of a given F<t/*.pod> file 114slurps the text of a single such F<t/*.pod> file into memory. The test 115program holds text in a C<DATA> handle which serves as a B<template> for the 116HTML expected to be generated by running the F<t/*.pod> file through 117C<Pod::Html::pod2html()>. The HTML output by C<Pod::Html::pod2html()> can 118vary greatly, particularly with respect to links, depending on the arguments 119passed to that function. The HTML output will also be affected by the 120underlying operating system, I<e.g.,> with respect to path separators. Hence, 121we cannot hard-code the expected HTML output into the C<DATA> template or any 122place else. We have to allow C<Pod::Html::pod2html()> to massage the template 123data to get an "expected output" against which we match the "actual output" 124which comes from running C<Pod::Html::pod2html()> over the text originally 125slurped into memory from the F<t/*.pod> file. 126 127Granted, there is a certain amount of circularity in this testing regimen. On 128a given operating system, with a given F<t/*.pod> file as raw input, a given 129POD parser invoked within C<Pod::Html::pod2html()> and a given set of 130arguments passed to C<pod2html()>, there can and should be only one possible 131HTML string generated as output. What we currently have in a given test 132program's C<DATA> handle is merely that HTML string retrofitted with certain 133template elements as needed to make the "got" and the "expected" identical. 134We're not testing whether we're generating "good" HTML. We're simply testing 135that we get consistent results out of C<pod2html()> year after year. 136 137=head3 How a test program works step-by-step 138 139Here we continue to focus on those test programs which make use of the testing 140functions exported by F<Testing> and which take a F<t/*.pod> file as input. 141 142We assume that we begin our tests from the top level of the Perl 5 core 143distribution and are using F<t/harness>. Hence, to run the test files we say: 144 145 cd t; ./perl harness ../ext/Pod-Html/t/*.t; cd - 146 147The program then slurps contents of the C<DATA> handle into memory. 148 149The program then calls C<setup_testing_dir()> from this module to create a 150temporary directory and populate it as needed. C<setup_testing_dir()> returns 151the absolute path to that directory, but at the point where that subroutine 152returns you are actually located two levels beneath the temporary directory in 153a directory whose relative path is F<ext/Pod-Html/>. (This is equivalent to 154being in F<toplevel/ext/Pod-Html/> for tests in versions of Pod-Html 155distributed with earlier versions of F<perl>.) 156 157Note that this means that at the end of the program you will have to switch 158back to your starting directory so that the tempdir can automatically be 159cleaned up. We automate this via an C<END> block. 160 161You then prepare arguments for our principal testing function, C<xconvert()> 162(which supersedes the former C<convert_n_test()>. These arguments take the 163form of a single hash reference. One customary but optional element in that 164hashref, C<p2h>, is itself a hashref of key-value pairs corresponding to 165switches passed to the F<pod2html> command-line utility or to 166C<Pod::Html::pod2html()>. The other elements in the hashref passed to 167C<xconvert()> include the stub of the basename of the F<t/*.pod> file being 168used, the text of that file (which we've already slurped into memory), the 169test description, and whether we want extra debugging output or not. The 170program then adds a key-value pair to indicate whether we're running via core 171distribution test harness or not. 172 173The hashref is then passed to C<xconvert()> which internally generates an 174expected HTML output string by massaging the text read in from the C<DATA> 175handle. C<xconvert()> reads in the relevant F<t/*.pod> file and passes it to 176C<Pod::Html::pod2html()>, which parses the POD and generates the actual HTML 177output. If "got" matches "expected", a PASS is recorded for this instance of 178C<xconvert()>. 179 180As the example of F<t/htmldir1.t> illustrates: 181 182=over 4 183 184=item * 185 186The user can define a variety of arguments to be passed through to C<Pod::Html::pod2html()>. 187 188 my ($v, $d) = splitpath(cwd(), 1); 189 my @dirs = splitdir($d); 190 shift @dirs if $dirs[0] eq ''; 191 my $relcwd = join '/', @dirs; 192 193 $args = { 194 ... 195 p2h => { 196 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 197 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 198 podroot => catpath($v, '/', ''), 199 htmldir => 't', 200 quiet => 1, 201 }, 202 ... 203 }; 204 205=item * 206 207The user can try out a variety of different arguments in the C<p2h> element 208and end up with the same HTML output as predicted by the C<DATA> template by 209calling C<xconvert()> more than once per file. 210 211 $args = { 212 podstub => "htmldir1", 213 description => "test --htmldir and --htmlroot 1a", 214 expect => $expect_raw, 215 p2h => { 216 podpath => File::Spec::Unix->catdir($relcwd, 't') . ":" . 217 File::Spec::Unix->catdir($relcwd, 'corpus/test.lib'), 218 podroot => catpath($v, '/', ''), 219 htmldir => 't', 220 quiet => 1, 221 }, 222 }; 223 xconvert($args); 224 225 $args = { 226 podstub => "htmldir1", 227 description => "test --htmldir and --htmlroot 1b", 228 expect => $expect_raw, 229 p2h => { 230 podpath => $relcwd, 231 podroot => catpath($v, '/', ''), 232 htmldir => catdir($relcwd, 't'), 233 htmlroot => '/', 234 quiet => 1, 235 }, 236 }; 237 xconvert($args); 238 239Note that in the two "runs" above, the values for C<podstub> are the 240same, but the arguments to C<p2h> differ; we've distinguished the two runs 241by different values for C<description>. 242 243=back 244 245Note that all runs within an individual F<t/*.t> program share the same 246temporary directory. Since C<Pod::Html::pod2html()> typically caches its 247understanding of where F<.pod> files are located, there is a possibility that 248the contents of the cache may affect the generated HTML output in an adverse 249way. This possibility will be addressed in an upcoming version of this 250program. 251 252When all runs have been completed (as noted above), the C<END> block brings us 253back to the directory we started from to permit the temporary directory and 254its contents to be cleanly deleted. 255 256=head1 SUBROUTINES 257 258=head2 C<setup_testing_dir()> 259 260=over 4 261 262=item * Purpose 263 264Create and populate a temporary directory to hold all activity for a single F<t/*.t> program. 265 266=item * Arguments 267 268 $tdir = setup_testing_dir( { 269 startdir => $startdir, 270 debug => $debug, 271 } ); 272 273Single hash reference with two possible elements. 274 275=over 4 276 277=item * C<debug> 278 279A Boolean which you will typically set at the start of your program. A 280Perl-true value prints out your location and creates a temporary directory 281which is B<not> cleaned up at the program's completion, thereby permitting you 282to examine the intermediate files created by the program. 283 284=back 285 286=item * Return Value 287 288String holding the absolute path of the temporary directory. 289 290=item * Comments 291 292The function C<chdir>s internally and leaves you in a directory called 293F<ext/Pod-Html> beneath the temporary directory found in the return value. 294 295The function is somewhat equivalent to testing helper function 296C<make_test_dir> in F<t/pod2html-lib.pl> in versions of Pod-Html shipped with 297versions of F<perl> up through 5.32. 298 299=back 300 301=cut 302 303sub setup_testing_dir { 304 my $args = shift; 305 my $cwd = cwd(); 306 my $toptempdir = $args->{debug} ? tempdir() : tempdir( CLEANUP => 1 ); 307 if ($args->{debug}) { 308 print STDERR "toptempdir: $toptempdir\n"; 309 } 310 chdir $toptempdir or die "Unable to change to $toptempdir: $!"; 311 312 my $ephdir = catdir($toptempdir, 'ext', 'Pod-Html'); 313 my ($fromdir, $targetdir, $pod_glob, @testfiles); 314 315 # Copy ext/Pod-Html/t/*.pod files into position under tempdir 316 $fromdir = catdir($cwd, 't'); 317 # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy 318 $pod_glob = catfile($fromdir, '*.pod'); 319 @testfiles = glob($pod_glob); 320 321 $targetdir = catdir($ephdir, 't'); 322 make_path($targetdir) or die("Cannot mkdir $targetdir for testing: $!"); 323 for my $f (@testfiles) { 324 copy $f => $targetdir or die "Unable to copy: $!"; 325 } 326 327 # Copy ext/Pod-Html/corpus/*.pod files into position under tempdir 328 $fromdir = catdir($cwd, 'corpus'); 329 # Per Craig Berry: Avoid hard-coded '/' to keep VMS happy 330 $pod_glob = catfile($fromdir, '*.pod'); 331 @testfiles = glob($pod_glob); 332 333 $targetdir = catdir($ephdir, 'corpus', 'test.lib'); 334 make_path($targetdir) or die "Could not make $targetdir for testing: $!"; 335 336 my %copying = (); 337 for my $g (@testfiles) { 338 my $basename = basename($g); 339 my ($stub) = $basename =~ m{^(.*)\.pod}; 340 $stub =~ s{^perl(.*)}{$1}; 341 $copying{$stub} = { 342 source => $g, 343 target => catfile($targetdir, "${stub}.pod") 344 }; 345 } 346 347 for my $k (keys %copying) { 348 copy $copying{$k}{source} => $copying{$k}{target} 349 or die "Unable to copy: $!"; 350 } 351 352 # Move into tempdir/ext/Pod-Html 353 chdir $ephdir or die "Unable to change to $ephdir: $!"; 354 return $toptempdir; 355} 356 357=head2 C<xconvert()> 358 359=over 4 360 361=item * Purpose 362 363Compare whether the HTML generated by C<Pod::Html::pod2html()>'s parsing of a 364F<.pod> file matches the expectation generated by parsing the C<DATA> block 365within the test file. 366 367=item * Arguments 368 369Single hash reference. 370 371 $args = { 372 podstub => "htmldir5", 373 description => "test --htmldir and --htmlroot 5", 374 expect => $expect_raw, 375 p2h => { 376 podpath => 't:corpus/test.lib', 377 podroot => $cwd, 378 htmldir => $cwd, 379 htmlroot => '/', 380 quiet => 1, 381 }, 382 debug => $debug, 383 }; 384 $args->{core} = 1 if $ENV{PERL_CORE}; 385 386Elements are as follows: 387 388=over 4 389 390=item * C<podstub> 391 392String holding the stub (or stem) of the F<.pod> file being used as input. 393The stub is the basename of the file less the file extension or suffix. 394(Equivalent to the first argument passed to the former C<convert_and_test> 395test helper routine.) Required. 396 397=item * C<description> 398 399String holding the description (or name or label) in typical TAP syntax. 400(Equivalent to the second argument passed to the former C<convert_and_test> 401helper routine.) Required. 402 403=item * C<expect> 404 405String holding the "raw" expectations read in from the C<DATA> handle. Each 406run of C<xconvert()> within a given test file should have the same value for 407this key. Required. 408 409=item * C<p2h> 410 411Hash reference holding arguments passed to C<Pod::Html::pod2html()> (though 412without the leading double hyphens (C<-->). See documentation for 413F<Pod::Html>. Optional, but mostly necessary. In particular, if a F<.pod> 414file contains any C<LE<lt>E<gt>> tags, a C<podpath> element almost always 415needs to be supplied with a colon-delimited list of directories from which to 416begin a search for files containing POD. 417 418=item * C<debug> 419 420Boolean, generally set once at the program's top. When Perl-true, displays 421extra debugging output, including turning on C<Pod::Html::pod2html()>'s 422C<verbose> option. Optional. 423 424=item * C<core> 425 426Boolean. This should be set to a Perl-true value when the file is to be run 427from the test harness rather than from the top-level of the repository. 428 429=back 430 431=item * Return Value 432 433Not explicitly defined, but should return a Perl-true value upon completion. 434 435=item * Comment 436 437This function essentially asks, "Are we getting the same HTML output the last 438time we tinkered with the code in this distribution?" Hence, it is dependent 439on the particular parsing and HTML composition functionality found within 440C<Pod::Html::pod2html()>, which is a somewhat customized subclass of 441F<Pod::Simple::XHTML>. If, in the future, we offer functionality based on 442other parsing classes, then the C<DATA> sections of the F<t/*.t> files will 443have to be revised and perhaps the guts of C<xconvert()> as well. 444 445This function is roughly equivalent to test helper function 446C<convert_n_test()> in earlier versions of Pod-Html. 447 448=back 449 450=cut 451 452sub xconvert { 453 my $args = shift; 454 for my $k ('podstub', 'description', 'expect') { 455 die("convert_n_test() must have $k element") 456 unless length($args->{$k}); 457 } 458 my $podstub = $args->{podstub}; 459 my $description = $args->{description}; 460 my $debug = $args->{debug} // 0; 461 $args->{expect_fail} //= 0; 462 if (defined $args->{p2h}) { 463 die "Value for 'p2h' must be hashref" 464 unless ref($args->{p2h}) eq 'HASH'; # TEST ME 465 } 466 my $cwd = unixify( Cwd::cwd() ); 467 my ($vol, $dir) = splitpath($cwd, 1); 468 my @dirs = splitdir($dir); 469 shift @dirs if $dirs[0] eq ''; 470 my $relcwd = join '/', @dirs; 471 472 my $new_dir = catdir $dir, "t"; 473 my $infile = catpath $vol, $new_dir, "$podstub.pod"; 474 my $outfile = catpath $vol, $new_dir, "$podstub.html"; 475 476 my $args_table = _prepare_argstable( { 477 infile => $infile, 478 outfile => $outfile, 479 cwd => $cwd, 480 p2h => $args->{p2h}, 481 } ); 482 my @args_list = _prepare_argslist($args_table); 483 Pod::Html::pod2html( @args_list ); 484 485 $cwd =~ s|\/$||; 486 487 my $expect = _set_expected_html($args->{expect}, $relcwd, $cwd); 488 my $result = _get_html($outfile); 489 490 _process_diff( { 491 expect => $expect, 492 result => $result, 493 description => $description, 494 podstub => $podstub, 495 outfile => $outfile, 496 debug => $debug, 497 expect_fail => $args->{expect_fail}, 498 } ); 499 500 # pod2html creates these 501 unless ($debug) { 502 1 while unlink $outfile; 503 1 while unlink "pod2htmd.tmp"; 504 } 505} 506 507sub _prepare_argstable { 508 my $args = shift; 509 my %args_table = ( 510 infile => $args->{infile}, 511 outfile => $args->{outfile}, 512 ); 513 my %no_arg_switches = map { $_ => 1 } @no_arg_switches; 514 if (defined $args->{p2h}) { 515 for my $sw (keys %{$args->{p2h}}) { 516 if ($no_arg_switches{$sw}) { 517 $args_table{$sw} = undef; 518 } 519 else { 520 $args_table{$sw} = $args->{p2h}->{$sw}; 521 } 522 } 523 } 524 return \%args_table; 525} 526 527sub _prepare_argslist { 528 my $args_table = shift; 529 my @args_list = (); 530 for my $k (keys %{$args_table}) { 531 if (defined $args_table->{$k}) { 532 push @args_list, "--" . $k . "=" . $args_table->{$k}; 533 } 534 else { 535 push @args_list, "--" . $k; 536 } 537 } 538 return @args_list; 539} 540 541sub _set_expected_html { 542 my ($expect, $relcwd, $cwd) = @_; 543 $expect =~ s/\[PERLADMIN\]/$Config::Config{perladmin}/; 544 $expect =~ s/\[RELCURRENTWORKINGDIRECTORY\]/$relcwd/g; 545 $expect =~ s/\[ABSCURRENTWORKINGDIRECTORY\]/$cwd/g; 546 if (ord("A") == 193) { # EBCDIC. 547 $expect =~ s/item_mat_3c_21_3e/item_mat_4c_5a_6e/; 548 } 549 $expect =~ s/\n\n(some html)/$1/m; 550 $expect =~ s{(TESTING FOR AND BEGIN</h1>)\n\n}{$1}m; 551 return $expect; 552} 553 554sub _get_html { 555 my $outfile = shift; 556 local $/; 557 558 open my $in, '<', $outfile or die "cannot open $outfile: $!"; 559 my $result = <$in>; 560 close $in; 561 return $result; 562} 563 564sub _process_diff { 565 my $args = shift; 566 die("process_diff() takes hash ref") unless ref($args) eq 'HASH'; 567 my %keys_needed = map { $_ => 1 } (qw| expect result description podstub outfile |); 568 my %keys_seen = map { $_ => 1 } ( keys %{$args} ); 569 my @keys_missing = (); 570 for my $kn (keys %keys_needed) { 571 push @keys_missing, $kn unless exists $keys_seen{$kn}; 572 } 573 die("process_diff() arguments missing: @keys_missing") if @keys_missing; 574 575 my $diff = '/bin/diff'; 576 -x $diff or $diff = '/usr/bin/diff'; 577 -x $diff or $diff = undef; 578 my $diffopt = $diff ? $^O =~ m/(linux|darwin)/ ? '-u' : '-c' 579 : ''; 580 $diff = 'fc/n' if $^O =~ /^MSWin/; 581 $diff = 'differences' if $^O eq 'VMS'; 582 if ($diff) { 583 my $outcome = $args->{expect} eq $args->{result}; 584 if ($outcome) { 585 ok($outcome, $args->{description}); 586 } 587 else { 588 if ($args->{expect_fail}) { 589 ok(! $outcome, $args->{description}); 590 } 591 else { 592 ok($outcome, $args->{description}) or do { 593 my $expectfile = $args->{podstub} . "_expected.tmp"; 594 open my $tmpfile, ">", $expectfile or die $!; 595 print $tmpfile $args->{expect}, "\n"; 596 close $tmpfile; 597 open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" 598 or die("problem diffing: $!"); 599 print STDERR "# $_" while <$diff_fh>; 600 close $diff_fh; 601 unlink $expectfile unless $args->{debug}; 602 }; 603 } 604 } 605 } 606 else { 607 # This is fairly evil, but lets us get detailed failure modes 608 # anywhere that we've failed to identify a diff program. 609 is($args->{expect}, $args->{result}, $args->{description}); 610 } 611 return 1; 612} 613 614=head2 C<record_state_of_cache()> 615 616=over 4 617 618=item * Purpose 619 620During debugging, enable developer to examine the state of the Pod-Html cache 621after each call to C<xconvert()>. 622 623=item * Arguments 624 625Single hash reference. 626 627 record_state_of_cache( { 628 outdir => "$ENV{P5P_DIR}/pod-html", 629 stub => $args->{podstub}, 630 run => 1, 631 } ); 632 633Hash reference has the following key-value pairs: 634 635=over 4 636 637=item * C<outdir> 638 639Any directory of your system to which you want a sorted copy of the cache to 640be printed. 641 642=item * C<stub> 643 644The same value you passed in C<$args> to C<xconvert()>. 645 646=item * C<run> 647 648Integer which you set manually to distinguish among multiple runs of this 649function within the same test file (presumably corresponding to multiple 650invocations of C<xconvert()>). 651 652=back 653 654=item * Return Value 655 656Implicitly returns Perl-true value. 657 658=item * Comment 659 660Function will print out location of cache files and other information. 661 662=back 663 664=cut 665 666sub record_state_of_cache { 667 my $args = shift; 668 die("record_state_of_cache() takes hash reference") 669 unless ref($args) eq 'HASH'; 670 for my $k ( qw| outdir stub run | ) { 671 die("Argument to record_state_of_cache() lacks defined $k element") 672 unless defined $args->{$k}; 673 } 674 my $cwd = cwd(); 675 my $cache = catfile($cwd, 'pod2htmd.tmp'); 676 die("Could not locate file $cache") unless -f $cache; 677 die("Could not locate directory $args->{outdir}") unless -d $args->{outdir}; 678 die("'run' element takes integer") unless $args->{run} =~ m/^\d+$/; 679 680 my @cachelines = (); 681 open my $in, '<', $cache or die "Unable to open $cache for reading"; 682 while (my $l = <$in>) { 683 chomp $l; 684 push @cachelines, $l; 685 } 686 close $in or die "Unable to close $cache after reading"; 687 688 my $outfile = catfile($args->{outdir}, "$args->{run}.cache.$args->{stub}.$$.txt"); 689 die("$outfile already exists; did you remember to increment the 'run' argument?") 690 if -f $outfile; 691 open my $out, '>', $outfile or die "Unable to open $outfile for writing"; 692 print $out "$_\n" for (sort @cachelines); 693 close $out or die "Unable to close after writing"; 694 print STDERR "XXX: cache (sorted): $outfile\n"; 695} 696 697=head1 AUTHORS 698 699The testing code reworked into its present form has many authors and dates 700back to the dawn of Perl 5, perhaps beyond. The documentation was written by 701James E Keenan in March 2021. 702 703=cut 704 7051; 706