1 package TestPodIncPlainText;
8 my $THISDIR = abs_path(dirname $0);
9 unshift @INC, $THISDIR;
12 my $PARENTDIR = dirname $THISDIR;
13 push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR);
21 #use Cwd qw(abs_path);
23 use vars qw($MYPKG @EXPORT @ISA);
24 $MYPKG = eval { (caller)[0] };
25 @EXPORT = qw(&testpodplaintext);
27 if ( $] >= 5.005_58 ) {
29 @ISA = qw( Pod::Text );
32 require Pod::PlainText;
33 @ISA = qw( Pod::PlainText );
35 require VMS::Filespec if $^O eq 'VMS';
38 ## Hardcode settings for TERMCAP and COLUMNS so we can try to get
39 ## reproducible results between environments
40 @ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76);
42 sub catfile(@) { File::Spec->catfile(@_); }
44 my $INSTDIR = abs_path(dirname $0);
45 if ($^O eq 'VMS') { # clean up directory spec
46 $INSTDIR = VMS::Filespec::unixpath($INSTDIR);
48 $INSTDIR =~ s#/000000/#/#;
52 # File::Spec::VMS::splitdir doesn't work on Unix syntax filespecs, but
53 # on VMS syntax filespecs dirname returns (as documented) the directory
54 # part of the path (NOT the parent directory, as is assumed in this script).
55 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod');
56 $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't');
59 $INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 'pod');
60 $INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 't');
63 my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
64 catfile($INSTDIR, 'scripts'),
65 catfile($INSTDIR, 'pod'),
66 catfile($INSTDIR, 't', 'pod')
68 print "PODINCDIRS = ",join(', ',@PODINCDIRS),"\n";
70 ## Find the path to the file to =include
75 ## See if its already found w/out any "searching;
76 return $incname if (-r $incname);
78 ## Need to search for it. Look in the following directories ...
79 ## 1. the directory containing this pod file
80 my $thispoddir = dirname $self->input_file;
81 ## 2. the parent directory of the above
82 my $parentdir = dirname $thispoddir;
83 my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS);
86 my $incfile = catfile($_, $incname);
87 return $incfile if (-r $incfile);
89 warn("*** Can't find =include file $incname in @podincdirs\n");
95 my ($cmd, $text, $line_num, $pod_para) = @_;
96 $cmd = '' unless (defined $cmd);
97 local $_ = $text || '';
98 my $out_fh = $self->output_handle;
100 ## Defer to the superclass for everything except '=include'
101 return $self->SUPER::command(@_) unless ($cmd eq "include");
103 ## We have an '=include' command
104 my $incdebug = 1; ## debugging
107 warn("*** No filename given for '=include'\n");
110 my $incfile = $self->findinclude(shift @incargs) or return;
111 my $incbase = basename $incfile;
112 print $out_fh "###### begin =include $incbase #####\n" if ($incdebug);
113 $self->parse_from_file( {-cutting => 1}, $incfile );
114 print $out_fh "###### end =include $incbase #####\n" if ($incdebug);
118 $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS';
121 sub podinc2plaintext( $ $ ) {
122 my ($infile, $outfile) = @_;
124 my $text_parser = $MYPKG->new(quotes => "`'");
125 $text_parser->parse_from_file($infile, $outfile);
128 sub testpodinc2plaintext( @ ) {
130 my $infile = $args{'-In'} || croak "No input file given!";
131 my $outfile = $args{'-Out'} || croak "No output file given!";
132 my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!";
135 my $testname = basename $cmpfile, '.t', '.xr';
137 unless (-e $cmpfile) {
138 my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
143 print "# Running testpodinc2plaintext for '$testname'...\n";
144 ## Compare the output against the expected result
145 podinc2plaintext($infile, $outfile);
146 if ( testcmp($outfile, $cmpfile) ) {
147 $different = "$outfile is different from $cmpfile";
155 sub testpodplaintext( @ ) {
156 my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
158 my ($testname, $testdir) = ("", "");
159 my ($podfile, $cmpfile) = ("", "");
160 my ($outfile, $errfile) = ("", "");
165 print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'});
167 for $podfile (@testpods) {
168 ($testname, $_) = fileparse($podfile);
170 $testname =~ s/\..*$//;
171 $cmpfile = $testdir . $testname . '.xr';
172 $outfile = $testdir . $testname . '.OUT';
174 if ($opts{'-xrgen'}) {
175 if ($opts{'-force'} or ! -e $cmpfile) {
176 ## Create the comparison file
177 print "# Creating expected result for \"$testname\"" .
178 " pod2plaintext test ...\n";
179 podinc2plaintext($podfile, $cmpfile);
182 print "# File $cmpfile already exists" .
183 " (use '-force' to regenerate it).\n";
188 my $failmsg = testpodinc2plaintext
194 print "#\tFAILED. ($failmsg)\n";
195 print "not ok ", $failed+$passes, "\n";
200 print "#\tPASSED.\n";
201 print "ok ", $failed+$passes, "\n";