| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package URI::_db; |
|
2
|
|
|
|
|
|
|
|
|
3
|
3
|
|
|
3
|
|
19
|
use strict; |
|
|
3
|
|
|
|
|
6
|
|
|
|
3
|
|
|
|
|
104
|
|
|
4
|
3
|
|
|
3
|
|
56
|
use 5.008001; |
|
|
3
|
|
|
|
|
12
|
|
|
5
|
3
|
|
|
3
|
|
14
|
use base 'URI::_login'; |
|
|
3
|
|
|
|
|
13
|
|
|
|
3
|
|
|
|
|
1520
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.23'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
934
|
|
|
934
|
0
|
505769
|
sub uri { shift } |
|
9
|
5
|
|
|
5
|
|
425
|
sub _no_scheme_ok { 0 } |
|
10
|
|
|
|
|
|
|
|
|
11
|
416
|
|
|
416
|
0
|
355846
|
sub canonical_engine { shift->scheme } |
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub canonical { |
|
14
|
53
|
|
|
53
|
1
|
5509
|
my $canon = shift->SUPER::canonical; |
|
15
|
53
|
|
|
|
|
1344
|
my $engine = $canon->canonical_engine; |
|
16
|
53
|
100
|
|
|
|
475
|
return $canon if $canon->scheme eq $engine; |
|
17
|
17
|
|
|
|
|
469
|
$canon = $canon->clone; |
|
18
|
17
|
|
|
|
|
179
|
$canon->scheme($engine); |
|
19
|
17
|
|
|
|
|
2871
|
return $canon; |
|
20
|
|
|
|
|
|
|
} |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub engine { |
|
23
|
950
|
|
|
950
|
0
|
306260
|
my $self = shift; |
|
24
|
950
|
100
|
|
|
|
6338
|
return $self->scheme unless @_; |
|
25
|
6
|
|
|
|
|
22
|
my $old = $self->scheme(@_); |
|
26
|
6
|
100
|
|
|
|
2210
|
bless $self => 'URI::_db' unless $self->isa('URI::_db'); |
|
27
|
6
|
|
|
|
|
35
|
return $old; |
|
28
|
|
|
|
|
|
|
} |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub has_recognized_engine { |
|
31
|
97
|
|
|
97
|
0
|
242933
|
ref $_[0] ne __PACKAGE__; |
|
32
|
|
|
|
|
|
|
} |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub dbname { |
|
35
|
1144
|
|
|
1144
|
0
|
93886
|
my $self = shift; |
|
36
|
1144
|
|
|
|
|
5402
|
my $is_full = $self->opaque =~ m{^//(?://|/?(?!/))}; |
|
37
|
1144
|
100
|
66
|
|
|
23323
|
return $self->path($is_full && defined $_[0] ? "/$_[0]" : shift) if @_; |
|
|
|
100
|
|
|
|
|
|
|
38
|
1134
|
100
|
|
|
|
4989
|
my @segs = $self->path_segments or return; |
|
39
|
807
|
100
|
|
|
|
44120
|
shift @segs if $is_full; |
|
40
|
807
|
|
|
|
|
5662
|
join '/' => @segs; |
|
41
|
|
|
|
|
|
|
} |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub query_params { |
|
44
|
1148
|
|
|
1148
|
0
|
2864426
|
my $self = shift; |
|
45
|
1148
|
|
|
|
|
10681
|
require URI::QueryParam; |
|
46
|
|
|
|
|
|
|
return map { |
|
47
|
1148
|
|
|
|
|
6046
|
my $f = $_; |
|
|
229
|
|
|
|
|
12903
|
|
|
48
|
229
|
|
|
|
|
736
|
map { $f => $_ } grep { defined } $self->query_param($f) |
|
|
323
|
|
|
|
|
1567
|
|
|
|
323
|
|
|
|
|
28383
|
|
|
49
|
|
|
|
|
|
|
} $self->query_param; |
|
50
|
|
|
|
|
|
|
} |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub _dbi_param_map { |
|
53
|
64
|
|
|
64
|
|
3892
|
my $self = shift; |
|
54
|
|
|
|
|
|
|
return ( |
|
55
|
64
|
|
|
|
|
259
|
[ host => scalar $self->host ], |
|
56
|
|
|
|
|
|
|
[ port => scalar $self->_port ], |
|
57
|
|
|
|
|
|
|
[ dbname => scalar $self->dbname ], |
|
58
|
|
|
|
|
|
|
); |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub dbi_params { |
|
62
|
171
|
|
|
171
|
0
|
1139
|
my $self = shift; |
|
63
|
|
|
|
|
|
|
return ( |
|
64
|
|
|
|
|
|
|
( |
|
65
|
275
|
|
|
|
|
350
|
map { @{ $_ } } |
|
|
275
|
|
|
|
|
872
|
|
|
66
|
171
|
100
|
|
|
|
412
|
grep { defined $_->[1] && length $_->[1] } $self->_dbi_param_map |
|
|
373
|
|
|
|
|
2814
|
|
|
67
|
|
|
|
|
|
|
), |
|
68
|
|
|
|
|
|
|
$self->query_params, |
|
69
|
|
|
|
|
|
|
); |
|
70
|
|
|
|
|
|
|
} |
|
71
|
|
|
|
|
|
|
|
|
72
|
1
|
|
|
1
|
0
|
6
|
sub dbi_driver { return undef } |
|
73
|
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _dsn_params { |
|
75
|
89
|
|
|
89
|
|
193
|
my $self = shift; |
|
76
|
89
|
|
|
|
|
187
|
my @params = $self->dbi_params; |
|
77
|
89
|
|
|
|
|
1877
|
my @kvpairs; |
|
78
|
89
|
|
|
|
|
237
|
while (@params) { |
|
79
|
210
|
|
|
|
|
696
|
push @kvpairs => join '=', shift @params, shift @params; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
89
|
|
|
|
|
814
|
return join ';' => @kvpairs; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub dbi_dsn { |
|
85
|
86
|
|
|
86
|
0
|
48701
|
my $self = shift; |
|
86
|
86
|
100
|
|
|
|
357
|
my $driver = $self->dbi_driver or return $self->_dsn_params; |
|
87
|
85
|
|
|
|
|
334
|
return join ':' => 'dbi', $driver, $self->_dsn_params; |
|
88
|
|
|
|
|
|
|
} |
|
89
|
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |