1*0Sstevel@tonic-gate############################################################################# 2*0Sstevel@tonic-gate# Pod/Checker.pm -- check pod documents for syntax errors 3*0Sstevel@tonic-gate# 4*0Sstevel@tonic-gate# Copyright (C) 1994-2000 by Bradford Appleton. All rights reserved. 5*0Sstevel@tonic-gate# This file is part of "PodParser". PodParser is free software; 6*0Sstevel@tonic-gate# you can redistribute it and/or modify it under the same terms 7*0Sstevel@tonic-gate# as Perl itself. 8*0Sstevel@tonic-gate############################################################################# 9*0Sstevel@tonic-gate 10*0Sstevel@tonic-gatepackage Pod::Checker; 11*0Sstevel@tonic-gate 12*0Sstevel@tonic-gateuse vars qw($VERSION); 13*0Sstevel@tonic-gate$VERSION = 1.41; ## Current version of this package 14*0Sstevel@tonic-gaterequire 5.005; ## requires this Perl version or later 15*0Sstevel@tonic-gate 16*0Sstevel@tonic-gateuse Pod::ParseUtils; ## for hyperlinks and lists 17*0Sstevel@tonic-gate 18*0Sstevel@tonic-gate=head1 NAME 19*0Sstevel@tonic-gate 20*0Sstevel@tonic-gatePod::Checker, podchecker() - check pod documents for syntax errors 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate=head1 SYNOPSIS 23*0Sstevel@tonic-gate 24*0Sstevel@tonic-gate use Pod::Checker; 25*0Sstevel@tonic-gate 26*0Sstevel@tonic-gate $syntax_okay = podchecker($filepath, $outputpath, %options); 27*0Sstevel@tonic-gate 28*0Sstevel@tonic-gate my $checker = new Pod::Checker %options; 29*0Sstevel@tonic-gate $checker->parse_from_file($filepath, \*STDERR); 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate=head1 OPTIONS/ARGUMENTS 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gateC<$filepath> is the input POD to read and C<$outputpath> is 34*0Sstevel@tonic-gatewhere to write POD syntax error messages. Either argument may be a scalar 35*0Sstevel@tonic-gateindicating a file-path, or else a reference to an open filehandle. 36*0Sstevel@tonic-gateIf unspecified, the input-file it defaults to C<\*STDIN>, and 37*0Sstevel@tonic-gatethe output-file defaults to C<\*STDERR>. 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate=head2 podchecker() 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gateThis function can take a hash of options: 42*0Sstevel@tonic-gate 43*0Sstevel@tonic-gate=over 4 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate=item B<-warnings> =E<gt> I<val> 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gateTurn warnings on/off. I<val> is usually 1 for on, but higher values 48*0Sstevel@tonic-gatetrigger additional warnings. See L<"Warnings">. 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate=back 51*0Sstevel@tonic-gate 52*0Sstevel@tonic-gate=head1 DESCRIPTION 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gateB<podchecker> will perform syntax checking of Perl5 POD format documentation. 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gateCurious/ambitious users are welcome to propose additional features they wish 57*0Sstevel@tonic-gateto see in B<Pod::Checker> and B<podchecker> and verify that the checks are 58*0Sstevel@tonic-gateconsistent with L<perlpod>. 59*0Sstevel@tonic-gate 60*0Sstevel@tonic-gateThe following checks are currently preformed: 61*0Sstevel@tonic-gate 62*0Sstevel@tonic-gate=over 4 63*0Sstevel@tonic-gate 64*0Sstevel@tonic-gate=item * 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gateUnknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences, 67*0Sstevel@tonic-gateand unterminated interior sequences. 68*0Sstevel@tonic-gate 69*0Sstevel@tonic-gate=item * 70*0Sstevel@tonic-gate 71*0Sstevel@tonic-gateCheck for proper balancing of C<=begin> and C<=end>. The contents of such 72*0Sstevel@tonic-gatea block are generally ignored, i.e. no syntax checks are performed. 73*0Sstevel@tonic-gate 74*0Sstevel@tonic-gate=item * 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gateCheck for proper nesting and balancing of C<=over>, C<=item> and C<=back>. 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate=item * 79*0Sstevel@tonic-gate 80*0Sstevel@tonic-gateCheck for same nested interior-sequences (e.g. 81*0Sstevel@tonic-gateC<LE<lt>...LE<lt>...E<gt>...E<gt>>). 82*0Sstevel@tonic-gate 83*0Sstevel@tonic-gate=item * 84*0Sstevel@tonic-gate 85*0Sstevel@tonic-gateCheck for malformed or nonexisting entities C<EE<lt>...E<gt>>. 86*0Sstevel@tonic-gate 87*0Sstevel@tonic-gate=item * 88*0Sstevel@tonic-gate 89*0Sstevel@tonic-gateCheck for correct syntax of hyperlinks C<LE<lt>...E<gt>>. See L<perlpod> 90*0Sstevel@tonic-gatefor details. 91*0Sstevel@tonic-gate 92*0Sstevel@tonic-gate=item * 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gateCheck for unresolved document-internal links. This check may also reveal 95*0Sstevel@tonic-gatemisspelled links that seem to be internal links but should be links 96*0Sstevel@tonic-gateto something else. 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gate=back 99*0Sstevel@tonic-gate 100*0Sstevel@tonic-gate=head1 DIAGNOSTICS 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gate=head2 Errors 103*0Sstevel@tonic-gate 104*0Sstevel@tonic-gate=over 4 105*0Sstevel@tonic-gate 106*0Sstevel@tonic-gate=item * empty =headn 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gateA heading (C<=head1> or C<=head2>) without any text? That ain't no 109*0Sstevel@tonic-gateheading! 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gate=item * =over on line I<N> without closing =back 112*0Sstevel@tonic-gate 113*0Sstevel@tonic-gateThe C<=over> command does not have a corresponding C<=back> before the 114*0Sstevel@tonic-gatenext heading (C<=head1> or C<=head2>) or the end of the file. 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gate=item * =item without previous =over 117*0Sstevel@tonic-gate 118*0Sstevel@tonic-gate=item * =back without previous =over 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gateAn C<=item> or C<=back> command has been found outside a 121*0Sstevel@tonic-gateC<=over>/C<=back> block. 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate=item * No argument for =begin 124*0Sstevel@tonic-gate 125*0Sstevel@tonic-gateA C<=begin> command was found that is not followed by the formatter 126*0Sstevel@tonic-gatespecification. 127*0Sstevel@tonic-gate 128*0Sstevel@tonic-gate=item * =end without =begin 129*0Sstevel@tonic-gate 130*0Sstevel@tonic-gateA standalone C<=end> command was found. 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate=item * Nested =begin's 133*0Sstevel@tonic-gate 134*0Sstevel@tonic-gateThere were at least two consecutive C<=begin> commands without 135*0Sstevel@tonic-gatethe corresponding C<=end>. Only one C<=begin> may be active at 136*0Sstevel@tonic-gatea time. 137*0Sstevel@tonic-gate 138*0Sstevel@tonic-gate=item * =for without formatter specification 139*0Sstevel@tonic-gate 140*0Sstevel@tonic-gateThere is no specification of the formatter after the C<=for> command. 141*0Sstevel@tonic-gate 142*0Sstevel@tonic-gate=item * unresolved internal link I<NAME> 143*0Sstevel@tonic-gate 144*0Sstevel@tonic-gateThe given link to I<NAME> does not have a matching node in the current 145*0Sstevel@tonic-gatePOD. This also happend when a single word node name is not enclosed in 146*0Sstevel@tonic-gateC<"">. 147*0Sstevel@tonic-gate 148*0Sstevel@tonic-gate=item * Unknown command "I<CMD>" 149*0Sstevel@tonic-gate 150*0Sstevel@tonic-gateAn invalid POD command has been found. Valid are C<=head1>, C<=head2>, 151*0Sstevel@tonic-gateC<=head3>, C<=head4>, C<=over>, C<=item>, C<=back>, C<=begin>, C<=end>, 152*0Sstevel@tonic-gateC<=for>, C<=pod>, C<=cut> 153*0Sstevel@tonic-gate 154*0Sstevel@tonic-gate=item * Unknown interior-sequence "I<SEQ>" 155*0Sstevel@tonic-gate 156*0Sstevel@tonic-gateAn invalid markup command has been encountered. Valid are: 157*0Sstevel@tonic-gateC<BE<lt>E<gt>>, C<CE<lt>E<gt>>, C<EE<lt>E<gt>>, C<FE<lt>E<gt>>, 158*0Sstevel@tonic-gateC<IE<lt>E<gt>>, C<LE<lt>E<gt>>, C<SE<lt>E<gt>>, C<XE<lt>E<gt>>, 159*0Sstevel@tonic-gateC<ZE<lt>E<gt>> 160*0Sstevel@tonic-gate 161*0Sstevel@tonic-gate=item * nested commands I<CMD>E<lt>...I<CMD>E<lt>...E<gt>...E<gt> 162*0Sstevel@tonic-gate 163*0Sstevel@tonic-gateTwo nested identical markup commands have been found. Generally this 164*0Sstevel@tonic-gatedoes not make sense. 165*0Sstevel@tonic-gate 166*0Sstevel@tonic-gate=item * garbled entity I<STRING> 167*0Sstevel@tonic-gate 168*0Sstevel@tonic-gateThe I<STRING> found cannot be interpreted as a character entity. 169*0Sstevel@tonic-gate 170*0Sstevel@tonic-gate=item * Entity number out of range 171*0Sstevel@tonic-gate 172*0Sstevel@tonic-gateAn entity specified by number (dec, hex, oct) is out of range (1-255). 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gate=item * malformed link LE<lt>E<gt> 175*0Sstevel@tonic-gate 176*0Sstevel@tonic-gateThe link found cannot be parsed because it does not conform to the 177*0Sstevel@tonic-gatesyntax described in L<perlpod>. 178*0Sstevel@tonic-gate 179*0Sstevel@tonic-gate=item * nonempty ZE<lt>E<gt> 180*0Sstevel@tonic-gate 181*0Sstevel@tonic-gateThe C<ZE<lt>E<gt>> sequence is supposed to be empty. 182*0Sstevel@tonic-gate 183*0Sstevel@tonic-gate=item * empty XE<lt>E<gt> 184*0Sstevel@tonic-gate 185*0Sstevel@tonic-gateThe index entry specified contains nothing but whitespace. 186*0Sstevel@tonic-gate 187*0Sstevel@tonic-gate=item * Spurious text after =pod / =cut 188*0Sstevel@tonic-gate 189*0Sstevel@tonic-gateThe commands C<=pod> and C<=cut> do not take any arguments. 190*0Sstevel@tonic-gate 191*0Sstevel@tonic-gate=item * Spurious character(s) after =back 192*0Sstevel@tonic-gate 193*0Sstevel@tonic-gateThe C<=back> command does not take any arguments. 194*0Sstevel@tonic-gate 195*0Sstevel@tonic-gate=back 196*0Sstevel@tonic-gate 197*0Sstevel@tonic-gate=head2 Warnings 198*0Sstevel@tonic-gate 199*0Sstevel@tonic-gateThese may not necessarily cause trouble, but indicate mediocre style. 200*0Sstevel@tonic-gate 201*0Sstevel@tonic-gate=over 4 202*0Sstevel@tonic-gate 203*0Sstevel@tonic-gate=item * multiple occurrence of link target I<name> 204*0Sstevel@tonic-gate 205*0Sstevel@tonic-gateThe POD file has some C<=item> and/or C<=head> commands that have 206*0Sstevel@tonic-gatethe same text. Potential hyperlinks to such a text cannot be unique then. 207*0Sstevel@tonic-gate 208*0Sstevel@tonic-gate=item * line containing nothing but whitespace in paragraph 209*0Sstevel@tonic-gate 210*0Sstevel@tonic-gateThere is some whitespace on a seemingly empty line. POD is very sensitive 211*0Sstevel@tonic-gateto such things, so this is flagged. B<vi> users switch on the B<list> 212*0Sstevel@tonic-gateoption to avoid this problem. 213*0Sstevel@tonic-gate 214*0Sstevel@tonic-gate=begin _disabled_ 215*0Sstevel@tonic-gate 216*0Sstevel@tonic-gate=item * file does not start with =head 217*0Sstevel@tonic-gate 218*0Sstevel@tonic-gateThe file starts with a different POD directive than head. 219*0Sstevel@tonic-gateThis is most probably something you do not want. 220*0Sstevel@tonic-gate 221*0Sstevel@tonic-gate=end _disabled_ 222*0Sstevel@tonic-gate 223*0Sstevel@tonic-gate=item * previous =item has no contents 224*0Sstevel@tonic-gate 225*0Sstevel@tonic-gateThere is a list C<=item> right above the flagged line that has no 226*0Sstevel@tonic-gatetext contents. You probably want to delete empty items. 227*0Sstevel@tonic-gate 228*0Sstevel@tonic-gate=item * preceding non-item paragraph(s) 229*0Sstevel@tonic-gate 230*0Sstevel@tonic-gateA list introduced by C<=over> starts with a text or verbatim paragraph, 231*0Sstevel@tonic-gatebut continues with C<=item>s. Move the non-item paragraph out of the 232*0Sstevel@tonic-gateC<=over>/C<=back> block. 233*0Sstevel@tonic-gate 234*0Sstevel@tonic-gate=item * =item type mismatch (I<one> vs. I<two>) 235*0Sstevel@tonic-gate 236*0Sstevel@tonic-gateA list started with e.g. a bulletted C<=item> and continued with a 237*0Sstevel@tonic-gatenumbered one. This is obviously inconsistent. For most translators the 238*0Sstevel@tonic-gatetype of the I<first> C<=item> determines the type of the list. 239*0Sstevel@tonic-gate 240*0Sstevel@tonic-gate=item * I<N> unescaped C<E<lt>E<gt>> in paragraph 241*0Sstevel@tonic-gate 242*0Sstevel@tonic-gateAngle brackets not written as C<E<lt>ltE<gt>> and C<E<lt>gtE<gt>> 243*0Sstevel@tonic-gatecan potentially cause errors as they could be misinterpreted as 244*0Sstevel@tonic-gatemarkup commands. This is only printed when the -warnings level is 245*0Sstevel@tonic-gategreater than 1. 246*0Sstevel@tonic-gate 247*0Sstevel@tonic-gate=item * Unknown entity 248*0Sstevel@tonic-gate 249*0Sstevel@tonic-gateA character entity was found that does not belong to the standard 250*0Sstevel@tonic-gateISO set or the POD specials C<verbar> and C<sol>. 251*0Sstevel@tonic-gate 252*0Sstevel@tonic-gate=item * No items in =over 253*0Sstevel@tonic-gate 254*0Sstevel@tonic-gateThe list opened with C<=over> does not contain any items. 255*0Sstevel@tonic-gate 256*0Sstevel@tonic-gate=item * No argument for =item 257*0Sstevel@tonic-gate 258*0Sstevel@tonic-gateC<=item> without any parameters is deprecated. It should either be followed 259*0Sstevel@tonic-gateby C<*> to indicate an unordered list, by a number (optionally followed 260*0Sstevel@tonic-gateby a dot) to indicate an ordered (numbered) list or simple text for a 261*0Sstevel@tonic-gatedefinition list. 262*0Sstevel@tonic-gate 263*0Sstevel@tonic-gate=item * empty section in previous paragraph 264*0Sstevel@tonic-gate 265*0Sstevel@tonic-gateThe previous section (introduced by a C<=head> command) does not contain 266*0Sstevel@tonic-gateany text. This usually indicates that something is missing. Note: A 267*0Sstevel@tonic-gateC<=head1> followed immediately by C<=head2> does not trigger this warning. 268*0Sstevel@tonic-gate 269*0Sstevel@tonic-gate=item * Verbatim paragraph in NAME section 270*0Sstevel@tonic-gate 271*0Sstevel@tonic-gateThe NAME section (C<=head1 NAME>) should consist of a single paragraph 272*0Sstevel@tonic-gatewith the script/module name, followed by a dash `-' and a very short 273*0Sstevel@tonic-gatedescription of what the thing is good for. 274*0Sstevel@tonic-gate 275*0Sstevel@tonic-gate=item * =headI<n> without preceding higher level 276*0Sstevel@tonic-gate 277*0Sstevel@tonic-gateFor example if there is a C<=head2> in the POD file prior to a 278*0Sstevel@tonic-gateC<=head1>. 279*0Sstevel@tonic-gate 280*0Sstevel@tonic-gate=back 281*0Sstevel@tonic-gate 282*0Sstevel@tonic-gate=head2 Hyperlinks 283*0Sstevel@tonic-gate 284*0Sstevel@tonic-gateThere are some warnings wrt. malformed hyperlinks. 285*0Sstevel@tonic-gate 286*0Sstevel@tonic-gate=over 4 287*0Sstevel@tonic-gate 288*0Sstevel@tonic-gate=item * ignoring leading/trailing whitespace in link 289*0Sstevel@tonic-gate 290*0Sstevel@tonic-gateThere is whitespace at the beginning or the end of the contents of 291*0Sstevel@tonic-gateLE<lt>...E<gt>. 292*0Sstevel@tonic-gate 293*0Sstevel@tonic-gate=item * (section) in '$page' deprecated 294*0Sstevel@tonic-gate 295*0Sstevel@tonic-gateThere is a section detected in the page name of LE<lt>...E<gt>, e.g. 296*0Sstevel@tonic-gateC<LE<lt>passwd(2)E<gt>>. POD hyperlinks may point to POD documents only. 297*0Sstevel@tonic-gatePlease write C<CE<lt>passwd(2)E<gt>> instead. Some formatters are able 298*0Sstevel@tonic-gateto expand this to appropriate code. For links to (builtin) functions, 299*0Sstevel@tonic-gateplease say C<LE<lt>perlfunc/mkdirE<gt>>, without (). 300*0Sstevel@tonic-gate 301*0Sstevel@tonic-gate=item * alternative text/node '%s' contains non-escaped | or / 302*0Sstevel@tonic-gate 303*0Sstevel@tonic-gateThe characters C<|> and C</> are special in the LE<lt>...E<gt> context. 304*0Sstevel@tonic-gateAlthough the hyperlink parser does its best to determine which "/" is 305*0Sstevel@tonic-gatetext and which is a delimiter in case of doubt, one ought to escape 306*0Sstevel@tonic-gatethese literal characters like this: 307*0Sstevel@tonic-gate 308*0Sstevel@tonic-gate / E<sol> 309*0Sstevel@tonic-gate | E<verbar> 310*0Sstevel@tonic-gate 311*0Sstevel@tonic-gate=back 312*0Sstevel@tonic-gate 313*0Sstevel@tonic-gate=head1 RETURN VALUE 314*0Sstevel@tonic-gate 315*0Sstevel@tonic-gateB<podchecker> returns the number of POD syntax errors found or -1 if 316*0Sstevel@tonic-gatethere were no POD commands at all found in the file. 317*0Sstevel@tonic-gate 318*0Sstevel@tonic-gate=head1 EXAMPLES 319*0Sstevel@tonic-gate 320*0Sstevel@tonic-gateSee L</SYNOPSIS> 321*0Sstevel@tonic-gate 322*0Sstevel@tonic-gate=head1 INTERFACE 323*0Sstevel@tonic-gate 324*0Sstevel@tonic-gateWhile checking, this module collects document properties, e.g. the nodes 325*0Sstevel@tonic-gatefor hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>). 326*0Sstevel@tonic-gatePOD translators can use this feature to syntax-check and get the nodes in 327*0Sstevel@tonic-gatea first pass before actually starting to convert. This is expensive in terms 328*0Sstevel@tonic-gateof execution time, but allows for very robust conversions. 329*0Sstevel@tonic-gate 330*0Sstevel@tonic-gateSince PodParser-1.24 the B<Pod::Checker> module uses only the B<poderror> 331*0Sstevel@tonic-gatemethod to print errors and warnings. The summary output (e.g. 332*0Sstevel@tonic-gate"Pod syntax OK") has been dropped from the module and has been included in 333*0Sstevel@tonic-gateB<podchecker> (the script). This allows users of B<Pod::Checker> to 334*0Sstevel@tonic-gatecontrol completely the output behaviour. Users of B<podchecker> (the script) 335*0Sstevel@tonic-gateget the well-known behaviour. 336*0Sstevel@tonic-gate 337*0Sstevel@tonic-gate=cut 338*0Sstevel@tonic-gate 339*0Sstevel@tonic-gate############################################################################# 340*0Sstevel@tonic-gate 341*0Sstevel@tonic-gateuse strict; 342*0Sstevel@tonic-gate#use diagnostics; 343*0Sstevel@tonic-gateuse Carp; 344*0Sstevel@tonic-gateuse Exporter; 345*0Sstevel@tonic-gateuse Pod::Parser; 346*0Sstevel@tonic-gate 347*0Sstevel@tonic-gateuse vars qw(@ISA @EXPORT); 348*0Sstevel@tonic-gate@ISA = qw(Pod::Parser); 349*0Sstevel@tonic-gate@EXPORT = qw(&podchecker); 350*0Sstevel@tonic-gate 351*0Sstevel@tonic-gateuse vars qw(%VALID_COMMANDS %VALID_SEQUENCES); 352*0Sstevel@tonic-gate 353*0Sstevel@tonic-gatemy %VALID_COMMANDS = ( 354*0Sstevel@tonic-gate 'pod' => 1, 355*0Sstevel@tonic-gate 'cut' => 1, 356*0Sstevel@tonic-gate 'head1' => 1, 357*0Sstevel@tonic-gate 'head2' => 1, 358*0Sstevel@tonic-gate 'head3' => 1, 359*0Sstevel@tonic-gate 'head4' => 1, 360*0Sstevel@tonic-gate 'over' => 1, 361*0Sstevel@tonic-gate 'back' => 1, 362*0Sstevel@tonic-gate 'item' => 1, 363*0Sstevel@tonic-gate 'for' => 1, 364*0Sstevel@tonic-gate 'begin' => 1, 365*0Sstevel@tonic-gate 'end' => 1, 366*0Sstevel@tonic-gate); 367*0Sstevel@tonic-gate 368*0Sstevel@tonic-gatemy %VALID_SEQUENCES = ( 369*0Sstevel@tonic-gate 'I' => 1, 370*0Sstevel@tonic-gate 'B' => 1, 371*0Sstevel@tonic-gate 'S' => 1, 372*0Sstevel@tonic-gate 'C' => 1, 373*0Sstevel@tonic-gate 'L' => 1, 374*0Sstevel@tonic-gate 'F' => 1, 375*0Sstevel@tonic-gate 'X' => 1, 376*0Sstevel@tonic-gate 'Z' => 1, 377*0Sstevel@tonic-gate 'E' => 1, 378*0Sstevel@tonic-gate); 379*0Sstevel@tonic-gate 380*0Sstevel@tonic-gate# stolen from HTML::Entities 381*0Sstevel@tonic-gatemy %ENTITIES = ( 382*0Sstevel@tonic-gate # Some normal chars that have special meaning in SGML context 383*0Sstevel@tonic-gate amp => '&', # ampersand 384*0Sstevel@tonic-gate'gt' => '>', # greater than 385*0Sstevel@tonic-gate'lt' => '<', # less than 386*0Sstevel@tonic-gate quot => '"', # double quote 387*0Sstevel@tonic-gate 388*0Sstevel@tonic-gate # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML 389*0Sstevel@tonic-gate AElig => '�', # capital AE diphthong (ligature) 390*0Sstevel@tonic-gate Aacute => '�', # capital A, acute accent 391*0Sstevel@tonic-gate Acirc => '�', # capital A, circumflex accent 392*0Sstevel@tonic-gate Agrave => '�', # capital A, grave accent 393*0Sstevel@tonic-gate Aring => '�', # capital A, ring 394*0Sstevel@tonic-gate Atilde => '�', # capital A, tilde 395*0Sstevel@tonic-gate Auml => '�', # capital A, dieresis or umlaut mark 396*0Sstevel@tonic-gate Ccedil => '�', # capital C, cedilla 397*0Sstevel@tonic-gate ETH => '�', # capital Eth, Icelandic 398*0Sstevel@tonic-gate Eacute => '�', # capital E, acute accent 399*0Sstevel@tonic-gate Ecirc => '�', # capital E, circumflex accent 400*0Sstevel@tonic-gate Egrave => '�', # capital E, grave accent 401*0Sstevel@tonic-gate Euml => '�', # capital E, dieresis or umlaut mark 402*0Sstevel@tonic-gate Iacute => '�', # capital I, acute accent 403*0Sstevel@tonic-gate Icirc => '�', # capital I, circumflex accent 404*0Sstevel@tonic-gate Igrave => '�', # capital I, grave accent 405*0Sstevel@tonic-gate Iuml => '�', # capital I, dieresis or umlaut mark 406*0Sstevel@tonic-gate Ntilde => '�', # capital N, tilde 407*0Sstevel@tonic-gate Oacute => '�', # capital O, acute accent 408*0Sstevel@tonic-gate Ocirc => '�', # capital O, circumflex accent 409*0Sstevel@tonic-gate Ograve => '�', # capital O, grave accent 410*0Sstevel@tonic-gate Oslash => '�', # capital O, slash 411*0Sstevel@tonic-gate Otilde => '�', # capital O, tilde 412*0Sstevel@tonic-gate Ouml => '�', # capital O, dieresis or umlaut mark 413*0Sstevel@tonic-gate THORN => '�', # capital THORN, Icelandic 414*0Sstevel@tonic-gate Uacute => '�', # capital U, acute accent 415*0Sstevel@tonic-gate Ucirc => '�', # capital U, circumflex accent 416*0Sstevel@tonic-gate Ugrave => '�', # capital U, grave accent 417*0Sstevel@tonic-gate Uuml => '�', # capital U, dieresis or umlaut mark 418*0Sstevel@tonic-gate Yacute => '�', # capital Y, acute accent 419*0Sstevel@tonic-gate aacute => '�', # small a, acute accent 420*0Sstevel@tonic-gate acirc => '�', # small a, circumflex accent 421*0Sstevel@tonic-gate aelig => '�', # small ae diphthong (ligature) 422*0Sstevel@tonic-gate agrave => '�', # small a, grave accent 423*0Sstevel@tonic-gate aring => '�', # small a, ring 424*0Sstevel@tonic-gate atilde => '�', # small a, tilde 425*0Sstevel@tonic-gate auml => '�', # small a, dieresis or umlaut mark 426*0Sstevel@tonic-gate ccedil => '�', # small c, cedilla 427*0Sstevel@tonic-gate eacute => '�', # small e, acute accent 428*0Sstevel@tonic-gate ecirc => '�', # small e, circumflex accent 429*0Sstevel@tonic-gate egrave => '�', # small e, grave accent 430*0Sstevel@tonic-gate eth => '�', # small eth, Icelandic 431*0Sstevel@tonic-gate euml => '�', # small e, dieresis or umlaut mark 432*0Sstevel@tonic-gate iacute => '�', # small i, acute accent 433*0Sstevel@tonic-gate icirc => '�', # small i, circumflex accent 434*0Sstevel@tonic-gate igrave => '�', # small i, grave accent 435*0Sstevel@tonic-gate iuml => '�', # small i, dieresis or umlaut mark 436*0Sstevel@tonic-gate ntilde => '�', # small n, tilde 437*0Sstevel@tonic-gate oacute => '�', # small o, acute accent 438*0Sstevel@tonic-gate ocirc => '�', # small o, circumflex accent 439*0Sstevel@tonic-gate ograve => '�', # small o, grave accent 440*0Sstevel@tonic-gate oslash => '�', # small o, slash 441*0Sstevel@tonic-gate otilde => '�', # small o, tilde 442*0Sstevel@tonic-gate ouml => '�', # small o, dieresis or umlaut mark 443*0Sstevel@tonic-gate szlig => '�', # small sharp s, German (sz ligature) 444*0Sstevel@tonic-gate thorn => '�', # small thorn, Icelandic 445*0Sstevel@tonic-gate uacute => '�', # small u, acute accent 446*0Sstevel@tonic-gate ucirc => '�', # small u, circumflex accent 447*0Sstevel@tonic-gate ugrave => '�', # small u, grave accent 448*0Sstevel@tonic-gate uuml => '�', # small u, dieresis or umlaut mark 449*0Sstevel@tonic-gate yacute => '�', # small y, acute accent 450*0Sstevel@tonic-gate yuml => '�', # small y, dieresis or umlaut mark 451*0Sstevel@tonic-gate 452*0Sstevel@tonic-gate # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96) 453*0Sstevel@tonic-gate copy => '�', # copyright sign 454*0Sstevel@tonic-gate reg => '�', # registered sign 455*0Sstevel@tonic-gate nbsp => "\240", # non breaking space 456*0Sstevel@tonic-gate 457*0Sstevel@tonic-gate # Additional ISO-8859/1 entities listed in rfc1866 (section 14) 458*0Sstevel@tonic-gate iexcl => '�', 459*0Sstevel@tonic-gate cent => '�', 460*0Sstevel@tonic-gate pound => '�', 461*0Sstevel@tonic-gate curren => '�', 462*0Sstevel@tonic-gate yen => '�', 463*0Sstevel@tonic-gate brvbar => '�', 464*0Sstevel@tonic-gate sect => '�', 465*0Sstevel@tonic-gate uml => '�', 466*0Sstevel@tonic-gate ordf => '�', 467*0Sstevel@tonic-gate laquo => '�', 468*0Sstevel@tonic-gate'not' => '�', # not is a keyword in perl 469*0Sstevel@tonic-gate shy => '�', 470*0Sstevel@tonic-gate macr => '�', 471*0Sstevel@tonic-gate deg => '�', 472*0Sstevel@tonic-gate plusmn => '�', 473*0Sstevel@tonic-gate sup1 => '�', 474*0Sstevel@tonic-gate sup2 => '�', 475*0Sstevel@tonic-gate sup3 => '�', 476*0Sstevel@tonic-gate acute => '�', 477*0Sstevel@tonic-gate micro => '�', 478*0Sstevel@tonic-gate para => '�', 479*0Sstevel@tonic-gate middot => '�', 480*0Sstevel@tonic-gate cedil => '�', 481*0Sstevel@tonic-gate ordm => '�', 482*0Sstevel@tonic-gate raquo => '�', 483*0Sstevel@tonic-gate frac14 => '�', 484*0Sstevel@tonic-gate frac12 => '�', 485*0Sstevel@tonic-gate frac34 => '�', 486*0Sstevel@tonic-gate iquest => '�', 487*0Sstevel@tonic-gate'times' => '�', # times is a keyword in perl 488*0Sstevel@tonic-gate divide => '�', 489*0Sstevel@tonic-gate 490*0Sstevel@tonic-gate# some POD special entities 491*0Sstevel@tonic-gate verbar => '|', 492*0Sstevel@tonic-gate sol => '/' 493*0Sstevel@tonic-gate); 494*0Sstevel@tonic-gate 495*0Sstevel@tonic-gate##--------------------------------------------------------------------------- 496*0Sstevel@tonic-gate 497*0Sstevel@tonic-gate##--------------------------------- 498*0Sstevel@tonic-gate## Function definitions begin here 499*0Sstevel@tonic-gate##--------------------------------- 500*0Sstevel@tonic-gate 501*0Sstevel@tonic-gatesub podchecker( $ ; $ % ) { 502*0Sstevel@tonic-gate my ($infile, $outfile, %options) = @_; 503*0Sstevel@tonic-gate local $_; 504*0Sstevel@tonic-gate 505*0Sstevel@tonic-gate ## Set defaults 506*0Sstevel@tonic-gate $infile ||= \*STDIN; 507*0Sstevel@tonic-gate $outfile ||= \*STDERR; 508*0Sstevel@tonic-gate 509*0Sstevel@tonic-gate ## Now create a pod checker 510*0Sstevel@tonic-gate my $checker = new Pod::Checker(%options); 511*0Sstevel@tonic-gate 512*0Sstevel@tonic-gate ## Now check the pod document for errors 513*0Sstevel@tonic-gate $checker->parse_from_file($infile, $outfile); 514*0Sstevel@tonic-gate 515*0Sstevel@tonic-gate ## Return the number of errors found 516*0Sstevel@tonic-gate return $checker->num_errors(); 517*0Sstevel@tonic-gate} 518*0Sstevel@tonic-gate 519*0Sstevel@tonic-gate##--------------------------------------------------------------------------- 520*0Sstevel@tonic-gate 521*0Sstevel@tonic-gate##------------------------------- 522*0Sstevel@tonic-gate## Method definitions begin here 523*0Sstevel@tonic-gate##------------------------------- 524*0Sstevel@tonic-gate 525*0Sstevel@tonic-gate################################## 526*0Sstevel@tonic-gate 527*0Sstevel@tonic-gate=over 4 528*0Sstevel@tonic-gate 529*0Sstevel@tonic-gate=item C<Pod::Checker-E<gt>new( %options )> 530*0Sstevel@tonic-gate 531*0Sstevel@tonic-gateReturn a reference to a new Pod::Checker object that inherits from 532*0Sstevel@tonic-gatePod::Parser and is used for calling the required methods later. The 533*0Sstevel@tonic-gatefollowing options are recognized: 534*0Sstevel@tonic-gate 535*0Sstevel@tonic-gateC<-warnings =E<gt> num> 536*0Sstevel@tonic-gate Print warnings if C<num> is true. The higher the value of C<num>, 537*0Sstevel@tonic-gatethe more warnings are printed. Currently there are only levels 1 and 2. 538*0Sstevel@tonic-gate 539*0Sstevel@tonic-gateC<-quiet =E<gt> num> 540*0Sstevel@tonic-gate If C<num> is true, do not print any errors/warnings. This is useful 541*0Sstevel@tonic-gatewhen Pod::Checker is used to munge POD code into plain text from within 542*0Sstevel@tonic-gatePOD formatters. 543*0Sstevel@tonic-gate 544*0Sstevel@tonic-gate=cut 545*0Sstevel@tonic-gate 546*0Sstevel@tonic-gate## sub new { 547*0Sstevel@tonic-gate## my $this = shift; 548*0Sstevel@tonic-gate## my $class = ref($this) || $this; 549*0Sstevel@tonic-gate## my %params = @_; 550*0Sstevel@tonic-gate## my $self = {%params}; 551*0Sstevel@tonic-gate## bless $self, $class; 552*0Sstevel@tonic-gate## $self->initialize(); 553*0Sstevel@tonic-gate## return $self; 554*0Sstevel@tonic-gate## } 555*0Sstevel@tonic-gate 556*0Sstevel@tonic-gatesub initialize { 557*0Sstevel@tonic-gate my $self = shift; 558*0Sstevel@tonic-gate ## Initialize number of errors, and setup an error function to 559*0Sstevel@tonic-gate ## increment this number and then print to the designated output. 560*0Sstevel@tonic-gate $self->{_NUM_ERRORS} = 0; 561*0Sstevel@tonic-gate $self->{_NUM_WARNINGS} = 0; 562*0Sstevel@tonic-gate $self->{-quiet} ||= 0; 563*0Sstevel@tonic-gate # set the error handling subroutine 564*0Sstevel@tonic-gate $self->errorsub($self->{-quiet} ? sub { 1; } : 'poderror'); 565*0Sstevel@tonic-gate $self->{_commands} = 0; # total number of POD commands encountered 566*0Sstevel@tonic-gate $self->{_list_stack} = []; # stack for nested lists 567*0Sstevel@tonic-gate $self->{_have_begin} = ''; # stores =begin 568*0Sstevel@tonic-gate $self->{_links} = []; # stack for internal hyperlinks 569*0Sstevel@tonic-gate $self->{_nodes} = []; # stack for =head/=item nodes 570*0Sstevel@tonic-gate $self->{_index} = []; # text in X<> 571*0Sstevel@tonic-gate # print warnings? 572*0Sstevel@tonic-gate $self->{-warnings} = 1 unless(defined $self->{-warnings}); 573*0Sstevel@tonic-gate $self->{_current_head1} = ''; # the current =head1 block 574*0Sstevel@tonic-gate $self->parseopts(-process_cut_cmd => 1, -warnings => $self->{-warnings}); 575*0Sstevel@tonic-gate} 576*0Sstevel@tonic-gate 577*0Sstevel@tonic-gate################################## 578*0Sstevel@tonic-gate 579*0Sstevel@tonic-gate=item C<$checker-E<gt>poderror( @args )> 580*0Sstevel@tonic-gate 581*0Sstevel@tonic-gate=item C<$checker-E<gt>poderror( {%opts}, @args )> 582*0Sstevel@tonic-gate 583*0Sstevel@tonic-gateInternal method for printing errors and warnings. If no options are 584*0Sstevel@tonic-gategiven, simply prints "@_". The following options are recognized and used 585*0Sstevel@tonic-gateto form the output: 586*0Sstevel@tonic-gate 587*0Sstevel@tonic-gate -msg 588*0Sstevel@tonic-gate 589*0Sstevel@tonic-gateA message to print prior to C<@args>. 590*0Sstevel@tonic-gate 591*0Sstevel@tonic-gate -line 592*0Sstevel@tonic-gate 593*0Sstevel@tonic-gateThe line number the error occurred in. 594*0Sstevel@tonic-gate 595*0Sstevel@tonic-gate -file 596*0Sstevel@tonic-gate 597*0Sstevel@tonic-gateThe file (name) the error occurred in. 598*0Sstevel@tonic-gate 599*0Sstevel@tonic-gate -severity 600*0Sstevel@tonic-gate 601*0Sstevel@tonic-gateThe error level, should be 'WARNING' or 'ERROR'. 602*0Sstevel@tonic-gate 603*0Sstevel@tonic-gate=cut 604*0Sstevel@tonic-gate 605*0Sstevel@tonic-gate# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) 606*0Sstevel@tonic-gatesub poderror { 607*0Sstevel@tonic-gate my $self = shift; 608*0Sstevel@tonic-gate my %opts = (ref $_[0]) ? %{shift()} : (); 609*0Sstevel@tonic-gate 610*0Sstevel@tonic-gate ## Retrieve options 611*0Sstevel@tonic-gate chomp( my $msg = ($opts{-msg} || "")."@_" ); 612*0Sstevel@tonic-gate my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ""; 613*0Sstevel@tonic-gate my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ""; 614*0Sstevel@tonic-gate unless (exists $opts{-severity}) { 615*0Sstevel@tonic-gate ## See if can find severity in message prefix 616*0Sstevel@tonic-gate $opts{-severity} = $1 if ( $msg =~ s/^\**\s*([A-Z]{3,}):\s+// ); 617*0Sstevel@tonic-gate } 618*0Sstevel@tonic-gate my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ""; 619*0Sstevel@tonic-gate 620*0Sstevel@tonic-gate ## Increment error count and print message " 621*0Sstevel@tonic-gate ++($self->{_NUM_ERRORS}) 622*0Sstevel@tonic-gate if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); 623*0Sstevel@tonic-gate ++($self->{_NUM_WARNINGS}) 624*0Sstevel@tonic-gate if(!%opts || ($opts{-severity} && $opts{-severity} eq 'WARNING')); 625*0Sstevel@tonic-gate my $out_fh = $self->output_handle() || \*STDERR; 626*0Sstevel@tonic-gate print $out_fh ($severity, $msg, $line, $file, "\n") 627*0Sstevel@tonic-gate if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING'); 628*0Sstevel@tonic-gate} 629*0Sstevel@tonic-gate 630*0Sstevel@tonic-gate################################## 631*0Sstevel@tonic-gate 632*0Sstevel@tonic-gate=item C<$checker-E<gt>num_errors()> 633*0Sstevel@tonic-gate 634*0Sstevel@tonic-gateSet (if argument specified) and retrieve the number of errors found. 635*0Sstevel@tonic-gate 636*0Sstevel@tonic-gate=cut 637*0Sstevel@tonic-gate 638*0Sstevel@tonic-gatesub num_errors { 639*0Sstevel@tonic-gate return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; 640*0Sstevel@tonic-gate} 641*0Sstevel@tonic-gate 642*0Sstevel@tonic-gate################################## 643*0Sstevel@tonic-gate 644*0Sstevel@tonic-gate=item C<$checker-E<gt>num_warnings()> 645*0Sstevel@tonic-gate 646*0Sstevel@tonic-gateSet (if argument specified) and retrieve the number of warnings found. 647*0Sstevel@tonic-gate 648*0Sstevel@tonic-gate=cut 649*0Sstevel@tonic-gate 650*0Sstevel@tonic-gatesub num_warnings { 651*0Sstevel@tonic-gate return (@_ > 1) ? ($_[0]->{_NUM_WARNINGS} = $_[1]) : $_[0]->{_NUM_WARNINGS}; 652*0Sstevel@tonic-gate} 653*0Sstevel@tonic-gate 654*0Sstevel@tonic-gate################################## 655*0Sstevel@tonic-gate 656*0Sstevel@tonic-gate=item C<$checker-E<gt>name()> 657*0Sstevel@tonic-gate 658*0Sstevel@tonic-gateSet (if argument specified) and retrieve the canonical name of POD as 659*0Sstevel@tonic-gatefound in the C<=head1 NAME> section. 660*0Sstevel@tonic-gate 661*0Sstevel@tonic-gate=cut 662*0Sstevel@tonic-gate 663*0Sstevel@tonic-gatesub name { 664*0Sstevel@tonic-gate return (@_ > 1 && $_[1]) ? 665*0Sstevel@tonic-gate ($_[0]->{-name} = $_[1]) : $_[0]->{-name}; 666*0Sstevel@tonic-gate} 667*0Sstevel@tonic-gate 668*0Sstevel@tonic-gate################################## 669*0Sstevel@tonic-gate 670*0Sstevel@tonic-gate=item C<$checker-E<gt>node()> 671*0Sstevel@tonic-gate 672*0Sstevel@tonic-gateAdd (if argument specified) and retrieve the nodes (as defined by C<=headX> 673*0Sstevel@tonic-gateand C<=item>) of the current POD. The nodes are returned in the order of 674*0Sstevel@tonic-gatetheir occurrence. They consist of plain text, each piece of whitespace is 675*0Sstevel@tonic-gatecollapsed to a single blank. 676*0Sstevel@tonic-gate 677*0Sstevel@tonic-gate=cut 678*0Sstevel@tonic-gate 679*0Sstevel@tonic-gatesub node { 680*0Sstevel@tonic-gate my ($self,$text) = @_; 681*0Sstevel@tonic-gate if(defined $text) { 682*0Sstevel@tonic-gate $text =~ s/\s+$//s; # strip trailing whitespace 683*0Sstevel@tonic-gate $text =~ s/\s+/ /gs; # collapse whitespace 684*0Sstevel@tonic-gate # add node, order important! 685*0Sstevel@tonic-gate push(@{$self->{_nodes}}, $text); 686*0Sstevel@tonic-gate # keep also a uniqueness counter 687*0Sstevel@tonic-gate $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); 688*0Sstevel@tonic-gate return $text; 689*0Sstevel@tonic-gate } 690*0Sstevel@tonic-gate @{$self->{_nodes}}; 691*0Sstevel@tonic-gate} 692*0Sstevel@tonic-gate 693*0Sstevel@tonic-gate################################## 694*0Sstevel@tonic-gate 695*0Sstevel@tonic-gate=item C<$checker-E<gt>idx()> 696*0Sstevel@tonic-gate 697*0Sstevel@tonic-gateAdd (if argument specified) and retrieve the index entries (as defined by 698*0Sstevel@tonic-gateC<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece 699*0Sstevel@tonic-gateof whitespace is collapsed to a single blank. 700*0Sstevel@tonic-gate 701*0Sstevel@tonic-gate=cut 702*0Sstevel@tonic-gate 703*0Sstevel@tonic-gate# set/return index entries of current POD 704*0Sstevel@tonic-gatesub idx { 705*0Sstevel@tonic-gate my ($self,$text) = @_; 706*0Sstevel@tonic-gate if(defined $text) { 707*0Sstevel@tonic-gate $text =~ s/\s+$//s; # strip trailing whitespace 708*0Sstevel@tonic-gate $text =~ s/\s+/ /gs; # collapse whitespace 709*0Sstevel@tonic-gate # add node, order important! 710*0Sstevel@tonic-gate push(@{$self->{_index}}, $text); 711*0Sstevel@tonic-gate # keep also a uniqueness counter 712*0Sstevel@tonic-gate $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s); 713*0Sstevel@tonic-gate return $text; 714*0Sstevel@tonic-gate } 715*0Sstevel@tonic-gate @{$self->{_index}}; 716*0Sstevel@tonic-gate} 717*0Sstevel@tonic-gate 718*0Sstevel@tonic-gate################################## 719*0Sstevel@tonic-gate 720*0Sstevel@tonic-gate=item C<$checker-E<gt>hyperlink()> 721*0Sstevel@tonic-gate 722*0Sstevel@tonic-gateAdd (if argument specified) and retrieve the hyperlinks (as defined by 723*0Sstevel@tonic-gateC<LE<lt>E<gt>>) of the current POD. They consist of a 2-item array: line 724*0Sstevel@tonic-gatenumber and C<Pod::Hyperlink> object. 725*0Sstevel@tonic-gate 726*0Sstevel@tonic-gate=back 727*0Sstevel@tonic-gate 728*0Sstevel@tonic-gate=cut 729*0Sstevel@tonic-gate 730*0Sstevel@tonic-gate# set/return hyperlinks of the current POD 731*0Sstevel@tonic-gatesub hyperlink { 732*0Sstevel@tonic-gate my $self = shift; 733*0Sstevel@tonic-gate if($_[0]) { 734*0Sstevel@tonic-gate push(@{$self->{_links}}, $_[0]); 735*0Sstevel@tonic-gate return $_[0]; 736*0Sstevel@tonic-gate } 737*0Sstevel@tonic-gate @{$self->{_links}}; 738*0Sstevel@tonic-gate} 739*0Sstevel@tonic-gate 740*0Sstevel@tonic-gate## overrides for Pod::Parser 741*0Sstevel@tonic-gate 742*0Sstevel@tonic-gatesub end_pod { 743*0Sstevel@tonic-gate ## Do some final checks and 744*0Sstevel@tonic-gate ## print the number of errors found 745*0Sstevel@tonic-gate my $self = shift; 746*0Sstevel@tonic-gate my $infile = $self->input_file(); 747*0Sstevel@tonic-gate my $out_fh = $self->output_handle(); 748*0Sstevel@tonic-gate 749*0Sstevel@tonic-gate if(@{$self->{_list_stack}}) { 750*0Sstevel@tonic-gate my $list; 751*0Sstevel@tonic-gate while(($list = $self->_close_list('EOF',$infile)) && 752*0Sstevel@tonic-gate $list->indent() ne 'auto') { 753*0Sstevel@tonic-gate $self->poderror({ -line => 'EOF', -file => $infile, 754*0Sstevel@tonic-gate -severity => 'ERROR', -msg => "=over on line " . 755*0Sstevel@tonic-gate $list->start() . " without closing =back" }); #" 756*0Sstevel@tonic-gate } 757*0Sstevel@tonic-gate } 758*0Sstevel@tonic-gate 759*0Sstevel@tonic-gate # check validity of document internal hyperlinks 760*0Sstevel@tonic-gate # first build the node names from the paragraph text 761*0Sstevel@tonic-gate my %nodes; 762*0Sstevel@tonic-gate foreach($self->node()) { 763*0Sstevel@tonic-gate $nodes{$_} = 1; 764*0Sstevel@tonic-gate if(/^(\S+)\s+\S/) { 765*0Sstevel@tonic-gate # we have more than one word. Use the first as a node, too. 766*0Sstevel@tonic-gate # This is used heavily in perlfunc.pod 767*0Sstevel@tonic-gate $nodes{$1} ||= 2; # derived node 768*0Sstevel@tonic-gate } 769*0Sstevel@tonic-gate } 770*0Sstevel@tonic-gate foreach($self->idx()) { 771*0Sstevel@tonic-gate $nodes{$_} = 3; # index node 772*0Sstevel@tonic-gate } 773*0Sstevel@tonic-gate foreach($self->hyperlink()) { 774*0Sstevel@tonic-gate my ($line,$link) = @$_; 775*0Sstevel@tonic-gate # _TODO_ what if there is a link to the page itself by the name, 776*0Sstevel@tonic-gate # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION"> 777*0Sstevel@tonic-gate if($link->node() && !$link->page() && $link->type() ne 'hyperlink') { 778*0Sstevel@tonic-gate my $node = $self->_check_ptree($self->parse_text($link->node(), 779*0Sstevel@tonic-gate $line), $line, $infile, 'L'); 780*0Sstevel@tonic-gate if($node && !$nodes{$node}) { 781*0Sstevel@tonic-gate $self->poderror({ -line => $line || '', -file => $infile, 782*0Sstevel@tonic-gate -severity => 'ERROR', 783*0Sstevel@tonic-gate -msg => "unresolved internal link '$node'"}); 784*0Sstevel@tonic-gate } 785*0Sstevel@tonic-gate } 786*0Sstevel@tonic-gate } 787*0Sstevel@tonic-gate 788*0Sstevel@tonic-gate # check the internal nodes for uniqueness. This pertains to 789*0Sstevel@tonic-gate # =headX, =item and X<...> 790*0Sstevel@tonic-gate foreach(grep($self->{_unique_nodes}->{$_} > 1, 791*0Sstevel@tonic-gate keys %{$self->{_unique_nodes}})) { 792*0Sstevel@tonic-gate $self->poderror({ -line => '-', -file => $infile, 793*0Sstevel@tonic-gate -severity => 'WARNING', 794*0Sstevel@tonic-gate -msg => "multiple occurrence of link target '$_'"}); 795*0Sstevel@tonic-gate } 796*0Sstevel@tonic-gate 797*0Sstevel@tonic-gate # no POD found here 798*0Sstevel@tonic-gate $self->num_errors(-1) if($self->{_commands} == 0); 799*0Sstevel@tonic-gate} 800*0Sstevel@tonic-gate 801*0Sstevel@tonic-gate# check a POD command directive 802*0Sstevel@tonic-gatesub command { 803*0Sstevel@tonic-gate my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; 804*0Sstevel@tonic-gate my ($file, $line) = $pod_para->file_line; 805*0Sstevel@tonic-gate ## Check the command syntax 806*0Sstevel@tonic-gate my $arg; # this will hold the command argument 807*0Sstevel@tonic-gate if (! $VALID_COMMANDS{$cmd}) { 808*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', 809*0Sstevel@tonic-gate -msg => "Unknown command '$cmd'" }); 810*0Sstevel@tonic-gate } 811*0Sstevel@tonic-gate else { # found a valid command 812*0Sstevel@tonic-gate $self->{_commands}++; # delete this line if below is enabled again 813*0Sstevel@tonic-gate 814*0Sstevel@tonic-gate ##### following check disabled due to strong request 815*0Sstevel@tonic-gate #if(!$self->{_commands}++ && $cmd !~ /^head/) { 816*0Sstevel@tonic-gate # $self->poderror({ -line => $line, -file => $file, 817*0Sstevel@tonic-gate # -severity => 'WARNING', 818*0Sstevel@tonic-gate # -msg => "file does not start with =head" }); 819*0Sstevel@tonic-gate #} 820*0Sstevel@tonic-gate 821*0Sstevel@tonic-gate # check syntax of particular command 822*0Sstevel@tonic-gate if($cmd eq 'over') { 823*0Sstevel@tonic-gate # check for argument 824*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 825*0Sstevel@tonic-gate my $indent = 4; # default 826*0Sstevel@tonic-gate if($arg && $arg =~ /^\s*(\d+)\s*$/) { 827*0Sstevel@tonic-gate $indent = $1; 828*0Sstevel@tonic-gate } 829*0Sstevel@tonic-gate # start a new list 830*0Sstevel@tonic-gate $self->_open_list($indent,$line,$file); 831*0Sstevel@tonic-gate } 832*0Sstevel@tonic-gate elsif($cmd eq 'item') { 833*0Sstevel@tonic-gate # are we in a list? 834*0Sstevel@tonic-gate unless(@{$self->{_list_stack}}) { 835*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 836*0Sstevel@tonic-gate -severity => 'ERROR', 837*0Sstevel@tonic-gate -msg => "=item without previous =over" }); 838*0Sstevel@tonic-gate # auto-open in case we encounter many more 839*0Sstevel@tonic-gate $self->_open_list('auto',$line,$file); 840*0Sstevel@tonic-gate } 841*0Sstevel@tonic-gate my $list = $self->{_list_stack}->[0]; 842*0Sstevel@tonic-gate # check whether the previous item had some contents 843*0Sstevel@tonic-gate if(defined $self->{_list_item_contents} && 844*0Sstevel@tonic-gate $self->{_list_item_contents} == 0) { 845*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 846*0Sstevel@tonic-gate -severity => 'WARNING', 847*0Sstevel@tonic-gate -msg => "previous =item has no contents" }); 848*0Sstevel@tonic-gate } 849*0Sstevel@tonic-gate if($list->{_has_par}) { 850*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 851*0Sstevel@tonic-gate -severity => 'WARNING', 852*0Sstevel@tonic-gate -msg => "preceding non-item paragraph(s)" }); 853*0Sstevel@tonic-gate delete $list->{_has_par}; 854*0Sstevel@tonic-gate } 855*0Sstevel@tonic-gate # check for argument 856*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line, $file); 857*0Sstevel@tonic-gate if($arg && $arg =~ /(\S+)/) { 858*0Sstevel@tonic-gate $arg =~ s/[\s\n]+$//; 859*0Sstevel@tonic-gate my $type; 860*0Sstevel@tonic-gate if($arg =~ /^[*]\s*(\S*.*)/) { 861*0Sstevel@tonic-gate $type = 'bullet'; 862*0Sstevel@tonic-gate $self->{_list_item_contents} = $1 ? 1 : 0; 863*0Sstevel@tonic-gate $arg = $1; 864*0Sstevel@tonic-gate } 865*0Sstevel@tonic-gate elsif($arg =~ /^\d+\.?\s*(\S*)/) { 866*0Sstevel@tonic-gate $type = 'number'; 867*0Sstevel@tonic-gate $self->{_list_item_contents} = $1 ? 1 : 0; 868*0Sstevel@tonic-gate $arg = $1; 869*0Sstevel@tonic-gate } 870*0Sstevel@tonic-gate else { 871*0Sstevel@tonic-gate $type = 'definition'; 872*0Sstevel@tonic-gate $self->{_list_item_contents} = 1; 873*0Sstevel@tonic-gate } 874*0Sstevel@tonic-gate my $first = $list->type(); 875*0Sstevel@tonic-gate if($first && $first ne $type) { 876*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 877*0Sstevel@tonic-gate -severity => 'WARNING', 878*0Sstevel@tonic-gate -msg => "=item type mismatch ('$first' vs. '$type')"}); 879*0Sstevel@tonic-gate } 880*0Sstevel@tonic-gate else { # first item 881*0Sstevel@tonic-gate $list->type($type); 882*0Sstevel@tonic-gate } 883*0Sstevel@tonic-gate } 884*0Sstevel@tonic-gate else { 885*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 886*0Sstevel@tonic-gate -severity => 'WARNING', 887*0Sstevel@tonic-gate -msg => "No argument for =item" }); 888*0Sstevel@tonic-gate $arg = ' '; # empty 889*0Sstevel@tonic-gate $self->{_list_item_contents} = 0; 890*0Sstevel@tonic-gate } 891*0Sstevel@tonic-gate # add this item 892*0Sstevel@tonic-gate $list->item($arg); 893*0Sstevel@tonic-gate # remember this node 894*0Sstevel@tonic-gate $self->node($arg); 895*0Sstevel@tonic-gate } 896*0Sstevel@tonic-gate elsif($cmd eq 'back') { 897*0Sstevel@tonic-gate # check if we have an open list 898*0Sstevel@tonic-gate unless(@{$self->{_list_stack}}) { 899*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 900*0Sstevel@tonic-gate -severity => 'ERROR', 901*0Sstevel@tonic-gate -msg => "=back without previous =over" }); 902*0Sstevel@tonic-gate } 903*0Sstevel@tonic-gate else { 904*0Sstevel@tonic-gate # check for spurious characters 905*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 906*0Sstevel@tonic-gate if($arg && $arg =~ /\S/) { 907*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 908*0Sstevel@tonic-gate -severity => 'ERROR', 909*0Sstevel@tonic-gate -msg => "Spurious character(s) after =back" }); 910*0Sstevel@tonic-gate } 911*0Sstevel@tonic-gate # close list 912*0Sstevel@tonic-gate my $list = $self->_close_list($line,$file); 913*0Sstevel@tonic-gate # check for empty lists 914*0Sstevel@tonic-gate if(!$list->item() && $self->{-warnings}) { 915*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 916*0Sstevel@tonic-gate -severity => 'WARNING', 917*0Sstevel@tonic-gate -msg => "No items in =over (at line " . 918*0Sstevel@tonic-gate $list->start() . ") / =back list"}); #" 919*0Sstevel@tonic-gate } 920*0Sstevel@tonic-gate } 921*0Sstevel@tonic-gate } 922*0Sstevel@tonic-gate elsif($cmd =~ /^head(\d+)/) { 923*0Sstevel@tonic-gate my $hnum = $1; 924*0Sstevel@tonic-gate $self->{"_have_head_$hnum"}++; # count head types 925*0Sstevel@tonic-gate if($hnum > 1 && !$self->{"_have_head_".($hnum -1)}) { 926*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 927*0Sstevel@tonic-gate -severity => 'WARNING', 928*0Sstevel@tonic-gate -msg => "=head$hnum without preceding higher level"}); 929*0Sstevel@tonic-gate } 930*0Sstevel@tonic-gate # check whether the previous =head section had some contents 931*0Sstevel@tonic-gate if(defined $self->{_commands_in_head} && 932*0Sstevel@tonic-gate $self->{_commands_in_head} == 0 && 933*0Sstevel@tonic-gate defined $self->{_last_head} && 934*0Sstevel@tonic-gate $self->{_last_head} >= $hnum) { 935*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 936*0Sstevel@tonic-gate -severity => 'WARNING', 937*0Sstevel@tonic-gate -msg => "empty section in previous paragraph"}); 938*0Sstevel@tonic-gate } 939*0Sstevel@tonic-gate $self->{_commands_in_head} = -1; 940*0Sstevel@tonic-gate $self->{_last_head} = $hnum; 941*0Sstevel@tonic-gate # check if there is an open list 942*0Sstevel@tonic-gate if(@{$self->{_list_stack}}) { 943*0Sstevel@tonic-gate my $list; 944*0Sstevel@tonic-gate while(($list = $self->_close_list($line,$file)) && 945*0Sstevel@tonic-gate $list->indent() ne 'auto') { 946*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 947*0Sstevel@tonic-gate -severity => 'ERROR', 948*0Sstevel@tonic-gate -msg => "=over on line ". $list->start() . 949*0Sstevel@tonic-gate " without closing =back (at $cmd)" }); 950*0Sstevel@tonic-gate } 951*0Sstevel@tonic-gate } 952*0Sstevel@tonic-gate # remember this node 953*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 954*0Sstevel@tonic-gate $arg =~ s/[\s\n]+$//s; 955*0Sstevel@tonic-gate $self->node($arg); 956*0Sstevel@tonic-gate unless(length($arg)) { 957*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 958*0Sstevel@tonic-gate -severity => 'ERROR', 959*0Sstevel@tonic-gate -msg => "empty =$cmd"}); 960*0Sstevel@tonic-gate } 961*0Sstevel@tonic-gate if($cmd eq 'head1') { 962*0Sstevel@tonic-gate $self->{_current_head1} = $arg; 963*0Sstevel@tonic-gate } else { 964*0Sstevel@tonic-gate $self->{_current_head1} = ''; 965*0Sstevel@tonic-gate } 966*0Sstevel@tonic-gate } 967*0Sstevel@tonic-gate elsif($cmd eq 'begin') { 968*0Sstevel@tonic-gate if($self->{_have_begin}) { 969*0Sstevel@tonic-gate # already have a begin 970*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 971*0Sstevel@tonic-gate -severity => 'ERROR', 972*0Sstevel@tonic-gate -msg => "Nested =begin's (first at line " . 973*0Sstevel@tonic-gate $self->{_have_begin} . ")"}); 974*0Sstevel@tonic-gate } 975*0Sstevel@tonic-gate else { 976*0Sstevel@tonic-gate # check for argument 977*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 978*0Sstevel@tonic-gate unless($arg && $arg =~ /(\S+)/) { 979*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 980*0Sstevel@tonic-gate -severity => 'ERROR', 981*0Sstevel@tonic-gate -msg => "No argument for =begin"}); 982*0Sstevel@tonic-gate } 983*0Sstevel@tonic-gate # remember the =begin 984*0Sstevel@tonic-gate $self->{_have_begin} = "$line:$1"; 985*0Sstevel@tonic-gate } 986*0Sstevel@tonic-gate } 987*0Sstevel@tonic-gate elsif($cmd eq 'end') { 988*0Sstevel@tonic-gate if($self->{_have_begin}) { 989*0Sstevel@tonic-gate # close the existing =begin 990*0Sstevel@tonic-gate $self->{_have_begin} = ''; 991*0Sstevel@tonic-gate # check for spurious characters 992*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 993*0Sstevel@tonic-gate # the closing argument is optional 994*0Sstevel@tonic-gate #if($arg && $arg =~ /\S/) { 995*0Sstevel@tonic-gate # $self->poderror({ -line => $line, -file => $file, 996*0Sstevel@tonic-gate # -severity => 'WARNING', 997*0Sstevel@tonic-gate # -msg => "Spurious character(s) after =end" }); 998*0Sstevel@tonic-gate #} 999*0Sstevel@tonic-gate } 1000*0Sstevel@tonic-gate else { 1001*0Sstevel@tonic-gate # don't have a matching =begin 1002*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1003*0Sstevel@tonic-gate -severity => 'ERROR', 1004*0Sstevel@tonic-gate -msg => "=end without =begin" }); 1005*0Sstevel@tonic-gate } 1006*0Sstevel@tonic-gate } 1007*0Sstevel@tonic-gate elsif($cmd eq 'for') { 1008*0Sstevel@tonic-gate unless($paragraph =~ /\s*(\S+)\s*/) { 1009*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1010*0Sstevel@tonic-gate -severity => 'ERROR', 1011*0Sstevel@tonic-gate -msg => "=for without formatter specification" }); 1012*0Sstevel@tonic-gate } 1013*0Sstevel@tonic-gate $arg = ''; # do not expand paragraph below 1014*0Sstevel@tonic-gate } 1015*0Sstevel@tonic-gate elsif($cmd =~ /^(pod|cut)$/) { 1016*0Sstevel@tonic-gate # check for argument 1017*0Sstevel@tonic-gate $arg = $self->interpolate_and_check($paragraph, $line,$file); 1018*0Sstevel@tonic-gate if($arg && $arg =~ /(\S+)/) { 1019*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1020*0Sstevel@tonic-gate -severity => 'ERROR', 1021*0Sstevel@tonic-gate -msg => "Spurious text after =$cmd"}); 1022*0Sstevel@tonic-gate } 1023*0Sstevel@tonic-gate } 1024*0Sstevel@tonic-gate $self->{_commands_in_head}++; 1025*0Sstevel@tonic-gate ## Check the interior sequences in the command-text 1026*0Sstevel@tonic-gate $self->interpolate_and_check($paragraph, $line,$file) 1027*0Sstevel@tonic-gate unless(defined $arg); 1028*0Sstevel@tonic-gate } 1029*0Sstevel@tonic-gate} 1030*0Sstevel@tonic-gate 1031*0Sstevel@tonic-gatesub _open_list 1032*0Sstevel@tonic-gate{ 1033*0Sstevel@tonic-gate my ($self,$indent,$line,$file) = @_; 1034*0Sstevel@tonic-gate my $list = Pod::List->new( 1035*0Sstevel@tonic-gate -indent => $indent, 1036*0Sstevel@tonic-gate -start => $line, 1037*0Sstevel@tonic-gate -file => $file); 1038*0Sstevel@tonic-gate unshift(@{$self->{_list_stack}}, $list); 1039*0Sstevel@tonic-gate undef $self->{_list_item_contents}; 1040*0Sstevel@tonic-gate $list; 1041*0Sstevel@tonic-gate} 1042*0Sstevel@tonic-gate 1043*0Sstevel@tonic-gatesub _close_list 1044*0Sstevel@tonic-gate{ 1045*0Sstevel@tonic-gate my ($self,$line,$file) = @_; 1046*0Sstevel@tonic-gate my $list = shift(@{$self->{_list_stack}}); 1047*0Sstevel@tonic-gate if(defined $self->{_list_item_contents} && 1048*0Sstevel@tonic-gate $self->{_list_item_contents} == 0) { 1049*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1050*0Sstevel@tonic-gate -severity => 'WARNING', 1051*0Sstevel@tonic-gate -msg => "previous =item has no contents" }); 1052*0Sstevel@tonic-gate } 1053*0Sstevel@tonic-gate undef $self->{_list_item_contents}; 1054*0Sstevel@tonic-gate $list; 1055*0Sstevel@tonic-gate} 1056*0Sstevel@tonic-gate 1057*0Sstevel@tonic-gate# process a block of some text 1058*0Sstevel@tonic-gatesub interpolate_and_check { 1059*0Sstevel@tonic-gate my ($self, $paragraph, $line, $file) = @_; 1060*0Sstevel@tonic-gate ## Check the interior sequences in the command-text 1061*0Sstevel@tonic-gate # and return the text 1062*0Sstevel@tonic-gate $self->_check_ptree( 1063*0Sstevel@tonic-gate $self->parse_text($paragraph,$line), $line, $file, ''); 1064*0Sstevel@tonic-gate} 1065*0Sstevel@tonic-gate 1066*0Sstevel@tonic-gatesub _check_ptree { 1067*0Sstevel@tonic-gate my ($self,$ptree,$line,$file,$nestlist) = @_; 1068*0Sstevel@tonic-gate local($_); 1069*0Sstevel@tonic-gate my $text = ''; 1070*0Sstevel@tonic-gate # process each node in the parse tree 1071*0Sstevel@tonic-gate foreach(@$ptree) { 1072*0Sstevel@tonic-gate # regular text chunk 1073*0Sstevel@tonic-gate unless(ref) { 1074*0Sstevel@tonic-gate # count the unescaped angle brackets 1075*0Sstevel@tonic-gate # complain only when warning level is greater than 1 1076*0Sstevel@tonic-gate if($self->{-warnings} && $self->{-warnings}>1) { 1077*0Sstevel@tonic-gate my $count; 1078*0Sstevel@tonic-gate if($count = tr/<>/<>/) { 1079*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1080*0Sstevel@tonic-gate -severity => 'WARNING', 1081*0Sstevel@tonic-gate -msg => "$count unescaped <> in paragraph" }); 1082*0Sstevel@tonic-gate } 1083*0Sstevel@tonic-gate } 1084*0Sstevel@tonic-gate $text .= $_; 1085*0Sstevel@tonic-gate next; 1086*0Sstevel@tonic-gate } 1087*0Sstevel@tonic-gate # have an interior sequence 1088*0Sstevel@tonic-gate my $cmd = $_->cmd_name(); 1089*0Sstevel@tonic-gate my $contents = $_->parse_tree(); 1090*0Sstevel@tonic-gate ($file,$line) = $_->file_line(); 1091*0Sstevel@tonic-gate # check for valid tag 1092*0Sstevel@tonic-gate if (! $VALID_SEQUENCES{$cmd}) { 1093*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1094*0Sstevel@tonic-gate -severity => 'ERROR', 1095*0Sstevel@tonic-gate -msg => qq(Unknown interior-sequence '$cmd')}); 1096*0Sstevel@tonic-gate # expand it anyway 1097*0Sstevel@tonic-gate $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); 1098*0Sstevel@tonic-gate next; 1099*0Sstevel@tonic-gate } 1100*0Sstevel@tonic-gate if($nestlist =~ /$cmd/) { 1101*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1102*0Sstevel@tonic-gate -severity => 'ERROR', 1103*0Sstevel@tonic-gate -msg => "nested commands $cmd<...$cmd<...>...>"}); 1104*0Sstevel@tonic-gate # _TODO_ should we add the contents anyway? 1105*0Sstevel@tonic-gate # expand it anyway, see below 1106*0Sstevel@tonic-gate } 1107*0Sstevel@tonic-gate if($cmd eq 'E') { 1108*0Sstevel@tonic-gate # preserve entities 1109*0Sstevel@tonic-gate if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { 1110*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1111*0Sstevel@tonic-gate -severity => 'ERROR', 1112*0Sstevel@tonic-gate -msg => "garbled entity " . $_->raw_text()}); 1113*0Sstevel@tonic-gate next; 1114*0Sstevel@tonic-gate } 1115*0Sstevel@tonic-gate my $ent = $$contents[0]; 1116*0Sstevel@tonic-gate my $val; 1117*0Sstevel@tonic-gate if($ent =~ /^0x[0-9a-f]+$/i) { 1118*0Sstevel@tonic-gate # hexadec entity 1119*0Sstevel@tonic-gate $val = hex($ent); 1120*0Sstevel@tonic-gate } 1121*0Sstevel@tonic-gate elsif($ent =~ /^0\d+$/) { 1122*0Sstevel@tonic-gate # octal 1123*0Sstevel@tonic-gate $val = oct($ent); 1124*0Sstevel@tonic-gate } 1125*0Sstevel@tonic-gate elsif($ent =~ /^\d+$/) { 1126*0Sstevel@tonic-gate # numeric entity 1127*0Sstevel@tonic-gate $val = $ent; 1128*0Sstevel@tonic-gate } 1129*0Sstevel@tonic-gate if(defined $val) { 1130*0Sstevel@tonic-gate if($val>0 && $val<256) { 1131*0Sstevel@tonic-gate $text .= chr($val); 1132*0Sstevel@tonic-gate } 1133*0Sstevel@tonic-gate else { 1134*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1135*0Sstevel@tonic-gate -severity => 'ERROR', 1136*0Sstevel@tonic-gate -msg => "Entity number out of range " . $_->raw_text()}); 1137*0Sstevel@tonic-gate } 1138*0Sstevel@tonic-gate } 1139*0Sstevel@tonic-gate elsif($ENTITIES{$ent}) { 1140*0Sstevel@tonic-gate # known ISO entity 1141*0Sstevel@tonic-gate $text .= $ENTITIES{$ent}; 1142*0Sstevel@tonic-gate } 1143*0Sstevel@tonic-gate else { 1144*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1145*0Sstevel@tonic-gate -severity => 'WARNING', 1146*0Sstevel@tonic-gate -msg => "Unknown entity " . $_->raw_text()}); 1147*0Sstevel@tonic-gate $text .= "E<$ent>"; 1148*0Sstevel@tonic-gate } 1149*0Sstevel@tonic-gate } 1150*0Sstevel@tonic-gate elsif($cmd eq 'L') { 1151*0Sstevel@tonic-gate # try to parse the hyperlink 1152*0Sstevel@tonic-gate my $link = Pod::Hyperlink->new($contents->raw_text()); 1153*0Sstevel@tonic-gate unless(defined $link) { 1154*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1155*0Sstevel@tonic-gate -severity => 'ERROR', 1156*0Sstevel@tonic-gate -msg => "malformed link " . $_->raw_text() ." : $@"}); 1157*0Sstevel@tonic-gate next; 1158*0Sstevel@tonic-gate } 1159*0Sstevel@tonic-gate $link->line($line); # remember line 1160*0Sstevel@tonic-gate if($self->{-warnings}) { 1161*0Sstevel@tonic-gate foreach my $w ($link->warning()) { 1162*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1163*0Sstevel@tonic-gate -severity => 'WARNING', 1164*0Sstevel@tonic-gate -msg => $w }); 1165*0Sstevel@tonic-gate } 1166*0Sstevel@tonic-gate } 1167*0Sstevel@tonic-gate # check the link text 1168*0Sstevel@tonic-gate $text .= $self->_check_ptree($self->parse_text($link->text(), 1169*0Sstevel@tonic-gate $line), $line, $file, "$nestlist$cmd"); 1170*0Sstevel@tonic-gate # remember link 1171*0Sstevel@tonic-gate $self->hyperlink([$line,$link]); 1172*0Sstevel@tonic-gate } 1173*0Sstevel@tonic-gate elsif($cmd =~ /[BCFIS]/) { 1174*0Sstevel@tonic-gate # add the guts 1175*0Sstevel@tonic-gate $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); 1176*0Sstevel@tonic-gate } 1177*0Sstevel@tonic-gate elsif($cmd eq 'Z') { 1178*0Sstevel@tonic-gate if(length($contents->raw_text())) { 1179*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1180*0Sstevel@tonic-gate -severity => 'ERROR', 1181*0Sstevel@tonic-gate -msg => "Nonempty Z<>"}); 1182*0Sstevel@tonic-gate } 1183*0Sstevel@tonic-gate } 1184*0Sstevel@tonic-gate elsif($cmd eq 'X') { 1185*0Sstevel@tonic-gate my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); 1186*0Sstevel@tonic-gate if($idx =~ /^\s*$/s) { 1187*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1188*0Sstevel@tonic-gate -severity => 'ERROR', 1189*0Sstevel@tonic-gate -msg => "Empty X<>"}); 1190*0Sstevel@tonic-gate } 1191*0Sstevel@tonic-gate else { 1192*0Sstevel@tonic-gate # remember this node 1193*0Sstevel@tonic-gate $self->idx($idx); 1194*0Sstevel@tonic-gate } 1195*0Sstevel@tonic-gate } 1196*0Sstevel@tonic-gate else { 1197*0Sstevel@tonic-gate # not reached 1198*0Sstevel@tonic-gate die "internal error"; 1199*0Sstevel@tonic-gate } 1200*0Sstevel@tonic-gate } 1201*0Sstevel@tonic-gate $text; 1202*0Sstevel@tonic-gate} 1203*0Sstevel@tonic-gate 1204*0Sstevel@tonic-gate# process a block of verbatim text 1205*0Sstevel@tonic-gatesub verbatim { 1206*0Sstevel@tonic-gate ## Nothing particular to check 1207*0Sstevel@tonic-gate my ($self, $paragraph, $line_num, $pod_para) = @_; 1208*0Sstevel@tonic-gate 1209*0Sstevel@tonic-gate $self->_preproc_par($paragraph); 1210*0Sstevel@tonic-gate 1211*0Sstevel@tonic-gate if($self->{_current_head1} eq 'NAME') { 1212*0Sstevel@tonic-gate my ($file, $line) = $pod_para->file_line; 1213*0Sstevel@tonic-gate $self->poderror({ -line => $line, -file => $file, 1214*0Sstevel@tonic-gate -severity => 'WARNING', 1215*0Sstevel@tonic-gate -msg => 'Verbatim paragraph in NAME section' }); 1216*0Sstevel@tonic-gate } 1217*0Sstevel@tonic-gate} 1218*0Sstevel@tonic-gate 1219*0Sstevel@tonic-gate# process a block of regular text 1220*0Sstevel@tonic-gatesub textblock { 1221*0Sstevel@tonic-gate my ($self, $paragraph, $line_num, $pod_para) = @_; 1222*0Sstevel@tonic-gate my ($file, $line) = $pod_para->file_line; 1223*0Sstevel@tonic-gate 1224*0Sstevel@tonic-gate $self->_preproc_par($paragraph); 1225*0Sstevel@tonic-gate 1226*0Sstevel@tonic-gate # skip this paragraph if in a =begin block 1227*0Sstevel@tonic-gate unless($self->{_have_begin}) { 1228*0Sstevel@tonic-gate my $block = $self->interpolate_and_check($paragraph, $line,$file); 1229*0Sstevel@tonic-gate if($self->{_current_head1} eq 'NAME') { 1230*0Sstevel@tonic-gate if($block =~ /^\s*(\S+?)\s*[,-]/) { 1231*0Sstevel@tonic-gate # this is the canonical name 1232*0Sstevel@tonic-gate $self->{-name} = $1 unless(defined $self->{-name}); 1233*0Sstevel@tonic-gate } 1234*0Sstevel@tonic-gate } 1235*0Sstevel@tonic-gate } 1236*0Sstevel@tonic-gate} 1237*0Sstevel@tonic-gate 1238*0Sstevel@tonic-gatesub _preproc_par 1239*0Sstevel@tonic-gate{ 1240*0Sstevel@tonic-gate my $self = shift; 1241*0Sstevel@tonic-gate $_[0] =~ s/[\s\n]+$//; 1242*0Sstevel@tonic-gate if($_[0]) { 1243*0Sstevel@tonic-gate $self->{_commands_in_head}++; 1244*0Sstevel@tonic-gate $self->{_list_item_contents}++ if(defined $self->{_list_item_contents}); 1245*0Sstevel@tonic-gate if(@{$self->{_list_stack}} && !$self->{_list_stack}->[0]->item()) { 1246*0Sstevel@tonic-gate $self->{_list_stack}->[0]->{_has_par} = 1; 1247*0Sstevel@tonic-gate } 1248*0Sstevel@tonic-gate } 1249*0Sstevel@tonic-gate} 1250*0Sstevel@tonic-gate 1251*0Sstevel@tonic-gate1; 1252*0Sstevel@tonic-gate 1253*0Sstevel@tonic-gate__END__ 1254*0Sstevel@tonic-gate 1255*0Sstevel@tonic-gate=head1 AUTHOR 1256*0Sstevel@tonic-gate 1257*0Sstevel@tonic-gatePlease report bugs using L<http://rt.cpan.org>. 1258*0Sstevel@tonic-gate 1259*0Sstevel@tonic-gateBrad Appleton E<lt>bradapp@enteract.comE<gt> (initial version), 1260*0Sstevel@tonic-gateMarek Rouchal E<lt>marekr@cpan.orgE<gt> 1261*0Sstevel@tonic-gate 1262*0Sstevel@tonic-gateBased on code for B<Pod::Text::pod2text()> written by 1263*0Sstevel@tonic-gateTom Christiansen E<lt>tchrist@mox.perl.comE<gt> 1264*0Sstevel@tonic-gate 1265*0Sstevel@tonic-gate=cut 1266*0Sstevel@tonic-gate 1267