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