Leaked source code of windows server 2003
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

1768 lines
63 KiB

  1. #############################################################################
  2. # Pod/Parser.pm -- package which defines a base class for parsing POD docs.
  3. #
  4. # Copyright (C) 1996-2000 by Bradford Appleton. All rights reserved.
  5. # This file is part of "PodParser". PodParser is free software;
  6. # you can redistribute it and/or modify it under the same terms
  7. # as Perl itself.
  8. #############################################################################
  9. package Pod::Parser;
  10. use vars qw($VERSION);
  11. $VERSION = 1.13; ## Current version of this package
  12. require 5.005; ## requires this Perl version or later
  13. #############################################################################
  14. =head1 NAME
  15. Pod::Parser - base class for creating POD filters and translators
  16. =head1 SYNOPSIS
  17. use Pod::Parser;
  18. package MyParser;
  19. @ISA = qw(Pod::Parser);
  20. sub command {
  21. my ($parser, $command, $paragraph, $line_num) = @_;
  22. ## Interpret the command and its text; sample actions might be:
  23. if ($command eq 'head1') { ... }
  24. elsif ($command eq 'head2') { ... }
  25. ## ... other commands and their actions
  26. my $out_fh = $parser->output_handle();
  27. my $expansion = $parser->interpolate($paragraph, $line_num);
  28. print $out_fh $expansion;
  29. }
  30. sub verbatim {
  31. my ($parser, $paragraph, $line_num) = @_;
  32. ## Format verbatim paragraph; sample actions might be:
  33. my $out_fh = $parser->output_handle();
  34. print $out_fh $paragraph;
  35. }
  36. sub textblock {
  37. my ($parser, $paragraph, $line_num) = @_;
  38. ## Translate/Format this block of text; sample actions might be:
  39. my $out_fh = $parser->output_handle();
  40. my $expansion = $parser->interpolate($paragraph, $line_num);
  41. print $out_fh $expansion;
  42. }
  43. sub interior_sequence {
  44. my ($parser, $seq_command, $seq_argument) = @_;
  45. ## Expand an interior sequence; sample actions might be:
  46. return "*$seq_argument*" if ($seq_command eq 'B');
  47. return "`$seq_argument'" if ($seq_command eq 'C');
  48. return "_${seq_argument}_'" if ($seq_command eq 'I');
  49. ## ... other sequence commands and their resulting text
  50. }
  51. package main;
  52. ## Create a parser object and have it parse file whose name was
  53. ## given on the command-line (use STDIN if no files were given).
  54. $parser = new MyParser();
  55. $parser->parse_from_filehandle(\*STDIN) if (@ARGV == 0);
  56. for (@ARGV) { $parser->parse_from_file($_); }
  57. =head1 REQUIRES
  58. perl5.005, Pod::InputObjects, Exporter, Symbol, Carp
  59. =head1 EXPORTS
  60. Nothing.
  61. =head1 DESCRIPTION
  62. B<Pod::Parser> is a base class for creating POD filters and translators.
  63. It handles most of the effort involved with parsing the POD sections
  64. from an input stream, leaving subclasses free to be concerned only with
  65. performing the actual translation of text.
  66. B<Pod::Parser> parses PODs, and makes method calls to handle the various
  67. components of the POD. Subclasses of B<Pod::Parser> override these methods
  68. to translate the POD into whatever output format they desire.
  69. =head1 QUICK OVERVIEW
  70. To create a POD filter for translating POD documentation into some other
  71. format, you create a subclass of B<Pod::Parser> which typically overrides
  72. just the base class implementation for the following methods:
  73. =over 2
  74. =item *
  75. B<command()>
  76. =item *
  77. B<verbatim()>
  78. =item *
  79. B<textblock()>
  80. =item *
  81. B<interior_sequence()>
  82. =back
  83. You may also want to override the B<begin_input()> and B<end_input()>
  84. methods for your subclass (to perform any needed per-file and/or
  85. per-document initialization or cleanup).
  86. If you need to perform any preprocesssing of input before it is parsed
  87. you may want to override one or more of B<preprocess_line()> and/or
  88. B<preprocess_paragraph()>.
  89. Sometimes it may be necessary to make more than one pass over the input
  90. files. If this is the case you have several options. You can make the
  91. first pass using B<Pod::Parser> and override your methods to store the
  92. intermediate results in memory somewhere for the B<end_pod()> method to
  93. process. You could use B<Pod::Parser> for several passes with an
  94. appropriate state variable to control the operation for each pass. If
  95. your input source can't be reset to start at the beginning, you can
  96. store it in some other structure as a string or an array and have that
  97. structure implement a B<getline()> method (which is all that
  98. B<parse_from_filehandle()> uses to read input).
  99. Feel free to add any member data fields you need to keep track of things
  100. like current font, indentation, horizontal or vertical position, or
  101. whatever else you like. Be sure to read L<"PRIVATE METHODS AND DATA">
  102. to avoid name collisions.
  103. For the most part, the B<Pod::Parser> base class should be able to
  104. do most of the input parsing for you and leave you free to worry about
  105. how to intepret the commands and translate the result.
  106. Note that all we have described here in this quick overview is the
  107. simplest most straightforward use of B<Pod::Parser> to do stream-based
  108. parsing. It is also possible to use the B<Pod::Parser::parse_text> function
  109. to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">.
  110. =head1 PARSING OPTIONS
  111. A I<parse-option> is simply a named option of B<Pod::Parser> with a
  112. value that corresponds to a certain specified behavior. These various
  113. behaviors of B<Pod::Parser> may be enabled/disabled by setting or
  114. or unsetting one or more I<parse-options> using the B<parseopts()> method.
  115. The set of currently accepted parse-options is as follows:
  116. =over 3
  117. =item B<-want_nonPODs> (default: unset)
  118. Normally (by default) B<Pod::Parser> will only provide access to
  119. the POD sections of the input. Input paragraphs that are not part
  120. of the POD-format documentation are not made available to the caller
  121. (not even using B<preprocess_paragraph()>). Setting this option to a
  122. non-empty, non-zero value will allow B<preprocess_paragraph()> to see
  123. non-POD sections of the input as well as POD sections. The B<cutting()>
  124. method can be used to determine if the corresponding paragraph is a POD
  125. paragraph, or some other input paragraph.
  126. =item B<-process_cut_cmd> (default: unset)
  127. Normally (by default) B<Pod::Parser> handles the C<=cut> POD directive
  128. by itself and does not pass it on to the caller for processing. Setting
  129. this option to a non-empty, non-zero value will cause B<Pod::Parser> to
  130. pass the C<=cut> directive to the caller just like any other POD command
  131. (and hence it may be processed by the B<command()> method).
  132. B<Pod::Parser> will still interpret the C<=cut> directive to mean that
  133. "cutting mode" has been (re)entered, but the caller will get a chance
  134. to capture the actual C<=cut> paragraph itself for whatever purpose
  135. it desires.
  136. =item B<-warnings> (default: unset)
  137. Normally (by default) B<Pod::Parser> recognizes a bare minimum of
  138. pod syntax errors and warnings and issues diagnostic messages
  139. for errors, but not for warnings. (Use B<Pod::Checker> to do more
  140. thorough checking of POD syntax.) Setting this option to a non-empty,
  141. non-zero value will cause B<Pod::Parser> to issue diagnostics for
  142. the few warnings it recognizes as well as the errors.
  143. =back
  144. Please see L<"parseopts()"> for a complete description of the interface
  145. for the setting and unsetting of parse-options.
  146. =cut
  147. #############################################################################
  148. use vars qw(@ISA);
  149. use strict;
  150. #use diagnostics;
  151. use Pod::InputObjects;
  152. use Carp;
  153. use Exporter;
  154. BEGIN {
  155. if ($] < 5.6) {
  156. require Symbol;
  157. import Symbol;
  158. }
  159. }
  160. @ISA = qw(Exporter);
  161. ## These "variables" are used as local "glob aliases" for performance
  162. use vars qw(%myData %myOpts @input_stack);
  163. #############################################################################
  164. =head1 RECOMMENDED SUBROUTINE/METHOD OVERRIDES
  165. B<Pod::Parser> provides several methods which most subclasses will probably
  166. want to override. These methods are as follows:
  167. =cut
  168. ##---------------------------------------------------------------------------
  169. =head1 B<command()>
  170. $parser->command($cmd,$text,$line_num,$pod_para);
  171. This method should be overridden by subclasses to take the appropriate
  172. action when a POD command paragraph (denoted by a line beginning with
  173. "=") is encountered. When such a POD directive is seen in the input,
  174. this method is called and is passed:
  175. =over 3
  176. =item C<$cmd>
  177. the name of the command for this POD paragraph
  178. =item C<$text>
  179. the paragraph text for the given POD paragraph command.
  180. =item C<$line_num>
  181. the line-number of the beginning of the paragraph
  182. =item C<$pod_para>
  183. a reference to a C<Pod::Paragraph> object which contains further
  184. information about the paragraph command (see L<Pod::InputObjects>
  185. for details).
  186. =back
  187. B<Note> that this method I<is> called for C<=pod> paragraphs.
  188. The base class implementation of this method simply treats the raw POD
  189. command as normal block of paragraph text (invoking the B<textblock()>
  190. method with the command paragraph).
  191. =cut
  192. sub command {
  193. my ($self, $cmd, $text, $line_num, $pod_para) = @_;
  194. ## Just treat this like a textblock
  195. $self->textblock($pod_para->raw_text(), $line_num, $pod_para);
  196. }
  197. ##---------------------------------------------------------------------------
  198. =head1 B<verbatim()>
  199. $parser->verbatim($text,$line_num,$pod_para);
  200. This method may be overridden by subclasses to take the appropriate
  201. action when a block of verbatim text is encountered. It is passed the
  202. following parameters:
  203. =over 3
  204. =item C<$text>
  205. the block of text for the verbatim paragraph
  206. =item C<$line_num>
  207. the line-number of the beginning of the paragraph
  208. =item C<$pod_para>
  209. a reference to a C<Pod::Paragraph> object which contains further
  210. information about the paragraph (see L<Pod::InputObjects>
  211. for details).
  212. =back
  213. The base class implementation of this method simply prints the textblock
  214. (unmodified) to the output filehandle.
  215. =cut
  216. sub verbatim {
  217. my ($self, $text, $line_num, $pod_para) = @_;
  218. my $out_fh = $self->{_OUTPUT};
  219. print $out_fh $text;
  220. }
  221. ##---------------------------------------------------------------------------
  222. =head1 B<textblock()>
  223. $parser->textblock($text,$line_num,$pod_para);
  224. This method may be overridden by subclasses to take the appropriate
  225. action when a normal block of POD text is encountered (although the base
  226. class method will usually do what you want). It is passed the following
  227. parameters:
  228. =over 3
  229. =item C<$text>
  230. the block of text for the a POD paragraph
  231. =item C<$line_num>
  232. the line-number of the beginning of the paragraph
  233. =item C<$pod_para>
  234. a reference to a C<Pod::Paragraph> object which contains further
  235. information about the paragraph (see L<Pod::InputObjects>
  236. for details).
  237. =back
  238. In order to process interior sequences, subclasses implementations of
  239. this method will probably want to invoke either B<interpolate()> or
  240. B<parse_text()>, passing it the text block C<$text>, and the corresponding
  241. line number in C<$line_num>, and then perform any desired processing upon
  242. the returned result.
  243. The base class implementation of this method simply prints the text block
  244. as it occurred in the input stream).
  245. =cut
  246. sub textblock {
  247. my ($self, $text, $line_num, $pod_para) = @_;
  248. my $out_fh = $self->{_OUTPUT};
  249. print $out_fh $self->interpolate($text, $line_num);
  250. }
  251. ##---------------------------------------------------------------------------
  252. =head1 B<interior_sequence()>
  253. $parser->interior_sequence($seq_cmd,$seq_arg,$pod_seq);
  254. This method should be overridden by subclasses to take the appropriate
  255. action when an interior sequence is encountered. An interior sequence is
  256. an embedded command within a block of text which appears as a command
  257. name (usually a single uppercase character) followed immediately by a
  258. string of text which is enclosed in angle brackets. This method is
  259. passed the sequence command C<$seq_cmd> and the corresponding text
  260. C<$seq_arg>. It is invoked by the B<interpolate()> method for each interior
  261. sequence that occurs in the string that it is passed. It should return
  262. the desired text string to be used in place of the interior sequence.
  263. The C<$pod_seq> argument is a reference to a C<Pod::InteriorSequence>
  264. object which contains further information about the interior sequence.
  265. Please see L<Pod::InputObjects> for details if you need to access this
  266. additional information.
  267. Subclass implementations of this method may wish to invoke the
  268. B<nested()> method of C<$pod_seq> to see if it is nested inside
  269. some other interior-sequence (and if so, which kind).
  270. The base class implementation of the B<interior_sequence()> method
  271. simply returns the raw text of the interior sequence (as it occurred
  272. in the input) to the caller.
  273. =cut
  274. sub interior_sequence {
  275. my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
  276. ## Just return the raw text of the interior sequence
  277. return $pod_seq->raw_text();
  278. }
  279. #############################################################################
  280. =head1 OPTIONAL SUBROUTINE/METHOD OVERRIDES
  281. B<Pod::Parser> provides several methods which subclasses may want to override
  282. to perform any special pre/post-processing. These methods do I<not> have to
  283. be overridden, but it may be useful for subclasses to take advantage of them.
  284. =cut
  285. ##---------------------------------------------------------------------------
  286. =head1 B<new()>
  287. my $parser = Pod::Parser->new();
  288. This is the constructor for B<Pod::Parser> and its subclasses. You
  289. I<do not> need to override this method! It is capable of constructing
  290. subclass objects as well as base class objects, provided you use
  291. any of the following constructor invocation styles:
  292. my $parser1 = MyParser->new();
  293. my $parser2 = new MyParser();
  294. my $parser3 = $parser2->new();
  295. where C<MyParser> is some subclass of B<Pod::Parser>.
  296. Using the syntax C<MyParser::new()> to invoke the constructor is I<not>
  297. recommended, but if you insist on being able to do this, then the
  298. subclass I<will> need to override the B<new()> constructor method. If
  299. you do override the constructor, you I<must> be sure to invoke the
  300. B<initialize()> method of the newly blessed object.
  301. Using any of the above invocations, the first argument to the
  302. constructor is always the corresponding package name (or object
  303. reference). No other arguments are required, but if desired, an
  304. associative array (or hash-table) my be passed to the B<new()>
  305. constructor, as in:
  306. my $parser1 = MyParser->new( MYDATA => $value1, MOREDATA => $value2 );
  307. my $parser2 = new MyParser( -myflag => 1 );
  308. All arguments passed to the B<new()> constructor will be treated as
  309. key/value pairs in a hash-table. The newly constructed object will be
  310. initialized by copying the contents of the given hash-table (which may
  311. have been empty). The B<new()> constructor for this class and all of its
  312. subclasses returns a blessed reference to the initialized object (hash-table).
  313. =cut
  314. sub new {
  315. ## Determine if we were called via an object-ref or a classname
  316. my $this = shift;
  317. my $class = ref($this) || $this;
  318. ## Any remaining arguments are treated as initial values for the
  319. ## hash that is used to represent this object.
  320. my %params = @_;
  321. my $self = { %params };
  322. ## Bless ourselves into the desired class and perform any initialization
  323. bless $self, $class;
  324. $self->initialize();
  325. return $self;
  326. }
  327. ##---------------------------------------------------------------------------
  328. =head1 B<initialize()>
  329. $parser->initialize();
  330. This method performs any necessary object initialization. It takes no
  331. arguments (other than the object instance of course, which is typically
  332. copied to a local variable named C<$self>). If subclasses override this
  333. method then they I<must> be sure to invoke C<$self-E<gt>SUPER::initialize()>.
  334. =cut
  335. sub initialize {
  336. #my $self = shift;
  337. #return;
  338. }
  339. ##---------------------------------------------------------------------------
  340. =head1 B<begin_pod()>
  341. $parser->begin_pod();
  342. This method is invoked at the beginning of processing for each POD
  343. document that is encountered in the input. Subclasses should override
  344. this method to perform any per-document initialization.
  345. =cut
  346. sub begin_pod {
  347. #my $self = shift;
  348. #return;
  349. }
  350. ##---------------------------------------------------------------------------
  351. =head1 B<begin_input()>
  352. $parser->begin_input();
  353. This method is invoked by B<parse_from_filehandle()> immediately I<before>
  354. processing input from a filehandle. The base class implementation does
  355. nothing, however, subclasses may override it to perform any per-file
  356. initializations.
  357. Note that if multiple files are parsed for a single POD document
  358. (perhaps the result of some future C<=include> directive) this method
  359. is invoked for every file that is parsed. If you wish to perform certain
  360. initializations once per document, then you should use B<begin_pod()>.
  361. =cut
  362. sub begin_input {
  363. #my $self = shift;
  364. #return;
  365. }
  366. ##---------------------------------------------------------------------------
  367. =head1 B<end_input()>
  368. $parser->end_input();
  369. This method is invoked by B<parse_from_filehandle()> immediately I<after>
  370. processing input from a filehandle. The base class implementation does
  371. nothing, however, subclasses may override it to perform any per-file
  372. cleanup actions.
  373. Please note that if multiple files are parsed for a single POD document
  374. (perhaps the result of some kind of C<=include> directive) this method
  375. is invoked for every file that is parsed. If you wish to perform certain
  376. cleanup actions once per document, then you should use B<end_pod()>.
  377. =cut
  378. sub end_input {
  379. #my $self = shift;
  380. #return;
  381. }
  382. ##---------------------------------------------------------------------------
  383. =head1 B<end_pod()>
  384. $parser->end_pod();
  385. This method is invoked at the end of processing for each POD document
  386. that is encountered in the input. Subclasses should override this method
  387. to perform any per-document finalization.
  388. =cut
  389. sub end_pod {
  390. #my $self = shift;
  391. #return;
  392. }
  393. ##---------------------------------------------------------------------------
  394. =head1 B<preprocess_line()>
  395. $textline = $parser->preprocess_line($text, $line_num);
  396. This method should be overridden by subclasses that wish to perform
  397. any kind of preprocessing for each I<line> of input (I<before> it has
  398. been determined whether or not it is part of a POD paragraph). The
  399. parameter C<$text> is the input line; and the parameter C<$line_num> is
  400. the line number of the corresponding text line.
  401. The value returned should correspond to the new text to use in its
  402. place. If the empty string or an undefined value is returned then no
  403. further processing will be performed for this line.
  404. Please note that the B<preprocess_line()> method is invoked I<before>
  405. the B<preprocess_paragraph()> method. After all (possibly preprocessed)
  406. lines in a paragraph have been assembled together and it has been
  407. determined that the paragraph is part of the POD documentation from one
  408. of the selected sections, then B<preprocess_paragraph()> is invoked.
  409. The base class implementation of this method returns the given text.
  410. =cut
  411. sub preprocess_line {
  412. my ($self, $text, $line_num) = @_;
  413. return $text;
  414. }
  415. ##---------------------------------------------------------------------------
  416. =head1 B<preprocess_paragraph()>
  417. $textblock = $parser->preprocess_paragraph($text, $line_num);
  418. This method should be overridden by subclasses that wish to perform any
  419. kind of preprocessing for each block (paragraph) of POD documentation
  420. that appears in the input stream. The parameter C<$text> is the POD
  421. paragraph from the input file; and the parameter C<$line_num> is the
  422. line number for the beginning of the corresponding paragraph.
  423. The value returned should correspond to the new text to use in its
  424. place If the empty string is returned or an undefined value is
  425. returned, then the given C<$text> is ignored (not processed).
  426. This method is invoked after gathering up all the lines in a paragraph
  427. and after determining the cutting state of the paragraph,
  428. but before trying to further parse or interpret them. After
  429. B<preprocess_paragraph()> returns, the current cutting state (which
  430. is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
  431. to true then input text (including the given C<$text>) is cut (not
  432. processed) until the next POD directive is encountered.
  433. Please note that the B<preprocess_line()> method is invoked I<before>
  434. the B<preprocess_paragraph()> method. After all (possibly preprocessed)
  435. lines in a paragraph have been assembled together and either it has been
  436. determined that the paragraph is part of the POD documentation from one
  437. of the selected sections or the C<-want_nonPODs> option is true,
  438. then B<preprocess_paragraph()> is invoked.
  439. The base class implementation of this method returns the given text.
  440. =cut
  441. sub preprocess_paragraph {
  442. my ($self, $text, $line_num) = @_;
  443. return $text;
  444. }
  445. #############################################################################
  446. =head1 METHODS FOR PARSING AND PROCESSING
  447. B<Pod::Parser> provides several methods to process input text. These
  448. methods typically won't need to be overridden (and in some cases they
  449. can't be overridden), but subclasses may want to invoke them to exploit
  450. their functionality.
  451. =cut
  452. ##---------------------------------------------------------------------------
  453. =head1 B<parse_text()>
  454. $ptree1 = $parser->parse_text($text, $line_num);
  455. $ptree2 = $parser->parse_text({%opts}, $text, $line_num);
  456. $ptree3 = $parser->parse_text(\%opts, $text, $line_num);
  457. This method is useful if you need to perform your own interpolation
  458. of interior sequences and can't rely upon B<interpolate> to expand
  459. them in simple bottom-up order order.
  460. The parameter C<$text> is a string or block of text to be parsed
  461. for interior sequences; and the parameter C<$line_num> is the
  462. line number curresponding to the beginning of C<$text>.
  463. B<parse_text()> will parse the given text into a parse-tree of "nodes."
  464. and interior-sequences. Each "node" in the parse tree is either a
  465. text-string, or a B<Pod::InteriorSequence>. The result returned is a
  466. parse-tree of type B<Pod::ParseTree>. Please see L<Pod::InputObjects>
  467. for more information about B<Pod::InteriorSequence> and B<Pod::ParseTree>.
  468. If desired, an optional hash-ref may be specified as the first argument
  469. to customize certain aspects of the parse-tree that is created and
  470. returned. The set of recognized option keywords are:
  471. =over 3
  472. =item B<-expand_seq> =E<gt> I<code-ref>|I<method-name>
  473. Normally, the parse-tree returned by B<parse_text()> will contain an
  474. unexpanded C<Pod::InteriorSequence> object for each interior-sequence
  475. encountered. Specifying B<-expand_seq> tells B<parse_text()> to "expand"
  476. every interior-sequence it sees by invoking the referenced function
  477. (or named method of the parser object) and using the return value as the
  478. expanded result.
  479. If a subroutine reference was given, it is invoked as:
  480. &$code_ref( $parser, $sequence )
  481. and if a method-name was given, it is invoked as:
  482. $parser->method_name( $sequence )
  483. where C<$parser> is a reference to the parser object, and C<$sequence>
  484. is a reference to the interior-sequence object.
  485. [I<NOTE>: If the B<interior_sequence()> method is specified, then it is
  486. invoked according to the interface specified in L<"interior_sequence()">].
  487. =item B<-expand_text> =E<gt> I<code-ref>|I<method-name>
  488. Normally, the parse-tree returned by B<parse_text()> will contain a
  489. text-string for each contiguous sequence of characters outside of an
  490. interior-sequence. Specifying B<-expand_text> tells B<parse_text()> to
  491. "preprocess" every such text-string it sees by invoking the referenced
  492. function (or named method of the parser object) and using the return value
  493. as the preprocessed (or "expanded") result. [Note that if the result is
  494. an interior-sequence, then it will I<not> be expanded as specified by the
  495. B<-expand_seq> option; Any such recursive expansion needs to be handled by
  496. the specified callback routine.]
  497. If a subroutine reference was given, it is invoked as:
  498. &$code_ref( $parser, $text, $ptree_node )
  499. and if a method-name was given, it is invoked as:
  500. $parser->method_name( $text, $ptree_node )
  501. where C<$parser> is a reference to the parser object, C<$text> is the
  502. text-string encountered, and C<$ptree_node> is a reference to the current
  503. node in the parse-tree (usually an interior-sequence object or else the
  504. top-level node of the parse-tree).
  505. =item B<-expand_ptree> =E<gt> I<code-ref>|I<method-name>
  506. Rather than returning a C<Pod::ParseTree>, pass the parse-tree as an
  507. argument to the referenced subroutine (or named method of the parser
  508. object) and return the result instead of the parse-tree object.
  509. If a subroutine reference was given, it is invoked as:
  510. &$code_ref( $parser, $ptree )
  511. and if a method-name was given, it is invoked as:
  512. $parser->method_name( $ptree )
  513. where C<$parser> is a reference to the parser object, and C<$ptree>
  514. is a reference to the parse-tree object.
  515. =back
  516. =cut
  517. sub parse_text {
  518. my $self = shift;
  519. local $_ = '';
  520. ## Get options and set any defaults
  521. my %opts = (ref $_[0]) ? %{ shift() } : ();
  522. my $expand_seq = $opts{'-expand_seq'} || undef;
  523. my $expand_text = $opts{'-expand_text'} || undef;
  524. my $expand_ptree = $opts{'-expand_ptree'} || undef;
  525. my $text = shift;
  526. my $line = shift;
  527. my $file = $self->input_file();
  528. my $cmd = "";
  529. ## Convert method calls into closures, for our convenience
  530. my $xseq_sub = $expand_seq;
  531. my $xtext_sub = $expand_text;
  532. my $xptree_sub = $expand_ptree;
  533. if (defined $expand_seq and $expand_seq eq 'interior_sequence') {
  534. ## If 'interior_sequence' is the method to use, we have to pass
  535. ## more than just the sequence object, we also need to pass the
  536. ## sequence name and text.
  537. $xseq_sub = sub {
  538. my ($self, $iseq) = @_;
  539. my $args = join("", $iseq->parse_tree->children);
  540. return $self->interior_sequence($iseq->name, $args, $iseq);
  541. };
  542. }
  543. ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) };
  544. ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) };
  545. ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) };
  546. ## Keep track of the "current" interior sequence, and maintain a stack
  547. ## of "in progress" sequences.
  548. ##
  549. ## NOTE that we push our own "accumulator" at the very beginning of the
  550. ## stack. It's really a parse-tree, not a sequence; but it implements
  551. ## the methods we need so we can use it to gather-up all the sequences
  552. ## and strings we parse. Thus, by the end of our parsing, it should be
  553. ## the only thing left on our stack and all we have to do is return it!
  554. ##
  555. my $seq = Pod::ParseTree->new();
  556. my @seq_stack = ($seq);
  557. my ($ldelim, $rdelim) = ('', '');
  558. ## Iterate over all sequence starts text (NOTE: split with
  559. ## capturing parens keeps the delimiters)
  560. $_ = $text;
  561. my @tokens = split /([A-Z]<(?:<+\s)?)/;
  562. while ( @tokens ) {
  563. $_ = shift @tokens;
  564. ## Look for the beginning of a sequence
  565. if ( /^([A-Z])(<(?:<+\s)?)$/ ) {
  566. ## Push a new sequence onto the stack of those "in-progress"
  567. ($cmd, $ldelim) = ($1, $2);
  568. $seq = Pod::InteriorSequence->new(
  569. -name => $cmd,
  570. -ldelim => $ldelim, -rdelim => '',
  571. -file => $file, -line => $line
  572. );
  573. $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
  574. (@seq_stack > 1) and $seq->nested($seq_stack[-1]);
  575. push @seq_stack, $seq;
  576. }
  577. ## Look for sequence ending
  578. elsif ( @seq_stack > 1 ) {
  579. ## Make sure we match the right kind of closing delimiter
  580. my ($seq_end, $post_seq) = ("", "");
  581. if ( ($ldelim eq '<' and /\A(.*?)(>)/s)
  582. or /\A(.*?)(\s+$rdelim)/s )
  583. {
  584. ## Found end-of-sequence, capture the interior and the
  585. ## closing the delimiter, and put the rest back on the
  586. ## token-list
  587. $post_seq = substr($_, length($1) + length($2));
  588. ($_, $seq_end) = ($1, $2);
  589. (length $post_seq) and unshift @tokens, $post_seq;
  590. }
  591. if (length) {
  592. ## In the middle of a sequence, append this text to it, and
  593. ## dont forget to "expand" it if that's what the caller wanted
  594. $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
  595. $_ .= $seq_end;
  596. }
  597. if (length $seq_end) {
  598. ## End of current sequence, record terminating delimiter
  599. $seq->rdelim($seq_end);
  600. ## Pop it off the stack of "in progress" sequences
  601. pop @seq_stack;
  602. ## Append result to its parent in current parse tree
  603. $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq)
  604. : $seq);
  605. ## Remember the current cmd-name and left-delimiter
  606. $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : '';
  607. $ldelim = (@seq_stack > 1) ? $seq_stack[-1]->ldelim : '';
  608. $ldelim =~ s/\s+$//, ($rdelim = $ldelim) =~ tr/</>/;
  609. }
  610. }
  611. elsif (length) {
  612. ## In the middle of a sequence, append this text to it, and
  613. ## dont forget to "expand" it if that's what the caller wanted
  614. $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_);
  615. }
  616. ## Keep track of line count
  617. $line += tr/\n//;
  618. ## Remember the "current" sequence
  619. $seq = $seq_stack[-1];
  620. }
  621. ## Handle unterminated sequences
  622. my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef;
  623. while (@seq_stack > 1) {
  624. ($cmd, $file, $line) = ($seq->name, $seq->file_line);
  625. $ldelim = $seq->ldelim;
  626. ($rdelim = $ldelim) =~ tr/</>/;
  627. $rdelim =~ s/^(\S+)(\s*)$/$2$1/;
  628. pop @seq_stack;
  629. my $errmsg = "*** ERROR: unterminated ${cmd}${ldelim}...${rdelim}".
  630. " at line $line in file $file\n";
  631. (ref $errorsub) and &{$errorsub}($errmsg)
  632. or (defined $errorsub) and $self->$errorsub($errmsg)
  633. or warn($errmsg);
  634. $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq);
  635. $seq = $seq_stack[-1];
  636. }
  637. ## Return the resulting parse-tree
  638. my $ptree = (pop @seq_stack)->parse_tree;
  639. return $expand_ptree ? &$xptree_sub($self, $ptree) : $ptree;
  640. }
  641. ##---------------------------------------------------------------------------
  642. =head1 B<interpolate()>
  643. $textblock = $parser->interpolate($text, $line_num);
  644. This method translates all text (including any embedded interior sequences)
  645. in the given text string C<$text> and returns the interpolated result. The
  646. parameter C<$line_num> is the line number corresponding to the beginning
  647. of C<$text>.
  648. B<interpolate()> merely invokes a private method to recursively expand
  649. nested interior sequences in bottom-up order (innermost sequences are
  650. expanded first). If there is a need to expand nested sequences in
  651. some alternate order, use B<parse_text> instead.
  652. =cut
  653. sub interpolate {
  654. my($self, $text, $line_num) = @_;
  655. my %parse_opts = ( -expand_seq => 'interior_sequence' );
  656. my $ptree = $self->parse_text( \%parse_opts, $text, $line_num );
  657. return join "", $ptree->children();
  658. }
  659. ##---------------------------------------------------------------------------
  660. =begin __PRIVATE__
  661. =head1 B<parse_paragraph()>
  662. $parser->parse_paragraph($text, $line_num);
  663. This method takes the text of a POD paragraph to be processed, along
  664. with its corresponding line number, and invokes the appropriate method
  665. (one of B<command()>, B<verbatim()>, or B<textblock()>).
  666. For performance reasons, this method is invoked directly without any
  667. dynamic lookup; Hence subclasses may I<not> override it!
  668. =end __PRIVATE__
  669. =cut
  670. sub parse_paragraph {
  671. my ($self, $text, $line_num) = @_;
  672. local *myData = $self; ## alias to avoid deref-ing overhead
  673. local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
  674. local $_;
  675. ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
  676. my $wantNonPods = $myOpts{'-want_nonPODs'};
  677. ## Update cutting status
  678. $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
  679. ## Perform any desired preprocessing if we wanted it this early
  680. $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num);
  681. ## Ignore up until next POD directive if we are cutting
  682. return if $myData{_CUTTING};
  683. ## Now we know this is block of text in a POD section!
  684. ##-----------------------------------------------------------------
  685. ## This is a hook (hack ;-) for Pod::Select to do its thing without
  686. ## having to override methods, but also without Pod::Parser assuming
  687. ## $self is an instance of Pod::Select (if the _SELECTED_SECTIONS
  688. ## field exists then we assume there is an is_selected() method for
  689. ## us to invoke (calling $self->can('is_selected') could verify this
  690. ## but that is more overhead than I want to incur)
  691. ##-----------------------------------------------------------------
  692. ## Ignore this block if it isnt in one of the selected sections
  693. if (exists $myData{_SELECTED_SECTIONS}) {
  694. $self->is_selected($text) or return ($myData{_CUTTING} = 1);
  695. }
  696. ## If we havent already, perform any desired preprocessing and
  697. ## then re-check the "cutting" state
  698. unless ($wantNonPods) {
  699. $text = $self->preprocess_paragraph($text, $line_num);
  700. return 1 unless ((defined $text) and (length $text));
  701. return 1 if ($myData{_CUTTING});
  702. }
  703. ## Look for one of the three types of paragraphs
  704. my ($pfx, $cmd, $arg, $sep) = ('', '', '', '');
  705. my $pod_para = undef;
  706. if ($text =~ /^(={1,2})(?=\S)/) {
  707. ## Looks like a command paragraph. Capture the command prefix used
  708. ## ("=" or "=="), as well as the command-name, its paragraph text,
  709. ## and whatever sequence of characters was used to separate them
  710. $pfx = $1;
  711. $_ = substr($text, length $pfx);
  712. ($cmd, $sep, $text) = split /(\s+)/, $_, 2;
  713. ## If this is a "cut" directive then we dont need to do anything
  714. ## except return to "cutting" mode.
  715. if ($cmd eq 'cut') {
  716. $myData{_CUTTING} = 1;
  717. return unless $myOpts{'-process_cut_cmd'};
  718. }
  719. }
  720. ## Save the attributes indicating how the command was specified.
  721. $pod_para = new Pod::Paragraph(
  722. -name => $cmd,
  723. -text => $text,
  724. -prefix => $pfx,
  725. -separator => $sep,
  726. -file => $myData{_INFILE},
  727. -line => $line_num
  728. );
  729. # ## Invoke appropriate callbacks
  730. # if (exists $myData{_CALLBACKS}) {
  731. # ## Look through the callback list, invoke callbacks,
  732. # ## then see if we need to do the default actions
  733. # ## (invoke_callbacks will return true if we do).
  734. # return 1 unless $self->invoke_callbacks($cmd, $text, $line_num, $pod_para);
  735. # }
  736. if (length $cmd) {
  737. ## A command paragraph
  738. $self->command($cmd, $text, $line_num, $pod_para);
  739. }
  740. elsif ($text =~ /^\s+/) {
  741. ## Indented text - must be a verbatim paragraph
  742. $self->verbatim($text, $line_num, $pod_para);
  743. }
  744. else {
  745. ## Looks like an ordinary block of text
  746. $self->textblock($text, $line_num, $pod_para);
  747. }
  748. return 1;
  749. }
  750. ##---------------------------------------------------------------------------
  751. =head1 B<parse_from_filehandle()>
  752. $parser->parse_from_filehandle($in_fh,$out_fh);
  753. This method takes an input filehandle (which is assumed to already be
  754. opened for reading) and reads the entire input stream looking for blocks
  755. (paragraphs) of POD documentation to be processed. If no first argument
  756. is given the default input filehandle C<STDIN> is used.
  757. The C<$in_fh> parameter may be any object that provides a B<getline()>
  758. method to retrieve a single line of input text (hence, an appropriate
  759. wrapper object could be used to parse PODs from a single string or an
  760. array of strings).
  761. Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
  762. into paragraphs or "blocks" (which are separated by lines containing
  763. nothing but whitespace). For each block of POD documentation
  764. encountered it will invoke a method to parse the given paragraph.
  765. If a second argument is given then it should correspond to a filehandle where
  766. output should be sent (otherwise the default output filehandle is
  767. C<STDOUT> if no output filehandle is currently in use).
  768. B<NOTE:> For performance reasons, this method caches the input stream at
  769. the top of the stack in a local variable. Any attempts by clients to
  770. change the stack contents during processing when in the midst executing
  771. of this method I<will not affect> the input stream used by the current
  772. invocation of this method.
  773. This method does I<not> usually need to be overridden by subclasses.
  774. =cut
  775. sub parse_from_filehandle {
  776. my $self = shift;
  777. my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
  778. my ($in_fh, $out_fh) = @_;
  779. $in_fh = \*STDIN unless ($in_fh);
  780. local *myData = $self; ## alias to avoid deref-ing overhead
  781. local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options
  782. local $_;
  783. ## Put this stream at the top of the stack and do beginning-of-input
  784. ## processing. NOTE that $in_fh might be reset during this process.
  785. my $topstream = $self->_push_input_stream($in_fh, $out_fh);
  786. (exists $opts{-cutting}) and $self->cutting( $opts{-cutting} );
  787. ## Initialize line/paragraph
  788. my ($textline, $paragraph) = ('', '');
  789. my ($nlines, $plines) = (0, 0);
  790. ## Use <$fh> instead of $fh->getline where possible (for speed)
  791. $_ = ref $in_fh;
  792. my $tied_fh = (/^(?:GLOB|FileHandle|IO::\w+)$/ or tied $in_fh);
  793. ## Read paragraphs line-by-line
  794. while (defined ($textline = $tied_fh ? <$in_fh> : $in_fh->getline)) {
  795. $textline = $self->preprocess_line($textline, ++$nlines);
  796. next unless ((defined $textline) && (length $textline));
  797. $_ = $paragraph; ## save previous contents
  798. if ((! length $paragraph) && ($textline =~ /^==/)) {
  799. ## '==' denotes a one-line command paragraph
  800. $paragraph = $textline;
  801. $plines = 1;
  802. $textline = '';
  803. } else {
  804. ## Append this line to the current paragraph
  805. $paragraph .= $textline;
  806. ++$plines;
  807. }
  808. ## See if this line is blank and ends the current paragraph.
  809. ## If it isnt, then keep iterating until it is.
  810. next unless (($textline =~ /^([^\S\r\n]*)[\r\n]*$/)
  811. && (length $paragraph));
  812. ## Issue a warning about any non-empty blank lines
  813. if (length($1) > 0 and $myOpts{'-warnings'} and ! $myData{_CUTTING}) {
  814. my $errorsub = $self->errorsub();
  815. my $file = $self->input_file();
  816. my $errmsg = "*** WARNING: line containing nothing but whitespace".
  817. " in paragraph at line $nlines in file $file\n";
  818. (ref $errorsub) and &{$errorsub}($errmsg)
  819. or (defined $errorsub) and $self->$errorsub($errmsg)
  820. or warn($errmsg);
  821. }
  822. ## Now process the paragraph
  823. parse_paragraph($self, $paragraph, ($nlines - $plines) + 1);
  824. $paragraph = '';
  825. $plines = 0;
  826. }
  827. ## Dont forget about the last paragraph in the file
  828. if (length $paragraph) {
  829. parse_paragraph($self, $paragraph, ($nlines - $plines) + 1)
  830. }
  831. ## Now pop the input stream off the top of the input stack.
  832. $self->_pop_input_stream();
  833. }
  834. ##---------------------------------------------------------------------------
  835. =head1 B<parse_from_file()>
  836. $parser->parse_from_file($filename,$outfile);
  837. This method takes a filename and does the following:
  838. =over 2
  839. =item *
  840. opens the input and output files for reading
  841. (creating the appropriate filehandles)
  842. =item *
  843. invokes the B<parse_from_filehandle()> method passing it the
  844. corresponding input and output filehandles.
  845. =item *
  846. closes the input and output files.
  847. =back
  848. If the special input filename "-" or "<&STDIN" is given then the STDIN
  849. filehandle is used for input (and no open or close is performed). If no
  850. input filename is specified then "-" is implied.
  851. If a second argument is given then it should be the name of the desired
  852. output file. If the special output filename "-" or ">&STDOUT" is given
  853. then the STDOUT filehandle is used for output (and no open or close is
  854. performed). If the special output filename ">&STDERR" is given then the
  855. STDERR filehandle is used for output (and no open or close is
  856. performed). If no output filehandle is currently in use and no output
  857. filename is specified, then "-" is implied.
  858. This method does I<not> usually need to be overridden by subclasses.
  859. =cut
  860. sub parse_from_file {
  861. my $self = shift;
  862. my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
  863. my ($infile, $outfile) = @_;
  864. my ($in_fh, $out_fh) = (gensym, gensym) if ($] < 5.6);
  865. my ($close_input, $close_output) = (0, 0);
  866. local *myData = $self;
  867. local $_;
  868. ## Is $infile a filename or a (possibly implied) filehandle
  869. $infile = '-' unless ((defined $infile) && (length $infile));
  870. if (($infile eq '-') || ($infile =~ /^<&(STDIN|0)$/i)) {
  871. ## Not a filename, just a string implying STDIN
  872. $myData{_INFILE} = "<standard input>";
  873. $in_fh = \*STDIN;
  874. }
  875. elsif (ref $infile) {
  876. ## Must be a filehandle-ref (or else assume its a ref to an object
  877. ## that supports the common IO read operations).
  878. $myData{_INFILE} = ${$infile};
  879. $in_fh = $infile;
  880. }
  881. else {
  882. ## We have a filename, open it for reading
  883. $myData{_INFILE} = $infile;
  884. open($in_fh, "< $infile") or
  885. croak "Can't open $infile for reading: $!\n";
  886. $close_input = 1;
  887. }
  888. ## NOTE: we need to be *very* careful when "defaulting" the output
  889. ## file. We only want to use a default if this is the beginning of
  890. ## the entire document (but *not* if this is an included file). We
  891. ## determine this by seeing if the input stream stack has been set-up
  892. ## already
  893. ##
  894. unless ((defined $outfile) && (length $outfile)) {
  895. (defined $myData{_TOP_STREAM}) && ($out_fh = $myData{_OUTPUT})
  896. || ($outfile = '-');
  897. }
  898. ## Is $outfile a filename or a (possibly implied) filehandle
  899. if ((defined $outfile) && (length $outfile)) {
  900. if (($outfile eq '-') || ($outfile =~ /^>&?(?:STDOUT|1)$/i)) {
  901. ## Not a filename, just a string implying STDOUT
  902. $myData{_OUTFILE} = "<standard output>";
  903. $out_fh = \*STDOUT;
  904. }
  905. elsif ($outfile =~ /^>&(STDERR|2)$/i) {
  906. ## Not a filename, just a string implying STDERR
  907. $myData{_OUTFILE} = "<standard error>";
  908. $out_fh = \*STDERR;
  909. }
  910. elsif (ref $outfile) {
  911. ## Must be a filehandle-ref (or else assume its a ref to an
  912. ## object that supports the common IO write operations).
  913. $myData{_OUTFILE} = ${$outfile};
  914. $out_fh = $outfile;
  915. }
  916. else {
  917. ## We have a filename, open it for writing
  918. $myData{_OUTFILE} = $outfile;
  919. (-d $outfile) and croak "$outfile is a directory, not POD input!\n";
  920. open($out_fh, "> $outfile") or
  921. croak "Can't open $outfile for writing: $!\n";
  922. $close_output = 1;
  923. }
  924. }
  925. ## Whew! That was a lot of work to set up reasonably/robust behavior
  926. ## in the case of a non-filename for reading and writing. Now we just
  927. ## have to parse the input and close the handles when we're finished.
  928. $self->parse_from_filehandle(\%opts, $in_fh, $out_fh);
  929. $close_input and
  930. close($in_fh) || croak "Can't close $infile after reading: $!\n";
  931. $close_output and
  932. close($out_fh) || croak "Can't close $outfile after writing: $!\n";
  933. }
  934. #############################################################################
  935. =head1 ACCESSOR METHODS
  936. Clients of B<Pod::Parser> should use the following methods to access
  937. instance data fields:
  938. =cut
  939. ##---------------------------------------------------------------------------
  940. =head1 B<errorsub()>
  941. $parser->errorsub("method_name");
  942. $parser->errorsub(\&warn_user);
  943. $parser->errorsub(sub { print STDERR, @_ });
  944. Specifies the method or subroutine to use when printing error messages
  945. about POD syntax. The supplied method/subroutine I<must> return TRUE upon
  946. successful printing of the message. If C<undef> is given, then the B<warn>
  947. builtin is used to issue error messages (this is the default behavior).
  948. my $errorsub = $parser->errorsub()
  949. my $errmsg = "This is an error message!\n"
  950. (ref $errorsub) and &{$errorsub}($errmsg)
  951. or (defined $errorsub) and $parser->$errorsub($errmsg)
  952. or warn($errmsg);
  953. Returns a method name, or else a reference to the user-supplied subroutine
  954. used to print error messages. Returns C<undef> if the B<warn> builtin
  955. is used to issue error messages (this is the default behavior).
  956. =cut
  957. sub errorsub {
  958. return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB};
  959. }
  960. ##---------------------------------------------------------------------------
  961. =head1 B<cutting()>
  962. $boolean = $parser->cutting();
  963. Returns the current C<cutting> state: a boolean-valued scalar which
  964. evaluates to true if text from the input file is currently being "cut"
  965. (meaning it is I<not> considered part of the POD document).
  966. $parser->cutting($boolean);
  967. Sets the current C<cutting> state to the given value and returns the
  968. result.
  969. =cut
  970. sub cutting {
  971. return (@_ > 1) ? ($_[0]->{_CUTTING} = $_[1]) : $_[0]->{_CUTTING};
  972. }
  973. ##---------------------------------------------------------------------------
  974. ##---------------------------------------------------------------------------
  975. =head1 B<parseopts()>
  976. When invoked with no additional arguments, B<parseopts> returns a hashtable
  977. of all the current parsing options.
  978. ## See if we are parsing non-POD sections as well as POD ones
  979. my %opts = $parser->parseopts();
  980. $opts{'-want_nonPODs}' and print "-want_nonPODs\n";
  981. When invoked using a single string, B<parseopts> treats the string as the
  982. name of a parse-option and returns its corresponding value if it exists
  983. (returns C<undef> if it doesn't).
  984. ## Did we ask to see '=cut' paragraphs?
  985. my $want_cut = $parser->parseopts('-process_cut_cmd');
  986. $want_cut and print "-process_cut_cmd\n";
  987. When invoked with multiple arguments, B<parseopts> treats them as
  988. key/value pairs and the specified parse-option names are set to the
  989. given values. Any unspecified parse-options are unaffected.
  990. ## Set them back to the default
  991. $parser->parseopts(-warnings => 0);
  992. When passed a single hash-ref, B<parseopts> uses that hash to completely
  993. reset the existing parse-options, all previous parse-option values
  994. are lost.
  995. ## Reset all options to default
  996. $parser->parseopts( { } );
  997. See L<"PARSING OPTIONS"> for more information on the name and meaning of each
  998. parse-option currently recognized.
  999. =cut
  1000. sub parseopts {
  1001. local *myData = shift;
  1002. local *myOpts = ($myData{_PARSEOPTS} ||= {});
  1003. return %myOpts if (@_ == 0);
  1004. if (@_ == 1) {
  1005. local $_ = shift;
  1006. return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_};
  1007. }
  1008. my @newOpts = (%myOpts, @_);
  1009. $myData{_PARSEOPTS} = { @newOpts };
  1010. }
  1011. ##---------------------------------------------------------------------------
  1012. =head1 B<output_file()>
  1013. $fname = $parser->output_file();
  1014. Returns the name of the output file being written.
  1015. =cut
  1016. sub output_file {
  1017. return $_[0]->{_OUTFILE};
  1018. }
  1019. ##---------------------------------------------------------------------------
  1020. =head1 B<output_handle()>
  1021. $fhandle = $parser->output_handle();
  1022. Returns the output filehandle object.
  1023. =cut
  1024. sub output_handle {
  1025. return $_[0]->{_OUTPUT};
  1026. }
  1027. ##---------------------------------------------------------------------------
  1028. =head1 B<input_file()>
  1029. $fname = $parser->input_file();
  1030. Returns the name of the input file being read.
  1031. =cut
  1032. sub input_file {
  1033. return $_[0]->{_INFILE};
  1034. }
  1035. ##---------------------------------------------------------------------------
  1036. =head1 B<input_handle()>
  1037. $fhandle = $parser->input_handle();
  1038. Returns the current input filehandle object.
  1039. =cut
  1040. sub input_handle {
  1041. return $_[0]->{_INPUT};
  1042. }
  1043. ##---------------------------------------------------------------------------
  1044. =begin __PRIVATE__
  1045. =head1 B<input_streams()>
  1046. $listref = $parser->input_streams();
  1047. Returns a reference to an array which corresponds to the stack of all
  1048. the input streams that are currently in the middle of being parsed.
  1049. While parsing an input stream, it is possible to invoke
  1050. B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
  1051. stream and then return to parsing the previous input stream. Each input
  1052. stream to be parsed is pushed onto the end of this input stack
  1053. before any of its input is read. The input stream that is currently
  1054. being parsed is always at the end (or top) of the input stack. When an
  1055. input stream has been exhausted, it is popped off the end of the
  1056. input stack.
  1057. Each element on this input stack is a reference to C<Pod::InputSource>
  1058. object. Please see L<Pod::InputObjects> for more details.
  1059. This method might be invoked when printing diagnostic messages, for example,
  1060. to obtain the name and line number of the all input files that are currently
  1061. being processed.
  1062. =end __PRIVATE__
  1063. =cut
  1064. sub input_streams {
  1065. return $_[0]->{_INPUT_STREAMS};
  1066. }
  1067. ##---------------------------------------------------------------------------
  1068. =begin __PRIVATE__
  1069. =head1 B<top_stream()>
  1070. $hashref = $parser->top_stream();
  1071. Returns a reference to the hash-table that represents the element
  1072. that is currently at the top (end) of the input stream stack
  1073. (see L<"input_streams()">). The return value will be the C<undef>
  1074. if the input stack is empty.
  1075. This method might be used when printing diagnostic messages, for example,
  1076. to obtain the name and line number of the current input file.
  1077. =end __PRIVATE__
  1078. =cut
  1079. sub top_stream {
  1080. return $_[0]->{_TOP_STREAM} || undef;
  1081. }
  1082. #############################################################################
  1083. =head1 PRIVATE METHODS AND DATA
  1084. B<Pod::Parser> makes use of several internal methods and data fields
  1085. which clients should not need to see or use. For the sake of avoiding
  1086. name collisions for client data and methods, these methods and fields
  1087. are briefly discussed here. Determined hackers may obtain further
  1088. information about them by reading the B<Pod::Parser> source code.
  1089. Private data fields are stored in the hash-object whose reference is
  1090. returned by the B<new()> constructor for this class. The names of all
  1091. private methods and data-fields used by B<Pod::Parser> begin with a
  1092. prefix of "_" and match the regular expression C</^_\w+$/>.
  1093. =cut
  1094. ##---------------------------------------------------------------------------
  1095. =begin _PRIVATE_
  1096. =head1 B<_push_input_stream()>
  1097. $hashref = $parser->_push_input_stream($in_fh,$out_fh);
  1098. This method will push the given input stream on the input stack and
  1099. perform any necessary beginning-of-document or beginning-of-file
  1100. processing. The argument C<$in_fh> is the input stream filehandle to
  1101. push, and C<$out_fh> is the corresponding output filehandle to use (if
  1102. it is not given or is undefined, then the current output stream is used,
  1103. which defaults to standard output if it doesnt exist yet).
  1104. The value returned will be reference to the hash-table that represents
  1105. the new top of the input stream stack. I<Please Note> that it is
  1106. possible for this method to use default values for the input and output
  1107. file handles. If this happens, you will need to look at the C<INPUT>
  1108. and C<OUTPUT> instance data members to determine their new values.
  1109. =end _PRIVATE_
  1110. =cut
  1111. sub _push_input_stream {
  1112. my ($self, $in_fh, $out_fh) = @_;
  1113. local *myData = $self;
  1114. ## Initialize stuff for the entire document if this is *not*
  1115. ## an included file.
  1116. ##
  1117. ## NOTE: we need to be *very* careful when "defaulting" the output
  1118. ## filehandle. We only want to use a default value if this is the
  1119. ## beginning of the entire document (but *not* if this is an included
  1120. ## file).
  1121. unless (defined $myData{_TOP_STREAM}) {
  1122. $out_fh = \*STDOUT unless (defined $out_fh);
  1123. $myData{_CUTTING} = 1; ## current "cutting" state
  1124. $myData{_INPUT_STREAMS} = []; ## stack of all input streams
  1125. }
  1126. ## Initialize input indicators
  1127. $myData{_OUTFILE} = '(unknown)' unless (defined $myData{_OUTFILE});
  1128. $myData{_OUTPUT} = $out_fh if (defined $out_fh);
  1129. $in_fh = \*STDIN unless (defined $in_fh);
  1130. $myData{_INFILE} = '(unknown)' unless (defined $myData{_INFILE});
  1131. $myData{_INPUT} = $in_fh;
  1132. my $input_top = $myData{_TOP_STREAM}
  1133. = new Pod::InputSource(
  1134. -name => $myData{_INFILE},
  1135. -handle => $in_fh,
  1136. -was_cutting => $myData{_CUTTING}
  1137. );
  1138. local *input_stack = $myData{_INPUT_STREAMS};
  1139. push(@input_stack, $input_top);
  1140. ## Perform beginning-of-document and/or beginning-of-input processing
  1141. $self->begin_pod() if (@input_stack == 1);
  1142. $self->begin_input();
  1143. return $input_top;
  1144. }
  1145. ##---------------------------------------------------------------------------
  1146. =begin _PRIVATE_
  1147. =head1 B<_pop_input_stream()>
  1148. $hashref = $parser->_pop_input_stream();
  1149. This takes no arguments. It will perform any necessary end-of-file or
  1150. end-of-document processing and then pop the current input stream from
  1151. the top of the input stack.
  1152. The value returned will be reference to the hash-table that represents
  1153. the new top of the input stream stack.
  1154. =end _PRIVATE_
  1155. =cut
  1156. sub _pop_input_stream {
  1157. my ($self) = @_;
  1158. local *myData = $self;
  1159. local *input_stack = $myData{_INPUT_STREAMS};
  1160. ## Perform end-of-input and/or end-of-document processing
  1161. $self->end_input() if (@input_stack > 0);
  1162. $self->end_pod() if (@input_stack == 1);
  1163. ## Restore cutting state to whatever it was before we started
  1164. ## parsing this file.
  1165. my $old_top = pop(@input_stack);
  1166. $myData{_CUTTING} = $old_top->was_cutting();
  1167. ## Dont forget to reset the input indicators
  1168. my $input_top = undef;
  1169. if (@input_stack > 0) {
  1170. $input_top = $myData{_TOP_STREAM} = $input_stack[-1];
  1171. $myData{_INFILE} = $input_top->name();
  1172. $myData{_INPUT} = $input_top->handle();
  1173. } else {
  1174. delete $myData{_TOP_STREAM};
  1175. delete $myData{_INPUT_STREAMS};
  1176. }
  1177. return $input_top;
  1178. }
  1179. #############################################################################
  1180. =head1 TREE-BASED PARSING
  1181. If straightforward stream-based parsing wont meet your needs (as is
  1182. likely the case for tasks such as translating PODs into structured
  1183. markup languages like HTML and XML) then you may need to take the
  1184. tree-based approach. Rather than doing everything in one pass and
  1185. calling the B<interpolate()> method to expand sequences into text, it
  1186. may be desirable to instead create a parse-tree using the B<parse_text()>
  1187. method to return a tree-like structure which may contain an ordered list
  1188. list of children (each of which may be a text-string, or a similar
  1189. tree-like structure).
  1190. Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and
  1191. to the objects described in L<Pod::InputObjects>. The former describes
  1192. the gory details and parameters for how to customize and extend the
  1193. parsing behavior of B<Pod::Parser>. B<Pod::InputObjects> provides
  1194. several objects that may all be used interchangeably as parse-trees. The
  1195. most obvious one is the B<Pod::ParseTree> object. It defines the basic
  1196. interface and functionality that all things trying to be a POD parse-tree
  1197. should do. A B<Pod::ParseTree> is defined such that each "node" may be a
  1198. text-string, or a reference to another parse-tree. Each B<Pod::Paragraph>
  1199. object and each B<Pod::InteriorSequence> object also supports the basic
  1200. parse-tree interface.
  1201. The B<parse_text()> method takes a given paragraph of text, and
  1202. returns a parse-tree that contains one or more children, each of which
  1203. may be a text-string, or an InteriorSequence object. There are also
  1204. callback-options that may be passed to B<parse_text()> to customize
  1205. the way it expands or transforms interior-sequences, as well as the
  1206. returned result. These callbacks can be used to create a parse-tree
  1207. with custom-made objects (which may or may not support the parse-tree
  1208. interface, depending on how you choose to do it).
  1209. If you wish to turn an entire POD document into a parse-tree, that process
  1210. is fairly straightforward. The B<parse_text()> method is the key to doing
  1211. this successfully. Every paragraph-callback (i.e. the polymorphic methods
  1212. for B<command()>, B<verbatim()>, and B<textblock()> paragraphs) takes
  1213. a B<Pod::Paragraph> object as an argument. Each paragraph object has a
  1214. B<parse_tree()> method that can be used to get or set a corresponding
  1215. parse-tree. So for each of those paragraph-callback methods, simply call
  1216. B<parse_text()> with the options you desire, and then use the returned
  1217. parse-tree to assign to the given paragraph object.
  1218. That gives you a parse-tree for each paragraph - so now all you need is
  1219. an ordered list of paragraphs. You can maintain that yourself as a data
  1220. element in the object/hash. The most straightforward way would be simply
  1221. to use an array-ref, with the desired set of custom "options" for each
  1222. invocation of B<parse_text>. Let's assume the desired option-set is
  1223. given by the hash C<%options>. Then we might do something like the
  1224. following:
  1225. package MyPodParserTree;
  1226. @ISA = qw( Pod::Parser );
  1227. ...
  1228. sub begin_pod {
  1229. my $self = shift;
  1230. $self->{'-paragraphs'} = []; ## initialize paragraph list
  1231. }
  1232. sub command {
  1233. my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
  1234. my $ptree = $parser->parse_text({%options}, $paragraph, ...);
  1235. $pod_para->parse_tree( $ptree );
  1236. push @{ $self->{'-paragraphs'} }, $pod_para;
  1237. }
  1238. sub verbatim {
  1239. my ($parser, $paragraph, $line_num, $pod_para) = @_;
  1240. push @{ $self->{'-paragraphs'} }, $pod_para;
  1241. }
  1242. sub textblock {
  1243. my ($parser, $paragraph, $line_num, $pod_para) = @_;
  1244. my $ptree = $parser->parse_text({%options}, $paragraph, ...);
  1245. $pod_para->parse_tree( $ptree );
  1246. push @{ $self->{'-paragraphs'} }, $pod_para;
  1247. }
  1248. ...
  1249. package main;
  1250. ...
  1251. my $parser = new MyPodParserTree(...);
  1252. $parser->parse_from_file(...);
  1253. my $paragraphs_ref = $parser->{'-paragraphs'};
  1254. Of course, in this module-author's humble opinion, I'd be more inclined to
  1255. use the existing B<Pod::ParseTree> object than a simple array. That way
  1256. everything in it, paragraphs and sequences, all respond to the same core
  1257. interface for all parse-tree nodes. The result would look something like:
  1258. package MyPodParserTree2;
  1259. ...
  1260. sub begin_pod {
  1261. my $self = shift;
  1262. $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree
  1263. }
  1264. sub parse_tree {
  1265. ## convenience method to get/set the parse-tree for the entire POD
  1266. (@_ > 1) and $_[0]->{'-ptree'} = $_[1];
  1267. return $_[0]->{'-ptree'};
  1268. }
  1269. sub command {
  1270. my ($parser, $command, $paragraph, $line_num, $pod_para) = @_;
  1271. my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
  1272. $pod_para->parse_tree( $ptree );
  1273. $parser->parse_tree()->append( $pod_para );
  1274. }
  1275. sub verbatim {
  1276. my ($parser, $paragraph, $line_num, $pod_para) = @_;
  1277. $parser->parse_tree()->append( $pod_para );
  1278. }
  1279. sub textblock {
  1280. my ($parser, $paragraph, $line_num, $pod_para) = @_;
  1281. my $ptree = $parser->parse_text({<<options>>}, $paragraph, ...);
  1282. $pod_para->parse_tree( $ptree );
  1283. $parser->parse_tree()->append( $pod_para );
  1284. }
  1285. ...
  1286. package main;
  1287. ...
  1288. my $parser = new MyPodParserTree2(...);
  1289. $parser->parse_from_file(...);
  1290. my $ptree = $parser->parse_tree;
  1291. ...
  1292. Now you have the entire POD document as one great big parse-tree. You
  1293. can even use the B<-expand_seq> option to B<parse_text> to insert
  1294. whole different kinds of objects. Just don't expect B<Pod::Parser>
  1295. to know what to do with them after that. That will need to be in your
  1296. code. Or, alternatively, you can insert any object you like so long as
  1297. it conforms to the B<Pod::ParseTree> interface.
  1298. One could use this to create subclasses of B<Pod::Paragraphs> and
  1299. B<Pod::InteriorSequences> for specific commands (or to create your own
  1300. custom node-types in the parse-tree) and add some kind of B<emit()>
  1301. method to each custom node/subclass object in the tree. Then all you'd
  1302. need to do is recursively walk the tree in the desired order, processing
  1303. the children (most likely from left to right) by formatting them if
  1304. they are text-strings, or by calling their B<emit()> method if they
  1305. are objects/references.
  1306. =head1 SEE ALSO
  1307. L<Pod::InputObjects>, L<Pod::Select>
  1308. B<Pod::InputObjects> defines POD input objects corresponding to
  1309. command paragraphs, parse-trees, and interior-sequences.
  1310. B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
  1311. to selectively include and/or exclude sections of a POD document from being
  1312. translated based upon the current heading, subheading, subsubheading, etc.
  1313. =for __PRIVATE__
  1314. B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
  1315. the ability the employ I<callback functions> instead of, or in addition
  1316. to, overriding methods of the base class.
  1317. =for __PRIVATE__
  1318. B<Pod::Select> and B<Pod::Callbacks> do not override any
  1319. methods nor do they define any new methods with the same name. Because
  1320. of this, they may I<both> be used (in combination) as a base class of
  1321. the same subclass in order to combine their functionality without
  1322. causing any namespace clashes due to multiple inheritance.
  1323. =head1 AUTHOR
  1324. Brad Appleton E<lt>bradapp@enteract.comE<gt>
  1325. Based on code for B<Pod::Text> written by
  1326. Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
  1327. =cut
  1328. 1;