Pm/Bc_chef.pm
Copying Source is Forbidden
165 lines of code
1
package Bc_chef;
2
3
#/
4
# A module for baking, devouring, and selecting browser cookies
5
#
6
# <table border=0 cellpadding=0 cellspacing=0 width=100%><tr><td align=center><table class=error cellpadding=0 cellspacing=0><tr><td align=center>This is base code<hr style='background-image: none; background-color: #FF0000; width: 50%;'></td></tr><tr><td align=center><b>do not</b> include any use statements like<br><i>use Pm::Bc_chef</i></td></tr></table></td></tr></table>
7
#/
8
9
#CHLOG
10
# CHANGE LOG
11
# ==========
12
# - May 5, 2021
13
# - Added Change Log
14
# - Updated description
15
# - Updated subroutine descriptions
16
# - A tweak to "cookie_set"
17
18
# - May 10, 2021
19
# - Added AUTODOC-NAME, -LINK, -ICON comments
20
#
21
#CHLOG
22
23
#AUTODOC-NAME=Chef
24
#AUTODOC-LINK=chef
25
#AUTODOC-ICON=site/cookie.png
26
27
use strict;
28
use warnings;
29
use Exporter;
30
use vars qw($VERSION @ISA @EXPORT_OK @EXPORT);
31
use CGI::Cookie qw(fatalsToBrowser);
32
use URI::Escape qw(uri_escape uri_unescape);
33
34
$VERSION = 1.00;
35
@ISA = qw(Exporter);
36
37
@EXPORT = qw(
38
cookie_get
39
cookie_set
40
cookie_delete
41
);
42
43
@EXPORT_OK = qw(
44
_tests
45
46
cookie_get
47
cookie_delete
48
cookie_set
49
);
50
51
########################
52
53
########################
54
sub cookie_set($$;$$) {
55
#*
56
# creates a cookie ready for output to a client
57
#*
58
my ($name, $value, $exp, $secure) = @_; # a name for the cookie && a value for it && the date it expires (optional) && HTTPS only (optional)
59
my $rv = "";
60
61
if ($name) {
62
$name =~ s/\n$//;
63
$value =~ s/\n$//;
64
$exp =~ s/\n$//;
65
$secure =~ s/\n$//;
66
67
my $c = "$name=$value";
68
if ($exp) { $c .= "; expires=$exp"; }
69
if (not $secure) { $c .= "; secure; samesite=none"; }
70
71
$rv .= "set-cookie: $c;";
72
73
if ($rv !~ /\n$/) { $rv .= "\n"; }
74
}
75
76
return $rv; # a scalar
77
#usage: print cookie_set("name", "value", $cExpDate);
78
}
79
80
########################
81
sub cookie_get($) {
82
#*
83
# retrieves a cookie from the client
84
# returns "" if $cName is invalid
85
#*
86
my ($cName) = @_; # the name of the cookie to retrieve
87
my %COOKIES = CGI::Cookie->fetch;
88
my $c = $COOKIES{$cName};
89
my $rv = "";
90
91
if ($c) {
92
$c =~ s/(.)*$cName=//; # delete everything up to and including "$cName="
93
$c =~ s/; (.)*//; # delete everything from first instance of "; " to EOL.
94
95
$rv = uri_unescape($c);
96
}
97
98
return $rv; # a scalar
99
#usage: my $c = cookie_get("name");
100
}
101
102
########################
103
sub cookie_delete($) {
104
#*
105
# deletes a cookie from client
106
# all this really does is runs
107
# <a href="#cookie_set">cookie_set</a> with "" as the value
108
#*
109
my ($cName) = @_; # the name of the cookie to delete
110
my $c = cookie_set($cName, "", Bc_sql::get_constant("BEGINNING_OF_TIME"), 1);
111
112
return $c; # whatever <a href='#cookie_set'>cookie_set($cName, '')</a> returns
113
#usage: print cookie_delete("loggedin");
114
}
115
116
########################
117
########################
118
########################
119
########################
120
########################
121
########################
122
########################
123
########################
124
########################
125
########################
126
########################
127
########################
128
########################
129
########################
130
########################
131
########################
132
########################
133
########################
134
########################
135
136
########################
137
sub _tests(;$) {
138
#*
139
# to test all <i>Pm::Bc_chef</i> functions
140
#*
141
my ($extended) = @_; # show extended data (optional)
142
my $rv = "";
143
my $test = "";
144
my $test2 = "";
145
my $test3 = "";
146
147
if ($Bc_sql::DB) {
148
$test = "sesh_id";
149
$test2 = "1234567890";
150
$test3 = Bc_sql::get_constant("END_OF_TIME");
151
$rv .= Html::display_debug_one("cookie_delete(\"$test\")", cookie_delete($test));
152
$rv .= Html::display_debug_one("cookie_get(\"$test\") (ret" . "urn value shortened)", Bc_misc::shorten_str(cookie_get($test), 80));
153
$rv .= Html::display_debug_one("cookie_set(\"$test\", \"$test2\", \"$test3\", 1)", cookie_set($test, $test2, $test3, 1));
154
Bc_sql::sql_disconnect();
155
# end if ($DB)
156
} else {
157
$rv .= "DB connection error!<br>\n";
158
# end else of if ($DB)
159
}
160
161
return $rv; # 0 on failure, or a scalar
162
#usage: print _tests();
163
}
164
165
1;