1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
use 5.006;
use strict;
use warnings;
use HTML::Stream;
use Path::Tiny qw(path);
use Test::More tests => 6 * 3;
use Pod::Tree;
use Pod::Tree::HTML;
my $Dir = 't/mapper.d';
Translate();
my $mapper = Map_Mapper->new;
Translate($mapper);
$mapper = URL_Mapper->new;
Translate($mapper);
sub Translate {
my $mapper = shift;
for my $file (qw(cut paragraph list sequence for link)) {
my $actual = '';
my $html = Pod::Tree::HTML->new( "$Dir/$file.pod", \$actual );
$html->set_options( toc => 0 );
$html->set_options( link_map => $mapper ) if $mapper;
$html->translate;
my $expected = path("$Dir/$file.exp")->slurp;
is $actual, $expected;
path("$Dir/$file.act")->spew($actual);
# WriteFile("$ENV{HOME}/public_html/pod/$file.html", $actual);
}
}
## no critic (RequireFilenameMatchesPackage)
package URL_Mapper;
sub new { bless {}, shift }
sub url {
my ( $mapper, $html, $target ) = @_;
my $depth = $html->{options}{depth};
my $base = join '/', ('..') x $depth;
my $page = $target->get_page;
$page =~ s(::)(/)g;
$page .= '.html' if $page;
my $section = $target->get_section;
my $fragment = $html->escape_2396($section);
my $url = $html->assemble_url( $base, $page, $fragment );
$url;
}
package Map_Mapper;
sub new { bless {}, shift }
sub map {
my ( $link_map, $base, $page, $section, $depth ) = @_;
$page =~ s(::)(/)g;
( '../' x $depth, $page, $section );
}
|
