line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#=============================================================================== |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# DESCRIPTION: Set of service subs |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# AUTHOR: Aliaksandr P. Zahatski, |
6
|
|
|
|
|
|
|
#=============================================================================== |
7
|
|
|
|
|
|
|
package WebDAO::Util; |
8
|
1
|
|
|
1
|
|
714
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
9
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
29
|
|
10
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
60
|
|
11
|
1
|
|
|
1
|
|
513
|
use WebDAO::Engine; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
42
|
|
12
|
1
|
|
|
1
|
|
526
|
use WebDAO::Session; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
92
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head2 load_module |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
Check if already loaded package and preload else |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
return : 0 - fail load class |
20
|
|
|
|
|
|
|
1 - suss loaded |
21
|
|
|
|
|
|
|
-1 - already loaded |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=cut |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub load_module { |
26
|
0
|
|
0
|
0
|
1
|
0
|
my $class = shift || return; |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#check non loaded mods |
29
|
0
|
|
|
|
|
0
|
my ( $main, $module ) = $class =~ m/(.*\:\:)?(\S+)$/; |
30
|
0
|
|
0
|
|
|
0
|
$main ||= 'main::'; |
31
|
0
|
|
|
|
|
0
|
$module .= '::'; |
32
|
1
|
|
|
1
|
|
5
|
no strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
75
|
|
33
|
0
|
0
|
|
|
|
0
|
unless ( exists $$main{$module} ) { |
34
|
0
|
|
|
|
|
0
|
eval "use $class"; |
35
|
0
|
0
|
|
|
|
0
|
if ($@) { |
36
|
0
|
|
|
|
|
0
|
croak "Error register class :$class with $@ "; |
37
|
0
|
|
|
|
|
0
|
return 0; |
38
|
|
|
|
|
|
|
} |
39
|
0
|
|
|
|
|
0
|
return 1; |
40
|
|
|
|
|
|
|
} |
41
|
1
|
|
|
1
|
|
5
|
use strict 'refs'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
473
|
|
42
|
0
|
|
|
|
|
0
|
-1; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head2 _parse_str_to_hash |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
convert string like: |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
config=/tmp/tests.ini;host=test.local |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
to hash: |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
{ |
54
|
|
|
|
|
|
|
config=>'/tmp/tests.ini', |
55
|
|
|
|
|
|
|
host=>'test.local' |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=cut |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _parse_str_to_hash { |
61
|
2
|
|
|
2
|
|
3
|
my $str = shift; |
62
|
2
|
100
|
|
|
|
9
|
return unless $str; |
63
|
1
|
|
|
|
|
2
|
my %hash = map { split( /=/, $_ ) } split( /;/, $str ); |
|
2
|
|
|
|
|
7
|
|
64
|
1
|
|
|
|
|
4
|
foreach ( values %hash ) { |
65
|
2
|
|
|
|
|
4
|
s/^\s+//; |
66
|
2
|
|
|
|
|
5
|
s/\s+^//; |
67
|
|
|
|
|
|
|
} |
68
|
1
|
|
|
|
|
4
|
\%hash; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 get_classes |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Get classes by check ENV variables |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
get_classes( wdEngine=> $def_eng_class) |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
return ref to hash |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub get_classes { |
82
|
|
|
|
|
|
|
|
83
|
1
|
|
|
1
|
1
|
743
|
my %defaults = ( |
84
|
|
|
|
|
|
|
wdEngine => 'WebDAO::Engine', |
85
|
|
|
|
|
|
|
wdSession => 'WebDAO::Session', |
86
|
|
|
|
|
|
|
wdSessionPar => undef, |
87
|
|
|
|
|
|
|
wdEnginePar => undef, |
88
|
|
|
|
|
|
|
@_ |
89
|
|
|
|
|
|
|
); |
90
|
1
|
|
50
|
|
|
4
|
my $env = delete $defaults{__env} || \%ENV; |
91
|
1
|
|
50
|
|
|
7
|
my $need_preload = delete $defaults{__preload} || 0; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$defaults{wdSession} = |
94
|
|
|
|
|
|
|
$env->{WD_SESSION} |
95
|
|
|
|
|
|
|
|| $env->{wdSession} |
96
|
1
|
|
33
|
|
|
7
|
|| $defaults{wdSession}; |
97
|
|
|
|
|
|
|
$defaults{wdEngine} = |
98
|
|
|
|
|
|
|
$env->{WD_ENGINE} |
99
|
|
|
|
|
|
|
|| $env->{wdEngine} |
100
|
1
|
|
33
|
|
|
7
|
|| $defaults{wdEngine}; |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
#init params |
103
|
|
|
|
|
|
|
$defaults{wdEnginePar} = |
104
|
|
|
|
|
|
|
WebDAO::Util::_parse_str_to_hash( $env->{WD_ENGINE_PAR} |
105
|
|
|
|
|
|
|
|| $env->{wdEnginePar} ) |
106
|
1
|
|
50
|
|
|
5
|
|| {}; |
107
|
|
|
|
|
|
|
$defaults{wdSessionPar} = |
108
|
|
|
|
|
|
|
WebDAO::Util::_parse_str_to_hash( $env->{WD_SESSION_PAR} |
109
|
|
|
|
|
|
|
|| $env->{wdSessionPar} ) |
110
|
1
|
|
50
|
|
|
6
|
|| {}; |
111
|
|
|
|
|
|
|
|
112
|
1
|
50
|
|
|
|
3
|
if ($need_preload) { |
113
|
0
|
|
|
|
|
0
|
for (qw/wdSession wdEngine /) { |
114
|
0
|
|
|
|
|
0
|
WebDAO::Util::load_module( $defaults{$_} ); |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
1
|
|
|
|
|
3
|
\%defaults; |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
our %HTTPStatusCode = ( |
124
|
|
|
|
|
|
|
100 => 'Continue', |
125
|
|
|
|
|
|
|
101 => 'Switching Protocols', |
126
|
|
|
|
|
|
|
102 => 'Processing', # RFC 2518 (WebDAV) |
127
|
|
|
|
|
|
|
200 => 'OK', |
128
|
|
|
|
|
|
|
201 => 'Created', |
129
|
|
|
|
|
|
|
202 => 'Accepted', |
130
|
|
|
|
|
|
|
203 => 'Non-Authoritative Information', |
131
|
|
|
|
|
|
|
204 => 'No Content', |
132
|
|
|
|
|
|
|
205 => 'Reset Content', |
133
|
|
|
|
|
|
|
206 => 'Partial Content', |
134
|
|
|
|
|
|
|
207 => 'Multi-Status', # RFC 2518 (WebDAV) |
135
|
|
|
|
|
|
|
300 => 'Multiple Choices', |
136
|
|
|
|
|
|
|
301 => 'Moved Permanently', |
137
|
|
|
|
|
|
|
302 => 'Found', |
138
|
|
|
|
|
|
|
303 => 'See Other', |
139
|
|
|
|
|
|
|
304 => 'Not Modified', |
140
|
|
|
|
|
|
|
305 => 'Use Proxy', |
141
|
|
|
|
|
|
|
307 => 'Temporary Redirect', |
142
|
|
|
|
|
|
|
400 => 'Bad Request', |
143
|
|
|
|
|
|
|
401 => 'Unauthorized', |
144
|
|
|
|
|
|
|
402 => 'Payment Required', |
145
|
|
|
|
|
|
|
403 => 'Forbidden', |
146
|
|
|
|
|
|
|
404 => 'Not Found', |
147
|
|
|
|
|
|
|
405 => 'Method Not Allowed', |
148
|
|
|
|
|
|
|
406 => 'Not Acceptable', |
149
|
|
|
|
|
|
|
407 => 'Proxy Authentication Required', |
150
|
|
|
|
|
|
|
408 => 'Request Timeout', |
151
|
|
|
|
|
|
|
409 => 'Conflict', |
152
|
|
|
|
|
|
|
410 => 'Gone', |
153
|
|
|
|
|
|
|
411 => 'Length Required', |
154
|
|
|
|
|
|
|
412 => 'Precondition Failed', |
155
|
|
|
|
|
|
|
413 => 'Request Entity Too Large', |
156
|
|
|
|
|
|
|
414 => 'Request-URI Too Large', |
157
|
|
|
|
|
|
|
415 => 'Unsupported Media Type', |
158
|
|
|
|
|
|
|
416 => 'Request Range Not Satisfiable', |
159
|
|
|
|
|
|
|
417 => 'Expectation Failed', |
160
|
|
|
|
|
|
|
422 => 'Unprocessable Entity', # RFC 2518 (WebDAV) |
161
|
|
|
|
|
|
|
423 => 'Locked', # RFC 2518 (WebDAV) |
162
|
|
|
|
|
|
|
424 => 'Failed Dependency', # RFC 2518 (WebDAV) |
163
|
|
|
|
|
|
|
425 => 'No code', # WebDAV Advanced Collections |
164
|
|
|
|
|
|
|
426 => 'Upgrade Required', # RFC 2817 |
165
|
|
|
|
|
|
|
449 => 'Retry with', # unofficial Microsoft |
166
|
|
|
|
|
|
|
500 => 'Internal Server Error', |
167
|
|
|
|
|
|
|
501 => 'Not Implemented', |
168
|
|
|
|
|
|
|
502 => 'Bad Gateway', |
169
|
|
|
|
|
|
|
503 => 'Service Unavailable', |
170
|
|
|
|
|
|
|
504 => 'Gateway Timeout', |
171
|
|
|
|
|
|
|
505 => 'HTTP Version Not Supported', |
172
|
|
|
|
|
|
|
506 => 'Variant Also Negotiates', # RFC 2295 |
173
|
|
|
|
|
|
|
507 => 'Insufficient Storage', # RFC 2518 (WebDAV) |
174
|
|
|
|
|
|
|
509 => 'Bandwidth Limit Exceeded', # unofficial |
175
|
|
|
|
|
|
|
510 => 'Not Extended', # RFC 2774 |
176
|
|
|
|
|
|
|
); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
1; |
179
|
|
|
|
|
|
|
|