File Coverage

lib/CGI/Mungo/Utils.pm
Criterion Covered Total %
statement 30 35 85.7
branch 6 12 50.0
condition 2 6 33.3
subroutine 7 7 100.0
pod 2 2 100.0
total 47 62 75.8


line stmt bran cond sub pod time code
1             package CGI::Mungo::Utils;
2             =pod
3              
4             =head1 NAME
5              
6             CGI::Mungo::Utils - Helper methods
7              
8             =head1 SYNOPSIS
9              
10             =head1 DESCRIPTION
11              
12             Various methods used by several of the Mungo classes.
13              
14             =head1 METHODS
15              
16             =cut
17 3     3   18 use strict;
  3         6  
  3         103  
18 3     3   15 use warnings;
  3         6  
  3         83  
19 3     3   17 use File::Basename;
  3         4  
  3         251  
20 3     3   15 use Carp;
  3         6  
  3         1903  
21             #########################################################
22              
23             =pod
24              
25             =head2 getThisUrl()
26              
27             my $url = $m->getThisUrl();
28              
29             Returns the full URL for the current script, ignoring the query string if any.
30              
31             =cut
32              
33             ###########################################################
34             sub getThisUrl{
35 2     2 1 449 my $self = shift;
36 2         9 my $url = $self->getSiteUrl();
37 2         6 $ENV{'REQUEST_URI'} =~ m/^([^\?]+)/; #match everything up to the query string if any
38 2         5 $url .= $1;
39 2         7 return $url;
40             }
41             #########################################################
42              
43             =pod
44              
45             =head2 getSiteUrl()
46              
47             my $url = $m->getSiteUrl();
48              
49             Returns the site URL for the current script, This includes the protocol and host name only.
50              
51             =cut
52              
53             ###########################################################
54             sub getSiteUrl{
55 2     2 1 4 my $self = shift;
56 2         4 my $url = "";
57 2 50       13 if(exists($ENV{'HTTPS'})){ #are we running on ssl?
58 0         0 $url .= "https://";
59             }
60             else{ #on plain
61 2         5 $url .= "http://";
62             }
63 2 50       14 if($ENV{'HTTP_HOST'} =~ /^([^\:]+)(\:\d+|)$/){
64 2         10 $url .= $1; #only want the hostname part
65 2 50       8 if(exists($ENV{'SERVER_PORT'})){ #will have to assume port 80 if we don't have this
66 2 50 33     25 if(exists($ENV{'HTTPS'}) && $ENV{'SERVER_PORT'} != 443){ #add non default ssl port
    50 33        
67 0         0 $url .= ":" . $ENV{'SERVER_PORT'};
68             }
69             elsif(!exists($ENV{'HTTPS'}) && $ENV{'SERVER_PORT'} != 80){ #add non default plain port
70 2         5 $url .= ":" . $ENV{'SERVER_PORT'};
71             }
72             }
73             }
74             else{
75 0         0 Confess("Invalid HTTP host header");
76             }
77 2         5 return $url;
78             }
79             ##########################################################
80             sub _getScriptName{ #returns the basename of the running script
81 1     1   3 my $scriptName = $ENV{'SCRIPT_NAME'};
82 1 50       4 if($scriptName){
83 1         65 return basename($scriptName);
84             }
85             else {
86 0           confess("Cant find scriptname, are you running a CGI");
87             }
88 0           return undef;
89             }
90              
91             #############################################################################################################
92              
93             =head1 Notes
94              
95             =head1 Author
96              
97             MacGyveR
98              
99             Development questions, bug reports, and patches are welcome to the above address
100              
101             =head1 Copyright
102              
103             Copyright (c) 2012 MacGyveR. All rights reserved.
104              
105             This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
106              
107             =cut
108              
109             ###########################################################
110             return 1;