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 | |
664bb207 |
23 | use vars qw($MYPKG @EXPORT @ISA); |
360aca43 |
24 | $MYPKG = eval { (caller)[0] }; |
664bb207 |
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 | } |
f0963acb |
35 | require VMS::Filespec if $^O eq 'VMS'; |
664bb207 |
36 | } |
360aca43 |
37 | |
38 | ## Hardcode settings for TERMCAP and COLUMNS so we can try to get |
39 | ## reproducible results between environments |
664bb207 |
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); |
e4dfc136 |
45 | if ($^O eq 'VMS') { # clean up directory spec |
46 | $INSTDIR = VMS::Filespec::unixpath($INSTDIR); |
47 | $INSTDIR =~ s#/$##; |
48 | $INSTDIR =~ s#/000000/#/#; |
49 | } |
be708cc0 |
50 | # cut 't/pod' from path (cut 't:pod:' on Mac OS) |
e9fdc7d2 |
51 | $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod'); |
52 | $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't'); |
be708cc0 |
53 | |
e9fdc7d2 |
54 | my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'), |
828c4421 |
55 | catfile($INSTDIR, 'scripts'), |
27f805f4 |
56 | catfile($INSTDIR, 'pod'), |
828c4421 |
57 | catfile($INSTDIR, 't', 'pod') |
e9fdc7d2 |
58 | ); |
e4dfc136 |
59 | print "PODINCDIRS = ",join(', ',@PODINCDIRS),"\n"; |
e9fdc7d2 |
60 | |
360aca43 |
61 | ## Find the path to the file to =include |
62 | sub findinclude { |
63 | my $self = shift; |
64 | my $incname = shift; |
65 | |
66 | ## See if its already found w/out any "searching; |
67 | return $incname if (-r $incname); |
68 | |
69 | ## Need to search for it. Look in the following directories ... |
70 | ## 1. the directory containing this pod file |
71 | my $thispoddir = dirname $self->input_file; |
72 | ## 2. the parent directory of the above |
e9fdc7d2 |
73 | my $parentdir = dirname $thispoddir; |
74 | my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS); |
360aca43 |
75 | |
76 | for (@podincdirs) { |
77 | my $incfile = catfile($_, $incname); |
78 | return $incfile if (-r $incfile); |
79 | } |
80 | warn("*** Can't find =include file $incname in @podincdirs\n"); |
81 | return ""; |
82 | } |
83 | |
84 | sub command { |
85 | my $self = shift; |
86 | my ($cmd, $text, $line_num, $pod_para) = @_; |
87 | $cmd = '' unless (defined $cmd); |
88 | local $_ = $text || ''; |
89 | my $out_fh = $self->output_handle; |
90 | |
91 | ## Defer to the superclass for everything except '=include' |
92 | return $self->SUPER::command(@_) unless ($cmd eq "include"); |
93 | |
94 | ## We have an '=include' command |
95 | my $incdebug = 1; ## debugging |
96 | my @incargs = split; |
97 | if (@incargs == 0) { |
98 | warn("*** No filename given for '=include'\n"); |
99 | return; |
100 | } |
101 | my $incfile = $self->findinclude(shift @incargs) or return; |
102 | my $incbase = basename $incfile; |
103 | print $out_fh "###### begin =include $incbase #####\n" if ($incdebug); |
104 | $self->parse_from_file( {-cutting => 1}, $incfile ); |
105 | print $out_fh "###### end =include $incbase #####\n" if ($incdebug); |
106 | } |
107 | |
828c4421 |
108 | sub begin_input { |
109 | $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS'; |
110 | } |
111 | |
360aca43 |
112 | sub podinc2plaintext( $ $ ) { |
113 | my ($infile, $outfile) = @_; |
114 | local $_; |
9811a09c |
115 | my $text_parser = $MYPKG->new(quotes => "`'"); |
360aca43 |
116 | $text_parser->parse_from_file($infile, $outfile); |
117 | } |
118 | |
119 | sub testpodinc2plaintext( @ ) { |
120 | my %args = @_; |
121 | my $infile = $args{'-In'} || croak "No input file given!"; |
122 | my $outfile = $args{'-Out'} || croak "No output file given!"; |
123 | my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; |
124 | |
125 | my $different = ''; |
126 | my $testname = basename $cmpfile, '.t', '.xr'; |
127 | |
128 | unless (-e $cmpfile) { |
129 | my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; |
130 | warn "$msg\n"; |
131 | return $msg; |
132 | } |
133 | |
27f805f4 |
134 | print "# Running testpodinc2plaintext for '$testname'...\n"; |
360aca43 |
135 | ## Compare the output against the expected result |
136 | podinc2plaintext($infile, $outfile); |
137 | if ( testcmp($outfile, $cmpfile) ) { |
138 | $different = "$outfile is different from $cmpfile"; |
139 | } |
140 | else { |
141 | unlink($outfile); |
142 | } |
143 | return $different; |
144 | } |
145 | |
146 | sub testpodplaintext( @ ) { |
147 | my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); |
148 | my @testpods = @_; |
149 | my ($testname, $testdir) = ("", ""); |
150 | my ($podfile, $cmpfile) = ("", ""); |
151 | my ($outfile, $errfile) = ("", ""); |
152 | my $passes = 0; |
153 | my $failed = 0; |
154 | local $_; |
155 | |
156 | print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); |
157 | |
158 | for $podfile (@testpods) { |
159 | ($testname, $_) = fileparse($podfile); |
160 | $testdir ||= $_; |
3827f17e |
161 | $testname =~ s/\..*$//; |
360aca43 |
162 | $cmpfile = $testdir . $testname . '.xr'; |
163 | $outfile = $testdir . $testname . '.OUT'; |
164 | |
165 | if ($opts{'-xrgen'}) { |
166 | if ($opts{'-force'} or ! -e $cmpfile) { |
167 | ## Create the comparison file |
27f805f4 |
168 | print "# Creating expected result for \"$testname\"" . |
360aca43 |
169 | " pod2plaintext test ...\n"; |
170 | podinc2plaintext($podfile, $cmpfile); |
171 | } |
172 | else { |
27f805f4 |
173 | print "# File $cmpfile already exists" . |
360aca43 |
174 | " (use '-force' to regenerate it).\n"; |
175 | } |
176 | next; |
177 | } |
178 | |
179 | my $failmsg = testpodinc2plaintext |
180 | -In => $podfile, |
181 | -Out => $outfile, |
182 | -Cmp => $cmpfile; |
183 | if ($failmsg) { |
184 | ++$failed; |
27f805f4 |
185 | print "#\tFAILED. ($failmsg)\n"; |
360aca43 |
186 | print "not ok ", $failed+$passes, "\n"; |
187 | } |
188 | else { |
189 | ++$passes; |
190 | unlink($outfile); |
27f805f4 |
191 | print "#\tPASSED.\n"; |
360aca43 |
192 | print "ok ", $failed+$passes, "\n"; |
193 | } |
194 | } |
195 | return $passes; |
196 | } |
197 | |
198 | 1; |