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