← Back to branch summary

~ubuntu-branches/ubuntu/trusty/libpod-simple-perl/trusty

« back to all changes in this revision

Viewing changes to .pc/pod.patch/lib/Pod/Simple/XHTML.pm

  • Committer: Bazaar Package Importer
  • Author(s): Jonathan Yu
  • Date: 2010-05-01 23:28:32 UTC
  • mfrom: (1.1.9 upstream)
  • Revision ID: james.westby@ubuntu.com-20100501232832-uhsd4zwmusp12z65
Tags: 3.14-1
* New upstream release
* Use new 3.0 (quilt) source format
* Standards-Version 3.8.4 (no changes)
* Add a patch to fix POD spelling errors
* Update copyright information to DEP5 format

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/pod.patch/lib/Pod/Simple/XHTML.pm
 
1
=pod
 
2
 
 
3
=head1 NAME
 
4
 
 
5
Pod::Simple::XHTML -- format Pod as validating XHTML
 
6
 
 
7
=head1 SYNOPSIS
 
8
 
 
9
  use Pod::Simple::XHTML;
 
10
 
 
11
  my $parser = Pod::Simple::XHTML->new();
 
12
 
 
13
  ...
 
14
 
 
15
  $parser->parse_file('path/to/file.pod');
 
16
 
 
17
=head1 DESCRIPTION
 
18
 
 
19
This class is a formatter that takes Pod and renders it as XHTML
 
20
validating HTML.
 
21
 
 
22
This is a subclass of L<Pod::Simple::Methody> and inherits all its
 
23
methods. The implementation is entirely different than
 
24
L<Pod::Simple::HTML>, but it largely preserves the same interface.
 
25
 
 
26
=cut
 
27
 
 
28
package Pod::Simple::XHTML;
 
29
use strict;
 
30
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
 
31
$VERSION = '3.14';
 
32
use Carp ();
 
33
use Pod::Simple::Methody ();
 
34
@ISA = ('Pod::Simple::Methody');
 
35
 
 
36
BEGIN {
 
37
  $HAS_HTML_ENTITIES = eval "require HTML::Entities; 1";
 
38
}
 
