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