| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package URI::_db; |
|
2
|
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
20
|
use strict; |
|
|
3
|
|
|
|
|
6
|
|
|
|
3
|
|
|
|
|
78
|
|
|
4
|
3
|
|
|
3
|
|
46
|
use 5.008001; |
|
|
3
|
|
|
|
|
12
|
|
|
5
|
3
|
|
|
3
|
|
15
|
use base 'URI::_login'; |
|
|
3
|
|
|
|
|
5
|
|
|
|
3
|
|
|
|
|
1334
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.21'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
914
|
|
|
914
|
0
|
352054
|
sub uri { shift } |
|
9
|
5
|
|
|
5
|
|
303
|
sub _no_scheme_ok { 0 } |
|
10
|
|
|
|
|
|
|
|
|
11
|
396
|
|
|
396
|
0
|
191983
|
sub canonical_engine { shift->scheme } |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub canonical { |
|
14
|
52
|
|
|
52
|
1
|
3589
|
my $canon = shift->SUPER::canonical; |
|
15
|
52
|
|
|
|
|
1409
|
my $engine = $canon->canonical_engine; |
|
16
|
52
|
100
|
|
|
|
415
|
return $canon if $canon->scheme eq $engine; |
|
17
|
17
|
|
|
|
|
463
|
$canon = $canon->clone; |
|
18
|
17
|
|
|
|
|
191
|
$canon->scheme($engine); |
|
19
|
17
|
|
|
|
|
2221
|
return $canon; |
|
20
|
|
|
|
|
|
|
} |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub engine { |
|
23
|
930
|
|
|
930
|
0
|
182294
|
my $self = shift; |
|
24
|
930
|
100
|
|
|
|
3708
|
return $self->scheme unless @_; |
|
25
|
6
|
|
|
|
|
19
|
my $old = $self->scheme(@_); |
|
26
|
6
|
100
|
|
|
|
2148
|
bless $self => 'URI::_db' unless $self->isa('URI::_db'); |
|
27
|
6
|
|
|
|
|
41
|
return $old; |
|
28
|
|
|
|
|
|
|
} |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub has_recognized_engine { |
|
31
|
95
|
|
|
95
|
0
|
148370
|
ref $_[0] ne __PACKAGE__; |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub dbname { |
|
35
|
1110
|
|
|
1110
|
0
|
59150
|
my $self = shift; |
|
36
|
1110
|
|
|
|
|
2981
|
my $is_full = $self->opaque =~ m{^//(?://|/?(?!/))}; |
|
37
|
1110
|
100
|
66
|
|
|
17866
|
return $self->path($is_full && defined $_[0] ? "/$_[0]" : shift) if @_; |
|
|
|
100
|
|
|
|
|
|
|
38
|
1100
|
100
|
|
|
|
3157
|
my @segs = $self->path_segments or return; |
|
39
|
787
|
100
|
|
|
|
34041
|
shift @segs if $is_full; |
|
40
|
787
|
|
|
|
|
4674
|
join '/' => @segs; |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub query_params { |
|
44
|
1116
|
|
|
1116
|
0
|
1813628
|
my $self = shift; |
|
45
|
1116
|
|
|
|
|
6338
|
require URI::QueryParam; |
|
46
|
|
|
|
|
|
|
return map { |
|
47
|
1116
|
|
|
|
|
4142
|
my $f = $_; |
|
|
218
|
|
|
|
|
10193
|
|
|
48
|
218
|
|
|
|
|
563
|
map { $f => $_ } grep { defined } $self->query_param($f) |
|
|
311
|
|
|
|
|
1326
|
|
|
|
311
|
|
|
|
|
19312
|
|
|
49
|
|
|
|
|
|
|
} $self->query_param; |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub _dbi_param_map { |
|
53
|
52
|
|
|
52
|
|
2963
|
my $self = shift; |
|
54
|
|
|
|
|
|
|
return ( |
|
55
|
52
|
|
|
|
|
158
|
[ host => scalar $self->host ], |
|
56
|
|
|
|
|
|
|
[ port => scalar $self->_port ], |
|
57
|
|
|
|
|
|
|
[ dbname => scalar $self->dbname ], |
|
58
|
|
|
|
|
|
|
); |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub dbi_params { |
|
62
|
167
|
|
|
167
|
0
|
951
|
my $self = shift; |
|
63
|
|
|
|
|
|
|
return ( |
|
64
|
|
|
|
|
|
|
( |
|
65
|
272
|
|
|
|
|
331
|
map { @{ $_ } } |
|
|
272
|
|
|
|
|
702
|
|
|
66
|
167
|
100
|
|
|
|
351
|
grep { defined $_->[1] && length $_->[1] } $self->_dbi_param_map |
|
|
369
|
|
|
|
|
2341
|
|
|
67
|
|
|
|
|
|
|
), |
|
68
|
|
|
|
|
|
|
$self->query_params, |
|
69
|
|
|
|
|
|
|
); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
1
|
|
|
1
|
0
|
5
|
sub dbi_driver { return undef } |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _dsn_params { |
|
75
|
90
|
|
|
90
|
|
161
|
my $self = shift; |
|
76
|
90
|
|
|
|
|
160
|
my @params = $self->dbi_params; |
|
77
|
90
|
|
|
|
|
1720
|
my @kvpairs; |
|
78
|
90
|
|
|
|
|
201
|
while (@params) { |
|
79
|
213
|
|
|
|
|
588
|
push @kvpairs => join '=', shift @params, shift @params; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
90
|
|
|
|
|
633
|
return join ';' => @kvpairs; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub dbi_dsn { |
|
85
|
81
|
|
|
81
|
0
|
33757
|
my $self = shift; |
|
86
|
81
|
100
|
|
|
|
220
|
my $driver = $self->dbi_driver or return $self->_dsn_params; |
|
87
|
80
|
|
|
|
|
209
|
return join ':' => 'dbi', $driver, $self->_dsn_params; |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |