package TestPodIncPlainText; my $PARENTDIR; BEGIN { use File::Basename; use File::Spec; use Cwd qw(abs_path); push @INC, '..'; my $THISDIR = abs_path(dirname $0); unshift @INC, $THISDIR; require "testcmp.pl"; import TestCompare; $PARENTDIR = File::Spec->catdir($THISDIR, File::Spec->updir()); push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); } #use strict; #use diagnostics; use Carp; use Exporter; #use File::Compare; #use Cwd qw(abs_path); use vars qw($MYPKG @EXPORT @ISA); $MYPKG = eval { (caller)[0] }; @EXPORT = qw(&testpodplaintext); BEGIN { # we want this for testing only unshift(@INC, File::Spec->catfile($PARENTDIR, 'inc')); print "INC=@INC\n"; require Pod::PlainText; @ISA = qw( Pod::PlainText ); require VMS::Filespec if $^O eq 'VMS'; } ## Hardcode settings for TERMCAP and COLUMNS so we can try to get ## reproducible results between environments @ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76); sub catfile(@) { File::Spec->catfile(@_); } my $INSTDIR = abs_path(dirname $0); $INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS'; $INSTDIR =~ s#/$## if $^O eq 'VMS'; $INSTDIR =~ s#:$## if $^O eq 'MacOS'; $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod'); $INSTDIR =~ s#:$## if $^O eq 'MacOS'; $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't'); my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'), catfile($INSTDIR, 'scripts'), catfile($INSTDIR, 'pod'), catfile($INSTDIR, 't', 'pod') ); # FIXME - we should make the core capable of finding utilities built in # locations in ext. push @PODINCDIRS, catfile((File::Spec->updir()) x 2, 'pod') if $ENV{PERL_CORE}; ## Find the path to the file to =include sub findinclude { my $self = shift; my $incname = shift; ## See if its already found w/out any "searching; return $incname if (-r $incname); ## Need to search for it. Look in the following directories ... ## 1. the directory containing this pod file my $thispoddir = dirname $self->input_file; ## 2. the parent directory of the above my $parentdir = dirname $thispoddir; my @podincdirs = ($thispoddir, $parentdir, @PODINCDIRS); for (@podincdirs) { my $incfile = catfile($_, $incname); return $incfile if (-r $incfile); } warn("*** Can't find =include file $incname in @podincdirs\n"); return ""; } sub command { my $self = shift; my ($cmd, $text, $line_num, $pod_para) = @_; $cmd = '' unless (defined $cmd); local $_ = $text || ''; my $out_fh = $self->output_handle; ## Defer to the superclass for everything except '=include' return $self->SUPER::command(@_) unless ($cmd eq "include"); ## We have an '=include' command my $incdebug = 1; ## debugging my @incargs = split; if (@incargs == 0) { warn("*** No filename given for '=include'\n"); return; } my $incfile = $self->findinclude(shift @incargs) or return; my $incbase = basename $incfile; print $out_fh "###### begin =include $incbase #####\n" if ($incdebug); $self->parse_from_file( {-cutting => 1}, $incfile ); print $out_fh "###### end =include $incbase #####\n" if ($incdebug); } sub begin_input { $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS'; } sub podinc2plaintext( $ $ ) { my ($infile, $outfile) = @_; local $_; my $text_parser = $MYPKG->new; $text_parser->parse_from_file($infile, $outfile); } sub testpodinc2plaintext( @ ) { my %args = @_; my $infile = $args{'-In'} || croak "No input file given!"; my $outfile = $args{'-Out'} || croak "No output file given!"; my $cmpfile = $args{'-Cmp'} || croak "No compare-result file given!"; my $different = ''; my $testname = basename $cmpfile, '.t', '.xr'; unless (-e $cmpfile) { my $msg = "*** Can't find comparison file $cmpfile for testing $infile"; warn "$msg\n"; return $msg; } print "# Running testpodinc2plaintext for '$testname'...\n"; ## Compare the output against the expected result podinc2plaintext($infile, $outfile); if ( testcmp($outfile, $cmpfile) ) { $different = "$outfile is different from $cmpfile"; } else { unlink($outfile); } return $different; } sub testpodplaintext( @ ) { my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : (); my @testpods = @_; my ($testname, $testdir) = ("", ""); my ($podfile, $cmpfile) = ("", ""); my ($outfile, $errfile) = ("", ""); my $passes = 0; my $failed = 0; local $_; print "1..", scalar @testpods, "\n" unless ($opts{'-xrgen'}); for $podfile (@testpods) { ($testname, $_) = fileparse($podfile); $testdir ||= $_; $testname =~ s/\.t$//; $cmpfile = $testdir . $testname . '.xr'; $outfile = $testdir . $testname . '.OUT'; if ($opts{'-xrgen'}) { if ($opts{'-force'} or ! -e $cmpfile) { ## Create the comparison file print "# Creating expected result for \"$testname\"" . " pod2plaintext test ...\n"; podinc2plaintext($podfile, $cmpfile); } else { print "# File $cmpfile already exists" . " (use '-force' to regenerate it).\n"; } next; } my $failmsg = testpodinc2plaintext -In => $podfile, -Out => $outfile, -Cmp => $cmpfile; if ($failmsg) { ++$failed; print "#\tFAILED. ($failmsg)\n"; print "not ok ", $failed+$passes, "\n"; } else { ++$passes; unlink($outfile); print "#\tPASSED.\n"; print "ok ", $failed+$passes, "\n"; } } return $passes; } 1;