39
 
 
40
my %entities = (
 
41
  q{>} => 'gt',
 
42
  q{<} => 'lt',
 
43
  q{'} => '#39',
 
44
  q{"} => 'quot',
 
45
  q{&} => 'amp',
 
46
);
 
47
 
 
48
sub encode_entities {
 
49
  return HTML::Entities::encode_entities( $_[0] ) if $HAS_HTML_ENTITIES;
 
50
  my $str = $_[0];
 
51
  my $ents = join '', keys %entities;
 
52
  $str =~ s/([$ents])/'&' . $entities{$1} . ';'/ge;
 
53
  return $str;
 
54
}
 
55
 
 
56
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
57
 
 
58
=head1 METHODS
 
59
 
 
60
Pod::Simple::XHTML offers a number of methods that modify the format of
 
61
the HTML output. Call these after creating the parser object, but before
 
62
the call to C<parse_file>:
 
63
 
 
64
  my $parser = Pod::PseudoPod::HTML->new();
 
65
  $parser->set_optional_param("value");
 
66
  $parser->parse_file($file);
 
67
 
 
68
=head2 perldoc_url_prefix
 
69
 
 
70
In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
 
71
to put before the "Foo%3a%3aBar". The default value is
 
72
"http://search.cpan.org/perldoc?".
 
73
 
 
74
=head2 perldoc_url_postfix
 
75
 
 
76
What to put after "Foo%3a%3aBar" in the URL. This option is not set by
 
77
default.
 
78
 
 
79
=head2 man_url_prefix
 
80
 
 
81
In turning C<< L<crontab(5)> >> into http://whatever/man/1/crontab, what
 
82
to put before the "1/crontab". The default value is
 
83
"http://man.he.net/man".
 
84
 
 
85
=head2 man_url_postfix
 
86
 
 
87
What to put after "1/crontab" in the URL. This option is not set by default.
 
88
 
 
89
=head2 title_prefix, title_postfix
 
90
 
 
91
What to put before and after the title in the head. The values should
 
92
already be &-escaped.
 
93
 
 
94
=head2 html_css
 
95
 
 
96
  $parser->html_css('path/to/style.css');
 
97
 
 
98
The URL or relative path of a CSS file to include. This option is not
 
99
set by default.
 
100
 
 
101
=head2 html_javascript
 
102
 
 
103
The URL or relative path of a JavaScript file to pull in. This option is
 
104
not set by default.
 
105
 
 
106
=head2 html_doctype
 
107
 
 
108
A document type tag for the file. This option is not set by default.
 
109
 
 
110
=head2 html_header_tags
 
111
 
 
112
Additional arbitrary HTML tags for the header of the document. The
 
113
default value is just a content type header tag:
 
114
 
 
115
  <meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
 
116
 
 
117
Add additional meta tags here, or blocks of inline CSS or JavaScript
 
118
(wrapped in the appropriate tags).
 
119
 
 
120
=head2 html_h_level
 
121
 
 
122
This is the level of HTML "Hn" element to which a Pod "head1" corresponds.  For
 
123
example, if C<html_h_level> is set to 2, a head1 will produce an H2, a head2
 
124
will produce an H3, and so on.
 
125
 
 
126
=head2 default_title
 
127
 
 
128
Set a default title for the page if no title can be determined from the
 
129
content. The value of this string should already be &-escaped.
 
130
 
 
131
=head2 force_title
 
132
 
 
133
Force a title for the page (don't try to determine it from the content).
 
134
The value of this string should already be &-escaped.
 
135
 
 
136
=head2 html_header, html_footer
 
137
 
 
138
Set the HTML output at the beginning and end of each file. The default
 
139
header includes a title, a doctype tag (if C<html_doctype> is set), a
 
140
content tag (customized by C<html_header_tags>), a tag for a CSS file
 
141
(if C<html_css> is set), and a tag for a Javascript file (if
 
142
C<html_javascript> is set). The default footer simply closes the C<html>
 
143
and C<body> tags.
 
144
 
 
145
The options listed above customize parts of the default header, but
 
146
setting C<html_header> or C<html_footer> completely overrides the
 
147
built-in header or footer. These may be useful if you want to use
 
148
template tags instead of literal HTML headers and footers or are
 
149
integrating converted POD pages in a larger website.
 
150
 
 
151
If you want no headers or footers output in the HTML, set these options
 
152
to the empty string.
 
153
 
 
154
=head2 index
 
155
 
 
156
Whether to add a table-of-contents at the top of each page (called an
 
157
index for the sake of tradition).
 
158
 
 
159
 
 
160
=cut
 
161
 
 
162
__PACKAGE__->_accessorize(
 
163
 'perldoc_url_prefix',
 
164
 'perldoc_url_postfix',
 
165
 'man_url_prefix',
 
166
 'man_url_postfix',
 
167
 'title_prefix',  'title_postfix',
 
168
 'html_css', 
 
169
 'html_javascript',
 
170
 'html_doctype',
 
171
 'html_header_tags',
 
172
 'html_h_level',
 
173
 'title', # Used internally for the title extracted from the content
 
174
 'default_title',
 
175
 'force_title',
 
176
 'html_header',
 
177
 'html_footer',
 
178
 'index',
 
179
 'batch_mode', # whether we're in batch mode
 
180
 'batch_mode_current_level',
 
181
    # When in batch mode, how deep the current module is: 1 for "LWP",
 
182
    #  2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
 
183
);
 
184
 
 
185
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
186
 
 
187
=head1 SUBCLASSING
 
188
 
 
189
If the standard options aren't enough, you may want to subclass
 
190
Pod::Simple::XHMTL. These are the most likely candidates for methods
 
191
you'll want to override when subclassing.
 
192
 
 
193
=cut
 
194
 
 
195
sub new {
 
196
  my $self = shift;
 
197
  my $new = $self->SUPER::new(@_);
 
198
  $new->{'output_fh'} ||= *STDOUT{IO};
 
199
  $new->perldoc_url_prefix('http://search.cpan.org/perldoc?');
 
200
  $new->man_url_prefix('http://man.he.net/man');
 
201
  $new->html_header_tags('<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" />');
 
202
  $new->nix_X_codes(1);
 
203
  $new->codes_in_verbatim(1);
 
204
  $new->{'scratch'} = '';
 
205
  $new->{'to_index'} = [];
 
206
  $new->{'output'} = [];
 
207
  $new->{'saved'} = [];
 
208
  $new->{'ids'} = {};
 
209
 
 
210
  $new->{'__region_targets'}  = [];
 
211
  $new->{'__literal_targets'} = {};
 
212
  $new->accept_targets_as_html( 'html', 'HTML' );
 
213
 
 
214
  return $new;
 
215
}
 
216
 
 
217
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
218
 
 
219
=head2 handle_text
 
220
 
 
221
This method handles the body of text within any element: it's the body
 
222
of a paragraph, or everything between a "=begin" tag and the
 
223
corresponding "=end" tag, or the text within an L entity, etc. You would
 
224
want to override this if you are adding a custom element type that does
 
225
more than just display formatted text. Perhaps adding a way to generate
 
226
HTML tables from an extended version of POD.
 
227
 
 
228
So, let's say you want add a custom element called 'foo'. In your
 
229
subclass's C<new> method, after calling C<SUPER::new> you'd call:
 
230
 
 
231
  $new->accept_targets_as_text( 'foo' );
 
232
 
 
233
Then override the C<start_for> method in the subclass to check for when
 
234
"$flags->{'target'}" is equal to 'foo' and set a flag that marks that
 
235
you're in a foo block (maybe "$self->{'in_foo'} = 1"). Then override the
 
236
C<handle_text> method to check for the flag, and pass $text to your
 
237
custom subroutine to construct the HTML output for 'foo' elements,
 
238
something like:
 
239
 
 
240
  sub handle_text {
 
241
      my ($self, $text) = @_;
 
242
      if ($self->{'in_foo'}) {
 
243
          $self->{'scratch'} .= build_foo_html($text);
 
244
      } else {
 
245
          $self->{'scratch'} .= $text;
 
246
      }
 
247
  }
 
248
 
 
249
=head2 accept_targets_as_html
 
250
 
 
251
This method behaves like C<accept_targets_as_text>, but also marks the region
 
252
as one whose content should be emitted literally, without HTML entity escaping
 
253
or wrapping in a C<div> element.
 
254
 
 
255
=cut
 
256
 
 
257
sub __in_literal_xhtml_region {
 
258
    return unless @{ $_[0]{__region_targets} };
 
259
    my $target = $_[0]{__region_targets}[-1];
 
260
    return $_[0]{__literal_targets}{ $target };
 
261
}
 
262
 
 
263
sub accept_targets_as_html {
 
264
    my ($self, @targets) = @_;
 
265
    $self->accept_targets(@targets);
 
266
    $self->{__literal_targets}{$_} = 1 for @targets;
 
267
}
 
268
 
 
269
sub handle_text {
 
270
    # escape special characters in HTML (<, >, &, etc)
 
271
    $_[0]{'scratch'} .= $_[0]->__in_literal_xhtml_region
 
272
                      ? $_[1]
 
273
                      : encode_entities( $_[1] );
 
274
}
 
275
 
 
276
sub start_Para     { $_[0]{'scratch'} = '<p>' }
 
277
sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>' }
 
278
 
 
279
sub start_head1 {  $_[0]{'in_head'} = 1 }
 
280
sub start_head2 {  $_[0]{'in_head'} = 2 }
 
281
sub start_head3 {  $_[0]{'in_head'} = 3 }
 
282
sub start_head4 {  $_[0]{'in_head'} = 4 }
 
283
 
 
284
sub start_item_number {
 
285
    $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
 
286
    $_[0]{'scratch'} .= '<li><p>';
 
287
    $_[0]{'in_li'} = 1
 
288
}
 
289
 
 
290
sub start_item_bullet {
 
291
    $_[0]{'scratch'} = "</li>\n" if $_[0]{'in_li'};
 
292
    $_[0]{'scratch'} .= '<li><p>';
 
293
    $_[0]{'in_li'} = 1
 
294
}
 
295
 
 
296
sub start_item_text   {
 
297
    if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) {
 
298
        $_[0]{'scratch'} = "</dd>\n";
 
299
        $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0;
 
300
    }
 
301
    $_[0]{'scratch'} .= '<dt>';
 
302
}
 
303
 
 
304
sub start_over_bullet { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
 
305
sub start_over_block  { $_[0]{'scratch'} = '<ul>'; $_[0]->emit }
 
306
sub start_over_number { $_[0]{'scratch'} = '<ol>'; $_[0]->emit }
 
307
sub start_over_text   {
 
308
    $_[0]{'scratch'} = '<dl>';
 
309
    $_[0]{'dl_level'}++;
 
310
    $_[0]{'in_dd'} ||= [];
 
311
    $_[0]->emit
 
312
}
 
313
 
 
314
sub end_over_block  { $_[0]{'scratch'} .= '</ul>'; $_[0]->emit }
 
315
 
 
316
sub end_over_number   {
 
317
    $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
 
318
    $_[0]{'scratch'} .= '</ol>';
 
319
    $_[0]->emit;
 
320
}
 
321
 
 
322
sub end_over_bullet   {
 
323
    $_[0]{'scratch'} = "</li>\n" if delete $_[0]{'in_li'};
 
324
    $_[0]{'scratch'} .= '</ul>';
 
325
    $_[0]->emit;
 
326
}
 
327
 
 
328
sub end_over_text   {
 
329
    if ($_[0]{'in_dd'}[ $_[0]{'dl_level'} ]) {
 
330
        $_[0]{'scratch'} = "</dd>\n";
 
331
        $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 0;
 
332
    }
 
333
    $_[0]{'scratch'} .= '</dl>';
 
334
    $_[0]{'dl_level'}--;
 
335
    $_[0]->emit;
 
336
}
 
337
 
 
338
# . . . . . Now the actual formatters:
 
339
 
 
340
sub end_Para     { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
 
341
sub end_Verbatim {
 
342
    $_[0]{'scratch'}     .= '</code></pre>';
 
343
    $_[0]->emit;
 
344
}
 
345
 
 
346
sub _end_head {
 
347
    my $h = delete $_[0]{in_head};
 
348
 
 
349
    my $add = $_[0]->html_h_level;
 
350
    $add = 1 unless defined $add;
 
351
    $h += $add - 1;
 
352
 
 
353
    my $id = $_[0]->idify($_[0]{scratch});
 
354
    my $text = $_[0]{scratch};
 
355
    $_[0]{'scratch'} = qq{<h$h id="$id">$text</h$h>};
 
356
    $_[0]->emit;
 
357
    push @{ $_[0]{'to_index'} }, [$h, $id, $text];
 
358
}
 
359
 
 
360
sub end_head1       { shift->_end_head(@_); }
 
361
sub end_head2       { shift->_end_head(@_); }
 
362
sub end_head3       { shift->_end_head(@_); }
 
363
sub end_head4       { shift->_end_head(@_); }
 
364
 
 
365
sub end_item_bullet { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
 
366
sub end_item_number { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
 
367
 
 
368
sub end_item_text   {
 
369
    $_[0]{'scratch'} .= "</dt>\n<dd>";
 
370
    $_[0]{'in_dd'}[ $_[0]{'dl_level'} ] = 1;
 
371
    $_[0]->emit;
 
372
}
 
373
 
 
374
# This handles =begin and =for blocks of all kinds.
 
375
sub start_for { 
 
376
  my ($self, $flags) = @_;
 
377
 
 
378
  push @{ $self->{__region_targets} }, $flags->{target_matching};
 
379
 
 
380
  unless ($self->__in_literal_xhtml_region) {
 
381
    $self->{scratch} .= '<div';
 
382
    $self->{scratch} .= qq( class="$flags->{target}") if $flags->{target};
 
383
    $self->{scratch} .= '>';
 
384
  }
 
385
 
 
386
  $self->emit;
 
387
 
 
388
}
 
389
sub end_for { 
 
390
  my ($self) = @_;
 
391
 
 
392
  $self->{'scratch'} .= '</div>' unless $self->__in_literal_xhtml_region;
 
393
 
 
394
  pop @{ $self->{__region_targets} };
 
395
  $self->emit;
 
396
}
 
397
 
 
398
sub start_Document { 
 
399
  my ($self) = @_;
 
400
  if (defined $self->html_header) {
 
401
    $self->{'scratch'} .= $self->html_header;
 
402
    $self->emit unless $self->html_header eq "";
 
403
  } else {
 
404
    my ($doctype, $title, $metatags);
 
405
    $doctype = $self->html_doctype || '';
 
406
    $title = $self->force_title || $self->title || $self->default_title || '';
 
407
    $metatags = $self->html_header_tags || '';
 
408
    if ($self->html_css) {
 
409
      $metatags .= "\n<link rel='stylesheet' href='" .
 
410
             $self->html_css . "' type='text/css'>";
 
411
    }
 
412
    if ($self->html_javascript) {
 
413
      $metatags .= "\n<script type='text/javascript' src='" .
 
414
                    $self->html_javascript . "'></script>";
 
415
    }
 
416
    $self->{'scratch'} .= <<"HTML";
 
417
$doctype
 
418
<html>
 
419
<head>
 
420
<title>$title</title>
 
421
$metatags
 
422
</head>
 
423
<body>
 
424
HTML
 
425
    $self->emit;
 
426
  }
 
427
}
 
428
 
 
429
sub end_Document   {
 
430
  my ($self) = @_;
 
431
  my $to_index = $self->{'to_index'};
 
432
  if ($self->index && @{ $to_index } ) {
 
433
      my @out;
 
434
      my $level  = 0;
 
435
      my $indent = -1;
 
436
      my $space  = '';
 
437
      my $id     = ' id="index"';
 
438
 
 
439
      for my $h (@{ $to_index }, [0]) {
 
440
          my $target_level = $h->[0];
 
441
          # Get to target_level by opening or closing ULs
 
442
          if ($level == $target_level) {
 
443
              $out[-1] .= '</li>';
 
444
          } elsif ($level > $target_level) {
 
445
              $out[-1] .= '</li>' if $out[-1] =~ /^\s+<li>/;
 
446
              while ($level > $target_level) {
 
447
                  --$level;
 
448
                  push @out, ('  ' x --$indent) . '</li>' if @out && $out[-1] =~ m{^\s+<\/ul};
 
449
                  push @out, ('  ' x --$indent) . '</ul>';
 
450
              }
 
451
              push @out, ('  ' x --$indent) . '</li>' if $level;
 
452
          } else {
 
453
              while ($level < $target_level) {
 
454
                  ++$level;
 
455
                  push @out, ('  ' x ++$indent) . '<li>' if @out && $out[-1]=~ /^\s*<ul/;
 
456
                  push @out, ('  ' x ++$indent) . "<ul$id>";
 
457
                  $id = '';
 
458
              }
 
459
              ++$indent;
 
460
          }
 
461
 
 
462
          next unless $level;
 
463
          $space = '  '  x $indent;
 
464
          push @out, sprintf '%s<li><a href="#%s">%s</a>',
 
465
              $space, $h->[1], $h->[2];
 
466
      }
 
467
      # Splice the index in between the HTML headers and the first element.
 
468
      my $offset = defined $self->html_header ? $self->html_header eq '' ? 0 : 1 : 1;
 
469
      splice @{ $self->{'output'} }, $offset, 0, join "\n", @out;
 
470
  }
 
471
 
 
472
  if (defined $self->html_footer) {
 
473
    $self->{'scratch'} .= $self->html_footer;
 
474
    $self->emit unless $self->html_footer eq "";
 
475
  } else {
 
476
    $self->{'scratch'} .= "</body>\n</html>";
 
477
    $self->emit;
 
478
  }
 
479
 
 
480
  if ($self->index) {
 
481
      print {$self->{'output_fh'}} join ("\n\n", @{ $self->{'output'} }), "\n\n";
 
482
      @{$self->{'output'}} = ();
 
483
  }
 
484
 
 
485
}
 
486
 
 
487
# Handling code tags
 
488
sub start_B { $_[0]{'scratch'} .= '<b>' }
 
489
sub end_B   { $_[0]{'scratch'} .= '</b>' }
 
490
 
 
491
sub start_C { $_[0]{'scratch'} .= '<code>' }
 
492
sub end_C   { $_[0]{'scratch'} .= '</code>' }
 
493
 
 
494
sub start_F { $_[0]{'scratch'} .= '<i>' }
 
495
sub end_F   { $_[0]{'scratch'} .= '</i>' }
 
496
 
 
497
sub start_I { $_[0]{'scratch'} .= '<i>' }
 
498
sub end_I   { $_[0]{'scratch'} .= '</i>' }
 
499
 
 
500
sub start_L {
 
501
  my ($self, $flags) = @_;
 
502
    my ($type, $to, $section) = @{$flags}{'type', 'to', 'section'};
 
503
    my $url = $type eq 'url' ? $to
 
504
            : $type eq 'pod' ? $self->resolve_pod_page_link($to, $section)
 
505
            : $type eq 'man' ? $self->resolve_man_page_link($to, $section)
 
506
            :                  undef;
 
507
 
 
508
    # If it's an unknown type, use an attribute-less <a> like HTML.pm.
 
509
    $self->{'scratch'} .= '<a' . ($url ? ' href="'. $url . '">' : '>');
 
510
}
 
511
 
 
512
sub end_L   { $_[0]{'scratch'} .= '</a>' }
 
513
 
 
514
sub start_S { $_[0]{'scratch'} .= '<nobr>' }
 
515
sub end_S   { $_[0]{'scratch'} .= '</nobr>' }
 
516
 
 
517
sub emit {
 
518
  my($self) = @_;
 
519
  if ($self->index) {
 
520
      push @{ $self->{'output'} }, $self->{'scratch'};
 
521
  } else {
 
522
      print {$self->{'output_fh'}} $self->{'scratch'}, "\n\n";
 
523
  }
 
524
  $self->{'scratch'} = '';
 
525
  return;
 
526
}
 
527
 
 
528
=head2 resolve_pod_page_link
 
529
 
 
530
  my $url = $pod->resolve_pod_page_link('Net::Ping', 'INSTALL');
 
531
  my $url = $pod->resolve_pod_page_link('perlpodspec');
 
532
  my $url = $pod->resolve_pod_page_link(undef, 'SYNOPSIS');
 
533
 
 
534
Resolves a POD link target (typically a module or POD file name) and section
 
535
name to a URL. The resulting link will be returned for the above examples as:
 
536
 
 
537
  http://search.cpan.org/perldoc?Net::Ping#INSTALL
 
538
  http://search.cpan.org/perldoc?perlpodspec
 
539
  #SYNOPSIS
 
540
 
 
541
Note that when there is only a section argument the URL will simply be a link
 
542
to a section in the current document.
 
543
 
 
544
=cut
 
545
 
 
546
sub resolve_pod_page_link {
 
547
    my ($self, $to, $section) = @_;
 
548
    return undef unless defined $to || defined $section;
 
549
    if (defined $section) {
 
550
        $section = '#' . $self->idify($section, 1);
 
551
        return $section unless defined $to;
 
552
    } else {
 
553
        $section = ''
 
554
    }
 
555
 
 
556
    return ($self->perldoc_url_prefix || '')
 
557
        . encode_entities($to) . $section
 
558
        . ($self->perldoc_url_postfix || '');
 
559
}
 
560
 
 
561
=head2 resolve_man_page_link
 
562
 
 
563
  my $url = $pod->resolve_man_page_link('crontab(5)', 'EXAMPLE CRON FILE');
 
564
  my $url = $pod->resolve_man_page_link('crontab');
 
565
 
 
566
Resolves a man page link target and numeric section to a URL. The resulting
 
567
link will be returned for the above examples as:
 
568
 
 
569
    http://man.he.net/man5/crontab
 
570
    http://man.he.net/man1/crontab
 
571
 
 
572
Note that the first argument is required. The section number will be parsed
 
573
from it, and if it's missing will default to 1. The second argument is
 
574
currently ignored, as L<man.he.net|http://man.he.net> does not currently
 
575
include linkable IDs or anchor names in its pages. Subclass to link to a
 
576
different man page HTTP server.
 
577
 
 
578
=cut
 
579
 
 
580
sub resolve_man_page_link {
 
581
    my ($self, $to, $section) = @_;
 
582
    return undef unless defined $to;
 
583
    my ($page, $part) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/;
 
584
    return undef unless $page;
 
585
    return ($self->man_url_prefix || '')
 
586
        . ($part || 1) . "/" . encode_entities($page)
 
587
        . ($self->man_url_postfix || '');
 
588
 
 
589
}
 
590
 
 
591
=head2 idify
 
592
 
 
593
  my $id   = $pod->idify($text);
 
594
  my $hash = $pod->idify($text, 1);
 
595
 
 
596
This method turns an arbitrary string into a valid XHTML ID attribute value.
 
597
The rules enforced, following
 
598
L<http://webdesign.about.com/od/htmltags/a/aa031707.htm>, are:
 
599
 
 
600
=over
 
601
 
 
602
=item *
 
603
 
 
604
The id must start with a letter (a-z or A-Z)
 
605
 
 
606
=item *
 
607
 
 
608
All subsequent characters can be letters, numbers (0-9), hyphens (-),
 
609
underscores (_), colons (:), and periods (.).
 
610
 
 
611
=item *
 
612
 
 
613
Each id must be unique within the document.
 
614
 
 
615
=back
 
616
 
 
617
In addition, the returned value will be unique within the context of the
 
618
Pod::Simple::XHTML object unless a second argument is passed a true value. ID
 
619
attributes should always be unique within a single XHTML document, but pass
 
620
the true value if you are creating not an ID but a URL hash to point to
 
621
an ID (i.e., if you need to put the "#foo" in C<< <a href="#foo">foo</a> >>.
 
622
 
 
623
=cut
 
624
 
 
625
sub idify {
 
626
    my ($self, $t, $not_unique) = @_;
 
627
    for ($t) {
 
628
        s/<[^>]+>//g;            # Strip HTML.
 
629
        s/&[^;]+;//g;            # Strip entities.
 
630
        s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
 
631
        s/^[^a-zA-Z]+//;         # First char must be a letter.
 
632
        s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
 
633
    }
 
634
    return $t if $not_unique;
 
635
    my $i = '';
 
636
    $i++ while $self->{ids}{"$t$i"}++;
 
637
    return "$t$i";
 
638
}
 
639
 
 
640
=head2 batch_mode_page_object_init
 
641
 
 
642
  $pod->batch_mode_page_object_init($batchconvobj, $module, $infile, $outfile, $depth);
 
643
 
 
644
Called by L<Pod::Simple::HTMLBatch> so that the class has a chance to
 
645
initialize the converter. Internally it sets the C<batch_mode> property to
 
646
true and sets C<batch_mode_current_level()>, but Pod::Simple::XHTML does not
 
647
currently use those features. Subclasses might, though.
 
648
 
 
649
=cut
 
650
 
 
651
sub batch_mode_page_object_init {
 
652
  my ($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_;
 
653
  $self->batch_mode(1);
 
654
  $self->batch_mode_current_level($depth);
 
655
  return $self;
 
656
}
 
657
 
 
658
1;
 
659
 
 
660
__END__
 
661
 
 
662
=head1 SEE ALSO
 
663
 
 
664
L<Pod::Simple>, L<Pod::Simple::Text>, L<Pod::Spell>
 
665
 
 
666
=head1 SUPPORT
 
667
 
 
668
Questions or discussion about POD and Pod::Simple should be sent to the
 
669
pod-people@perl.org mail list. Send an empty email to
 
670
pod-people-subscribe@perl.org to subscribe.
 
671
 
 
672
This module is managed in an open GitHub repository,
 
673
L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
 
674
to clone L<git://github.com/theory/pod-simple.git> and send patches!
 
675
 
 
676
Patches against Pod::Simple are welcome. Please send bug reports to
 
677
<bug-pod-simple@rt.cpan.org>.
 
678
 
 
679
=head1 COPYRIGHT AND DISCLAIMERS
 
680
 
 
681
Copyright (c) 2003-2005 Allison Randal.
 
682
 
 
683
This library is free software; you can redistribute it and/or modify it
 
684
under the same terms as Perl itself.
 
685
 
 
686
This program is distributed in the hope that it will be useful, but
 
687
without any warranty; without even the implied warranty of
 
688
merchantability or fitness for a particular purpose.
 
689
 
 
690
=head1 ACKNOWLEDGEMENTS
 
691
 
 
692
Thanks to L<Hurricane Electrict|http://he.net/> for permission to use its
 
693
L<Linux man pages online|http://man.he.net/> site for man page links.
 
694
 
 
695
Thanks to L<search.cpan.org|http://search.cpan.org/> for permission to use the
 
696
site for Perl module links.
 
697
 
 
698
=head1 AUTHOR
 
699
 
 
700
Pod::Simpele::XHTML was created by Allison Randal <allison@perl.org>.
 
701
 
 
702
Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
 
703
But don't bother him, he's retired.
 
704
 
 
705
Pod::Simple is maintained by:
 
706
 
 
707
=over
 
708
 
 
709
=item * Allison Randal C<allison@perl.org>
 
710
 
 
711
=item * Hans Dieter Pearcey C<hdp@cpan.org>
 
712
 
 
713
=item * David E. Wheeler C<dwheeler@cpan.org>
 
714
 
 
715
=back
 
716
 
 
717
=cut