Commit | Line | Data |
360aca43 |
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); |
e9fdc7d2 |
16 | $VERSION = 1.081; ## Current version of this package |
360aca43 |
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 | |