1 package TestPodIncPlainText;
7 my $THISDIR = dirname $0;
8 unshift @INC, $THISDIR;
11 my $PARENTDIR = dirname $THISDIR;
12 push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
16 use vars qw(@ISA @EXPORT $MYPKG);
23 @ISA = qw(Pod::PlainText);
24 @EXPORT = qw(&testpodplaintext);
25 $MYPKG = eval { (caller)[0] };
27 ## Hardcode settings for TERMCAP and COLUMNS so we can try to get
28 ## reproducible results between environments
29 @ENV{qw(TERMCAP COLUMNS)} = ('co=72:do=^J', 72);
31 sub catfile(@) { File::Spec->catfile(@_); }
33 ## Find the path to the file to =include
38 ## See if its already found w/out any "searching;
39 return $incname if (-r $incname);
41 ## Need to search for it. Look in the following directories ...
42 ## 1. the directory containing this pod file
43 my $thispoddir = dirname $self->input_file;
44 ## 2. the parent directory of the above
45 my $parentdir = ($thispoddir eq '.') ? '..' : dirname $thispoddir;
46 ## 3. any Pod/ or scripts/ subdirectory of these two
48 for ($thispoddir, $parentdir) {
50 for ( qw(scripts lib) ) {
51 push @dirs, $dir, catfile($dir, $_),
53 catfile($dir, $_, 'Pod');
56 my %dirs = (map { ($_ => 1) } @dirs);
57 my @podincdirs = (sort keys %dirs);
60 my $incfile = catfile($_, $incname);
61 return $incfile if (-r $incfile);
63 warn("*** Can't find =include file $incname in @podincdirs\n");
69 my ($cmd, $text, $line_num, $pod_para) = @_;
70 $cmd = '' unless (defined $cmd);
71 local $_ = $text || '';
72 my $out_fh = $self->output_handle;
74 ## Defer to the superclass for everything except '=include'
75 return $self->SUPER::command(@_) unless ($cmd eq "include");
77 ## We have an '=include' command
78 my $incdebug = 1; ## debugging
81 warn("*** No filename given for '=include'\n");
84 my $incfile = $self->findinclude(shift @incargs) or return;
85 my $incbase = basename $incfile;
86 print $out_fh "###### begin =include $incbase #####\n" if ($incdebug);
87 $self->parse_from_file( {-cutting => 1}, $incfile );
88 print $out_fh "###### end =include $incbase #####\n" if ($incdebug);
91 sub podinc2plaintext( $ $ ) {
92 my ($infile, $outfile) = @_;
94 my $text_parser = $MYPKG->new;
95 $text_parser->parse_from_file($infile, $outfile);
98 sub testpodinc2plaintext( @ ) {
100 my $infile = $args{'-In'} || croak "No input file given!";
101 my $outfile = $args{'-Out'} || croak "No output file given!";
102 my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
105 my $testname = basename $cmpfile, '.t', '.xr';
107 unless (-e $cmpfile) {
108 my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
113 print "+ Running testpodinc2plaintext for '$testname'...\n";
114 ## Compare the output against the expected result
115 podinc2plaintext($infile, $outfile);
116 if ( testcmp($outfile, $cmpfile) ) {
117 $different = "$outfile is different from $cmpfile";
125 sub testpodplaintext( @ ) {
126 my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
128 my ($testname, $testdir) = ("", "");
129 my ($podfile, $cmpfile) = ("", "");
130 my ($outfile, $errfile) = ("", "");
135 print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'});
137 for $podfile (@testpods) {
138 ($testname, $_) = fileparse($podfile);
140 $testname =~ s/\.t$//;
141 $cmpfile = $testdir . $testname . '.xr';
142 $outfile = $testdir . $testname . '.OUT';
144 if ($opts{'-xrgen'}) {
145 if ($opts{'-force'} or ! -e $cmpfile) {
146 ## Create the comparison file
147 print "+ Creating expected result for \"$testname\"" .
148 " pod2plaintext test ...\n";
149 podinc2plaintext($podfile, $cmpfile);
152 print "+ File $cmpfile already exists" .
153 " (use '-force' to regenerate it).\n";
158 my $failmsg = testpodinc2plaintext
164 print "+\tFAILED. ($failmsg)\n";
165 print "not ok ", $failed+$passes, "\n";
170 print "+\tPASSED.\n";
171 print "ok ", $failed+$passes, "\n";