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