lib/Pod/Checker.pm

   1 #############################################################################
   2 # Pod/Checker.pm -- check pod documents for syntax errors
   3 #
   4 # Based on Tom Christiansen's Pod::Text::pod2text() function
   5 # (with modifications).
   6 #
   7 # Copyright (C) 1994-1999 Tom Christiansen. All rights reserved.
   8 # This file is part of "PodParser". PodParser is free software;
   9 # you can redistribute it and/or modify it under the same terms
  10 # as Perl itself.
  11 #############################################################################
  12
  13 package Pod::Checker;
  14
  15 use vars qw($VERSION);
  16 $VERSION = 1.081;  ## Current version of this package
  17 require  5.004;    ## requires this Perl version or later
  18
  19 =head1 NAME
  20
  21 Pod::Checker, podchecker() - check pod documents for syntax errors
  22
  23 =head1 SYNOPSIS
  24
  25   use Pod::Checker;
  26
  27   $syntax_okay = podchecker($filepath, $outputpath);
  28
  29 =head1 OPTIONS/ARGUMENTS
  30
  31 C<$filepath> is the input POD to read and C<$outputpath> is
  32 where to write POD syntax error messages. Either argument may be a scalar
  33 indcating a file-path, or else a reference to an open filehandle.
  34 If unspecified, the input-file it defaults to C<\*STDIN>, and
  35 the output-file defaults to C<\*STDERR>.
  36
  37
  38 =head1 DESCRIPTION
  39
  40 B<podchecker> will perform syntax checking of Perl5 POD format documentation.
  41
  42 I<NOTE THAT THIS MODULE IS CURRENTLY IN THE INITIAL DEVELOPMENT STAGE!>
  43 As of this writing, all it does is check for unknown '=xxxx' commands,
  44 unknown 'X<...>' interior-sequences, and unterminated interior sequences.
  45
  46 It is hoped that curious/ambitious user will help flesh out and add the
  47 additional features they wish to see in B<Pod::Checker> and B<podchecker>.
  48
  49 =head1 EXAMPLES
  50
  51 I<[T.B.D.]>
  52
  53 =head1 AUTHOR
  54
  55 Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version)
  56
  57 Based on code for B<Pod::Text::pod2text()> written by
  58 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  59
  60 =cut
  61
  62 #############################################################################
  63
  64 use strict;
  65 #use diagnostics;
  66 use Carp;
  67 use Exporter;
  68 use Pod::Parser;
  69
  70 use vars qw(@ISA @EXPORT);
  71 @ISA = qw(Pod::Parser);
  72 @EXPORT = qw(&podchecker);
  73
  74 use vars qw(%VALID_COMMANDS %VALID_SEQUENCES);
  75
  76 my %VALID_COMMANDS = (
  77     'pod'    =>  1,
  78     'cut'    =>  1,
  79     'head1'  =>  1,
  80     'head2'  =>  1,
  81     'over'   =>  1,
  82     'back'   =>  1,
  83     'item'   =>  1,
  84     'for'    =>  1,
  85     'begin'  =>  1,
  86     'end'    =>  1,
  87 );
  88
  89 my %VALID_SEQUENCES = (
  90     'I'  =>  1,
  91     'B'  =>  1,
  92     'S'  =>  1,
  93     'C'  =>  1,
  94     'L'  =>  1,
  95     'F'  =>  1,
  96     'X'  =>  1,
  97     'Z'  =>  1,
  98     'E'  =>  1,
  99 );
 100
 101 ##---------------------------------------------------------------------------
 102
 103 ##---------------------------------
 104 ## Function definitions begin here
 105 ##---------------------------------
 106
 107 sub podchecker( $ ; $ ) {
 108     my ($infile, $outfile) = @_;
 109     local $_;
 110
 111     ## Set defaults
 112     $infile  ||= \*STDIN;
 113     $outfile ||= \*STDERR;
 114
 115     ## Now create a pod checker
 116     my $checker = new Pod::Checker();
 117
 118     ## Now check the pod document for errors
 119     $checker->parse_from_file($infile, $outfile);
 120
 121     ## Return the number of errors found
 122     return $checker->num_errors();
 123 }
 124
 125 ##---------------------------------------------------------------------------
 126
 127 ##-------------------------------
 128 ## Method definitions begin here
 129 ##-------------------------------
 130
 131 sub new {
 132     my $this = shift;
 133     my $class = ref($this) || $this;
 134     my %params = @_;
 135     my $self = {%params};
 136     bless $self, $class;
 137     $self->initialize();
 138     return $self;
 139 }
 140
 141 sub initialize {
 142     my $self = shift;
 143     $self->num_errors(0);
 144 }
 145
 146 sub num_errors {
 147    return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
 148 }
 149
 150 sub end_pod {
 151    ## Print the number of errors found
 152    my $self   = shift;
 153    my $infile = $self->input_file();
 154    my $out_fh = $self->output_handle();
 155
 156    my $num_errors = $self->num_errors();
 157    if ($num_errors > 0) {
 158       printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
 159                       ($num_errors == 1) ? "error" : "errors");
 160    }
 161    else {
 162       print $out_fh "$infile pod syntax OK.\n";
 163    }
 164 }
 165
 166 sub command {
 167     my ($self, $command, $paragraph, $line_num, $pod_para) = @_;
 168     my ($file, $line) = $pod_para->file_line;
 169     my $out_fh  = $self->output_handle();
 170     ## Check the command syntax
 171     if (! $VALID_COMMANDS{$command}) {
 172        ++($self->{_NUM_ERRORS});
 173        _invalid_cmd($out_fh, $command, $paragraph, $file, $line);
 174     }
 175     else {
 176        ## check syntax of particular command
 177     }
 178     ## Check the interior sequences in the command-text
 179     my $expansion = $self->interpolate($paragraph, $line_num);
 180 }
 181
 182 sub verbatim {
 183     ## Nothing to check
 184     ## my ($self, $paragraph, $line_num, $pod_para) = @_;
 185 }
 186
 187 sub textblock {
 188     my ($self, $paragraph, $line_num, $pod_para) = @_;
 189     my $out_fh  = $self->output_handle();
 190     ## Check the interior sequences in the text (set $SIG{__WARN__} to
 191     ## send parse_text warnings about untermnated sequences to $out_fh)
 192     local  $SIG{__WARN__} = sub {
 193                                 ++($self->{_NUM_ERRORS});
 194                                 print $out_fh @_
 195                             };
 196     my $expansion = $self->interpolate($paragraph, $line_num);
 197 }
 198
 199 sub interior_sequence {
 200     my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
 201     my ($file, $line) = $pod_seq->file_line;
 202     my $out_fh  = $self->output_handle();
 203     ## Check the sequence syntax
 204     if (! $VALID_SEQUENCES{$seq_cmd}) {
 205        ++($self->{_NUM_ERRORS});
 206        _invalid_seq($out_fh, $seq_cmd, $seq_arg, $file, $line);
 207     }
 208     else {
 209        ## check syntax of the particular sequence
 210     }
 211 }
 212
 213 sub _invalid_cmd {
 214     my ($fh, $cmd, $text, $file, $line) = @_;
 215     print $fh "*** ERROR: Unknown command \"$cmd\""
 216             . " at line $line of file $file\n";
 217 }
 218
 219 sub _invalid_seq {
 220     my ($fh, $cmd, $text, $file, $line) = @_;
 221     print $fh "*** ERROR: Unknown interior-sequence \"$cmd\""
 222             . " at line $line of file $file\n";
 223 }
 224