1 | #############################################################################
|
---|
2 | # Pod/ParseUtils.pm -- helpers for POD parsing and conversion
|
---|
3 | #
|
---|
4 | # Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
|
---|
5 | # This file is part of "PodParser". PodParser is free software;
|
---|
6 | # you can redistribute it and/or modify it under the same terms
|
---|
7 | # as Perl itself.
|
---|
8 | #############################################################################
|
---|
9 |
|
---|
10 | package Pod::ParseUtils;
|
---|
11 |
|
---|
12 | use vars qw($VERSION);
|
---|
13 | $VERSION = 1.33; ## Current version of this package
|
---|
14 | require 5.005; ## requires this Perl version or later
|
---|
15 |
|
---|
16 | =head1 NAME
|
---|
17 |
|
---|
18 | Pod::ParseUtils - helpers for POD parsing and conversion
|
---|
19 |
|
---|
20 | =head1 SYNOPSIS
|
---|
21 |
|
---|
22 | use Pod::ParseUtils;
|
---|
23 |
|
---|
24 | my $list = new Pod::List;
|
---|
25 | my $link = Pod::Hyperlink->new('Pod::Parser');
|
---|
26 |
|
---|
27 | =head1 DESCRIPTION
|
---|
28 |
|
---|
29 | B<Pod::ParseUtils> contains a few object-oriented helper packages for
|
---|
30 | POD parsing and processing (i.e. in POD formatters and translators).
|
---|
31 |
|
---|
32 | =cut
|
---|
33 |
|
---|
34 | #-----------------------------------------------------------------------------
|
---|
35 | # Pod::List
|
---|
36 | #
|
---|
37 | # class to hold POD list info (=over, =item, =back)
|
---|
38 | #-----------------------------------------------------------------------------
|
---|
39 |
|
---|
40 | package Pod::List;
|
---|
41 |
|
---|
42 | use Carp;
|
---|
43 |
|
---|
44 | =head2 Pod::List
|
---|
45 |
|
---|
46 | B<Pod::List> can be used to hold information about POD lists
|
---|
47 | (written as =over ... =item ... =back) for further processing.
|
---|
48 | The following methods are available:
|
---|
49 |
|
---|
50 | =over 4
|
---|
51 |
|
---|
52 | =item Pod::List-E<gt>new()
|
---|
53 |
|
---|
54 | Create a new list object. Properties may be specified through a hash
|
---|
55 | reference like this:
|
---|
56 |
|
---|
57 | my $list = Pod::List->new({ -start => $., -indent => 4 });
|
---|
58 |
|
---|
59 | See the individual methods/properties for details.
|
---|
60 |
|
---|
61 | =cut
|
---|
62 |
|
---|
63 | sub new {
|
---|
64 | my $this = shift;
|
---|
65 | my $class = ref($this) || $this;
|
---|
66 | my %params = @_;
|
---|
67 | my $self = {%params};
|
---|
68 | bless $self, $class;
|
---|
69 | $self->initialize();
|
---|
70 | return $self;
|
---|
71 | }
|
---|
72 |
|
---|
73 | sub initialize {
|
---|
74 | my $self = shift;
|
---|
75 | $self->{-file} ||= 'unknown';
|
---|
76 | $self->{-start} ||= 'unknown';
|
---|
77 | $self->{-indent} ||= 4; # perlpod: "should be the default"
|
---|
78 | $self->{_items} = [];
|
---|
79 | $self->{-type} ||= '';
|
---|
80 | }
|
---|
81 |
|
---|
82 | =item $list-E<gt>file()
|
---|
83 |
|
---|
84 | Without argument, retrieves the file name the list is in. This must
|
---|
85 | have been set before by either specifying B<-file> in the B<new()>
|
---|
86 | method or by calling the B<file()> method with a scalar argument.
|
---|
87 |
|
---|
88 | =cut
|
---|
89 |
|
---|
90 | # The POD file name the list appears in
|
---|
91 | sub file {
|
---|
92 | return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
|
---|
93 | }
|
---|
94 |
|
---|
95 | =item $list-E<gt>start()
|
---|
96 |
|
---|
97 | Without argument, retrieves the line number where the list started.
|
---|
98 | This must have been set before by either specifying B<-start> in the
|
---|
99 | B<new()> method or by calling the B<start()> method with a scalar
|
---|
100 | argument.
|
---|
101 |
|
---|
102 | =cut
|
---|
103 |
|
---|
104 | # The line in the file the node appears
|
---|
105 | sub start {
|
---|
106 | return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
|
---|
107 | }
|
---|
108 |
|
---|
109 | =item $list-E<gt>indent()
|
---|
110 |
|
---|
111 | Without argument, retrieves the indent level of the list as specified
|
---|
112 | in C<=over n>. This must have been set before by either specifying
|
---|
113 | B<-indent> in the B<new()> method or by calling the B<indent()> method
|
---|
114 | with a scalar argument.
|
---|
115 |
|
---|
116 | =cut
|
---|
117 |
|
---|
118 | # indent level
|
---|
119 | sub indent {
|
---|
120 | return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
|
---|
121 | }
|
---|
122 |
|
---|
123 | =item $list-E<gt>type()
|
---|
124 |
|
---|
125 | Without argument, retrieves the list type, which can be an arbitrary value,
|
---|
126 | e.g. C<OL>, C<UL>, ... when thinking the HTML way.
|
---|
127 | This must have been set before by either specifying
|
---|
128 | B<-type> in the B<new()> method or by calling the B<type()> method
|
---|
129 | with a scalar argument.
|
---|
130 |
|
---|
131 | =cut
|
---|
132 |
|
---|
133 | # The type of the list (UL, OL, ...)
|
---|
134 | sub type {
|
---|
135 | return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
|
---|
136 | }
|
---|
137 |
|
---|
138 | =item $list-E<gt>rx()
|
---|
139 |
|
---|
140 | Without argument, retrieves a regular expression for simplifying the
|
---|
141 | individual item strings once the list type has been determined. Usage:
|
---|
142 | E.g. when converting to HTML, one might strip the leading number in
|
---|
143 | an ordered list as C<E<lt>OLE<gt>> already prints numbers itself.
|
---|
144 | This must have been set before by either specifying
|
---|
145 | B<-rx> in the B<new()> method or by calling the B<rx()> method
|
---|
146 | with a scalar argument.
|
---|
147 |
|
---|
148 | =cut
|
---|
149 |
|
---|
150 | # The regular expression to simplify the items
|
---|
151 | sub rx {
|
---|
152 | return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
|
---|
153 | }
|
---|
154 |
|
---|
155 | =item $list-E<gt>item()
|
---|
156 |
|
---|
157 | Without argument, retrieves the array of the items in this list.
|
---|
158 | The items may be represented by any scalar.
|
---|
159 | If an argument has been given, it is pushed on the list of items.
|
---|
160 |
|
---|
161 | =cut
|
---|
162 |
|
---|
163 | # The individual =items of this list
|
---|
164 | sub item {
|
---|
165 | my ($self,$item) = @_;
|
---|
166 | if(defined $item) {
|
---|
167 | push(@{$self->{_items}}, $item);
|
---|
168 | return $item;
|
---|
169 | }
|
---|
170 | else {
|
---|
171 | return @{$self->{_items}};
|
---|
172 | }
|
---|
173 | }
|
---|
174 |
|
---|
175 | =item $list-E<gt>parent()
|
---|
176 |
|
---|
177 | Without argument, retrieves information about the parent holding this
|
---|
178 | list, which is represented as an arbitrary scalar.
|
---|
179 | This must have been set before by either specifying
|
---|
180 | B<-parent> in the B<new()> method or by calling the B<parent()> method
|
---|
181 | with a scalar argument.
|
---|
182 |
|
---|
183 | =cut
|
---|
184 |
|
---|
185 | # possibility for parsers/translators to store information about the
|
---|
186 | # lists's parent object
|
---|
187 | sub parent {
|
---|
188 | return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
|
---|
189 | }
|
---|
190 |
|
---|
191 | =item $list-E<gt>tag()
|
---|
192 |
|
---|
193 | Without argument, retrieves information about the list tag, which can be
|
---|
194 | any scalar.
|
---|
195 | This must have been set before by either specifying
|
---|
196 | B<-tag> in the B<new()> method or by calling the B<tag()> method
|
---|
197 | with a scalar argument.
|
---|
198 |
|
---|
199 | =back
|
---|
200 |
|
---|
201 | =cut
|
---|
202 |
|
---|
203 | # possibility for parsers/translators to store information about the
|
---|
204 | # list's object
|
---|
205 | sub tag {
|
---|
206 | return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
|
---|
207 | }
|
---|
208 |
|
---|
209 | #-----------------------------------------------------------------------------
|
---|
210 | # Pod::Hyperlink
|
---|
211 | #
|
---|
212 | # class to manipulate POD hyperlinks (L<>)
|
---|
213 | #-----------------------------------------------------------------------------
|
---|
214 |
|
---|
215 | package Pod::Hyperlink;
|
---|
216 |
|
---|
217 | =head2 Pod::Hyperlink
|
---|
218 |
|
---|
219 | B<Pod::Hyperlink> is a class for manipulation of POD hyperlinks. Usage:
|
---|
220 |
|
---|
221 | my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
|
---|
222 |
|
---|
223 | The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
|
---|
224 | C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
|
---|
225 | different parts of a POD hyperlink for further processing. It can also be
|
---|
226 | used to construct hyperlinks.
|
---|
227 |
|
---|
228 | =over 4
|
---|
229 |
|
---|
230 | =item Pod::Hyperlink-E<gt>new()
|
---|
231 |
|
---|
232 | The B<new()> method can either be passed a set of key/value pairs or a single
|
---|
233 | scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
|
---|
234 | of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
|
---|
235 | failure, the error message is stored in C<$@>.
|
---|
236 |
|
---|
237 | =cut
|
---|
238 |
|
---|
239 | use Carp;
|
---|
240 |
|
---|
241 | sub new {
|
---|
242 | my $this = shift;
|
---|
243 | my $class = ref($this) || $this;
|
---|
244 | my $self = +{};
|
---|
245 | bless $self, $class;
|
---|
246 | $self->initialize();
|
---|
247 | if(defined $_[0]) {
|
---|
248 | if(ref($_[0])) {
|
---|
249 | # called with a list of parameters
|
---|
250 | %$self = %{$_[0]};
|
---|
251 | $self->_construct_text();
|
---|
252 | }
|
---|
253 | else {
|
---|
254 | # called with L<> contents
|
---|
255 | return undef unless($self->parse($_[0]));
|
---|
256 | }
|
---|
257 | }
|
---|
258 | return $self;
|
---|
259 | }
|
---|
260 |
|
---|
261 | sub initialize {
|
---|
262 | my $self = shift;
|
---|
263 | $self->{-line} ||= 'undef';
|
---|
264 | $self->{-file} ||= 'undef';
|
---|
265 | $self->{-page} ||= '';
|
---|
266 | $self->{-node} ||= '';
|
---|
267 | $self->{-alttext} ||= '';
|
---|
268 | $self->{-type} ||= 'undef';
|
---|
269 | $self->{_warnings} = [];
|
---|
270 | }
|
---|
271 |
|
---|
272 | =item $link-E<gt>parse($string)
|
---|
273 |
|
---|
274 | This method can be used to (re)parse a (new) hyperlink, i.e. the contents
|
---|
275 | of a C<LE<lt>...E<gt>> sequence. The result is stored in the current object.
|
---|
276 | Warnings are stored in the B<warnings> property.
|
---|
277 | E.g. sections like C<LE<lt>open(2)E<gt>> are deprecated, as they do not point
|
---|
278 | to Perl documents. C<LE<lt>DBI::foo(3p)E<gt>> is wrong as well, the manpage
|
---|
279 | section can simply be dropped.
|
---|
280 |
|
---|
281 | =cut
|
---|
282 |
|
---|
283 | sub parse {
|
---|
284 | my $self = shift;
|
---|
285 | local($_) = $_[0];
|
---|
286 | # syntax check the link and extract destination
|
---|
287 | my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);
|
---|
288 |
|
---|
289 | $self->{_warnings} = [];
|
---|
290 |
|
---|
291 | # collapse newlines with whitespace
|
---|
292 | s/\s*\n+\s*/ /g;
|
---|
293 |
|
---|
294 | # strip leading/trailing whitespace
|
---|
295 | if(s/^[\s\n]+//) {
|
---|
296 | $self->warning("ignoring leading whitespace in link");
|
---|
297 | }
|
---|
298 | if(s/[\s\n]+$//) {
|
---|
299 | $self->warning("ignoring trailing whitespace in link");
|
---|
300 | }
|
---|
301 | unless(length($_)) {
|
---|
302 | _invalid_link("empty link");
|
---|
303 | return undef;
|
---|
304 | }
|
---|
305 |
|
---|
306 | ## Check for different possibilities. This is tedious and error-prone
|
---|
307 | # we match all possibilities (alttext, page, section/item)
|
---|
308 | #warn "DEBUG: link=$_\n";
|
---|
309 |
|
---|
310 | # only page
|
---|
311 | # problem: a lot of people use (), or (1) or the like to indicate
|
---|
312 | # man page sections. But this collides with L<func()> that is supposed
|
---|
313 | # to point to an internal funtion...
|
---|
314 | my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
|
---|
315 | # page name only
|
---|
316 | if(m!^($page_rx)$!o) {
|
---|
317 | $page = $1;
|
---|
318 | $type = 'page';
|
---|
319 | }
|
---|
320 | # alttext, page and "section"
|
---|
321 | elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$!o) {
|
---|
322 | ($alttext, $page, $node) = ($1, $2, $3);
|
---|
323 | $type = 'section';
|
---|
324 | $quoted = 1; #... therefore | and / are allowed
|
---|
325 | }
|
---|
326 | # alttext and page
|
---|
327 | elsif(m!^(.*?)\s*[|]\s*($page_rx)$!o) {
|
---|
328 | ($alttext, $page) = ($1, $2);
|
---|
329 | $type = 'page';
|
---|
330 | }
|
---|
331 | # alttext and "section"
|
---|
332 | elsif(m!^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
|
---|
333 | ($alttext, $node) = ($1,$2);
|
---|
334 | $type = 'section';
|
---|
335 | $quoted = 1;
|
---|
336 | }
|
---|
337 | # page and "section"
|
---|
338 | elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
|
---|
339 | ($page, $node) = ($1, $2);
|
---|
340 | $type = 'section';
|
---|
341 | $quoted = 1;
|
---|
342 | }
|
---|
343 | # page and item
|
---|
344 | elsif(m!^($page_rx)\s*/\s*(.+)$!o) {
|
---|
345 | ($page, $node) = ($1, $2);
|
---|
346 | $type = 'item';
|
---|
347 | }
|
---|
348 | # only "section"
|
---|
349 | elsif(m!^/?"(.+)"$!) {
|
---|
350 | $node = $1;
|
---|
351 | $type = 'section';
|
---|
352 | $quoted = 1;
|
---|
353 | }
|
---|
354 | # only item
|
---|
355 | elsif(m!^\s*/(.+)$!) {
|
---|
356 | $node = $1;
|
---|
357 | $type = 'item';
|
---|
358 | }
|
---|
359 | # non-standard: Hyperlink
|
---|
360 | elsif(m!^(\w+:[^:\s]\S*)$!i) {
|
---|
361 | $node = $1;
|
---|
362 | $type = 'hyperlink';
|
---|
363 | }
|
---|
364 | # alttext, page and item
|
---|
365 | elsif(m!^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$!o) {
|
---|
366 | ($alttext, $page, $node) = ($1, $2, $3);
|
---|
367 | $type = 'item';
|
---|
368 | }
|
---|
369 | # alttext and item
|
---|
370 | elsif(m!^(.*?)\s*[|]\s*/(.+)$!) {
|
---|
371 | ($alttext, $node) = ($1,$2);
|
---|
372 | }
|
---|
373 | # nonstandard: alttext and hyperlink
|
---|
374 | elsif(m!^(.*?)\s*[|]\s*(\w+:[^:\s]\S*)$!) {
|
---|
375 | ($alttext, $node) = ($1,$2);
|
---|
376 | $type = 'hyperlink';
|
---|
377 | }
|
---|
378 | # must be an item or a "malformed" section (without "")
|
---|
379 | else {
|
---|
380 | $node = $_;
|
---|
381 | $type = 'item';
|
---|
382 | }
|
---|
383 | # collapse whitespace in nodes
|
---|
384 | $node =~ s/\s+/ /gs;
|
---|
385 |
|
---|
386 | # empty alternative text expands to node name
|
---|
387 | if(defined $alttext) {
|
---|
388 | if(!length($alttext)) {
|
---|
389 | $alttext = $node | $page;
|
---|
390 | }
|
---|
391 | }
|
---|
392 | else {
|
---|
393 | $alttext = '';
|
---|
394 | }
|
---|
395 |
|
---|
396 | if($page =~ /[(]\w*[)]$/) {
|
---|
397 | $self->warning("(section) in '$page' deprecated");
|
---|
398 | }
|
---|
399 | if(!$quoted && $node =~ m:[|/]: && $type ne 'hyperlink') {
|
---|
400 | $self->warning("node '$node' contains non-escaped | or /");
|
---|
401 | }
|
---|
402 | if($alttext =~ m:[|/]:) {
|
---|
403 | $self->warning("alternative text '$node' contains non-escaped | or /");
|
---|
404 | }
|
---|
405 | $self->{-page} = $page;
|
---|
406 | $self->{-node} = $node;
|
---|
407 | $self->{-alttext} = $alttext;
|
---|
408 | #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
|
---|
409 | $self->{-type} = $type;
|
---|
410 | $self->_construct_text();
|
---|
411 | 1;
|
---|
412 | }
|
---|
413 |
|
---|
414 | sub _construct_text {
|
---|
415 | my $self = shift;
|
---|
416 | my $alttext = $self->alttext();
|
---|
417 | my $type = $self->type();
|
---|
418 | my $section = $self->node();
|
---|
419 | my $page = $self->page();
|
---|
420 | my $page_ext = '';
|
---|
421 | $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
|
---|
422 | if($alttext) {
|
---|
423 | $self->{_text} = $alttext;
|
---|
424 | }
|
---|
425 | elsif($type eq 'hyperlink') {
|
---|
426 | $self->{_text} = $section;
|
---|
427 | }
|
---|
428 | else {
|
---|
429 | $self->{_text} = ($section || '') .
|
---|
430 | (($page && $section) ? ' in ' : '') .
|
---|
431 | "$page$page_ext";
|
---|
432 | }
|
---|
433 | # for being marked up later
|
---|
434 | # use the non-standard markers P<> and Q<>, so that the resulting
|
---|
435 | # text can be parsed by the translators. It's their job to put
|
---|
436 | # the correct hypertext around the linktext
|
---|
437 | if($alttext) {
|
---|
438 | $self->{_markup} = "Q<$alttext>";
|
---|
439 | }
|
---|
440 | elsif($type eq 'hyperlink') {
|
---|
441 | $self->{_markup} = "Q<$section>";
|
---|
442 | }
|
---|
443 | else {
|
---|
444 | $self->{_markup} = (!$section ? '' : "Q<$section>") .
|
---|
445 | ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
|
---|
446 | }
|
---|
447 | }
|
---|
448 |
|
---|
449 | =item $link-E<gt>markup($string)
|
---|
450 |
|
---|
451 | Set/retrieve the textual value of the link. This string contains special
|
---|
452 | markers C<PE<lt>E<gt>> and C<QE<lt>E<gt>> that should be expanded by the
|
---|
453 | translator's interior sequence expansion engine to the
|
---|
454 | formatter-specific code to highlight/activate the hyperlink. The details
|
---|
455 | have to be implemented in the translator.
|
---|
456 |
|
---|
457 | =cut
|
---|
458 |
|
---|
459 | #' retrieve/set markuped text
|
---|
460 | sub markup {
|
---|
461 | return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
|
---|
462 | }
|
---|
463 |
|
---|
464 | =item $link-E<gt>text()
|
---|
465 |
|
---|
466 | This method returns the textual representation of the hyperlink as above,
|
---|
467 | but without markers (read only). Depending on the link type this is one of
|
---|
468 | the following alternatives (the + and * denote the portions of the text
|
---|
469 | that are marked up):
|
---|
470 |
|
---|
471 | +perl+ L<perl>
|
---|
472 | *$|* in +perlvar+ L<perlvar/$|>
|
---|
473 | *OPTIONS* in +perldoc+ L<perldoc/"OPTIONS">
|
---|
474 | *DESCRIPTION* L<"DESCRIPTION">
|
---|
475 |
|
---|
476 | =cut
|
---|
477 |
|
---|
478 | # The complete link's text
|
---|
479 | sub text {
|
---|
480 | $_[0]->{_text};
|
---|
481 | }
|
---|
482 |
|
---|
483 | =item $link-E<gt>warning()
|
---|
484 |
|
---|
485 | After parsing, this method returns any warnings encountered during the
|
---|
486 | parsing process.
|
---|
487 |
|
---|
488 | =cut
|
---|
489 |
|
---|
490 | # Set/retrieve warnings
|
---|
491 | sub warning {
|
---|
492 | my $self = shift;
|
---|
493 | if(@_) {
|
---|
494 | push(@{$self->{_warnings}}, @_);
|
---|
495 | return @_;
|
---|
496 | }
|
---|
497 | return @{$self->{_warnings}};
|
---|
498 | }
|
---|
499 |
|
---|
500 | =item $link-E<gt>file()
|
---|
501 |
|
---|
502 | =item $link-E<gt>line()
|
---|
503 |
|
---|
504 | Just simple slots for storing information about the line and the file
|
---|
505 | the link was encountered in. Has to be filled in manually.
|
---|
506 |
|
---|
507 | =cut
|
---|
508 |
|
---|
509 | # The line in the file the link appears
|
---|
510 | sub line {
|
---|
511 | return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
|
---|
512 | }
|
---|
513 |
|
---|
514 | # The POD file name the link appears in
|
---|
515 | sub file {
|
---|
516 | return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
|
---|
517 | }
|
---|
518 |
|
---|
519 | =item $link-E<gt>page()
|
---|
520 |
|
---|
521 | This method sets or returns the POD page this link points to.
|
---|
522 |
|
---|
523 | =cut
|
---|
524 |
|
---|
525 | # The POD page the link appears on
|
---|
526 | sub page {
|
---|
527 | if (@_ > 1) {
|
---|
528 | $_[0]->{-page} = $_[1];
|
---|
529 | $_[0]->_construct_text();
|
---|
530 | }
|
---|
531 | $_[0]->{-page};
|
---|
532 | }
|
---|
533 |
|
---|
534 | =item $link-E<gt>node()
|
---|
535 |
|
---|
536 | As above, but the destination node text of the link.
|
---|
537 |
|
---|
538 | =cut
|
---|
539 |
|
---|
540 | # The link destination
|
---|
541 | sub node {
|
---|
542 | if (@_ > 1) {
|
---|
543 | $_[0]->{-node} = $_[1];
|
---|
544 | $_[0]->_construct_text();
|
---|
545 | }
|
---|
546 | $_[0]->{-node};
|
---|
547 | }
|
---|
548 |
|
---|
549 | =item $link-E<gt>alttext()
|
---|
550 |
|
---|
551 | Sets or returns an alternative text specified in the link.
|
---|
552 |
|
---|
553 | =cut
|
---|
554 |
|
---|
555 | # Potential alternative text
|
---|
556 | sub alttext {
|
---|
557 | if (@_ > 1) {
|
---|
558 | $_[0]->{-alttext} = $_[1];
|
---|
559 | $_[0]->_construct_text();
|
---|
560 | }
|
---|
561 | $_[0]->{-alttext};
|
---|
562 | }
|
---|
563 |
|
---|
564 | =item $link-E<gt>type()
|
---|
565 |
|
---|
566 | The node type, either C<section> or C<item>. As an unofficial type,
|
---|
567 | there is also C<hyperlink>, derived from e.g. C<LE<lt>http://perl.comE<gt>>
|
---|
568 |
|
---|
569 | =cut
|
---|
570 |
|
---|
571 | # The type: item or headn
|
---|
572 | sub type {
|
---|
573 | return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
|
---|
574 | }
|
---|
575 |
|
---|
576 | =item $link-E<gt>link()
|
---|
577 |
|
---|
578 | Returns the link as contents of C<LE<lt>E<gt>>. Reciprocal to B<parse()>.
|
---|
579 |
|
---|
580 | =back
|
---|
581 |
|
---|
582 | =cut
|
---|
583 |
|
---|
584 | # The link itself
|
---|
585 | sub link {
|
---|
586 | my $self = shift;
|
---|
587 | my $link = $self->page() || '';
|
---|
588 | if($self->node()) {
|
---|
589 | my $node = $self->node();
|
---|
590 | $text =~ s/\|/E<verbar>/g;
|
---|
591 | $text =~ s:/:E<sol>:g;
|
---|
592 | if($self->type() eq 'section') {
|
---|
593 | $link .= ($link ? '/' : '') . '"' . $node . '"';
|
---|
594 | }
|
---|
595 | elsif($self->type() eq 'hyperlink') {
|
---|
596 | $link = $self->node();
|
---|
597 | }
|
---|
598 | else { # item
|
---|
599 | $link .= '/' . $node;
|
---|
600 | }
|
---|
601 | }
|
---|
602 | if($self->alttext()) {
|
---|
603 | my $text = $self->alttext();
|
---|
604 | $text =~ s/\|/E<verbar>/g;
|
---|
605 | $text =~ s:/:E<sol>:g;
|
---|
606 | $link = "$text|$link";
|
---|
607 | }
|
---|
608 | $link;
|
---|
609 | }
|
---|
610 |
|
---|
611 | sub _invalid_link {
|
---|
612 | my ($msg) = @_;
|
---|
613 | # this sets @_
|
---|
614 | #eval { die "$msg\n" };
|
---|
615 | #chomp $@;
|
---|
616 | $@ = $msg; # this seems to work, too!
|
---|
617 | undef;
|
---|
618 | }
|
---|
619 |
|
---|
620 | #-----------------------------------------------------------------------------
|
---|
621 | # Pod::Cache
|
---|
622 | #
|
---|
623 | # class to hold POD page details
|
---|
624 | #-----------------------------------------------------------------------------
|
---|
625 |
|
---|
626 | package Pod::Cache;
|
---|
627 |
|
---|
628 | =head2 Pod::Cache
|
---|
629 |
|
---|
630 | B<Pod::Cache> holds information about a set of POD documents,
|
---|
631 | especially the nodes for hyperlinks.
|
---|
632 | The following methods are available:
|
---|
633 |
|
---|
634 | =over 4
|
---|
635 |
|
---|
636 | =item Pod::Cache-E<gt>new()
|
---|
637 |
|
---|
638 | Create a new cache object. This object can hold an arbitrary number of
|
---|
639 | POD documents of class Pod::Cache::Item.
|
---|
640 |
|
---|
641 | =cut
|
---|
642 |
|
---|
643 | sub new {
|
---|
644 | my $this = shift;
|
---|
645 | my $class = ref($this) || $this;
|
---|
646 | my $self = [];
|
---|
647 | bless $self, $class;
|
---|
648 | return $self;
|
---|
649 | }
|
---|
650 |
|
---|
651 | =item $cache-E<gt>item()
|
---|
652 |
|
---|
653 | Add a new item to the cache. Without arguments, this method returns a
|
---|
654 | list of all cache elements.
|
---|
655 |
|
---|
656 | =cut
|
---|
657 |
|
---|
658 | sub item {
|
---|
659 | my ($self,%param) = @_;
|
---|
660 | if(%param) {
|
---|
661 | my $item = Pod::Cache::Item->new(%param);
|
---|
662 | push(@$self, $item);
|
---|
663 | return $item;
|
---|
664 | }
|
---|
665 | else {
|
---|
666 | return @{$self};
|
---|
667 | }
|
---|
668 | }
|
---|
669 |
|
---|
670 | =item $cache-E<gt>find_page($name)
|
---|
671 |
|
---|
672 | Look for a POD document named C<$name> in the cache. Returns the
|
---|
673 | reference to the corresponding Pod::Cache::Item object or undef if
|
---|
674 | not found.
|
---|
675 |
|
---|
676 | =back
|
---|
677 |
|
---|
678 | =cut
|
---|
679 |
|
---|
680 | sub find_page {
|
---|
681 | my ($self,$page) = @_;
|
---|
682 | foreach(@$self) {
|
---|
683 | if($_->page() eq $page) {
|
---|
684 | return $_;
|
---|
685 | }
|
---|
686 | }
|
---|
687 | undef;
|
---|
688 | }
|
---|
689 |
|
---|
690 | package Pod::Cache::Item;
|
---|
691 |
|
---|
692 | =head2 Pod::Cache::Item
|
---|
693 |
|
---|
694 | B<Pod::Cache::Item> holds information about individual POD documents,
|
---|
695 | that can be grouped in a Pod::Cache object.
|
---|
696 | It is intended to hold information about the hyperlink nodes of POD
|
---|
697 | documents.
|
---|
698 | The following methods are available:
|
---|
699 |
|
---|
700 | =over 4
|
---|
701 |
|
---|
702 | =item Pod::Cache::Item-E<gt>new()
|
---|
703 |
|
---|
704 | Create a new object.
|
---|
705 |
|
---|
706 | =cut
|
---|
707 |
|
---|
708 | sub new {
|
---|
709 | my $this = shift;
|
---|
710 | my $class = ref($this) || $this;
|
---|
711 | my %params = @_;
|
---|
712 | my $self = {%params};
|
---|
713 | bless $self, $class;
|
---|
714 | $self->initialize();
|
---|
715 | return $self;
|
---|
716 | }
|
---|
717 |
|
---|
718 | sub initialize {
|
---|
719 | my $self = shift;
|
---|
720 | $self->{-nodes} = [] unless(defined $self->{-nodes});
|
---|
721 | }
|
---|
722 |
|
---|
723 | =item $cacheitem-E<gt>page()
|
---|
724 |
|
---|
725 | Set/retrieve the POD document name (e.g. "Pod::Parser").
|
---|
726 |
|
---|
727 | =cut
|
---|
728 |
|
---|
729 | # The POD page
|
---|
730 | sub page {
|
---|
731 | return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
|
---|
732 | }
|
---|
733 |
|
---|
734 | =item $cacheitem-E<gt>description()
|
---|
735 |
|
---|
736 | Set/retrieve the POD short description as found in the C<=head1 NAME>
|
---|
737 | section.
|
---|
738 |
|
---|
739 | =cut
|
---|
740 |
|
---|
741 | # The POD description, taken out of NAME if present
|
---|
742 | sub description {
|
---|
743 | return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
|
---|
744 | }
|
---|
745 |
|
---|
746 | =item $cacheitem-E<gt>path()
|
---|
747 |
|
---|
748 | Set/retrieve the POD file storage path.
|
---|
749 |
|
---|
750 | =cut
|
---|
751 |
|
---|
752 | # The file path
|
---|
753 | sub path {
|
---|
754 | return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
|
---|
755 | }
|
---|
756 |
|
---|
757 | =item $cacheitem-E<gt>file()
|
---|
758 |
|
---|
759 | Set/retrieve the POD file name.
|
---|
760 |
|
---|
761 | =cut
|
---|
762 |
|
---|
763 | # The POD file name
|
---|
764 | sub file {
|
---|
765 | return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
|
---|
766 | }
|
---|
767 |
|
---|
768 | =item $cacheitem-E<gt>nodes()
|
---|
769 |
|
---|
770 | Add a node (or a list of nodes) to the document's node list. Note that
|
---|
771 | the order is kept, i.e. start with the first node and end with the last.
|
---|
772 | If no argument is given, the current list of nodes is returned in the
|
---|
773 | same order the nodes have been added.
|
---|
774 | A node can be any scalar, but usually is a pair of node string and
|
---|
775 | unique id for the C<find_node> method to work correctly.
|
---|
776 |
|
---|
777 | =cut
|
---|
778 |
|
---|
779 | # The POD nodes
|
---|
780 | sub nodes {
|
---|
781 | my ($self,@nodes) = @_;
|
---|
782 | if(@nodes) {
|
---|
783 | push(@{$self->{-nodes}}, @nodes);
|
---|
784 | return @nodes;
|
---|
785 | }
|
---|
786 | else {
|
---|
787 | return @{$self->{-nodes}};
|
---|
788 | }
|
---|
789 | }
|
---|
790 |
|
---|
791 | =item $cacheitem-E<gt>find_node($name)
|
---|
792 |
|
---|
793 | Look for a node or index entry named C<$name> in the object.
|
---|
794 | Returns the unique id of the node (i.e. the second element of the array
|
---|
795 | stored in the node arry) or undef if not found.
|
---|
796 |
|
---|
797 | =cut
|
---|
798 |
|
---|
799 | sub find_node {
|
---|
800 | my ($self,$node) = @_;
|
---|
801 | my @search;
|
---|
802 | push(@search, @{$self->{-nodes}}) if($self->{-nodes});
|
---|
803 | push(@search, @{$self->{-idx}}) if($self->{-idx});
|
---|
804 | foreach(@search) {
|
---|
805 | if($_->[0] eq $node) {
|
---|
806 | return $_->[1]; # id
|
---|
807 | }
|
---|
808 | }
|
---|
809 | undef;
|
---|
810 | }
|
---|
811 |
|
---|
812 | =item $cacheitem-E<gt>idx()
|
---|
813 |
|
---|
814 | Add an index entry (or a list of them) to the document's index list. Note that
|
---|
815 | the order is kept, i.e. start with the first node and end with the last.
|
---|
816 | If no argument is given, the current list of index entries is returned in the
|
---|
817 | same order the entries have been added.
|
---|
818 | An index entry can be any scalar, but usually is a pair of string and
|
---|
819 | unique id.
|
---|
820 |
|
---|
821 | =back
|
---|
822 |
|
---|
823 | =cut
|
---|
824 |
|
---|
825 | # The POD index entries
|
---|
826 | sub idx {
|
---|
827 | my ($self,@idx) = @_;
|
---|
828 | if(@idx) {
|
---|
829 | push(@{$self->{-idx}}, @idx);
|
---|
830 | return @idx;
|
---|
831 | }
|
---|
832 | else {
|
---|
833 | return @{$self->{-idx}};
|
---|
834 | }
|
---|
835 | }
|
---|
836 |
|
---|
837 | =head1 AUTHOR
|
---|
838 |
|
---|
839 | Please report bugs using L<http://rt.cpan.org>.
|
---|
840 |
|
---|
841 | Marek Rouchal E<lt>[email protected]<gt>, borrowing
|
---|
842 | a lot of things from L<pod2man> and L<pod2roff> as well as other POD
|
---|
843 | processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.
|
---|
844 |
|
---|
845 | =head1 SEE ALSO
|
---|
846 |
|
---|
847 | L<pod2man>, L<pod2roff>, L<Pod::Parser>, L<Pod::Checker>,
|
---|
848 | L<pod2html>
|
---|
849 |
|
---|
850 | =cut
|
---|
851 |
|
---|
852 | 1;
|
---|