File Coverage

blib/lib/URI/_db.pm
Criterion Covered Total %
statement 53 53 100.0
branch 18 18 100.0
condition 2 3 66.6
subroutine 16 16 100.0
pod 1 10 10.0
total 90 100 90.0


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;