rt/lib/RT/Pod/HTML.pm

   1 use strict;
   2 use warnings;
   3
   4 package RT::Pod::HTML;
   5 use base 'Pod::Simple::XHTML';
   6
   7 sub new {
   8     my $self = shift->SUPER::new(@_);
   9     $self->index(1);
  10     $self->anchor_items(1);
  11     return $self;
  12 }
  13
  14 sub perldoc_url_prefix { "http://metacpan.org/module/" }
  15
  16 sub html_header { '' }
  17 sub html_footer {
  18     my $self = shift;
  19     my $toc  = "../" x ($self->batch_mode_current_level - 1);
  20     return '<a href="./' . $toc . '">&larr; Back to index</a>';
  21 }
  22
  23 sub start_Verbatim { $_[0]{'scratch'} = "<pre>" }
  24 sub end_Verbatim   { $_[0]{'scratch'} .= "</pre>"; $_[0]->emit; }
  25
  26 sub _end_head {
  27     my $self = shift;
  28     $self->{scratch} = '<a href="#___top">' . $self->{scratch} . '</a>';
  29     return $self->SUPER::_end_head(@_);
  30 }
  31
  32 sub resolve_pod_page_link {
  33     my $self = shift;
  34     my ($name, $section) = @_;
  35
  36     # Only try to resolve local links if we're in batch mode and are linking
  37     # outside the current document.
  38     return $self->SUPER::resolve_pod_page_link(@_)
  39         unless $self->batch_mode and $name;
  40
  41     $section = defined $section
  42         ? '#' . $self->idify($section, 1)
  43         : '';
  44
  45     my $local;
  46     if ($name =~ /^RT::/) {
  47         $local = join "/",
  48                   map { $self->encode_entities($_) }
  49                 split /::/, $name;
  50     }
  51     elsif ($name =~ /^rt-/) {
  52         $local = $self->encode_entities($name);
  53     }
  54
  55     if ($local) {
  56         # Resolve links correctly by going up
  57         my $depth = $self->batch_mode_current_level - 1;
  58         return join "/",
  59                     ($depth ? ".." x $depth : ()),
  60                     "$local.html$section";
  61     } else {
  62         return $self->SUPER::resolve_pod_page_link(@_)
  63     }
  64 }
  65
  66 1;