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.0901';
3 12     12   59496 use strict;
  12         31  
  12         307  
4 12     12   55 use warnings;
  12         18  
  12         300  
5              
6 12     12   410 use parent 'HTML::Widgets::NavMenu::Object';
  12         296  
  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 791     791   981 my $self = shift;
22              
23 791         1286 my ( $url, $is_dir, $mode ) = @_;
24              
25             # TODO - extract a method.
26 791 100       2368 $self->_url(
27             ( ref($url) eq "ARRAY" )
28             ? [@$url]
29             : [ split( /\//, $url ) ]
30             );
31              
32 791   100     1869 $self->_is_dir( $is_dir || 0 );
33              
34 791   100     1596 $self->_mode( $mode || 'server' );
35              
36 791         1236 return 0;
37             }
38              
39             sub _get_url
40             {
41 791     791   900 my $self = shift;
42              
43 791         852 return [ @{ $self->_url() } ];
  791         1963  
44             }
45              
46             sub _get_relative_url
47             {
48 395     395   541 my $base = shift;
49              
50 395         712 my $url = $base->_get_url_worker(@_);
51              
52 393 100       1012 return ( ( $url eq "" ) ? "./" : $url );
53             }
54              
55             sub _get_url_worker
56             {
57 395     395   462 my $base = shift;
58 395         453 my $to = shift;
59 395         448 my $slash_terminated = shift;
60 395         434 my $no_leading_dot = shift;
61              
62 395 100       636 my $prefix = ( $no_leading_dot ? "" : "./" );
63              
64 395         454 my @this_url = @{ $base->_get_url() };
  395         550  
65 395         599 my @other_url = @{ $to->_get_url() };
  395         532  
66              
67 395         593 my $ret;
68              
69 395         606 my @this_url_bak = @this_url;
70 395         542 my @other_url_bak = @other_url;
71              
72 395   100     1580 while (scalar(@this_url)
      100        
73             && scalar(@other_url)
74             && ( $this_url[0] eq $other_url[0] ) )
75             {
76 139         199 shift(@this_url);
77 139         382 shift(@other_url);
78             }
79              
80 395 100 100     811 if ( ( !@this_url ) && ( !@other_url ) )
81             {
82 38 100       152 if ( ( !$base->_is_dir() ) ne ( !$to->_is_dir() ) )
83             {
84 1         10 die "Two identical URLs with non-matching _is_dir()'s";
85             }
86 37 100       166 if ( !$base->_is_dir() )
87             {
88 4 100       12 if ( scalar(@this_url_bak) )
89             {
90 3         17 return $prefix . $this_url_bak[-1];
91             }
92             else
93             {
94 1         7 die "Root URL is not a directory";
95             }
96             }
97             }
98              
99 390 100 100     869 if ( ( $base->_mode() eq "harddisk" ) && ( $to->_is_dir() ) )
100             {
101 2         4 push @other_url, "index.html";
102             }
103              
104 390         525 $ret = "";
105              
106 390 100       592 if ($slash_terminated)
107             {
108 299 100 100     649 if ( ( scalar(@this_url) == 0 ) && ( scalar(@other_url) == 0 ) )
109             {
110 29         53 $ret = $prefix;
111             }
112             else
113             {
114 270 100       486 if ( !$base->_is_dir() )
115             {
116 1         2 pop(@this_url);
117             }
118 270         492 $ret .= join( "/", ( map { ".." } @this_url ), @other_url );
  261         756  
119 270 100 100     881 if ( $to->_is_dir() && ( $base->_mode() ne "harddisk" ) )
120             {
121 257         340 $ret .= "/";
122             }
123             }
124             }
125             else
126             {
127             my @components =
128 91         206 ( ( map { ".." } @this_url[ 1 .. $#this_url ] ), @other_url );
  82         163  
129 91         232 $ret .= ( $prefix . join( "/", @components ) );
130 91 100 100     411 if ( ( $to->_is_dir() )
      100        
131             && ( $base->_mode() ne "harddisk" )
132             && scalar(@components) )
133             {
134 66         117 $ret .= "/";
135             }
136             }
137              
138             #if (($to->_is_dir()) && (scalar(@other_url) || $slash_terminated))
139              
140 390         882 return $ret;
141             }
142              
143              
144             1;
145              
146             __END__