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