This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make exists() work better on pseudo-hashes (reworked a patch suggested
[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);
e9fdc7d2 16$VERSION = 1.081; ## Current version of this package
360aca43
GS
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
22641bdf
GS
654## an interior sequence looks like '-' or '=', but not '--', '==',
655## '$-', or '$='
360aca43 656use vars qw( $ARROW_RE );
22641bdf 657$ARROW_RE = join('', qw{ (?: [^-+*/=!&|%^x.<>$]= | [^$-]- )$ });
e9fdc7d2 658#$ARROW_RE = qr/(?:[^=]+=|[^-]+-)$/; ## 5.005+ only!
360aca43
GS
659
660sub 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;
e9fdc7d2 677 if (defined $expand_seq and $expand_seq eq 'interior_sequence') {
360aca43
GS
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])(<)$/ ) {
e9fdc7d2 710 ## Push a new sequence onto the stack of those "in-progress"
360aca43
GS
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
e9fdc7d2 734 $seq->append($_) if length;
360aca43
GS
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
760This method translates all text (including any embedded interior sequences)
761in the given text string C<$text> and returns the interpolated result. The
762parameter C<$line_num> is the line number corresponding to the beginning
763of C<$text>.
764
765B<interpolate()> merely invokes a private method to recursively expand
766nested interior sequences in bottom-up order (innermost sequences are
767expanded first). If there is a need to expand nested sequences in
768some alternate order, use B<parse_text> instead.
769
770=cut
771
772sub 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
787This method takes the text of a POD paragraph to be processed, along
788with its corresponding line number, and invokes the appropriate method
789(one of B<command()>, B<verbatim()>, or B<textblock()>).
790
791This method does I<not> usually need to be overridden by subclasses.
792
793=end __PRIVATE__
794
795=cut
796
797sub 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
885This method takes an input filehandle (which is assumed to already be
886opened for reading) and reads the entire input stream looking for blocks
887(paragraphs) of POD documentation to be processed. If no first argument
888is given the default input filehandle C<STDIN> is used.
889
890The C<$in_fh> parameter may be any object that provides a B<getline()>
891method to retrieve a single line of input text (hence, an appropriate
892wrapper object could be used to parse PODs from a single string or an
893array of strings).
894
895Using C<$in_fh-E<gt>getline()>, input is read line-by-line and assembled
896into paragraphs or "blocks" (which are separated by lines containing
897nothing but whitespace). For each block of POD documentation
898encountered it will invoke a method to parse the given paragraph.
899
900If a second argument is given then it should correspond to a filehandle where
901output should be sent (otherwise the default output filehandle is
902C<STDOUT> if no output filehandle is currently in use).
903
904B<NOTE:> For performance reasons, this method caches the input stream at
905the top of the stack in a local variable. Any attempts by clients to
906change the stack contents during processing when in the midst executing
907of this method I<will not affect> the input stream used by the current
908invocation of this method.
909
910This method does I<not> usually need to be overridden by subclasses.
911
912=cut
913
914sub parse_from_filehandle {
915 my $self = shift;
916 my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : ();
917 my ($in_fh, $out_fh) = @_;
22641bdf 918 $in_fh = \*STDIN unless ($in_fh);
360aca43
GS
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
975This method takes a filename and does the following:
976
977=over 2
978
979=item *
980
981opens the input and output files for reading
982(creating the appropriate filehandles)
983
984=item *
985
986invokes the B<parse_from_filehandle()> method passing it the
987corresponding input and output filehandles.
988
989=item *
990
991closes the input and output files.
992
993=back
994
995If the special input filename "-" or "<&STDIN" is given then the STDIN
996filehandle is used for input (and no open or close is performed). If no
997input filename is specified then "-" is implied.
998
999If a second argument is given then it should be the name of the desired
1000output file. If the special output filename "-" or ">&STDOUT" is given
1001then the STDOUT filehandle is used for output (and no open or close is
1002performed). If the special output filename ">&STDERR" is given then the
1003STDERR filehandle is used for output (and no open or close is
1004performed). If no output filehandle is currently in use and no output
1005filename is specified, then "-" is implied.
1006
1007This method does I<not> usually need to be overridden by subclasses.
1008
1009=cut
1010
1011sub 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
1093Clients of B<Pod::Parser> should use the following methods to access
1094instance data fields:
1095
1096=cut
1097
1098##---------------------------------------------------------------------------
1099
1100=head1 B<cutting()>
1101
1102 $boolean = $parser->cutting();
1103
1104Returns the current C<cutting> state: a boolean-valued scalar which
1105evaluates 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
1110Sets the current C<cutting> state to the given value and returns the
1111result.
1112
1113=cut
1114
1115sub 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
1125Returns the name of the output file being written.
1126
1127=cut
1128
1129sub output_file {
1130 return $_[0]->{_OUTFILE};
1131}
1132
1133##---------------------------------------------------------------------------
1134
1135=head1 B<output_handle()>
1136
1137 $fhandle = $parser->output_handle();
1138
1139Returns the output filehandle object.
1140
1141=cut
1142
1143sub output_handle {
1144 return $_[0]->{_OUTPUT};
1145}
1146
1147##---------------------------------------------------------------------------
1148
1149=head1 B<input_file()>
1150
1151 $fname = $parser->input_file();
1152
1153Returns the name of the input file being read.
1154
1155=cut
1156
1157sub input_file {
1158 return $_[0]->{_INFILE};
1159}
1160
1161##---------------------------------------------------------------------------
1162
1163=head1 B<input_handle()>
1164
1165 $fhandle = $parser->input_handle();
1166
1167Returns the current input filehandle object.
1168
1169=cut
1170
1171sub 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
1183Returns a reference to an array which corresponds to the stack of all
1184the input streams that are currently in the middle of being parsed.
1185
1186While parsing an input stream, it is possible to invoke
1187B<parse_from_file()> or B<parse_from_filehandle()> to parse a new input
1188stream and then return to parsing the previous input stream. Each input
1189stream to be parsed is pushed onto the end of this input stack
1190before any of its input is read. The input stream that is currently
1191being parsed is always at the end (or top) of the input stack. When an
1192input stream has been exhausted, it is popped off the end of the
1193input stack.
1194
1195Each element on this input stack is a reference to C<Pod::InputSource>
1196object. Please see L<Pod::InputObjects> for more details.
1197
1198This method might be invoked when printing diagnostic messages, for example,
1199to obtain the name and line number of the all input files that are currently
1200being processed.
1201
1202=end __PRIVATE__
1203
1204=cut
1205
1206sub 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
1218Returns a reference to the hash-table that represents the element
1219that is currently at the top (end) of the input stream stack
1220(see L<"input_streams()">). The return value will be the C<undef>
1221if the input stack is empty.
1222
1223This method might be used when printing diagnostic messages, for example,
1224to obtain the name and line number of the current input file.
1225
1226=end __PRIVATE__
1227
1228=cut
1229
1230sub top_stream {
1231 return $_[0]->{_TOP_STREAM} || undef;
1232}
1233
1234#############################################################################
1235
1236=head1 PRIVATE METHODS AND DATA
1237
1238B<Pod::Parser> makes use of several internal methods and data fields
1239which clients should not need to see or use. For the sake of avoiding
1240name collisions for client data and methods, these methods and fields
1241are briefly discussed here. Determined hackers may obtain further
1242information about them by reading the B<Pod::Parser> source code.
1243
1244Private data fields are stored in the hash-object whose reference is
1245returned by the B<new()> constructor for this class. The names of all
1246private methods and data-fields used by B<Pod::Parser> begin with a
1247prefix 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
1259This method will push the given input stream on the input stack and
1260perform any necessary beginning-of-document or beginning-of-file
1261processing. The argument C<$in_fh> is the input stream filehandle to
1262push, and C<$out_fh> is the corresponding output filehandle to use (if
1263it is not given or is undefined, then the current output stream is used,
1264which defaults to standard output if it doesnt exist yet).
1265
1266The value returned will be reference to the hash-table that represents
1267the new top of the input stream stack. I<Please Note> that it is
1268possible for this method to use default values for the input and output
1269file handles. If this happens, you will need to look at the C<INPUT>
1270and C<OUTPUT> instance data members to determine their new values.
1271
1272=end _PRIVATE_
1273
1274=cut
1275
1276sub _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
1323This takes no arguments. It will perform any necessary end-of-file or
1324end-of-document processing and then pop the current input stream from
1325the top of the input stack.
1326
1327The value returned will be reference to the hash-table that represents
1328the new top of the input stream stack.
1329
1330=end _PRIVATE_
1331
1332=cut
1333
1334sub _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
1366L<Pod::InputObjects>, L<Pod::Select>
1367
1368B<Pod::InputObjects> defines POD input objects corresponding to
1369command paragraphs, parse-trees, and interior-sequences.
1370
1371B<Pod::Select> is a subclass of B<Pod::Parser> which provides the ability
1372to selectively include and/or exclude sections of a POD document from being
1373translated based upon the current heading, subheading, subsubheading, etc.
1374
1375=for __PRIVATE__
1376B<Pod::Callbacks> is a subclass of B<Pod::Parser> which gives its users
1377the ability the employ I<callback functions> instead of, or in addition
1378to, overriding methods of the base class.
1379
1380=for __PRIVATE__
1381B<Pod::Select> and B<Pod::Callbacks> do not override any
1382methods nor do they define any new methods with the same name. Because
1383of this, they may I<both> be used (in combination) as a base class of
1384the same subclass in order to combine their functionality without
1385causing any namespace clashes due to multiple inheritance.
1386
1387=head1 AUTHOR
1388
1389Brad Appleton E<lt>bradapp@enteract.comE<gt>
1390
1391Based on code for B<Pod::Text> written by
1392Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
1393
1394=cut
1395
13961;