lib/Pod/Checker.pm

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