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
73
74
75
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 6;
use HTML::Widgets::NavMenu::Url ();
{
my $from =
HTML::Widgets::NavMenu::Url->new( [qw(hello there wow.html)], 1, );
my $to = HTML::Widgets::NavMenu::Url->new( [qw(hello there wow.html)], 0, );
my $url;
eval { $url = $from->_get_relative_url($to); };
# TEST
like(
$@,
qr{^Two identical URLs},
"Checking that an exception was thrown."
);
}
{
my $from = HTML::Widgets::NavMenu::Url->new( [], 0, );
my $to = HTML::Widgets::NavMenu::Url->new( [], 0, );
my $url;
eval { $url = $from->_get_relative_url($to); };
# TEST
like( $@, qr{^Root URL}, "Checking that an exception was thrown." );
}
{
my $from = HTML::Widgets::NavMenu::Url->new( ["hello"], 1, "harddisk", );
my $to = HTML::Widgets::NavMenu::Url->new( ["good.html"], 0, );
# TEST
is( $from->_get_relative_url( $to, 1 ),
"../good.html", "Checking for harddisk URL from dir to file" );
}
{
my $from = HTML::Widgets::NavMenu::Url->new( ["hello"], 1, "harddisk", );
my $to = HTML::Widgets::NavMenu::Url->new( ["good"], 1, );
# TEST
is( $from->_get_relative_url( $to, 1 ),
"../good/index.html", "Checking for harddisk URL from dir to dir" );
}
{
my $from = HTML::Widgets::NavMenu::Url->new( ["hello"], 1, "harddisk", );
my $to = HTML::Widgets::NavMenu::Url->new( ["good"], 1, );
# TEST
is( $from->_get_relative_url( $to, 0 ),
"./good/index.html", "Checking for harddisk URL from dir to dir" );
}
{
my $from =
HTML::Widgets::NavMenu::Url->new(
[ "directory", "sub-dir", "good.html" ],
0, "server", );
my $to = HTML::Widgets::NavMenu::Url->new( ["directory"], 1, "server" );
# TEST
is( $from->_get_relative_url( $to, 1 ),
"../", "Checking for relative URL from a non-dir to a dir." );
}
|
