File Coverage

blib/lib/XAO/DO/Web/URL.pm
Criterion Covered Total %
statement 34 34 100.0
branch 20 20 100.0
condition 3 5 60.0
subroutine 5 5 100.0
pod 1 1 100.0
total 63 65 96.9


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   575 use strict;
  1         1  
  1         25  
57 1     1   4 use XAO::Utils;
  1         2  
  1         43  
58 1     1   5 use XAO::Objects;
  1         1  
  1         23  
59 1     1   4 use base XAO::Objects->load(objname => 'Web::Page');
  1         1  
  1         3  
60              
61             our $VERSION='2.002';
62              
63             sub display ($%) {
64 63     63 1 78 my $self=shift;
65 63         112 my $args=get_args(\@_);
66              
67 63         422 my $secure;
68 63 100       107 if($args->{'secure'}) {
    100          
69 23         29 $secure=1;
70             }
71             elsif($args->{'insecure'}) {
72 11         16 $secure=0;
73             }
74             else {
75 29         57 $secure=$self->is_secure;
76             }
77              
78 63         473 my $url;
79              
80 63         76 my $x=$args->{'x'};
81              
82 63 100       82 if($x) {
83 20   50     39 my $extra_urls=$self->siteconfig->get('extra_urls') || { };
84              
85 20 100       750 $url=$extra_urls->{$x.'.'.($secure ? 'secure' : 'insecure')};
86              
87 20 100       35 if(!$url) {
88 10   66     27 $url=$extra_urls->{$x} ||
89             $self->base_url(active => 0, secure => $secure);
90              
91 10 100       19 if($secure) {
92 6         15 $url=~s/^http:/https:/;
93             }
94             }
95             }
96             else {
97 43 100       67 my $active=$args->{'active'} ? 1 : 0;
98 43 100       60 my $full=$args->{'top'} ? 0 : 1;
99              
100 43 100       102 $url=$full ? $self->pageurl(active => $active, secure => $secure) :
101             $self->base_url(active => $active, secure => $secure);
102             }
103              
104 63 100       113 if($args->{'uri'}) {
105 2         11 $url=~s/^\w+:\/\/.*?\//\//;
106             }
107              
108 63         114 $self->textout($url);
109             }
110              
111             ###############################################################################
112             1;
113             __END__