Commit | Line | Data |
---|---|---|
e2c3adef GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 JH |
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 GS |
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 GS |
289 | |
290 | $self->{_warnings} = []; | |
291 | ||
292 | # collapse newlines with whitespace | |
5c9f27e7 JH |
293 | s/\s*\n+\s*/ /g; |
294 | ||
e2c3adef GS |
295 | # strip leading/trailing whitespace |
296 | if(s/^[\s\n]+//) { | |
1bc4b319 | 297 | $self->warning('ignoring leading whitespace in link'); |
e2c3adef GS |
298 | } |
299 | if(s/[\s\n]+$//) { | |
1bc4b319 | 300 | $self->warning('ignoring trailing whitespace in link'); |
e2c3adef GS |
301 | } |
302 | unless(length($_)) { | |
1bc4b319 SH |
303 | _invalid_link('empty link'); |
304 | return; | |
e2c3adef GS |
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 GS |
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 GS |
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 GS |
329 | ($alttext, $page) = ($1, $2); |
330 | $type = 'page'; | |
331 | } | |
332 | # alttext and "section" | |
1bc4b319 | 333 | elsif(m{^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$}) { |
48f30392 GS |
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 GS |
343 | } |
344 | # page and item | |
1bc4b319 | 345 | elsif(m{^($page_rx)\s*/\s*(.+)$}o) { |
66aff6dd | 346 | ($page, $node) = ($1, $2); |
e2c3adef GS |
347 | $type = 'item'; |
348 | } | |
66aff6dd | 349 | # only "section" |
1bc4b319 | 350 | elsif(m{^/?"(.+)"$}) { |
e2c3adef GS |
351 | $node = $1; |
352 | $type = 'section'; | |
9c6ed6d7 | 353 | $quoted = 1; |
e2c3adef GS |
354 | } |
355 | # only item | |
1bc4b319 | 356 | elsif(m{^\s*/(.+)$}) { |
e2c3adef GS |
357 | $node = $1; |
358 | $type = 'item'; | |
359 | } | |
267d5541 SP |
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 SP |
363 | ($alttext,$node) = ($1,$2); |
364 | $type = 'hyperlink'; | |
365 | } | |
366 | ||
e2c3adef | 367 | # non-standard: Hyperlink |
1bc4b319 | 368 | elsif(/^(\w+:[^:\s]\S*)$/i) { |
e2c3adef GS |
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 GS |
375 | $type = 'item'; |
376 | } | |
e2c3adef | 377 | # alttext and item |
1bc4b319 | 378 | elsif(m{^(.*?)\s*[|]\s*/(.+)$}) { |
e2c3adef GS |
379 | ($alttext, $node) = ($1,$2); |
380 | } | |
e2c3adef GS |
381 | # must be an item or a "malformed" section (without "") |
382 | else { | |
383 | $node = $_; | |
384 | $type = 'item'; | |
385 | } | |
66aff6dd GS |
386 | # collapse whitespace in nodes |
387 | $node =~ s/\s+/ /gs; | |
e2c3adef | 388 | |
92e3d63a JH |
389 | # empty alternative text expands to node name |
390 | if(defined $alttext) { | |
391 | if(!length($alttext)) { | |
1bc4b319 | 392 | $alttext = $node || $page; |
92e3d63a JH |
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 GS |
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 GS |
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 HS |
432 | $self->{_text} = ($section || '') . |
433 | (($page && $section) ? ' in ' : '') . | |
434 | "$page$page_ext"; | |
e2c3adef GS |
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 HS |
447 | $self->{_markup} = (!$section ? '' : "Q<$section>") . |
448 | ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : ''); | |
e2c3adef GS |
449 | } |
450 | } | |
451 | ||
92e3d63a | 452 | =item $link-E<gt>markup($string) |
e2c3adef GS |
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 GS |
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 HS |
474 | +perl+ L<perl> |
475 | *$|* in +perlvar+ L<perlvar/$|> | |
476 | *OPTIONS* in +perldoc+ L<perldoc/"OPTIONS"> | |
477 | *DESCRIPTION* L<"DESCRIPTION"> | |
e2c3adef GS |
478 | |
479 | =cut | |
480 | ||
481 | # The complete link's text | |
482 | sub text { | |
1bc4b319 | 483 | return $_[0]->{_text}; |
e2c3adef GS |
484 | } |
485 | ||
92e3d63a | 486 | =item $link-E<gt>warning() |
e2c3adef GS |
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 JH |
503 | =item $link-E<gt>file() |
504 | ||
505 | =item $link-E<gt>line() | |
e2c3adef GS |
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 GS |
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 GS |
535 | } |
536 | ||
92e3d63a | 537 | =item $link-E<gt>node() |
e2c3adef GS |
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 GS |
550 | } |
551 | ||
92e3d63a | 552 | =item $link-E<gt>alttext() |
e2c3adef GS |
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 GS |
565 | } |
566 | ||
92e3d63a | 567 | =item $link-E<gt>type() |
e2c3adef GS |
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 GS |
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 SH |
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 GS |
597 | } |
598 | elsif($self->type() eq 'hyperlink') { | |
599 | $link = $self->node(); | |
600 | } | |
601 | else { # item | |
66aff6dd | 602 | $link .= '/' . $node; |
e2c3adef GS |
603 | } |
604 | } | |
605 | if($self->alttext()) { | |
66aff6dd GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
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 GS |
800 | =cut |
801 | ||
802 | sub find_node { | |
803 | my ($self,$node) = @_; | |
48f30392 GS |
804 | my @search; |
805 | push(@search, @{$self->{-nodes}}) if($self->{-nodes}); | |
806 | push(@search, @{$self->{-idx}}) if($self->{-idx}); | |
807 | foreach(@search) { | |
e2c3adef GS |
808 | if($_->[0] eq $node) { |
809 | return $_->[1]; # id | |
810 | } | |
811 | } | |
1bc4b319 | 812 | return; |
e2c3adef GS |
813 | } |
814 | ||
92e3d63a | 815 | =item $cacheitem-E<gt>idx() |
48f30392 GS |
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 JH |
824 | =back |
825 | ||
48f30392 GS |
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 GS |
839 | |
840 | =head1 AUTHOR | |
841 | ||
aaa799f9 NC |
842 | Please report bugs using L<http://rt.cpan.org>. |
843 | ||
844 | Marek Rouchal E<lt>marekr@cpan.orgE<gt>, borrowing | |
e2c3adef GS |
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; |