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