File Coverage

blib/lib/ASP4/Server.pm
Criterion Covered Total %
statement 35 46 76.0
branch 1 2 50.0
condition n/a
subroutine 12 16 75.0
pod 7 9 77.7
total 55 73 75.3


line stmt bran cond sub pod time code
1              
2             package ASP4::Server;
3              
4 9     9   32 use strict;
  9         12  
  9         251  
5 9     9   35 use warnings 'all';
  9         10  
  9         280  
6 9     9   31 use ASP4::HTTPContext;
  9         8  
  9         178  
7 9     9   4529 use encoding 'utf8';
  9         82547  
  9         35  
8 9     9   7971 use Mail::Sendmail;
  9         74237  
  9         1729  
9              
10             sub new
11             {
12 5122     5122 0 12847 return bless { }, shift;
13             }# end new()
14              
15              
16 1     1 0 5 sub context { ASP4::HTTPContext->current }
17              
18              
19             sub URLEncode
20             {
21 0     0 1 0 ASP4::HTTPContext->current->cgi->escape( $_[1] );
22             }# end URLEncode()
23              
24              
25             sub URLDecode
26             {
27 0     0 1 0 ASP4::HTTPContext->current->cgi->unescape( $_[1] );
28             }# end URLDecode()
29              
30              
31             sub HTMLEncode
32             {
33 4     4 1 13 my ($s, $str) = @_;
34 9     9   332 no warnings 'uninitialized';
  9         15  
  9         295  
35 4         22 $str =~ s/&/&/g;
36 4         14 $str =~ s/
37 4         8 $str =~ s/>/>/g;
38 4         7 $str =~ s/"/"/g;
39 4         8 $str =~ s/'/'/g;
40 4         16 return $str;
41             }# end HTMLEncode()
42              
43              
44             sub HTMLDecode
45             {
46 0     0 1 0 my ($s, $str) = @_;
47 9     9   2663 no warnings 'uninitialized';
  9         17  
  9         221  
48 0         0 $str =~ s/</
49 0         0 $str =~ s/>/>/g;
50 0         0 $str =~ s/"/"/g;
51 0         0 $str =~ s/&/&/g;
52 0         0 $str =~ s/'/'/g;
53 0         0 return $str;
54             }# end HTMLDecode()
55              
56              
57             sub MapPath
58             {
59 8     8 1 16 my ($s, $path) = @_;
60            
61 8 50       20 return unless defined($path);
62            
63 8         25 ASP4::HTTPContext->current->config->web->www_root . $path;
64             }# end MapPath()
65              
66              
67             sub Mail
68             {
69 0     0 1 0 my $s = shift;
70            
71 0         0 Mail::Sendmail::sendmail( @_ );
72             }# end Mail()
73              
74              
75             sub RegisterCleanup
76             {
77 1     1 1 7 my ($s, $sub, @args) = @_;
78            
79 1         5 $s->context->r->pool->cleanup_register( $sub, \@args );
80             }# end RegisterCleanup()
81              
82             1;# return true:
83              
84             =pod
85              
86             =head1 NAME
87              
88             ASP4::Server - Utility Methods
89              
90             =head1 SYNOPSIS
91              
92             # Get the full disk path to /contact/form.asp:
93             $Server->MapPath("/contact/form.asp");
94            
95             # Email someone:
96             $Server->Mail(
97             To => 'jim@bob.com',
98             From => 'Joe Jangles ',
99             Subject => 'Test Email',
100             Message => "Hello There!",
101             );
102            
103             # Avoid XSS:
104            
105            
106             # Proper URLs:
107             Click
108              
109             =head1 DESCRIPTION
110              
111             The C<$Server> object provides some utility methods that don't really fit anywhere
112             else, but are still important.
113              
114             =head1 PUBLIC METHODS
115              
116             =head2 HTMLEncode( $str )
117              
118             Performs a simple string substitution to sanitize C<$str> for inclusion on HTML pages.
119              
120             Removes the threat of cross-site-scripting (XSS).
121              
122             Eg:
123              
124            
125              
126             Becomes:
127              
128             <tag/>
129              
130             =head2 HTMLDecode( $str )
131              
132             Does exactly the reverse of HTMLEncode.
133              
134             Eg:
135              
136             <tag/>
137              
138             Becomes:
139              
140            
141              
142             =head2 URLEncode( $str )
143              
144             Converts a string for use within a URL.
145              
146             eg:
147              
148             test@test.com
149              
150             becomes:
151              
152             test%40test.com
153              
154             =head2 URLDecode( $str )
155              
156             Converts a url-encoded string to a normal string.
157              
158             eg:
159              
160             test%40test.com
161              
162             becomes:
163              
164             test@test.com
165              
166             =head2 MapPath( $file )
167              
168             Converts a relative path to a full disk path.
169              
170             eg:
171              
172             /contact/form.asp
173              
174             becomes:
175              
176             /var/www/mysite.com/htdocs/contact/form.asp
177              
178             =head2 Mail( %args )
179              
180             Sends email - uses L's C function.
181              
182             =head2 RegisterCleanup( \&code, @args )
183              
184             The supplied coderef will be executed with its arguments as the request enters
185             its Cleanup phase.
186              
187             See L for details.
188              
189             =cut
190