Commit | Line | Data |
360aca43 |
1 | ############################################################################# |
2 | # Pod/Checker.pm -- check pod documents for syntax errors |
3 | # |
664bb207 |
4 | # Copyright (C) 1994-1999 by Bradford Appleton. All rights reserved. |
360aca43 |
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); |
664bb207 |
13 | $VERSION = 1.085; ## Current version of this package |
360aca43 |
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; |
664bb207 |
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"); |
360aca43 |
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 { |
664bb207 |
184 | my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; |
360aca43 |
185 | my ($file, $line) = $pod_para->file_line; |
360aca43 |
186 | ## Check the command syntax |
664bb207 |
187 | if (! $VALID_COMMANDS{$cmd}) { |
188 | $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', |
189 | -msg => "Unknown command \"$cmd\"" }); |
360aca43 |
190 | } |
191 | else { |
192 | ## check syntax of particular command |
193 | } |
360aca43 |
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) = @_; |
360aca43 |
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; |
360aca43 |
210 | ## Check the sequence syntax |
211 | if (! $VALID_SEQUENCES{$seq_cmd}) { |
664bb207 |
212 | $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', |
213 | -msg => "Unknown interior-sequence \"$seq_cmd\"" }); |
360aca43 |
214 | } |
215 | else { |
216 | ## check syntax of the particular sequence |
217 | } |
218 | } |
219 | |