Pm/Redir.pm
Copying Source is Forbidden
158 lines of code
1
package Redir;
2
3
#/
4
# Client Redirections
5
#
6
# Research shows 200 when server prcoesses request ok,
7
# even if it's a login failure! that's NOT a
8
# client/server error - that's a fuckin USER error!
9
#
10
# i'm thinking redirection for login should not occur
11
# !EVER
12
#/
13
14
use strict;
15
use warnings;
16
use CGI::Carp qw(fatalsToBrowser);
17
use URI::Escape;
18
use Exporter;
19
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
20
21
$VERSION = 1.00;
22
@ISA = qw(Exporter);
23
our @EXPORT = qw(error_redir notice_redir);
24
25
@EXPORT = qw(
26
error_redir
27
notice_redir
28
);
29
30
@EXPORT_OK = qw(
31
_tests
32
33
redir
34
redir3
35
error_redir
36
notice_redir
37
);
38
39
my $DEBUG = 0;
40
41
use lib "./Pm";
42
43
require Bc_chef;
44
require Html;
45
46
##############################
47
sub redir($;$) {
48
#*
49
# redirects a client browser to a specified URL (may include a msg)
50
# just a redirect.
51
#*
52
my ($url, $msg) = @_; # a url to redirect to && a msg (optional)
53
54
my %settings = {};
55
$settings{type} = "location: $url";
56
if (ref $url eq "HASH") {
57
# for UPGRADES! will work just like %settings, below, in the "else" block
58
} else {
59
$settings{status} = "301 Login: $msg";
60
}
61
my $html = Html::pre_html_header(\%settings);
62
63
return $html; # a scalar
64
#usage print redir("/", "invalid page");
65
}
66
67
##############################
68
sub redir3($$;$) {
69
#*
70
# redirects a client browser to a specified URL (may include a msg)
71
# can add a cookie to the redirect (for errors or msgs or other things you deem necessary)
72
# this is NOT version 3 of the redir command. it's a 3 param command!
73
#*
74
my ($url, $msg, $type) = @_; # a url to redirect to && a msg && (deprecated) a msg type ('e' or 'n', or whatever else you like)
75
$msg = uri_escape($msg);
76
my %settings;
77
78
if ($DEBUG) { $msg .= " ($ENV{REQUEST_METHOD})"; }
79
$settings{use_only_settings} = 1;
80
$settings{type} = "location: $url";
81
$settings{status} = "301 $msg";
82
$settings{cookies} = "set-cookie: $type=$msg; expires=-1; secure;\n";
83
$settings{skipmaintcheck} = "location: $url";
84
my $html = Html::pre_html_header(\%settings);
85
86
return $html; # a scalar
87
#usage: print redir3("/", "Access Denied by redir3", 'e')
88
}
89
90
##############################
91
sub error_redir($$) {
92
#*
93
# redirects a client browser to a specified URL (may include a msg)
94
# adds an 'error' cookie to the redirect
95
#*
96
my ($url, $msg) = @_; # a url to redirect to && a msg
97
my $html = redir3($url, $msg, 'e');
98
99
return $html; # a scalar
100
#usage: print error_redir("/subscribe.pl", "you must subscribe to access this area");
101
}
102
103
##############################
104
sub notice_redir($$) {
105
#*
106
# redirects a client browser to a specified URL (may include a msg)
107
# adds a 'notice' cookie to the redirect
108
#*
109
my ($url, $msg) = @_; # a url to redirect to && a msg
110
my $html = redir3($url, $msg, 'n');
111
112
return $html; # a scalar
113
#usage: print notice_redir("/', "file updated!");
114
}
115
116
##############################
117
sub _tests(;$) {
118
#*
119
# to test all <i>Pm::Redir</i> functions
120
#*
121
my ($extended) = @_; # show extended data (optional)
122
my $rv = "";
123
my $test = "";
124
my $test2 = "";
125
my $test3 = "";
126
127
$test = "/index.pl";
128
$test2 = "Test Redirection";
129
130
$rv .= Html::display_debug_code("error_redir(\"$test\", \"$test2\")", error_redir($test, $test2));
131
$rv .= Html::display_debug_code("notice_redir(\"$test\", \"$test2\")", notice_redir($test, $test2));
132
$rv .= Html::display_debug_code("redir(\"$test\", \"$test2\")", redir($test, $test2));
133
$rv .= Html::display_debug_code("redir3(\"$test\", \"$test2\", \"$test3\")", redir3($test, $test2));
134
135
return $rv; # a scalar of the results of all tests
136
#usage: print _tests();
137
}
138
139
##############################
140
##############################
141
##############################
142
##############################
143
##############################
144
##############################
145
##############################
146
##############################
147
##############################
148
##############################
149
##############################
150
##############################
151
##############################
152
##############################
153
##############################
154
##############################
155
##############################
156
##############################
157
158
1;