xref: /openbsd-src/gnu/usr.bin/perl/ext/Pod-Html/t/lib/Testing.pm (revision 5486feefcc8cb79b19e014ab332cc5dfd05b3b33)
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