line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#Session functions |
2
|
|
|
|
|
|
|
package PSGI::Hector::Session; |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=pod |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
PSGI::Hector::Session - Session class |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
my $s = $hector->getSession(); |
13
|
|
|
|
|
|
|
$s->setVar('name', 'value'); |
14
|
|
|
|
|
|
|
my $var = $s->getVar('name'); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 DESCRIPTION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
Class to deal with session management. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 METHODS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=cut |
23
|
|
|
|
|
|
|
|
24
|
5
|
|
|
5
|
|
18
|
use strict; |
|
5
|
|
|
|
|
4
|
|
|
5
|
|
|
|
|
118
|
|
25
|
5
|
|
|
5
|
|
16
|
use warnings; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
94
|
|
26
|
5
|
|
|
5
|
|
17
|
use Digest::MD5; |
|
5
|
|
|
|
|
4
|
|
|
5
|
|
|
|
|
148
|
|
27
|
5
|
|
|
5
|
|
2848
|
use Data::Dumper; |
|
5
|
|
|
|
|
26716
|
|
|
5
|
|
|
|
|
280
|
|
28
|
5
|
|
|
5
|
|
2067
|
use CGI::Simple::Cookie; |
|
5
|
|
|
|
|
18347
|
|
|
5
|
|
|
|
|
118
|
|
29
|
5
|
|
|
5
|
|
30
|
use File::Spec; |
|
5
|
|
|
|
|
7
|
|
|
5
|
|
|
|
|
103
|
|
30
|
5
|
|
|
5
|
|
16
|
use parent qw(PSGI::Hector::Base); |
|
5
|
|
|
|
|
6
|
|
|
5
|
|
|
|
|
26
|
|
31
|
|
|
|
|
|
|
our $prefix = "HT"; |
32
|
|
|
|
|
|
|
our $path = "/tmp"; |
33
|
|
|
|
|
|
|
############################################################################################################################## |
34
|
|
|
|
|
|
|
sub new{ #constructor |
35
|
2
|
|
|
2
|
0
|
14
|
my($class, $hector) = @_; |
36
|
2
|
|
|
|
|
18
|
my $self = $class->SUPER::new(); |
37
|
2
|
|
|
|
|
56
|
$self->{'_hector'} = $hector; |
38
|
2
|
|
|
|
|
6
|
$self->{'id'} = undef; |
39
|
2
|
|
|
|
|
5
|
$self->{'error'} = ""; |
40
|
2
|
|
|
|
|
5
|
$self->{'vars'} = {}; |
41
|
2
|
|
|
|
|
8
|
$self->_readOrCreate(); |
42
|
2
|
|
|
|
|
12
|
return $self; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
######################################################################################################################### |
45
|
|
|
|
|
|
|
sub DESTROY{ |
46
|
1
|
|
|
1
|
|
509
|
__PACKAGE__->_expire(); #remove old sessions |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
######################################################################################################################### |
49
|
|
|
|
|
|
|
sub validate{ #runs the defined sub to see if this sesion is validate |
50
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
51
|
0
|
0
|
|
|
|
0
|
if($self->getVar('remoteIp')){ |
52
|
0
|
|
|
|
|
0
|
my $env = $self->_getHector()->getEnv(); |
53
|
0
|
0
|
|
|
|
0
|
if($self->getVar('remoteIp') eq $env->{'REMOTE_ADDR'}){ |
54
|
0
|
0
|
0
|
|
|
0
|
if($self->getVar('scriptPath') && $self->getVar('scriptPath') eq $env->{'SCRIPT_NAME'}){ |
55
|
0
|
|
|
|
|
0
|
return 1; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
else{ |
58
|
0
|
|
|
|
|
0
|
$self->_getHector()->getLog()->log("Session " . $self->getVar('scriptPath') . " <> " . $env->{'SCRIPT_NAME'}, 'debug'); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
else{ |
62
|
0
|
|
|
|
|
0
|
$self->_getHector()->getLog()->log("Session " . $self->getVar('remoteIp') . " <> " . $env->{'REMOTE_ADDR'}, 'debug'); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
else{ |
66
|
0
|
|
|
|
|
0
|
$self->_getHector()->getLog()->log("Session has no remote IP", 'debug'); |
67
|
|
|
|
|
|
|
} |
68
|
0
|
|
|
|
|
0
|
return 0; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
################################################################################################################ |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 setVar() |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
$s->setVar('name', 'value'); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
Takes two arguments, first the name of the variable then the value of the variable to store. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=cut |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
########################################################################################################################## |
81
|
|
|
|
|
|
|
sub setVar{ #stores a variable in the session |
82
|
0
|
|
|
0
|
1
|
0
|
my($self, $name, $value) = @_; |
83
|
0
|
|
|
|
|
0
|
$self->_storeVar($name, $value); |
84
|
0
|
|
|
|
|
0
|
return $self->_write(); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
########################################################################################################################## |
87
|
|
|
|
|
|
|
sub getVar{ #gets a stored variable from the session |
88
|
0
|
|
|
0
|
0
|
0
|
my($self, $name) = @_; |
89
|
0
|
0
|
|
|
|
0
|
if(defined($self->{'vars'}->{$name})){ |
90
|
0
|
|
|
|
|
0
|
return $self->{'vars'}->{$name}; |
91
|
|
|
|
|
|
|
} |
92
|
0
|
|
|
|
|
0
|
else{return undef;} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
########################################################################################################################### |
95
|
|
|
|
|
|
|
sub setError{ |
96
|
2
|
|
|
2
|
1
|
4
|
my($self, $error) = @_; |
97
|
2
|
|
|
|
|
9
|
$self->{'error'} = $error; #save the error |
98
|
2
|
|
|
|
|
3
|
return 1; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
########################################################################################################################### |
101
|
|
|
|
|
|
|
sub getError{ #returns the last error |
102
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
103
|
2
|
|
|
|
|
7
|
return $self->{'error'}; |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
########################################################################################################################### |
106
|
|
|
|
|
|
|
sub getId{ #returns the session id |
107
|
4
|
|
|
4
|
0
|
8
|
my $self = shift; |
108
|
4
|
|
|
|
|
18
|
return $self->{'id'}; |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
############################################################################################################## |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 create() |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
$response = $wf->getResponse(); |
115
|
|
|
|
|
|
|
my $hashref = { |
116
|
|
|
|
|
|
|
username => "bob" |
117
|
|
|
|
|
|
|
}; |
118
|
|
|
|
|
|
|
$s->create($hashref, $response); |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Creates a new session for the visitor. |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
This saves the contents of the given hash reference into the session. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
The correct Set-Cookie header will be issued through the provided L object. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
############################################################################################################## |
129
|
|
|
|
|
|
|
sub create{ #creates a server-side cookie for the session |
130
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
131
|
2
|
|
|
|
|
3
|
my $result = 0; |
132
|
2
|
|
|
|
|
8
|
$self->setError(""); #as we are starting a new session we clear any previous errors first |
133
|
2
|
|
|
|
|
18
|
my $sessionId = time() * $$; #time in seconds * process id |
134
|
2
|
|
|
|
|
12
|
my $ctx = Digest::MD5->new; |
135
|
2
|
|
|
|
|
12
|
$ctx->add($sessionId); |
136
|
2
|
|
|
|
|
6
|
$sessionId = $self->_getPrefix() . $ctx->hexdigest; |
137
|
2
|
|
|
|
|
7
|
$self->_setId($sessionId); #remember the session id |
138
|
2
|
|
|
|
|
4
|
my $env = $self->_getHector()->getEnv(); |
139
|
|
|
|
|
|
|
#set some initial values |
140
|
2
|
|
|
|
|
12
|
$self->_storeVar('remoteIp', $env->{'REMOTE_ADDR'}); |
141
|
2
|
|
|
|
|
8
|
$self->_storeVar('scriptPath', $env->{'SCRIPT_NAME'}); |
142
|
2
|
50
|
|
|
|
7
|
if(!$self->getError()){ #all ok so far |
143
|
2
|
|
|
|
|
6
|
my $cookie = $self->_setCookie(VALUE => $self->getId()); |
144
|
2
|
|
|
|
|
103
|
my $response = $self->_getHector()->getResponse(); |
145
|
2
|
|
|
|
|
22
|
$response->header("Set-Cookie" => $cookie); |
146
|
2
|
|
|
|
|
199
|
$result = 1; |
147
|
|
|
|
|
|
|
} |
148
|
2
|
|
|
|
|
19
|
$result; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
############################################################################################################## |
151
|
|
|
|
|
|
|
sub read{ #read an existing session |
152
|
2
|
|
|
2
|
0
|
3
|
my $self = shift; |
153
|
2
|
|
|
|
|
3
|
my $result = 0; |
154
|
2
|
|
|
|
|
8
|
my $sessionId = $self->_getHector()->getRequest()->getCookie("SESSION"); #get the session id from the browser |
155
|
2
|
50
|
|
|
|
6
|
if(defined($sessionId)){ #got a sessionid of some sort |
156
|
0
|
|
|
|
|
0
|
my $prefix = $self->_getPrefix(); |
157
|
0
|
0
|
|
|
|
0
|
if($sessionId =~ m/^($prefix[a-f0-9]+)$/){ #filename valid |
158
|
0
|
|
|
|
|
0
|
my $path = $self->_getPath(); |
159
|
0
|
|
|
|
|
0
|
my $sessionFile = File::Spec->catfile($path, $1); |
160
|
0
|
0
|
|
|
|
0
|
if(open(SSIDE, "<", $sessionFile)){ #try to open the session file |
161
|
0
|
|
|
|
|
0
|
my $contents = ""; |
162
|
0
|
|
|
|
|
0
|
while(){ #read each line of the file |
163
|
0
|
|
|
|
|
0
|
$contents .= $_; |
164
|
|
|
|
|
|
|
} |
165
|
0
|
|
|
|
|
0
|
close(SSIDE); |
166
|
0
|
0
|
|
|
|
0
|
if($contents =~ m/^(\$VAR1 = \{.+\};)$/m){ #check session contents |
167
|
0
|
|
|
|
|
0
|
my $validContents = $1; #untaint variable |
168
|
0
|
|
|
|
|
0
|
my $VAR1; #the session contents var |
169
|
|
|
|
|
|
|
{ |
170
|
0
|
|
|
|
|
0
|
eval $validContents; |
|
0
|
|
|
|
|
0
|
|
171
|
|
|
|
|
|
|
} |
172
|
0
|
|
|
|
|
0
|
$self->{'vars'} = $VAR1; |
173
|
0
|
|
|
|
|
0
|
$result = 1; |
174
|
0
|
|
|
|
|
0
|
$self->_setId($sessionId); #remember the session id |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
else{ |
177
|
0
|
|
|
|
|
0
|
$self->setError("Session contents invalid"); |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
else{ |
181
|
0
|
|
|
|
|
0
|
$self->setError("Cant open session file: $sessionFile: $!"); |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
else{ |
185
|
0
|
|
|
|
|
0
|
$self->setError("Session ID invalid: $sessionId"); |
186
|
|
|
|
|
|
|
} |
187
|
|
|
|
|
|
|
} |
188
|
2
|
|
|
|
|
19
|
return $result; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
########################################################################################### |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=pod |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=head2 delete() |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Remove the current session from memory, disk and expire it in the browser. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
########################################################################################### |
201
|
|
|
|
|
|
|
sub delete{ #remove a session |
202
|
0
|
|
|
0
|
1
|
0
|
my($self, $response) = @_; |
203
|
0
|
|
|
|
|
0
|
my $result = 0; |
204
|
0
|
0
|
|
|
|
0
|
if($response){ |
205
|
0
|
|
|
|
|
0
|
my $sessionId = $self->getId(); |
206
|
0
|
|
|
|
|
0
|
my $prefix = $self->_getPrefix(); |
207
|
0
|
0
|
|
|
|
0
|
if($sessionId =~ m/^$prefix[a-f0-9]+$/){ #id valid |
208
|
0
|
|
|
|
|
0
|
my $path = $self->_getPath(); |
209
|
0
|
|
|
|
|
0
|
my $sessionFile = File::Spec->catfile($path, $sessionId); |
210
|
0
|
0
|
|
|
|
0
|
if(unlink($sessionFile)){ |
211
|
0
|
|
|
|
|
0
|
$self->_getHector()->getLog()->log("Deleted session: $sessionId", 'debug'); |
212
|
0
|
|
|
|
|
0
|
my $cookie = $self->_setCookie(EXPIRE => 'now'); |
213
|
0
|
|
|
|
|
0
|
$response->header("Set-Cookie" , => $cookie); |
214
|
0
|
|
|
|
|
0
|
$self = undef; #destroy this object |
215
|
0
|
|
|
|
|
0
|
$result = 1; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
else{ |
218
|
0
|
|
|
|
|
0
|
$self->setError("Could not delete session"); |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
else{ |
222
|
0
|
|
|
|
|
0
|
$self->setError("Session ID invalid: $sessionId"); |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
} |
225
|
|
|
|
|
|
|
else{ |
226
|
0
|
|
|
|
|
0
|
$self->setError("No response given"); |
227
|
|
|
|
|
|
|
} |
228
|
0
|
|
|
|
|
0
|
$result; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
############################################################################################################### |
231
|
|
|
|
|
|
|
#private class method |
232
|
|
|
|
|
|
|
############################################################################################################### |
233
|
|
|
|
|
|
|
sub _getHector{ |
234
|
10
|
|
|
10
|
|
22
|
my $self = shift; |
235
|
10
|
|
|
|
|
28
|
return $self->{'_hector'}; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
########################################################################################################################### |
238
|
|
|
|
|
|
|
sub _setId{ |
239
|
2
|
|
|
2
|
|
3
|
my($self, $id) = @_; |
240
|
2
|
|
|
|
|
5
|
$self->{'id'} = $id; #save the id |
241
|
2
|
|
|
|
|
7
|
return 1; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
############################################################################################################### |
244
|
|
|
|
|
|
|
sub _setCookie{ |
245
|
2
|
|
|
2
|
|
6
|
my($self, %options) = @_; |
246
|
2
|
|
|
|
|
4
|
my $secure = 0; |
247
|
2
|
|
|
|
|
5
|
my $hector = $self->_getHector(); |
248
|
2
|
|
|
|
|
7
|
my $env = $hector->getEnv(); |
249
|
2
|
50
|
|
|
|
7
|
if(exists($env->{'HTTPS'})){ #use secure cookies if running on ssl |
250
|
0
|
|
|
|
|
0
|
$secure = 1; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
my $cookie = CGI::Simple::Cookie->new( |
253
|
|
|
|
|
|
|
-name => 'SESSION', |
254
|
|
|
|
|
|
|
-value => $options{'VALUE'} || undef, |
255
|
2
|
|
50
|
|
|
45
|
-expires => $options{'EXPIRE'} || undef, |
|
|
|
50
|
|
|
|
|
256
|
|
|
|
|
|
|
-httponly => 1, |
257
|
|
|
|
|
|
|
-secure => $secure |
258
|
|
|
|
|
|
|
); |
259
|
2
|
50
|
|
|
|
359
|
if($cookie){ |
260
|
2
|
|
|
|
|
271
|
return $cookie->as_string(); |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
else{ |
263
|
0
|
|
|
|
|
0
|
$self->setError("Can't create cookie"); |
264
|
|
|
|
|
|
|
} |
265
|
0
|
|
|
|
|
0
|
return undef; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
############################################################################################################## |
268
|
|
|
|
|
|
|
sub _expire{ #remove old session files |
269
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
270
|
1
|
|
|
|
|
5
|
my $path = $self->_getPath(); |
271
|
1
|
50
|
|
|
|
103
|
if(opendir(COOKIES, $path)){ |
272
|
1
|
|
|
|
|
27
|
my @sessions = readdir(COOKIES); |
273
|
1
|
|
|
|
|
3
|
my $expire = (time - 86400); |
274
|
1
|
|
|
|
|
4
|
foreach(@sessions){ #check each of the cookies |
275
|
4
|
|
|
|
|
11
|
my $prefix = $self->_getPrefix(); |
276
|
4
|
50
|
|
|
|
49
|
if($_ =~ m/^($prefix[a-f0-9]+)$/){ #found a cookie file |
277
|
0
|
|
|
|
|
0
|
my $sessionFile = File::Spec->catfile($path, $1); |
278
|
0
|
|
|
|
|
0
|
my @stat = stat($sessionFile); |
279
|
0
|
0
|
0
|
|
|
0
|
if(defined($stat[9]) && $stat[9] < $expire){ #cookie is more than a day old, so remove it |
280
|
0
|
|
|
|
|
0
|
unlink $sessionFile; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
} |
284
|
1
|
|
|
|
|
75
|
closedir(COOKIES); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
############################################################################################################ |
288
|
|
|
|
|
|
|
#private methods |
289
|
|
|
|
|
|
|
########################################################################################### |
290
|
|
|
|
|
|
|
sub _write{ #writes a server-side cookie for the session |
291
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
292
|
0
|
|
|
|
|
0
|
my $prefix = $self->_getPrefix(); |
293
|
0
|
0
|
|
|
|
0
|
if($self->getId() =~ m/^($prefix[a-f0-9]+)$/){ #filename valid |
294
|
0
|
|
|
|
|
0
|
my $path = $self->_getPath(); |
295
|
0
|
|
|
|
|
0
|
my $sessionFile = File::Spec->catfile($path, $1); |
296
|
0
|
0
|
|
|
|
0
|
if(open(SSIDE, ">", $sessionFile)){ |
297
|
0
|
|
|
|
|
0
|
$Data::Dumper::Freezer = 'freeze'; |
298
|
0
|
|
|
|
|
0
|
$Data::Dumper::Toaster = 'toast'; |
299
|
0
|
|
|
|
|
0
|
$Data::Dumper::Indent = 0; #turn off formatting |
300
|
0
|
|
|
|
|
0
|
my $dump = Dumper $self->{'vars'}; |
301
|
0
|
0
|
|
|
|
0
|
if($dump){ #if we have any data |
302
|
0
|
|
|
|
|
0
|
print SSIDE $dump; |
303
|
|
|
|
|
|
|
} |
304
|
0
|
|
|
|
|
0
|
close(SSIDE); |
305
|
|
|
|
|
|
|
} |
306
|
0
|
|
|
|
|
0
|
else{$self->setError("Cant write session: $!");} |
307
|
|
|
|
|
|
|
} |
308
|
0
|
|
|
|
|
0
|
else{$self->setError('Session ID invalid');} |
309
|
0
|
0
|
|
|
|
0
|
if($self->getError()){return 0;} |
|
0
|
|
|
|
|
0
|
|
310
|
0
|
|
|
|
|
0
|
else{return 1;} |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
########################################################################################################################## |
313
|
|
|
|
|
|
|
sub _storeVar{ #stores a variable in the session |
314
|
4
|
|
|
4
|
|
15
|
my($self, $name, $value) = @_; |
315
|
4
|
100
|
|
|
|
10
|
if(!defined($value)){ #remove the var |
316
|
2
|
50
|
|
|
|
8
|
if($self->{'vars'}){ |
317
|
2
|
|
|
|
|
9
|
my %vars = %{$self->{'vars'}}; |
|
2
|
|
|
|
|
10
|
|
318
|
2
|
|
|
|
|
4
|
delete $vars{$name}; |
319
|
2
|
|
|
|
|
5
|
$self->{'vars'} = \%vars; |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
} |
322
|
|
|
|
|
|
|
else{ #update/create a var |
323
|
2
|
|
|
|
|
9
|
$self->{'vars'}->{$name} = $value; #store for later |
324
|
|
|
|
|
|
|
} |
325
|
4
|
|
|
|
|
7
|
return 1; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
##################################################################################################################### |
328
|
|
|
|
|
|
|
sub _getPrefix{ #this should be a config option |
329
|
6
|
|
|
6
|
|
21
|
return $prefix; |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
##################################################################################################################### |
332
|
|
|
|
|
|
|
sub _getPath{ #this should be a config option |
333
|
1
|
|
|
1
|
|
2
|
return $path; |
334
|
|
|
|
|
|
|
} |
335
|
|
|
|
|
|
|
##################################################################################################################### |
336
|
|
|
|
|
|
|
sub _readOrCreate{ |
337
|
2
|
|
|
2
|
|
2
|
my $self = shift; |
338
|
2
|
50
|
33
|
|
|
9
|
if($self->read() && $self->validate()){ |
|
|
50
|
|
|
|
|
|
339
|
0
|
|
|
|
|
0
|
$self->_getHector()->getLog()->log("Existing session: " . $self->getId(), 'debug'); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
elsif($self->create()){ #start a new session |
342
|
2
|
|
|
|
|
7
|
$self->_getHector()->getLog()->log("Created new session: " . $self->getId(), 'debug'); |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
##################################################################################################################### |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=pod |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=head1 Notes |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=head1 Author |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
MacGyveR |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
Development questions, bug reports, and patches are welcome to the above address |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
=head1 See Also |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head1 Copyright |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Copyright (c) 2017 MacGyveR. All rights reserved. |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
=cut |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
########################################## |
368
|
|
|
|
|
|
|
return 1; |
369
|
|
|
|
5
|
|
|
END {} |