Commit | Line | Data |
360aca43 |
1 | package TestPodIncPlainText; |
2 | |
3 | BEGIN { |
4 | use File::Basename; |
5 | use File::Spec; |
e9fdc7d2 |
6 | use Cwd qw(abs_path); |
360aca43 |
7 | push @INC, '..'; |
e9fdc7d2 |
8 | my $THISDIR = abs_path(dirname $0); |
360aca43 |
9 | unshift @INC, $THISDIR; |
10 | require "testcmp.pl"; |
11 | import TestCompare; |
12 | my $PARENTDIR = dirname $THISDIR; |
13 | push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); |
14 | } |
15 | |
360aca43 |
16 | #use strict; |
17 | #use diagnostics; |
18 | use Carp; |
19 | use Exporter; |
20 | #use File::Compare; |
e9fdc7d2 |
21 | #use Cwd qw(abs_path); |
360aca43 |
22 | |
146174a9 |
23 | use vars qw($MYPKG @EXPORT @ISA); |
360aca43 |
24 | $MYPKG = eval { (caller)[0] }; |
146174a9 |
25 | @EXPORT = qw(&testpodplaintext); |
26 | BEGIN { |
27 | if ( $] >= 5.005_58 ) { |
28 | require Pod::Text; |
29 | @ISA = qw( Pod::Text ); |
30 | } |
31 | else { |
32 | require Pod::PlainText; |
33 | @ISA = qw( Pod::PlainText ); |
34 | } |
7de3340a |
35 | require VMS::Filespec if $^O eq 'VMS'; |
146174a9 |
36 | } |
360aca43 |
37 | |
38 | ## Hardcode settings for TERMCAP and COLUMNS so we can try to get |
39 | ## reproducible results between environments |
146174a9 |
40 | @ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76); |
360aca43 |
41 | |
42 | sub catfile(@) { File::Spec->catfile(@_); } |
43 | |
e9fdc7d2 |
44 | my $INSTDIR = abs_path(dirname $0); |
7de3340a |
45 | $INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS'; |
46 | $INSTDIR =~ s#/$## if $^O eq 'VMS'; |
e9fdc7d2 |
47 | $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'xtra'); |
48 | $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod'); |
49 | $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't'); |
50 | my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'), |
146174a9 |
51 | catfile($INSTDIR, 'pod'), |
e9fdc7d2 |
52 | catfile($INSTDIR, 't', 'pod'), |
53 | catfile($INSTDIR, 't', 'pod', 'xtra') |
54 | ); |
55 | |
360aca43 |
56 | ## Find the path to the file to =include |
57 | sub findinclude { |
58 | my $self = shift; |
59 | my $incname = shift; |
60 | |
61 | ## See if its already found w/out any "searching; |
62 | return $incname if (-r $incname); |
63 | |
64 | ## Need to search for it. Look in the following directories ... |
65 | ## 1. the directory containing this pod file |
66 | my $thispoddir = dirname $self->input_file; |
67 | ## 2. the parent directory of the above |
e9fdc7d2 |
68 | my $parentdir = dirname $thispoddir; |
69 | my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS); |
360aca43 |
70 | |
71 | for (@podincdirs) { |
72 | my $incfile = catfile($_, $incname); |
73 | return $incfile if (-r $incfile); |
74 | } |
75 | warn("*** Can't find =include file $incname in @podincdirs\n"); |
76 | return ""; |
77 | } |
78 | |
79 | sub command { |
80 | my $self = shift; |
81 | my ($cmd, $text, $line_num, $pod_para) = @_; |
82 | $cmd = '' unless (defined $cmd); |
83 | local $_ = $text || ''; |
84 | my $out_fh = $self->output_handle; |
85 | |
86 | ## Defer to the superclass for everything except '=include' |
87 | return $self->SUPER::command(@_) unless ($cmd eq "include"); |
88 | |
89 | ## We have an '=include' command |
90 | my $incdebug = 1; ## debugging |
91 | my @incargs = split; |
92 | if (@incargs == 0) { |
93 | warn("*** No filename given for '=include'\n"); |
94 | return; |
95 | } |
96 | my $incfile = $self->findinclude(shift @incargs) or return; |
97 | my $incbase = basename $incfile; |
98 | print $out_fh "###### begin =include $incbase #####\n" if ($incdebug); |
99 | $self->parse_from_file( {-cutting => 1}, $incfile ); |
100 | print $out_fh "###### end =include $incbase #####\n" if ($incdebug); |
101 | } |
102 | |
103 | sub podinc2plaintext( $ $ ) { |
104 | my ($infile, $outfile) = @_; |
105 | local $_; |
106 | my $text_parser = $MYPKG->new; |
107 | $text_parser->parse_from_file($infile, $outfile); |
108 | } |
109 | |
110 | sub testpodinc2plaintext( @ ) { |
111 | my %args = @_; |
112 | my $infile = $args{'-In'} || croak "No input file given!"; |
113 | my $outfile = $args{'-Out'} || croak "No output file given!"; |
114 | my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; |
115 | |
116 | my $different = ''; |
117 | my $testname = basename $cmpfile, '.t', '.xr'; |
118 | |
119 | unless (-e $cmpfile) { |
120 | my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; |
121 | warn "$msg\n"; |
122 | return $msg; |
123 | } |
124 | |
146174a9 |
125 | print "# Running testpodinc2plaintext for '$testname'...\n"; |
360aca43 |
126 | ## Compare the output against the expected result |
127 | podinc2plaintext($infile, $outfile); |
128 | if ( testcmp($outfile, $cmpfile) ) { |
129 | $different = "$outfile is different from $cmpfile"; |
130 | } |
131 | else { |
132 | unlink($outfile); |
133 | } |
134 | return $different; |
135 | } |
136 | |
137 | sub testpodplaintext( @ ) { |
138 | my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); |
139 | my @testpods = @_; |
140 | my ($testname, $testdir) = ("", ""); |
141 | my ($podfile, $cmpfile) = ("", ""); |
142 | my ($outfile, $errfile) = ("", ""); |
143 | my $passes = 0; |
144 | my $failed = 0; |
145 | local $_; |
146 | |
147 | print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); |
148 | |
149 | for $podfile (@testpods) { |
150 | ($testname, $_) = fileparse($podfile); |
151 | $testdir ||= $_; |
152 | $testname =~ s/\.t$//; |
153 | $cmpfile = $testdir . $testname . '.xr'; |
154 | $outfile = $testdir . $testname . '.OUT'; |
155 | |
156 | if ($opts{'-xrgen'}) { |
157 | if ($opts{'-force'} or ! -e $cmpfile) { |
158 | ## Create the comparison file |
146174a9 |
159 | print "# Creating expected result for \"$testname\"" . |
360aca43 |
160 | " pod2plaintext test ...\n"; |
161 | podinc2plaintext($podfile, $cmpfile); |
162 | } |
163 | else { |
146174a9 |
164 | print "# File $cmpfile already exists" . |
360aca43 |
165 | " (use '-force' to regenerate it).\n"; |
166 | } |
167 | next; |
168 | } |
169 | |
170 | my $failmsg = testpodinc2plaintext |
171 | -In => $podfile, |
172 | -Out => $outfile, |
173 | -Cmp => $cmpfile; |
174 | if ($failmsg) { |
175 | ++$failed; |
146174a9 |
176 | print "#\tFAILED. ($failmsg)\n"; |
360aca43 |
177 | print "not ok ", $failed+$passes, "\n"; |
178 | } |
179 | else { |
180 | ++$passes; |
181 | unlink($outfile); |
146174a9 |
182 | print "#\tPASSED.\n"; |
360aca43 |
183 | print "ok ", $failed+$passes, "\n"; |
184 | } |
185 | } |
186 | return $passes; |
187 | } |
188 | |
189 | 1; |