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