home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / t / pod / testp2pt.pl < prev    next >
Perl Script  |  2000-03-13  |  6KB  |  193 lines

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