line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Apache::ASP::State; |
2
|
|
|
|
|
|
|
|
3
|
14
|
|
|
14
|
|
14820
|
use MLDBM; |
|
14
|
|
|
|
|
67624
|
|
|
14
|
|
|
|
|
106
|
|
4
|
14
|
|
|
14
|
|
18398
|
use MLDBM::Sync 0.25; |
|
14
|
|
|
|
|
8275481
|
|
|
14
|
|
|
|
|
591
|
|
5
|
14
|
|
|
14
|
|
159
|
use MLDBM::Sync::SDBM_File; |
|
14
|
|
|
|
|
30
|
|
|
14
|
|
|
|
|
617
|
|
6
|
14
|
|
|
14
|
|
87
|
use SDBM_File; |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
431
|
|
7
|
14
|
|
|
14
|
|
75
|
use Data::Dumper; |
|
14
|
|
|
|
|
25
|
|
|
14
|
|
|
|
|
605
|
|
8
|
|
|
|
|
|
|
|
9
|
14
|
|
|
14
|
|
74
|
use strict; |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
542
|
|
10
|
14
|
|
|
14
|
|
67
|
no strict qw(refs); |
|
14
|
|
|
|
|
28
|
|
|
14
|
|
|
|
|
370
|
|
11
|
14
|
|
|
14
|
|
82
|
use vars qw(%DB %CACHE $DefaultGroupIdLength); |
|
14
|
|
|
|
|
27
|
|
|
14
|
|
|
|
|
1013
|
|
12
|
14
|
|
|
14
|
|
75
|
use Fcntl qw(:flock O_RDWR O_CREAT); |
|
14
|
|
|
|
|
41
|
|
|
14
|
|
|
|
|
35431
|
|
13
|
|
|
|
|
|
|
$DefaultGroupIdLength = 2; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Database formats supports and their underlying extensions |
16
|
|
|
|
|
|
|
%DB = ( |
17
|
|
|
|
|
|
|
SDBM_File => ['.pag', '.dir'], |
18
|
|
|
|
|
|
|
DB_File => [''], |
19
|
|
|
|
|
|
|
'MLDBM::Sync::SDBM_File' => ['.pag', '.dir'], |
20
|
|
|
|
|
|
|
GDBM_File => [''], |
21
|
|
|
|
|
|
|
'Tie::TextDir' => [''], |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# About locking, we use a separate lock file from the SDBM files |
25
|
|
|
|
|
|
|
# generated because locking directly on the SDBM files occasionally |
26
|
|
|
|
|
|
|
# results in sdbm store errors. This is less efficient, than locking |
27
|
|
|
|
|
|
|
# to the db file directly, but having a separate lock file works for now. |
28
|
|
|
|
|
|
|
# |
29
|
|
|
|
|
|
|
# If there is no $group given, then the $group will be extracted from |
30
|
|
|
|
|
|
|
# the $id as the first 2 letters of that group. |
31
|
|
|
|
|
|
|
# |
32
|
|
|
|
|
|
|
# If the group and the id are the same length, then what was passed |
33
|
|
|
|
|
|
|
# was just a group id, and the object is being created for informational |
34
|
|
|
|
|
|
|
# purposes only. So, we don't create a lock file in this case, as this |
35
|
|
|
|
|
|
|
# is not a real State object |
36
|
|
|
|
|
|
|
# |
37
|
|
|
|
|
|
|
sub new { |
38
|
199
|
|
|
199
|
0
|
411
|
my($asp, $id, $group) = @_; |
39
|
|
|
|
|
|
|
|
40
|
199
|
50
|
|
|
|
780
|
if($id) { |
41
|
199
|
|
|
|
|
414
|
$id =~ tr///; |
42
|
|
|
|
|
|
|
} else { |
43
|
0
|
|
|
|
|
0
|
$asp->Error("no id: $id passed into new State"); |
44
|
0
|
|
|
|
|
0
|
return; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# default group is first 2 characters of id, simple hashing |
48
|
199
|
100
|
|
|
|
417
|
if($group) { |
49
|
57
|
|
|
|
|
199
|
$group =~ tr///; |
50
|
|
|
|
|
|
|
} else { |
51
|
142
|
|
|
|
|
459
|
$group = substr($id, 0, $DefaultGroupIdLength) |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
199
|
50
|
|
|
|
477
|
unless($group) { |
55
|
0
|
|
|
|
|
0
|
$asp->Error("no group defined for id $id"); |
56
|
0
|
|
|
|
|
0
|
return; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
199
|
|
|
|
|
400
|
my $state_dir = $asp->{state_dir}; |
60
|
199
|
|
|
|
|
432
|
my $group_dir = $state_dir.'/'.$group; |
61
|
199
|
|
|
|
|
473
|
my $lock_file = $group_dir.'/'.$id.'.lock'; |
62
|
199
|
|
|
|
|
396
|
my $file = $group_dir.'/'.$id; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# we only need SDBM_File for internal, and its faster so use it |
65
|
199
|
|
|
|
|
232
|
my($state_db, $state_serializer); |
66
|
199
|
100
|
100
|
|
|
1712
|
if($id eq 'internal') { |
|
|
100
|
|
|
|
|
|
67
|
28
|
|
|
|
|
56
|
$state_db = $Apache::ASP::DefaultStateDB; |
68
|
28
|
|
|
|
|
50
|
$state_serializer = $Apache::ASP::DefaultStateSerializer; |
69
|
|
|
|
|
|
|
} elsif($asp->{Internal} && (length($id) > $DefaultGroupIdLength)) { |
70
|
|
|
|
|
|
|
# don't get data for dummy group id sessions |
71
|
96
|
|
|
|
|
207
|
my $internal = $asp->{Internal}; |
72
|
96
|
|
|
|
|
439
|
my $idata = $internal->{$id}; |
73
|
96
|
50
|
33
|
|
|
502
|
if(! $idata->{state_db} || ! $idata->{state_serializer}) { |
74
|
96
|
|
33
|
|
|
721
|
$state_db = $idata->{state_db} || $asp->{state_db} || $Apache::ASP::DefaultStateDB; |
75
|
96
|
|
33
|
|
|
595
|
$state_serializer = $idata->{state_serializer} || |
76
|
|
|
|
|
|
|
$asp->{state_serializer} || $Apache::ASP::DefaultStateSerializer; |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# INIT StateDB && StateSerializer if hitting for the first time |
79
|
|
|
|
|
|
|
# only if real id like a session id or application |
80
|
96
|
50
|
|
|
|
272
|
if(length($id) > $DefaultGroupIdLength) { |
81
|
96
|
|
|
|
|
134
|
my $diff = 0; |
82
|
96
|
50
|
33
|
|
|
437
|
if(($idata->{state_db} || $Apache::ASP::DefaultStateDB) ne $state_db) { |
83
|
0
|
|
|
|
|
0
|
$idata->{state_db} = $state_db; |
84
|
0
|
|
|
|
|
0
|
$diff = 1; |
85
|
|
|
|
|
|
|
} |
86
|
96
|
50
|
33
|
|
|
388
|
if(($idata->{state_serializer} || $Apache::ASP::DefaultStateSerializer) ne $state_serializer) { |
87
|
0
|
|
|
|
|
0
|
$idata->{state_serializer} = $state_serializer; |
88
|
0
|
|
|
|
|
0
|
$diff = 1; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
96
|
50
|
|
|
|
456
|
if($diff) { |
92
|
0
|
0
|
|
|
|
0
|
$asp->{dbg} && $asp->Debug("setting internal data for state $id", $idata); |
93
|
0
|
|
|
|
|
0
|
$internal->{$id} = $idata; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
} else { |
97
|
|
|
|
|
|
|
# this state has already been created |
98
|
0
|
|
|
|
|
0
|
$state_db = $idata->{state_db}; |
99
|
0
|
|
|
|
|
0
|
$state_serializer = $idata->{state_serializer}; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
} else { |
102
|
|
|
|
|
|
|
# cache layer doesn't need internal |
103
|
75
|
|
|
|
|
217
|
($state_db, $state_serializer) = ($asp->{state_db}, $asp->{state_serializer}); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
199
|
|
|
|
|
1951
|
my $self = |
107
|
|
|
|
|
|
|
bless { |
108
|
|
|
|
|
|
|
asp=>$asp, |
109
|
|
|
|
|
|
|
dbm => undef, |
110
|
|
|
|
|
|
|
'dir' => $group_dir, |
111
|
|
|
|
|
|
|
id => $id, |
112
|
|
|
|
|
|
|
file => $file, |
113
|
|
|
|
|
|
|
group => $group, |
114
|
|
|
|
|
|
|
group_dir => $group_dir, |
115
|
|
|
|
|
|
|
reads => 0, |
116
|
|
|
|
|
|
|
state_dir => $state_dir, |
117
|
|
|
|
|
|
|
writes => 0, |
118
|
|
|
|
|
|
|
}; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# short circuit before expensive directory tests for group stub |
121
|
199
|
100
|
|
|
|
553
|
if ($group eq $id) { |
122
|
74
|
|
|
|
|
381
|
return $self; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
125
|
50
|
|
|
|
555
|
if($asp->config('StateAllWrite')) { |
|
|
50
|
|
|
|
|
|
126
|
0
|
0
|
|
|
|
0
|
$asp->{dbg} and $asp->{state_all_write} = 1; |
127
|
0
|
|
|
|
|
0
|
$self->{dir_perms} = 0777; |
128
|
0
|
|
|
|
|
0
|
$self->{file_perms} = 0666; |
129
|
|
|
|
|
|
|
} elsif($asp->config('StateGroupWrite')) { |
130
|
0
|
0
|
|
|
|
0
|
$asp->{dbg} and $asp->{state_group_write} = 1; |
131
|
0
|
|
|
|
|
0
|
$self->{dir_perms} = 0770; |
132
|
0
|
|
|
|
|
0
|
$self->{file_perms} = 0660; |
133
|
|
|
|
|
|
|
} else { |
134
|
125
|
|
|
|
|
475
|
$self->{dir_perms} = 0750; |
135
|
125
|
|
|
|
|
243
|
$self->{file_perms} = 0640; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
# push(@{$self->{'ext'}}, @{$DB{$self->{state_db}}}); |
139
|
|
|
|
|
|
|
# $self->{asp}->Debug("db ext: ".join(",", @{$self->{'ext'}})); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# create state directories |
142
|
125
|
|
|
|
|
183
|
my @create_dirs; |
143
|
125
|
100
|
|
|
|
2093
|
unless(-d $state_dir) { |
144
|
2
|
|
|
|
|
6
|
push(@create_dirs, $state_dir); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
# create group directory |
147
|
125
|
100
|
|
|
|
7767
|
unless(-d $group_dir) { |
148
|
13
|
|
|
|
|
45
|
push(@create_dirs, $group_dir); |
149
|
|
|
|
|
|
|
} |
150
|
125
|
100
|
|
|
|
311
|
if(@create_dirs) { |
151
|
13
|
|
|
|
|
52
|
$self->UmaskClear; |
152
|
13
|
|
|
|
|
36
|
for my $create_dir (@create_dirs) { |
153
|
|
|
|
|
|
|
# $create_dir =~ tr///; # this doesn't work to untaint with perl 5.6.1, use old method |
154
|
15
|
|
|
|
|
76
|
$create_dir =~ /^(.*)$/s; |
155
|
15
|
|
|
|
|
49
|
$create_dir = $1; |
156
|
15
|
50
|
|
|
|
1377
|
if(mkdir($create_dir, $self->{dir_perms})) { |
157
|
15
|
100
|
|
|
|
105
|
$asp->{dbg} && $asp->Debug("creating state dir $create_dir"); |
158
|
|
|
|
|
|
|
} else { |
159
|
0
|
|
|
|
|
0
|
my $error = $!; |
160
|
0
|
0
|
|
|
|
0
|
-d $create_dir || $self->{asp}->Error("can't create group dir $create_dir: $error"); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
13
|
|
|
|
|
54
|
$self->UmaskRestore; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# INIT MLDBM::Sync DBM |
167
|
|
|
|
|
|
|
{ |
168
|
125
|
|
50
|
|
|
172
|
local $MLDBM::UseDB = $state_db || 'SDBM_File'; |
|
125
|
|
|
|
|
351
|
|
169
|
125
|
|
100
|
|
|
308
|
local $MLDBM::Serializer = $state_serializer || 'Data::Dumper'; |
170
|
|
|
|
|
|
|
# clear current tied relationship first, if any |
171
|
125
|
|
|
|
|
237
|
$self->{dbm} = undef; |
172
|
125
|
|
|
0
|
|
1111
|
local $SIG{__WARN__} = sub {}; |
|
0
|
|
|
|
|
0
|
|
173
|
|
|
|
|
|
|
|
174
|
125
|
|
|
|
|
628
|
my $error; |
175
|
125
|
|
|
|
|
585
|
$self->{file} =~ /^(.*)$/; # untaint |
176
|
125
|
|
|
|
|
385
|
$self->{file} = $1; |
177
|
125
|
|
|
|
|
186
|
local $MLDBM::RemoveTaint = 1; |
178
|
125
|
|
|
|
|
582
|
$self->{dbm} = &MLDBM::Sync::TIEHASH('MLDBM', $self->{file}, O_RDWR|O_CREAT, $self->{file_perms}); |
179
|
125
|
100
|
|
|
|
3147
|
$asp->{dbg} && $asp->Debug("creating dbm for file $self->{file}, db $MLDBM::UseDB, serializer: $MLDBM::Serializer"); |
180
|
125
|
|
100
|
|
|
1204
|
$error = $! || 'Undefined Error'; |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
|
183
|
125
|
50
|
|
|
|
935
|
if(! $self->{dbm}) { |
184
|
0
|
|
|
|
|
0
|
$self->{asp}->Error(qq{ |
185
|
|
|
|
|
|
|
Cannot tie to file $self->{file}, $error !! |
186
|
|
|
|
|
|
|
Make sure you have the permissions on the directory set correctly, and that your |
187
|
|
|
|
|
|
|
version of Data::Dumper is up to date. Also, make sure you have set StateDir to |
188
|
|
|
|
|
|
|
to a good directory in the config file. StateDir defaults to Global/.state |
189
|
|
|
|
|
|
|
}); |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
125
|
|
|
|
|
754
|
$self; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
0
|
0
|
0
|
sub Init { shift->{dbm}->CLEAR(); } |
197
|
29
|
|
|
29
|
0
|
146
|
sub Size { shift->{dbm}->SyncSize; } |
198
|
16
|
|
|
16
|
0
|
71
|
sub Delete { shift->{dbm}->CLEAR(); } |
199
|
4
|
|
|
4
|
0
|
22
|
sub WriteLock { shift->{dbm}->Lock; } |
200
|
0
|
|
|
0
|
0
|
0
|
sub ReadLock { shift->{dbm}->ReadLock; } |
201
|
3
|
|
|
3
|
0
|
13
|
sub UnLock { shift->{dbm}->UnLock; } |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub DeleteGroupId { |
204
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
205
|
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
0
|
my $group_dir = $self->{group_dir}; |
207
|
0
|
0
|
|
|
|
0
|
if(-d $group_dir) { |
208
|
0
|
|
|
|
|
0
|
$self->{asp}{Internal}->LOCK; |
209
|
0
|
0
|
|
|
|
0
|
if(rmdir($group_dir)) { |
210
|
0
|
|
|
|
|
0
|
$self->{asp}->Debug("deleting group dir $group_dir"); |
211
|
|
|
|
|
|
|
} else { |
212
|
0
|
|
|
|
|
0
|
$self->{asp}->Log("cannot delete group dir $group_dir: $!"); |
213
|
|
|
|
|
|
|
} |
214
|
0
|
|
|
|
|
0
|
$self->{asp}{Internal}->UNLOCK; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
43
|
|
|
43
|
0
|
281
|
sub GroupId { shift->{group}; } |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub GroupMembers { |
221
|
74
|
|
|
74
|
0
|
117
|
my $self = shift; |
222
|
74
|
|
|
|
|
201
|
local(*DIR); |
223
|
74
|
|
|
|
|
90
|
my(%ids, @ids); |
224
|
|
|
|
|
|
|
|
225
|
74
|
50
|
|
|
|
2448
|
unless(opendir(DIR, $self->{group_dir})) { |
226
|
0
|
|
|
|
|
0
|
$self->{asp}->Log("opening group $self->{group_dir} failed: $!"); |
227
|
0
|
|
|
|
|
0
|
return []; |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
74
|
|
|
|
|
9715
|
for(readdir(DIR)) { |
231
|
181
|
100
|
|
|
|
833
|
next if /^\.\.?$/; |
232
|
33
|
|
|
|
|
320
|
$_ =~ /^(.*?)(\.[^\.]+)?$/; |
233
|
33
|
50
|
|
|
|
93
|
next unless $1; |
234
|
33
|
|
|
|
|
80
|
$ids{$1}++; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# need to explicitly close directory, or we get a file |
238
|
|
|
|
|
|
|
# handle leak on Solaris |
239
|
74
|
|
|
|
|
847
|
closedir(DIR); |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# since not all sessions have their own dbms now, find session ids in $Internal too |
242
|
74
|
50
|
|
|
|
272
|
if(my $internal = $self->{asp}{Internal}) { |
243
|
74
|
|
|
|
|
305
|
my $cached_keys = {}; |
244
|
74
|
100
|
|
|
|
264
|
unless($cached_keys = $self->{asp}{internal_cached_keys}) { |
245
|
|
|
|
|
|
|
map { |
246
|
8
|
100
|
|
|
|
76
|
if(/^([0-9a-f]{2})/) { |
|
153
|
|
|
|
|
461
|
|
247
|
57
|
|
|
|
|
321
|
$cached_keys->{$1}{$_}++ |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
} keys %$internal; |
250
|
8
|
|
|
|
|
65
|
$self->{asp}{internal_cached_keys} = $cached_keys; |
251
|
|
|
|
|
|
|
} |
252
|
74
|
100
|
|
|
|
280
|
if(my $group_keys = $cached_keys->{$self->{group}}) { |
253
|
41
|
|
|
|
|
235
|
%ids = ( %ids, %$group_keys ); |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
74
|
|
|
|
|
207
|
@ids = keys %ids; |
258
|
|
|
|
|
|
|
|
259
|
74
|
|
|
|
|
6140
|
\@ids; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub DefaultGroups { |
263
|
8
|
|
|
8
|
0
|
18
|
my $self = shift; |
264
|
8
|
|
|
|
|
11
|
my(@ids); |
265
|
8
|
|
|
|
|
26
|
local *STATEDIR; |
266
|
|
|
|
|
|
|
|
267
|
8
|
50
|
|
|
|
316
|
opendir(STATEDIR, $self->{state_dir}) |
268
|
|
|
|
|
|
|
|| $self->{asp}->Error("can't open state dir $self->{state_dir}"); |
269
|
8
|
|
|
|
|
24
|
my $time = time; |
270
|
8
|
|
|
|
|
331
|
for(readdir(STATEDIR)) { |
271
|
98
|
100
|
|
|
|
216
|
next if /^\./; |
272
|
82
|
100
|
|
|
|
177
|
next unless (length($_) eq $DefaultGroupIdLength); |
273
|
74
|
|
|
|
|
149
|
push(@ids, $_); |
274
|
|
|
|
|
|
|
} |
275
|
8
|
|
|
|
|
132
|
closedir STATEDIR; |
276
|
|
|
|
|
|
|
|
277
|
8
|
|
|
|
|
51
|
\@ids; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
sub UmaskClear { |
281
|
280
|
|
|
280
|
0
|
437
|
my $self = shift; |
282
|
280
|
50
|
|
|
|
892
|
return if $self->{asp}{win32}; |
283
|
280
|
|
|
|
|
1452
|
$self->{umask_restore} = umask(0000); |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub UmaskRestore { |
287
|
280
|
|
|
280
|
0
|
608
|
my $self = shift; |
288
|
280
|
50
|
|
|
|
886
|
return if $self->{asp}{win32}; |
289
|
280
|
50
|
|
|
|
764
|
if(defined $self->{umask_restore}) { |
290
|
280
|
|
|
|
|
1285
|
umask($self->{umask_restore}); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
} |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
sub DESTROY { |
295
|
352
|
|
|
352
|
|
967
|
my $self = shift; |
296
|
352
|
100
|
|
|
|
387
|
return unless %{$self}; |
|
352
|
|
|
|
|
1453
|
|
297
|
309
|
100
|
|
|
|
1680
|
return if $self->{destroyed}++; |
298
|
199
|
100
|
|
|
|
488
|
$self->{dbm} && eval { $self->{dbm}->DESTROY }; |
|
125
|
|
|
|
|
397
|
|
299
|
199
|
|
|
|
|
1381
|
$self->{dbm} = undef; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
# don't need to skip DESTROY since we have it defined |
303
|
|
|
|
|
|
|
# return if ($AUTOLOAD =~ /DESTROY/); |
304
|
|
|
|
|
|
|
sub AUTOLOAD { |
305
|
204
|
|
|
204
|
|
267
|
my $self = shift; |
306
|
204
|
|
|
|
|
252
|
my $AUTOLOAD = $Apache::ASP::State::AUTOLOAD; |
307
|
204
|
|
|
|
|
1032
|
$AUTOLOAD =~ s/^(.*)::(.*?)$/$2/o; |
308
|
|
|
|
|
|
|
|
309
|
204
|
|
|
|
|
240
|
my $value; |
310
|
204
|
|
|
|
|
771
|
$value = $self->{dbm}->$AUTOLOAD(@_); |
311
|
|
|
|
|
|
|
|
312
|
204
|
|
|
|
|
13853
|
$value; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub TIEHASH { |
316
|
56
|
|
|
56
|
|
105
|
my $type = shift; |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# dual tie contructor, if we receive a State object to tie |
319
|
|
|
|
|
|
|
# then just return it, otherwise construct a new object |
320
|
|
|
|
|
|
|
# before tieing |
321
|
56
|
50
|
|
|
|
232
|
if((ref $_[0]) =~ /State/) { |
322
|
0
|
|
|
|
|
0
|
$_[0]; |
323
|
|
|
|
|
|
|
} else { |
324
|
56
|
|
|
|
|
166
|
bless &new(@_), $type; |
325
|
|
|
|
|
|
|
} |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub FETCH { |
329
|
482
|
|
|
482
|
|
1124
|
my($self, $index) = @_; |
330
|
482
|
|
|
|
|
538
|
my $value; |
331
|
|
|
|
|
|
|
|
332
|
482
|
50
|
|
|
|
2282
|
if($index eq '_FILE') { |
|
|
50
|
|
|
|
|
|
333
|
0
|
|
|
|
|
0
|
$value = $self->{file}; |
334
|
|
|
|
|
|
|
} elsif($index eq '_SELF') { |
335
|
0
|
|
|
|
|
0
|
$value = $self; |
336
|
|
|
|
|
|
|
} else { |
337
|
482
|
|
|
|
|
4156
|
$value = $self->{dbm}->FETCH($index); |
338
|
482
|
|
|
|
|
103040
|
$self->{reads}++; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
482
|
|
|
|
|
3001
|
$value; |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
sub STORE { |
345
|
267
|
|
|
267
|
|
507
|
my $self = shift; |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# don't worry about overhead of Umask* routines, the STORE |
348
|
|
|
|
|
|
|
# being called is much heavier |
349
|
267
|
|
|
|
|
651
|
$self->UmaskClear; |
350
|
267
|
|
|
|
|
1597
|
my $rv = $self->{dbm}->STORE(@_); |
351
|
267
|
|
|
|
|
52686
|
$self->UmaskRestore; |
352
|
267
|
|
|
|
|
524
|
$self->{writes}++; |
353
|
|
|
|
|
|
|
|
354
|
267
|
|
|
|
|
957
|
$rv; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
380
|
|
|
380
|
0
|
455
|
sub LOCK { my $self = tied(%{$_[0]}); $self->{dbm}->Lock(); } |
|
380
|
|
|
|
|
787
|
|
|
380
|
|
|
|
|
1309
|
|
358
|
422
|
|
|
422
|
0
|
588
|
sub UNLOCK { my $self = tied(%{$_[0]}); $self->{dbm}->UnLock(); } |
|
422
|
|
|
|
|
837
|
|
|
422
|
|
|
|
|
1318
|
|
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
1; |