t/pod/testp2pt.pl

   1 package TestPodIncPlainText;
   2
   3 BEGIN {
   4    use File::Basename;
   5    use File::Spec;
   6    use Cwd qw(abs_path);
   7    push @INC, '..';
   8    my $THISDIR = abs_path(dirname $0);
   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
  16 #use strict;
  17 #use diagnostics;
  18 use Carp;
  19 use Exporter;
  20 #use File::Compare;
  21 #use Cwd qw(abs_path);
  22
  23 use vars qw($MYPKG @EXPORT @ISA);
  24 $MYPKG = eval { (caller)[0] };
  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     }
  35     require VMS::Filespec if $^O eq 'VMS';
  36 }
  37
  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);
  41
  42 sub catfile(@) { File::Spec->catfile(@_); }
  43
  44 my $INSTDIR = abs_path(dirname $0);
  45 if ($^O eq 'VMS') { # clean up directory spec
  46     $INSTDIR = VMS::Filespec::unixpath($INSTDIR);
  47     $INSTDIR =~ s#/$##;
  48     $INSTDIR =~ s#/000000/#/#;
  49 }
  50
  51 if ($^O eq 'VMS') {
  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');
  57 }
  58 else {
  59   $INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 'pod');
  60   $INSTDIR = (dirname $INSTDIR) if ((File::Spec->splitdir($INSTDIR))[-1] eq 't');
  61 }
  62
  63 my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'),
  64                    catfile($INSTDIR, 'scripts'),
  65                    catfile($INSTDIR, 'pod'),
  66                    catfile($INSTDIR, 't', 'pod')
  67                  );
  68 print "PODINCDIRS = ",join(', ',@PODINCDIRS),"\n";
  69
  70 ## Find the path to the file to =include
  71 sub findinclude {
  72     my $self    = shift;
  73     my $incname = shift;
  74
  75     ## See if its already found w/out any "searching;
  76     return  $incname if (-r $incname);
  77
  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);
  84
  85     for (@podincdirs) {
  86        my $incfile = catfile($_, $incname);
  87        return $incfile  if (-r $incfile);
  88     }
  89     warn("*** Can't find =include file $incname in @podincdirs\n");
  90     return "";
  91 }
  92
  93 sub command {
  94     my $self = shift;
  95     my ($cmd, $text, $line_num, $pod_para)  = @_;
  96     $cmd     = ''  unless (defined $cmd);
  97     local $_ = $text || '';
  98     my $out_fh  = $self->output_handle;
  99
 100     ## Defer to the superclass for everything except '=include'
 101     return  $self->SUPER::command(@_) unless ($cmd eq "include");
 102
 103     ## We have an '=include' command
 104     my $incdebug = 1; ## debugging
 105     my @incargs = split;
 106     if (@incargs == 0) {
 107         warn("*** No filename given for '=include'\n");
 108         return;
 109     }
 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);
 115 }
 116
 117 sub begin_input {
 118    $_[0]->{_INFILE} = VMS::Filespec::unixify($_[0]->{_INFILE}) if $^O eq 'VMS';
 119 }
 120
 121 sub podinc2plaintext( $ $ ) {
 122     my ($infile, $outfile) = @_;
 123     local $_;
 124     my $text_parser = $MYPKG->new(quotes => "`'");
 125     $text_parser->parse_from_file($infile, $outfile);
 126 }
 127
 128 sub testpodinc2plaintext( @ ) {
 129    my %args = @_;
 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!";
 133
 134    my $different = '';
 135    my $testname = basename $cmpfile, '.t', '.xr';
 136
 137    unless (-e $cmpfile) {
 138       my $msg = "*** Can't find comparison file $cmpfile for testing $infile";
 139       warn  "$msg\n";
 140       return  $msg;
 141    }
 142
 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";
 148    }
 149    else {
 150        unlink($outfile);
 151    }
 152    return  $different;
 153 }
 154
 155 sub testpodplaintext( @ ) {
 156    my %opts = (ref $_[0] eq 'HASH') ? %{shift()} : ();
 157    my @testpods = @_;
 158    my ($testname, $testdir) = ("", "");
 159    my ($podfile, $cmpfile) = ("", "");
 160    my ($outfile, $errfile) = ("", "");
 161    my $passes = 0;
 162    my $failed = 0;
 163    local $_;
 164
 165    print "1..", scalar @testpods, "\n"  unless ($opts{'-xrgen'});
 166
 167    for $podfile (@testpods) {
 168       ($testname, $_) = fileparse($podfile);
 169       $testdir ||=  $_;
 170       $testname  =~ s/\..*$//;
 171       $cmpfile   =  $testdir . $testname . '.xr';
 172       $outfile   =  $testdir . $testname . '.OUT';
 173
 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);
 180           }
 181           else {
 182              print "# File $cmpfile already exists" .
 183                    " (use '-force' to regenerate it).\n";
 184           }
 185           next;
 186       }
 187
 188       my $failmsg = testpodinc2plaintext
 189                         -In  => $podfile,
 190                         -Out => $outfile,
 191                         -Cmp => $cmpfile;
 192       if ($failmsg) {
 193           ++$failed;
 194           print "#\tFAILED. ($failmsg)\n";
 195           print "not ok ", $failed+$passes, "\n";
 196       }
 197       else {
 198           ++$passes;
 199           unlink($outfile);
 200           print "#\tPASSED.\n";
 201           print "ok ", $failed+$passes, "\n";
 202       }
 203    }
 204    return  $passes;
 205 }
 206
 207 1;