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