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); |
e2c3adef |
13 | $VERSION = 1.096; ## Current version of this package |
360aca43 |
14 | require 5.004; ## requires this Perl version or later |
15 | |
e2c3adef |
16 | use Pod::ParseUtils; ## for hyperlinks and lists |
17 | |
360aca43 |
18 | =head1 NAME |
19 | |
20 | Pod::Checker, podchecker() - check pod documents for syntax errors |
21 | |
22 | =head1 SYNOPSIS |
23 | |
24 | use Pod::Checker; |
25 | |
e3237417 |
26 | $syntax_okay = podchecker($filepath, $outputpath, %options); |
360aca43 |
27 | |
e2c3adef |
28 | my $checker = new Pod::Checker %options; |
29 | |
360aca43 |
30 | =head1 OPTIONS/ARGUMENTS |
31 | |
32 | C<$filepath> is the input POD to read and C<$outputpath> is |
33 | where to write POD syntax error messages. Either argument may be a scalar |
e2c3adef |
34 | indicating a file-path, or else a reference to an open filehandle. |
360aca43 |
35 | If unspecified, the input-file it defaults to C<\*STDIN>, and |
36 | the output-file defaults to C<\*STDERR>. |
37 | |
e2c3adef |
38 | =head2 podchecker() |
39 | |
40 | This function can take a hash of options: |
e3237417 |
41 | |
42 | =over 4 |
43 | |
44 | =item B<-warnings> =E<gt> I<val> |
45 | |
46 | Turn warnings on/off. See L<"Warnings">. |
47 | |
48 | =back |
360aca43 |
49 | |
50 | =head1 DESCRIPTION |
51 | |
52 | B<podchecker> will perform syntax checking of Perl5 POD format documentation. |
53 | |
e2c3adef |
54 | I<NOTE THAT THIS MODULE IS CURRENTLY IN THE BETA STAGE!> |
360aca43 |
55 | |
56 | It is hoped that curious/ambitious user will help flesh out and add the |
e2c3adef |
57 | additional features they wish to see in B<Pod::Checker> and B<podchecker> |
58 | and verify that the checks are consistent with L<perlpod>. |
360aca43 |
59 | |
e2c3adef |
60 | The following checks are preformed: |
e3237417 |
61 | |
62 | =over 4 |
63 | |
64 | =item * |
65 | |
e2c3adef |
66 | Unknown '=xxxx' commands, unknown 'X<...>' interior-sequences, |
67 | and unterminated interior sequences. |
68 | |
69 | =item * |
70 | |
71 | Check for proper balancing of C<=begin> and C<=end>. The contents of such |
72 | a block are generally ignored, i.e. no syntax checks are performed. |
e3237417 |
73 | |
74 | =item * |
75 | |
76 | Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. |
77 | |
78 | =item * |
79 | |
e2c3adef |
80 | Check for same nested interior-sequences (e.g. |
81 | C<LE<lt>...LE<lt>...E<gt>...E<gt>>). |
e3237417 |
82 | |
83 | =item * |
84 | |
e2c3adef |
85 | Check for malformed or nonexisting entities C<EE<lt>...E<gt>>. |
e3237417 |
86 | |
87 | =item * |
88 | |
e2c3adef |
89 | Check for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod> |
90 | for details. |
e3237417 |
91 | |
92 | =item * |
93 | |
e2c3adef |
94 | Check for unresolved document-internal links. This check may also reveal |
95 | misspelled links that seem to be internal links but should be links |
96 | to something else. |
e3237417 |
97 | |
98 | =back |
99 | |
e2c3adef |
100 | =head2 Additional Features |
101 | |
102 | While checking, this module collects document properties, e.g. the nodes |
103 | for hyperlinks (C<=headX>, C<=item>). POD translators can use this feature |
104 | to syntax-check and get the nodes in a first pass before actually starting |
105 | to convert. This is expensive in terms of execution time, but allows for |
106 | very robust conversions. |
107 | |
108 | =head1 DIAGNOSTICS |
e3237417 |
109 | |
e2c3adef |
110 | =head2 Errors |
e3237417 |
111 | |
112 | =over 4 |
113 | |
e2c3adef |
114 | =item * =over on line I<N> without closing =back |
e3237417 |
115 | |
e2c3adef |
116 | The C<=over> command does not have a corresponding C<=back> before the |
117 | next heading (C<=head1> or C<=head2>) or the end of the file. |
e3237417 |
118 | |
e2c3adef |
119 | =item * =item without previous =over |
e3237417 |
120 | |
e2c3adef |
121 | =item * =back without previous =over |
e3237417 |
122 | |
e2c3adef |
123 | An C<=item> or C<=back> command has been found outside a |
124 | C<=over>/C<=back> block. |
e3237417 |
125 | |
e2c3adef |
126 | =item * No argument for =begin |
e3237417 |
127 | |
e2c3adef |
128 | A C<=begin> command was found that is not followed by the formatter |
129 | specification. |
e3237417 |
130 | |
e2c3adef |
131 | =item * =end without =begin |
e3237417 |
132 | |
e2c3adef |
133 | A standalone C<=end> command was found. |
134 | |
135 | =item * Nested =begin's |
136 | |
137 | There were at least two concecutive C<=begin> commands without |
138 | the corresponding C<=end>. Only one C<=begin> may be active at |
139 | a time. |
140 | |
141 | =item * =for without formatter specification |
e3237417 |
142 | |
e2c3adef |
143 | There is no specification of the formatter after the C<=for> command. |
144 | |
145 | =item * unresolved internal link I<NAME> |
146 | |
147 | The given link to I<NAME> does not have a matching node in the current |
148 | POD. This also happend when a single word node name is not enclosed in |
149 | C<"">. |
150 | |
151 | =item * Unknown command "I<CMD>" |
152 | |
153 | An invalid POD command has been found. Valid are C<=head1>, C<=head2>, |
154 | C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, C<=for>, C<=pod>, |
155 | C<=cut> |
156 | |
157 | =item * Unknown interior-sequence "I<SEQ>" |
158 | |
159 | An invalid markup command has been encountered. Valid are: |
160 | C<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, |
161 | C<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, |
162 | C<ZE<lt>E<gt>> |
163 | |
164 | =item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> |
165 | |
166 | Two nested identical markup commands have been found. Generally this |
167 | does not make sense. |
168 | |
169 | =item * garbled entity I<STRING> |
170 | |
171 | The I<STRING> found cannot be interpreted as an character entity. |
172 | |
173 | =item * malformed link LE<lt>E<gt> |
174 | |
175 | The link found cannot be parsed because it does not conform to the |
176 | syntax described in L<perlpod>. |
e3237417 |
177 | |
178 | =back |
179 | |
e2c3adef |
180 | =head2 Warnings |
e3237417 |
181 | |
e2c3adef |
182 | These may not necessarily cause trouble, but indicate mediocre style. |
183 | |
184 | =over 4 |
185 | |
186 | =item * No numeric argument for =over |
187 | |
188 | The C<=over> command is supposed to have a numeric argument (the |
189 | indentation). |
190 | |
191 | =item * Spurious character(s) after =back |
192 | |
193 | The C<=back> command does not take any arguments. |
194 | |
195 | =item * I<N> unescaped C<E<lt>E<gt>> in paragraph |
196 | |
197 | Angle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> |
198 | can potentially cause errors as they could be misinterpreted as |
199 | markup commands. |
200 | |
201 | =item * Non-standard entity |
202 | |
203 | A character entity was found that does not belong to the standard |
204 | ISO set. |
205 | |
206 | =item * No items in =over |
207 | |
208 | The list does not contain any items. |
209 | |
210 | =item * No argument for =item |
211 | |
212 | C<=item> without any parameters is deprecated. It should either be followed |
213 | by C<*> to indicate an unordered list, by a number (optionally followed |
214 | by a dot) to indicate an ordered (numbered) list or simple text for a |
215 | definition list. |
216 | |
217 | =item * Verbatim paragraph in NAME section |
218 | |
219 | The NAME section (C<=head1 NAME>) should consist of a single paragraph |
220 | with the script/module name, followed by a dash `-' and a very short |
221 | description of what the thing is good for. |
222 | |
223 | =item * Hyperlinks |
224 | |
225 | There are some warnings wrt. hyperlinks: |
226 | Leading/trailing whitespace, newlines in hyperlinks, |
227 | brackets C<()>. |
228 | |
229 | =back |
e3237417 |
230 | |
231 | =head1 RETURN VALUE |
232 | |
233 | B<podchecker> returns the number of POD syntax errors found or -1 if |
234 | there were no POD commands at all found in the file. |
235 | |
360aca43 |
236 | =head1 EXAMPLES |
237 | |
238 | I<[T.B.D.]> |
239 | |
240 | =head1 AUTHOR |
241 | |
e3237417 |
242 | Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version), |
243 | Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt> |
360aca43 |
244 | |
245 | Based on code for B<Pod::Text::pod2text()> written by |
246 | Tom Christiansen E<lt>tchrist@mox.perl.comE<gt> |
247 | |
248 | =cut |
249 | |
250 | ############################################################################# |
251 | |
252 | use strict; |
253 | #use diagnostics; |
254 | use Carp; |
255 | use Exporter; |
256 | use Pod::Parser; |
257 | |
258 | use vars qw(@ISA @EXPORT); |
259 | @ISA = qw(Pod::Parser); |
260 | @EXPORT = qw(&podchecker); |
261 | |
262 | use vars qw(%VALID_COMMANDS %VALID_SEQUENCES); |
263 | |
264 | my %VALID_COMMANDS = ( |
265 | 'pod' => 1, |
266 | 'cut' => 1, |
267 | 'head1' => 1, |
268 | 'head2' => 1, |
269 | 'over' => 1, |
270 | 'back' => 1, |
271 | 'item' => 1, |
272 | 'for' => 1, |
273 | 'begin' => 1, |
274 | 'end' => 1, |
275 | ); |
276 | |
277 | my %VALID_SEQUENCES = ( |
278 | 'I' => 1, |
279 | 'B' => 1, |
280 | 'S' => 1, |
281 | 'C' => 1, |
282 | 'L' => 1, |
283 | 'F' => 1, |
284 | 'X' => 1, |
285 | 'Z' => 1, |
286 | 'E' => 1, |
287 | ); |
288 | |
e2c3adef |
289 | # stolen from HTML::Entities |
290 | my %ENTITIES = ( |
291 | # Some normal chars that have special meaning in SGML context |
292 | amp => '&', # ampersand |
293 | 'gt' => '>', # greater than |
294 | 'lt' => '<', # less than |
295 | quot => '"', # double quote |
296 | |
297 | # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML |
298 | AElig => 'Æ', # capital AE diphthong (ligature) |
299 | Aacute => 'Á', # capital A, acute accent |
300 | Acirc => 'Â', # capital A, circumflex accent |
301 | Agrave => 'À', # capital A, grave accent |
302 | Aring => 'Å', # capital A, ring |
303 | Atilde => 'Ã', # capital A, tilde |
304 | Auml => 'Ä', # capital A, dieresis or umlaut mark |
305 | Ccedil => 'Ç', # capital C, cedilla |
306 | ETH => 'Ð', # capital Eth, Icelandic |
307 | Eacute => 'É', # capital E, acute accent |
308 | Ecirc => 'Ê', # capital E, circumflex accent |
309 | Egrave => 'È', # capital E, grave accent |
310 | Euml => 'Ë', # capital E, dieresis or umlaut mark |
311 | Iacute => 'Í', # capital I, acute accent |
312 | Icirc => 'Î', # capital I, circumflex accent |
313 | Igrave => 'Ì', # capital I, grave accent |
314 | Iuml => 'Ï', # capital I, dieresis or umlaut mark |
315 | Ntilde => 'Ñ', # capital N, tilde |
316 | Oacute => 'Ó', # capital O, acute accent |
317 | Ocirc => 'Ô', # capital O, circumflex accent |
318 | Ograve => 'Ò', # capital O, grave accent |
319 | Oslash => 'Ø', # capital O, slash |
320 | Otilde => 'Õ', # capital O, tilde |
321 | Ouml => 'Ö', # capital O, dieresis or umlaut mark |
322 | THORN => 'Þ', # capital THORN, Icelandic |
323 | Uacute => 'Ú', # capital U, acute accent |
324 | Ucirc => 'Û', # capital U, circumflex accent |
325 | Ugrave => 'Ù', # capital U, grave accent |
326 | Uuml => 'Ü', # capital U, dieresis or umlaut mark |
327 | Yacute => 'Ý', # capital Y, acute accent |
328 | aacute => 'á', # small a, acute accent |
329 | acirc => 'â', # small a, circumflex accent |
330 | aelig => 'æ', # small ae diphthong (ligature) |
331 | agrave => 'à', # small a, grave accent |
332 | aring => 'å', # small a, ring |
333 | atilde => 'ã', # small a, tilde |
334 | auml => 'ä', # small a, dieresis or umlaut mark |
335 | ccedil => 'ç', # small c, cedilla |
336 | eacute => 'é', # small e, acute accent |
337 | ecirc => 'ê', # small e, circumflex accent |
338 | egrave => 'è', # small e, grave accent |
339 | eth => 'ð', # small eth, Icelandic |
340 | euml => 'ë', # small e, dieresis or umlaut mark |
341 | iacute => 'í', # small i, acute accent |
342 | icirc => 'î', # small i, circumflex accent |
343 | igrave => 'ì', # small i, grave accent |
344 | iuml => 'ï', # small i, dieresis or umlaut mark |
345 | ntilde => 'ñ', # small n, tilde |
346 | oacute => 'ó', # small o, acute accent |
347 | ocirc => 'ô', # small o, circumflex accent |
348 | ograve => 'ò', # small o, grave accent |
349 | oslash => 'ø', # small o, slash |
350 | otilde => 'õ', # small o, tilde |
351 | ouml => 'ö', # small o, dieresis or umlaut mark |
352 | szlig => 'ß', # small sharp s, German (sz ligature) |
353 | thorn => 'þ', # small thorn, Icelandic |
354 | uacute => 'ú', # small u, acute accent |
355 | ucirc => 'û', # small u, circumflex accent |
356 | ugrave => 'ù', # small u, grave accent |
357 | uuml => 'ü', # small u, dieresis or umlaut mark |
358 | yacute => 'ý', # small y, acute accent |
359 | yuml => 'ÿ', # small y, dieresis or umlaut mark |
360 | |
361 | # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) |
362 | copy => '©', # copyright sign |
363 | reg => '®', # registered sign |
364 | nbsp => "\240", # non breaking space |
365 | |
366 | # Additional ISO-8859/1 entities listed in rfc1866 (section 14) |
367 | iexcl => '¡', |
368 | cent => '¢', |
369 | pound => '£', |
370 | curren => '¤', |
371 | yen => '¥', |
372 | brvbar => '¦', |
373 | sect => '§', |
374 | uml => '¨', |
375 | ordf => 'ª', |
376 | laquo => '«', |
377 | 'not' => '¬', # not is a keyword in perl |
378 | shy => '', |
379 | macr => '¯', |
380 | deg => '°', |
381 | plusmn => '±', |
382 | sup1 => '¹', |
383 | sup2 => '²', |
384 | sup3 => '³', |
385 | acute => '´', |
386 | micro => 'µ', |
387 | para => '¶', |
388 | middot => '·', |
389 | cedil => '¸', |
390 | ordm => 'º', |
391 | raquo => '»', |
392 | frac14 => '¼', |
393 | frac12 => '½', |
394 | frac34 => '¾', |
395 | iquest => '¿', |
396 | 'times' => '×', # times is a keyword in perl |
397 | divide => '÷', |
398 | ); |
399 | |
360aca43 |
400 | ##--------------------------------------------------------------------------- |
401 | |
402 | ##--------------------------------- |
403 | ## Function definitions begin here |
404 | ##--------------------------------- |
405 | |
e3237417 |
406 | sub podchecker( $ ; $ % ) { |
407 | my ($infile, $outfile, %options) = @_; |
360aca43 |
408 | local $_; |
409 | |
410 | ## Set defaults |
411 | $infile ||= \*STDIN; |
412 | $outfile ||= \*STDERR; |
413 | |
414 | ## Now create a pod checker |
e3237417 |
415 | my $checker = new Pod::Checker(%options); |
360aca43 |
416 | |
417 | ## Now check the pod document for errors |
418 | $checker->parse_from_file($infile, $outfile); |
419 | |
420 | ## Return the number of errors found |
421 | return $checker->num_errors(); |
422 | } |
423 | |
424 | ##--------------------------------------------------------------------------- |
425 | |
426 | ##------------------------------- |
427 | ## Method definitions begin here |
428 | ##------------------------------- |
429 | |
430 | sub new { |
431 | my $this = shift; |
432 | my $class = ref($this) || $this; |
433 | my %params = @_; |
434 | my $self = {%params}; |
435 | bless $self, $class; |
436 | $self->initialize(); |
437 | return $self; |
438 | } |
439 | |
440 | sub initialize { |
441 | my $self = shift; |
664bb207 |
442 | ## Initialize number of errors, and setup an error function to |
443 | ## increment this number and then print to the designated output. |
444 | $self->{_NUM_ERRORS} = 0; |
e2c3adef |
445 | $self->errorsub('poderror'); # set the error handling subroutine |
e3237417 |
446 | $self->{_commands} = 0; # total number of POD commands encountered |
447 | $self->{_list_stack} = []; # stack for nested lists |
448 | $self->{_have_begin} = ''; # stores =begin |
449 | $self->{_links} = []; # stack for internal hyperlinks |
450 | $self->{_nodes} = []; # stack for =head/=item nodes |
e2c3adef |
451 | # print warnings? |
e3237417 |
452 | $self->{-warnings} = 1 unless(defined $self->{-warnings}); |
e2c3adef |
453 | $self->{_current_head1} = ''; # the current =head1 block |
664bb207 |
454 | } |
455 | |
e2c3adef |
456 | # Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) |
664bb207 |
457 | sub poderror { |
458 | my $self = shift; |
459 | my %opts = (ref $_[0]) ? %{shift()} : (); |
460 | |
461 | ## Retrieve options |
462 | chomp( my $msg = ($opts{-msg} || "")."@_" ); |
463 | my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ""; |
464 | my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ""; |
465 | my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ""; |
466 | |
e3237417 |
467 | ## Increment error count and print message " |
468 | ++($self->{_NUM_ERRORS}) |
469 | if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); |
664bb207 |
470 | my $out_fh = $self->output_handle(); |
e2c3adef |
471 | print $out_fh ($severity, $msg, $line, $file, "\n") |
472 | if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); |
360aca43 |
473 | } |
474 | |
e2c3adef |
475 | # set/retrieve the number of errors found |
360aca43 |
476 | sub num_errors { |
477 | return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; |
478 | } |
479 | |
e2c3adef |
480 | # set and/or retrieve canonical name of POD |
481 | sub name { |
482 | return (@_ > 1 && $_[1]) ? |
483 | ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; |
484 | } |
485 | |
486 | # set/return nodes of the current POD |
487 | sub node { |
488 | my ($self,$text) = @_; |
489 | if(defined $text) { |
490 | $text =~ s/[\s\n]+$//; # strip trailing whitespace |
491 | # add node |
492 | push(@{$self->{_nodes}}, $text); |
493 | return $text; |
494 | } |
495 | @{$self->{_nodes}}; |
496 | } |
497 | |
498 | # set/return hyperlinks of the current POD |
499 | sub hyperlink { |
500 | my $self = shift; |
501 | if($_[0]) { |
502 | push(@{$self->{_links}}, $_[0]); |
503 | return $_[0]; |
504 | } |
505 | @{$self->{_links}}; |
506 | } |
507 | |
e3237417 |
508 | ## overrides for Pod::Parser |
509 | |
360aca43 |
510 | sub end_pod { |
e3237417 |
511 | ## Do some final checks and |
512 | ## print the number of errors found |
360aca43 |
513 | my $self = shift; |
514 | my $infile = $self->input_file(); |
515 | my $out_fh = $self->output_handle(); |
516 | |
e3237417 |
517 | if(@{$self->{_list_stack}}) { |
518 | # _TODO_ display, but don't count them for now |
519 | my $list; |
520 | while($list = shift(@{$self->{_list_stack}})) { |
521 | $self->poderror({ -line => 'EOF', -file => $infile, |
522 | -severity => 'ERROR', -msg => "=over on line " . |
523 | $list->start() . " without closing =back" }); #" |
524 | } |
525 | } |
526 | |
527 | # check validity of document internal hyperlinks |
528 | # first build the node names from the paragraph text |
529 | my %nodes; |
530 | foreach($self->node()) { |
e3237417 |
531 | $nodes{$_} = 1; |
532 | if(/^(\S+)\s+/) { |
533 | # we have more than one word. Use the first as a node, too. |
534 | # This is used heavily in perlfunc.pod |
535 | $nodes{$1} ||= 2; # derived node |
536 | } |
537 | } |
538 | foreach($self->hyperlink()) { |
e3237417 |
539 | my $line = ''; |
540 | s/^(\d+):// && ($line = $1); |
541 | if($_ && !$nodes{$_}) { |
542 | $self->poderror({ -line => $line, -file => $infile, |
543 | -severity => 'ERROR', |
544 | -msg => "unresolved internal link `$_'"}); |
545 | } |
546 | } |
547 | |
548 | ## Print the number of errors found |
360aca43 |
549 | my $num_errors = $self->num_errors(); |
550 | if ($num_errors > 0) { |
551 | printf $out_fh ("$infile has $num_errors pod syntax %s.\n", |
552 | ($num_errors == 1) ? "error" : "errors"); |
553 | } |
e3237417 |
554 | elsif($self->{_commands} == 0) { |
555 | print $out_fh "$infile does not contain any pod commands.\n"; |
556 | $self->num_errors(-1); |
557 | } |
360aca43 |
558 | else { |
559 | print $out_fh "$infile pod syntax OK.\n"; |
560 | } |
561 | } |
562 | |
e2c3adef |
563 | # check a POD command directive |
360aca43 |
564 | sub command { |
664bb207 |
565 | my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; |
360aca43 |
566 | my ($file, $line) = $pod_para->file_line; |
360aca43 |
567 | ## Check the command syntax |
e3237417 |
568 | my $arg; # this will hold the command argument |
664bb207 |
569 | if (! $VALID_COMMANDS{$cmd}) { |
570 | $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', |
571 | -msg => "Unknown command \"$cmd\"" }); |
360aca43 |
572 | } |
573 | else { |
e3237417 |
574 | $self->{_commands}++; # found a valid command |
575 | ## check syntax of particular command |
576 | if($cmd eq 'over') { |
e2c3adef |
577 | # check for argument |
578 | $arg = $self->interpolate_and_check($paragraph, $line,$file); |
579 | my $indent = 4; # default |
580 | if($arg && $arg =~ /^\s*(\d+)\s*$/) { |
581 | $indent = $1; |
582 | } else { |
583 | $self->poderror({ -line => $line, -file => $file, |
584 | -severity => 'WARNING', |
585 | -msg => "No numeric argument for =over"}); |
586 | } |
e3237417 |
587 | # start a new list |
e2c3adef |
588 | unshift(@{$self->{_list_stack}}, Pod::List->new( |
589 | -indent => $indent, |
e3237417 |
590 | -start => $line, |
591 | -file => $file)); |
592 | } |
593 | elsif($cmd eq 'item') { |
e2c3adef |
594 | # are we in a list? |
e3237417 |
595 | unless(@{$self->{_list_stack}}) { |
596 | $self->poderror({ -line => $line, -file => $file, |
597 | -severity => 'ERROR', |
598 | -msg => "=item without previous =over" }); |
e2c3adef |
599 | # auto-open in case we encounter many more |
600 | unshift(@{$self->{_list_stack}}, |
601 | Pod::List->new( |
602 | -indent => 'auto', |
603 | -start => $line, |
604 | -file => $file)); |
e3237417 |
605 | } |
e2c3adef |
606 | # check for argument |
607 | $arg = $self->interpolate_and_check($paragraph, $line, $file); |
608 | unless($arg && $arg =~ /(\S+)/) { |
609 | $self->poderror({ -line => $line, -file => $file, |
610 | -severity => 'WARNING', |
611 | -msg => "No argument for =item" }); |
612 | $arg = ' '; # empty |
e3237417 |
613 | } |
e2c3adef |
614 | # add this item |
615 | $self->{_list_stack}[0]->item($arg); |
616 | # remember this node |
617 | $self->node($arg); |
e3237417 |
618 | } |
619 | elsif($cmd eq 'back') { |
620 | # check if we have an open list |
621 | unless(@{$self->{_list_stack}}) { |
622 | $self->poderror({ -line => $line, -file => $file, |
623 | -severity => 'ERROR', |
624 | -msg => "=back without previous =over" }); |
625 | } |
626 | else { |
627 | # check for spurious characters |
e2c3adef |
628 | $arg = $self->interpolate_and_check($paragraph, $line,$file); |
e3237417 |
629 | if($arg && $arg =~ /\S/) { |
630 | $self->poderror({ -line => $line, -file => $file, |
631 | -severity => 'WARNING', |
632 | -msg => "Spurious character(s) after =back" }); |
633 | } |
634 | # close list |
635 | my $list = shift @{$self->{_list_stack}}; |
636 | # check for empty lists |
637 | if(!$list->item() && $self->{-warnings}) { |
638 | $self->poderror({ -line => $line, -file => $file, |
639 | -severity => 'WARNING', |
640 | -msg => "No items in =over (at line " . |
641 | $list->start() . ") / =back list"}); #" |
642 | } |
643 | } |
644 | } |
645 | elsif($cmd =~ /^head/) { |
646 | # check if there is an open list |
647 | if(@{$self->{_list_stack}}) { |
648 | my $list; |
649 | while($list = shift(@{$self->{_list_stack}})) { |
650 | $self->poderror({ -line => $line, -file => $file, |
651 | -severity => 'ERROR', |
e2c3adef |
652 | -msg => "=over on line ". $list->start() . |
653 | " without closing =back (at $cmd)" }); |
e3237417 |
654 | } |
655 | } |
656 | # remember this node |
e2c3adef |
657 | $arg = $self->interpolate_and_check($paragraph, $line,$file); |
e3237417 |
658 | $self->node($arg) if($arg); |
e2c3adef |
659 | if($cmd eq 'head1') { |
660 | $arg =~ s/[\s\n]+$//; |
661 | $self->{_current_head1} = $arg; |
662 | } else { |
663 | $self->{_current_head1} = ''; |
664 | } |
e3237417 |
665 | } |
666 | elsif($cmd eq 'begin') { |
667 | if($self->{_have_begin}) { |
668 | # already have a begin |
669 | $self->poderror({ -line => $line, -file => $file, |
670 | -severity => 'ERROR', |
671 | -msg => "Nested =begin's (first at line " . |
672 | $self->{_have_begin} . ")"}); |
673 | } |
674 | else { |
675 | # check for argument |
e2c3adef |
676 | $arg = $self->interpolate_and_check($paragraph, $line,$file); |
e3237417 |
677 | unless($arg && $arg =~ /(\S+)/) { |
678 | $self->poderror({ -line => $line, -file => $file, |
e2c3adef |
679 | -severity => 'ERROR', |
e3237417 |
680 | -msg => "No argument for =begin"}); |
681 | } |
682 | # remember the =begin |
683 | $self->{_have_begin} = "$line:$1"; |
684 | } |
685 | } |
686 | elsif($cmd eq 'end') { |
687 | if($self->{_have_begin}) { |
688 | # close the existing =begin |
689 | $self->{_have_begin} = ''; |
690 | # check for spurious characters |
e2c3adef |
691 | $arg = $self->interpolate_and_check($paragraph, $line,$file); |
692 | # the closing argument is optional |
693 | #if($arg && $arg =~ /\S/) { |
694 | # $self->poderror({ -line => $line, -file => $file, |
695 | # -severity => 'WARNING', |
696 | # -msg => "Spurious character(s) after =end" }); |
697 | #} |
e3237417 |
698 | } |
699 | else { |
700 | # don't have a matching =begin |
701 | $self->poderror({ -line => $line, -file => $file, |
e2c3adef |
702 | -severity => 'ERROR', |
e3237417 |
703 | -msg => "=end without =begin" }); |
704 | } |
705 | } |
e2c3adef |
706 | elsif($cmd eq 'for') { |
707 | unless($paragraph =~ /\s*(\S+)\s*/) { |
708 | $self->poderror({ -line => $line, -file => $file, |
709 | -severity => 'ERROR', |
710 | -msg => "=for without formatter specification" }); |
711 | } |
712 | $arg = ''; # do not expand paragraph below |
713 | } |
e3237417 |
714 | ## Check the interior sequences in the command-text |
e2c3adef |
715 | $self->interpolate_and_check($paragraph, $line,$file) |
e3237417 |
716 | unless(defined $arg); |
e2c3adef |
717 | } |
360aca43 |
718 | } |
719 | |
e2c3adef |
720 | # process a block of some text |
721 | sub interpolate_and_check { |
e3237417 |
722 | my ($self, $paragraph, $line, $file) = @_; |
723 | ## Check the interior sequences in the command-text |
724 | # and return the text |
725 | $self->_check_ptree( |
726 | $self->parse_text($paragraph,$line), $line, $file, ''); |
727 | } |
728 | |
729 | sub _check_ptree { |
730 | my ($self,$ptree,$line,$file,$nestlist) = @_; |
731 | local($_); |
732 | my $text = ''; |
733 | # process each node in the parse tree |
734 | foreach(@$ptree) { |
735 | # regular text chunk |
736 | unless(ref) { |
737 | my $count; |
738 | # count the unescaped angle brackets |
739 | my $i = $_; |
e2c3adef |
740 | if($count = $i =~ tr/<>/<>/) { |
e3237417 |
741 | $self->poderror({ -line => $line, -file => $file, |
742 | -severity => 'WARNING', |
e2c3adef |
743 | -msg => "$count unescaped <> in paragraph" }) |
744 | if($self->{-warnings}); |
e3237417 |
745 | } |
746 | $text .= $i; |
747 | next; |
748 | } |
749 | # have an interior sequence |
750 | my $cmd = $_->cmd_name(); |
751 | my $contents = $_->parse_tree(); |
752 | ($file,$line) = $_->file_line(); |
753 | # check for valid tag |
754 | if (! $VALID_SEQUENCES{$cmd}) { |
755 | $self->poderror({ -line => $line, -file => $file, |
756 | -severity => 'ERROR', |
757 | -msg => qq(Unknown interior-sequence "$cmd")}); |
758 | # expand it anyway |
759 | $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); |
760 | next; |
761 | } |
762 | if($nestlist =~ /$cmd/) { |
763 | $self->poderror({ -line => $line, -file => $file, |
764 | -severity => 'ERROR', |
765 | -msg => "nested commands $cmd<...$cmd<...>...>"}); |
766 | # _TODO_ should we add the contents anyway? |
767 | # expand it anyway, see below |
768 | } |
769 | if($cmd eq 'E') { |
770 | # preserve entities |
771 | if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { |
772 | $self->poderror({ -line => $line, -file => $file, |
773 | -severity => 'ERROR', |
774 | -msg => "garbled entity " . $_->raw_text()}); |
775 | next; |
776 | } |
e2c3adef |
777 | my $ent = $$contents[0]; |
778 | if($ent =~ /^\d+$/) { |
779 | # numeric entity |
780 | $text .= chr($ent); |
781 | } |
782 | elsif($ENTITIES{$ent}) { |
783 | # known ISO entity |
784 | $text .= $ENTITIES{$ent}; |
785 | } |
786 | else { |
787 | $self->poderror({ -line => $line, -file => $file, |
788 | -severity => 'WARNING', |
789 | -msg => "Non-standard entity " . $_->raw_text()}); |
790 | $text .= "E<$ent>"; |
791 | } |
e3237417 |
792 | } |
793 | elsif($cmd eq 'L') { |
794 | # try to parse the hyperlink |
795 | my $link = Pod::Hyperlink->new($contents->raw_text()); |
796 | unless(defined $link) { |
797 | $self->poderror({ -line => $line, -file => $file, |
798 | -severity => 'ERROR', |
e2c3adef |
799 | -msg => "malformed link " . $_->raw_text() ." : $@"}); |
e3237417 |
800 | next; |
801 | } |
802 | $link->line($line); # remember line |
803 | if($self->{-warnings}) { |
804 | foreach my $w ($link->warning()) { |
805 | $self->poderror({ -line => $line, -file => $file, |
806 | -severity => 'WARNING', |
807 | -msg => $w }); |
808 | } |
809 | } |
810 | # check the link text |
811 | $text .= $self->_check_ptree($self->parse_text($link->text(), |
812 | $line), $line, $file, "$nestlist$cmd"); |
813 | my $node = ''; |
e2c3adef |
814 | # remember internal link |
e3237417 |
815 | # _TODO_ what if there is a link to the page itself by the name, |
e2c3adef |
816 | # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION"> |
817 | if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { |
818 | $node = $self->_check_ptree($self->parse_text($link->node(), |
819 | $line), $line, $file, "$nestlist$cmd"); |
820 | $self->hyperlink("$line:$node") if($node); |
821 | } |
e3237417 |
822 | } |
823 | elsif($cmd =~ /[BCFIS]/) { |
824 | # add the guts |
825 | $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); |
826 | } |
827 | else { |
828 | # check, but add nothing to $text (X<>, Z<>) |
829 | $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); |
830 | } |
831 | } |
832 | $text; |
833 | } |
834 | |
e2c3adef |
835 | # _TODO_ overloadable methods for BC..Z<...> expansion? |
e3237417 |
836 | |
e2c3adef |
837 | # process a block of verbatim text |
360aca43 |
838 | sub verbatim { |
839 | ## Nothing to check |
e2c3adef |
840 | my ($self, $paragraph, $line_num, $pod_para) = @_; |
841 | if($self->{_current_head1} eq 'NAME') { |
842 | my ($file, $line) = $pod_para->file_line; |
843 | $self->poderror({ -line => $line, -file => $file, |
844 | -severity => 'WARNING', |
845 | -msg => 'Verbatim paragraph in NAME section' }); |
846 | } |
360aca43 |
847 | } |
848 | |
e2c3adef |
849 | # process a block of regular text |
360aca43 |
850 | sub textblock { |
851 | my ($self, $paragraph, $line_num, $pod_para) = @_; |
e3237417 |
852 | my ($file, $line) = $pod_para->file_line; |
e3237417 |
853 | |
e2c3adef |
854 | # skip this paragraph if in a =begin block |
855 | unless($self->{_have_begin}) { |
856 | my $block = $self->interpolate_and_check($paragraph, $line,$file); |
857 | if($self->{_current_head1} eq 'NAME') { |
858 | if($block =~ /^\s*(\S+?)\s*[,-]/) { |
859 | # this is the canonical name |
860 | $self->{-name} = $1 unless(defined $self->{-name}); |
861 | } |
e3237417 |
862 | } |
863 | } |
e3237417 |
864 | } |
865 | |
866 | 1; |