line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
XAO::DO::Web::URL - displays base, active and secure URLs |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Given that base_url is 'http://host.com' and browser is at |
8
|
|
|
|
|
|
|
'http://www.host.com/test.html?a=1' the following translations will be |
9
|
|
|
|
|
|
|
performed: |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
<%URL%> -- http://www.host.com/test.html |
12
|
|
|
|
|
|
|
<%URL active%> -- http://www.host.com/test.html |
13
|
|
|
|
|
|
|
<%URL active top%> -- http://www.host.com |
14
|
|
|
|
|
|
|
<%URL active full%> -- http://www.host.com/test.html |
15
|
|
|
|
|
|
|
<%URL active secure%> -- https://www.host.com/test.html |
16
|
|
|
|
|
|
|
<%URL active top secure%> -- https://www.host.com |
17
|
|
|
|
|
|
|
<%URL active full secure%> -- https://www.host.com/test.html |
18
|
|
|
|
|
|
|
<%URL base%> -- http://host.com/test.html |
19
|
|
|
|
|
|
|
<%URL base top%> -- http://host.com |
20
|
|
|
|
|
|
|
<%URL base full%> -- http://host.com/test.html |
21
|
|
|
|
|
|
|
<%URL base secure%> -- https://host.com/test.html |
22
|
|
|
|
|
|
|
<%URL base top secure%> -- https://host.com |
23
|
|
|
|
|
|
|
<%URL base full secure%> -- https://host.com/test.html |
24
|
|
|
|
|
|
|
<%URL secure%> -- https://www.host.com/test.html |
25
|
|
|
|
|
|
|
<%URL uri%> -- /test.html |
26
|
|
|
|
|
|
|
<%URL x='TAG'%> -- from /extra_urls, assumes "top" |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
If browser is at 'https://www.host.com/test.html' (secure protocol): |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
<%URL%> -- https://www.host.com/test.html |
31
|
|
|
|
|
|
|
<%URL insecure%> -- http://www.host.com/test.html |
32
|
|
|
|
|
|
|
<%URL base%> -- https://host.com/test.html |
33
|
|
|
|
|
|
|
<%URL base top insecure%> -- http://host.com |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Allows to display URL with some possible alterations. Default is to |
38
|
|
|
|
|
|
|
display full URL of the current page using the base host name. If the |
39
|
|
|
|
|
|
|
page is a secure one then the URL will also be secure. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
Base URL is set as 'base_url' parameter in the initial site |
42
|
|
|
|
|
|
|
configuration. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Active host name is usually the same as base host name, but may differ |
45
|
|
|
|
|
|
|
if your web server is set up to serve more then one domain using the |
46
|
|
|
|
|
|
|
same XAO::Web site. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 METHODS |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=over |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=cut |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
############################################################################### |
55
|
|
|
|
|
|
|
package XAO::DO::Web::URL; |
56
|
1
|
|
|
1
|
|
785
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
57
|
1
|
|
|
1
|
|
5
|
use XAO::Utils; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
57
|
|
58
|
1
|
|
|
1
|
|
5
|
use XAO::Objects; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
43
|
|
59
|
1
|
|
|
1
|
|
6
|
use base XAO::Objects->load(objname => 'Web::Page'); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
4
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
our $VERSION='2.002'; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub display ($%) { |
64
|
63
|
|
|
63
|
1
|
99
|
my $self=shift; |
65
|
63
|
|
|
|
|
135
|
my $args=get_args(\@_); |
66
|
|
|
|
|
|
|
|
67
|
63
|
|
|
|
|
519
|
my $secure; |
68
|
63
|
100
|
|
|
|
143
|
if($args->{'secure'}) { |
|
|
100
|
|
|
|
|
|
69
|
23
|
|
|
|
|
42
|
$secure=1; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
elsif($args->{'insecure'}) { |
72
|
11
|
|
|
|
|
20
|
$secure=0; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
else { |
75
|
29
|
|
|
|
|
72
|
$secure=$self->is_secure; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
63
|
|
|
|
|
578
|
my $url; |
79
|
|
|
|
|
|
|
|
80
|
63
|
|
|
|
|
101
|
my $x=$args->{'x'}; |
81
|
|
|
|
|
|
|
|
82
|
63
|
100
|
|
|
|
112
|
if($x) { |
83
|
20
|
|
50
|
|
|
46
|
my $extra_urls=$self->siteconfig->get('extra_urls') || { }; |
84
|
|
|
|
|
|
|
|
85
|
20
|
100
|
|
|
|
904
|
$url=$extra_urls->{$x.'.'.($secure ? 'secure' : 'insecure')}; |
86
|
|
|
|
|
|
|
|
87
|
20
|
100
|
|
|
|
53
|
if(!$url) { |
88
|
10
|
|
66
|
|
|
39
|
$url=$extra_urls->{$x} || |
89
|
|
|
|
|
|
|
$self->base_url(active => 0, secure => $secure); |
90
|
|
|
|
|
|
|
|
91
|
10
|
100
|
|
|
|
27
|
if($secure) { |
92
|
6
|
|
|
|
|
22
|
$url=~s/^http:/https:/; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
else { |
97
|
43
|
100
|
|
|
|
79
|
my $active=$args->{'active'} ? 1 : 0; |
98
|
43
|
100
|
|
|
|
78
|
my $full=$args->{'top'} ? 0 : 1; |
99
|
|
|
|
|
|
|
|
100
|
43
|
100
|
|
|
|
136
|
$url=$full ? $self->pageurl(active => $active, secure => $secure) : |
101
|
|
|
|
|
|
|
$self->base_url(active => $active, secure => $secure); |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
63
|
100
|
|
|
|
147
|
if($args->{'uri'}) { |
105
|
2
|
|
|
|
|
13
|
$url=~s/^\w+:\/\/.*?\//\//; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
63
|
|
|
|
|
152
|
$self->textout($url); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
############################################################################### |
112
|
|
|
|
|
|
|
1; |
113
|
|
|
|
|
|
|
__END__ |