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