File Coverage

blib/lib/HTML/Widgets/NavMenu/Url.pm
Criterion Covered Total %
statement 61 61 100.0
branch 26 26 100.0
condition 26 26 100.0
subroutine 7 7 100.0
pod n/a
total 120 120 100.0


line stmt bran cond sub pod time code
1             package HTML::Widgets::NavMenu::Url;
2             $HTML::Widgets::NavMenu::Url::VERSION = '1.0902';
3 12     12   56205 use strict;
  12         26  
  12         285  
4 12     12   49 use warnings;
  12         19  
  12         268  
5              
6 12     12   390 use parent 'HTML::Widgets::NavMenu::Object';
  12         267  
  12         47  
7              
8             __PACKAGE__->mk_acc_ref(
9             [
10             qw(
11             _url
12             _is_dir
13             _mode
14             )
15             ]
16             );
17              
18              
19             sub _init
20             {
21 821     821   960 my $self = shift;
22              
23 821         1360 my ( $url, $is_dir, $mode ) = @_;
24              
25             # TODO - extract a method.
26 821 100       2557 $self->_url(
27             ( ref($url) eq "ARRAY" )
28             ? [@$url]
29             : [ split( /\//, $url ) ]
30             );
31              
32 821   100     1969 $self->_is_dir( $is_dir || 0 );
33              
34 821   100     1558 $self->_mode( $mode || 'server' );
35              
36 821         1311 return 0;
37             }
38              
39             sub _get_url
40             {
41 821     821   935 my $self = shift;
42              
43 821         914 return [ @{ $self->_url() } ];
  821         1965  
44             }
45              
46             sub _get_relative_url
47             {
48 410     410   591 my $base = shift;
49              
50 410         697 my $url = $base->_get_url_worker(@_);
51              
52 408 100       965 return ( ( $url eq "" ) ? "./" : $url );
53             }
54              
55             sub _get_url_worker
56             {
57 410     410   464 my $base = shift;
58 410         487 my $to = shift;
59 410         507 my $slash_terminated = shift;
60 410         486 my $no_leading_dot = shift;
61              
62 410 100       604 my $prefix = ( $no_leading_dot ? "" : "./" );
63              
64 410         464 my @this_url = @{ $base->_get_url() };
  410         592  
65 410         669 my @other_url = @{ $to->_get_url() };
  410         559  
66              
67 410         563 my $ret;
68              
69 410         609 my @this_url_bak = @this_url;
70 410         540 my @other_url_bak = @other_url;
71              
72 410   100     1593 while (scalar(@this_url)
      100        
73             && scalar(@other_url)
74             && ( $this_url[0] eq $other_url[0] ) )
75             {
76 139         198 shift(@this_url);
77 139         376 shift(@other_url);
78             }
79              
80 410 100 100     811 if ( ( !@this_url ) && ( !@other_url ) )
81             {
82 38 100       117 if ( ( !$base->_is_dir() ) ne ( !$to->_is_dir() ) )
83             {
84 1         9 die "Two identical URLs with non-matching _is_dir()'s";
85             }
86 37 100       88 if ( !$base->_is_dir() )
87             {
88 4 100       9 if ( scalar(@this_url_bak) )
89             {
90 3         12 return $prefix . $this_url_bak[-1];
91             }
92             else
93             {
94 1         8 die "Root URL is not a directory";
95             }
96             }
97             }
98              
99 405 100 100     1011 if ( ( $base->_mode() eq "harddisk" ) && ( $to->_is_dir() ) )
100             {
101 2         4 push @other_url, "index.html";
102             }
103              
104 405         569 $ret = "";
105              
106 405 100       613 if ($slash_terminated)
107             {
108 308 100 100     681 if ( ( scalar(@this_url) == 0 ) && ( scalar(@other_url) == 0 ) )
109             {
110 29         46 $ret = $prefix;
111             }
112             else
113             {
114 279 100       555 if ( !$base->_is_dir() )
115             {
116 1         2 pop(@this_url);
117             }
118 279         495 $ret .= join( "/", ( map { ".." } @this_url ), @other_url );
  272         765  
119 279 100 100     906 if ( $to->_is_dir() && ( $base->_mode() ne "harddisk" ) )
120             {
121 266         383 $ret .= "/";
122             }
123             }
124             }
125             else
126             {
127             my @components =
128 97         243 ( ( map { ".." } @this_url[ 1 .. $#this_url ] ), @other_url );
  93         213  
129 97         236 $ret .= ( $prefix . join( "/", @components ) );
130 97 100 100     452 if ( ( $to->_is_dir() )
      100        
131             && ( $base->_mode() ne "harddisk" )
132             && scalar(@components) )
133             {
134 72         131 $ret .= "/";
135             }
136             }
137              
138             #if (($to->_is_dir()) && (scalar(@other_url) || $slash_terminated))
139              
140 405         912 return $ret;
141             }
142              
143              
144             1;
145              
146             __END__