| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package URI::_db; |
|
2
|
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
14
|
use strict; |
|
|
3
|
|
|
|
|
6
|
|
|
|
3
|
|
|
|
|
72
|
|
|
4
|
3
|
|
|
3
|
|
36
|
use 5.008001; |
|
|
3
|
|
|
|
|
7
|
|
|
5
|
3
|
|
|
3
|
|
10
|
use base 'URI::_login'; |
|
|
3
|
|
|
|
|
5
|
|
|
|
3
|
|
|
|
|
969
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.19'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
834
|
|
|
834
|
0
|
237411
|
sub uri { shift } |
|
9
|
5
|
|
|
5
|
|
297
|
sub _no_scheme_ok { 0 } |
|
10
|
|
|
|
|
|
|
|
|
11
|
396
|
|
|
396
|
0
|
144229
|
sub canonical_engine { shift->scheme } |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub canonical { |
|
14
|
48
|
|
|
48
|
1
|
2557
|
my $canon = shift->SUPER::canonical; |
|
15
|
48
|
|
|
|
|
778
|
my $engine = $canon->canonical_engine; |
|
16
|
48
|
100
|
|
|
|
302
|
return $canon if $canon->scheme eq $engine; |
|
17
|
14
|
|
|
|
|
227
|
$canon = $canon->clone; |
|
18
|
14
|
|
|
|
|
119
|
$canon->scheme($engine); |
|
19
|
14
|
|
|
|
|
1254
|
return $canon; |
|
20
|
|
|
|
|
|
|
} |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub engine { |
|
23
|
850
|
|
|
850
|
0
|
124894
|
my $self = shift; |
|
24
|
850
|
100
|
|
|
|
2519
|
return $self->scheme unless @_; |
|
25
|
6
|
|
|
|
|
14
|
my $old = $self->scheme(@_); |
|
26
|
6
|
100
|
|
|
|
1682
|
bless $self => 'URI::_db' unless $self->isa('URI::_db'); |
|
27
|
6
|
|
|
|
|
25
|
return $old; |
|
28
|
|
|
|
|
|
|
} |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub has_recognized_engine { |
|
31
|
87
|
|
|
87
|
0
|
99646
|
ref $_[0] ne __PACKAGE__; |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub dbname { |
|
35
|
995
|
|
|
995
|
0
|
41163
|
my $self = shift; |
|
36
|
995
|
|
|
|
|
2197
|
my $is_full = $self->opaque =~ m{^//(?://|/?(?!/))}; |
|
37
|
995
|
100
|
66
|
|
|
11672
|
return $self->path($is_full && defined $_[0] ? "/$_[0]" : shift) if @_; |
|
|
|
100
|
|
|
|
|
|
|
38
|
985
|
100
|
|
|
|
2314
|
my @segs = $self->path_segments or return; |
|
39
|
710
|
100
|
|
|
|
22653
|
shift @segs if $is_full; |
|
40
|
710
|
|
|
|
|
2768
|
join '/' => @segs; |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub query_params { |
|
44
|
1001
|
|
|
1001
|
0
|
1237817
|
my $self = shift; |
|
45
|
1001
|
|
|
|
|
4670
|
require URI::QueryParam; |
|
46
|
|
|
|
|
|
|
return map { |
|
47
|
1001
|
|
|
|
|
2993
|
my $f = $_; |
|
|
186
|
|
|
|
|
6453
|
|
|
48
|
186
|
|
|
|
|
369
|
map { $f => $_ } grep { defined } $self->query_param($f) |
|
|
263
|
|
|
|
|
878
|
|
|
|
263
|
|
|
|
|
12093
|
|
|
49
|
|
|
|
|
|
|
} $self->query_param; |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub _dbi_param_map { |
|
53
|
52
|
|
|
52
|
|
2394
|
my $self = shift; |
|
54
|
|
|
|
|
|
|
return ( |
|
55
|
52
|
|
|
|
|
140
|
[ host => scalar $self->host ], |
|
56
|
|
|
|
|
|
|
[ port => scalar $self->_port ], |
|
57
|
|
|
|
|
|
|
[ dbname => scalar $self->dbname ], |
|
58
|
|
|
|
|
|
|
); |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub dbi_params { |
|
62
|
141
|
|
|
141
|
0
|
640
|
my $self = shift; |
|
63
|
|
|
|
|
|
|
return ( |
|
64
|
|
|
|
|
|
|
( |
|
65
|
222
|
|
|
|
|
209
|
map { @{ $_ } } |
|
|
222
|
|
|
|
|
412
|
|
|
66
|
141
|
100
|
|
|
|
242
|
grep { defined $_->[1] && length $_->[1] } $self->_dbi_param_map |
|
|
291
|
|
|
|
|
1446
|
|
|
67
|
|
|
|
|
|
|
), |
|
68
|
|
|
|
|
|
|
$self->query_params, |
|
69
|
|
|
|
|
|
|
); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
1
|
|
|
1
|
0
|
3
|
sub dbi_driver { return undef } |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _dsn_params { |
|
75
|
77
|
|
|
77
|
|
108
|
my $self = shift; |
|
76
|
77
|
|
|
|
|
107
|
my @params = $self->dbi_params; |
|
77
|
77
|
|
|
|
|
1057
|
my @kvpairs; |
|
78
|
77
|
|
|
|
|
124
|
while (@params) { |
|
79
|
176
|
|
|
|
|
372
|
push @kvpairs => join '=', shift @params, shift @params; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
77
|
|
|
|
|
410
|
return join ';' => @kvpairs; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub dbi_dsn { |
|
85
|
66
|
|
|
66
|
0
|
18127
|
my $self = shift; |
|
86
|
66
|
100
|
|
|
|
148
|
my $driver = $self->dbi_driver or return $self->_dsn_params; |
|
87
|
65
|
|
|
|
|
138
|
return join ':' => 'dbi', $driver, $self->_dsn_params; |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |