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   16 use strict;
  3         6  
  3         66  
4 3     3   38 use 5.008001;
  3         7  
5 3     3   13 use base 'URI::_login';
  3         5  
  3         1866  
6             our $VERSION = '0.20';
7              
8 914     914 0 291842 sub uri { shift }
9 5     5   315 sub _no_scheme_ok { 0 }
10              
11 396     396 0 159553 sub canonical_engine { shift->scheme }
12              
13             sub canonical {
14 52     52 1 2904 my $canon = shift->SUPER::canonical;
15 52         826 my $engine = $canon->canonical_engine;
16 52 100       299 return $canon if $canon->scheme eq $engine;
17 17         319 $canon = $canon->clone;
18 17         131 $canon->scheme($engine);
19 17         1637 return $canon;
20             }
21              
22             sub engine {
23 930     930 0 150164 my $self = shift;
24 930 100       3513 return $self->scheme unless @_;
25 6         14 my $old = $self->scheme(@_);
26 6 100       1526 bless $self => 'URI::_db' unless $self->isa('URI::_db');
27 6         27 return $old;
28             }
29              
30             sub has_recognized_engine {
31 95     95 0 123277 ref $_[0] ne __PACKAGE__;
32             }
33              
34             sub dbname {
35 1101     1101 0 49246 my $self = shift;
36 1101         3027 my $is_full = $self->opaque =~ m{^//(?://|/?(?!/))};
37 1101 100 66     14740 return $self->path($is_full && defined $_[0] ? "/$_[0]" : shift) if @_;
    100          
38 1091 100       3111 my @segs = $self->path_segments or return;
39 778 100       28343 shift @segs if $is_full;
40 778         3344 join '/' => @segs;
41             }
42              
43             sub query_params {
44 1107     1107 0 1513524 my $self = shift;
45 1107         5605 require URI::QueryParam;
46             return map {
47 1107         3786 my $f = $_;
  218         8304  
48 218         441 map { $f => $_ } grep { defined } $self->query_param($f)
  311         1028  
  311         15718  
49             } $self->query_param;
50             }
51              
52             sub _dbi_param_map {
53 52     52   2438 my $self = shift;
54             return (
55 52         126 [ host => scalar $self->host ],
56             [ port => scalar $self->_port ],
57             [ dbname => scalar $self->dbname ],
58             );
59             }
60              
61             sub dbi_params {
62 161     161 0 757 my $self = shift;
63             return (
64             (
65 262         265 map { @{ $_ } }
  262         555  
66 161 100       287 grep { defined $_->[1] && length $_->[1] } $self->_dbi_param_map
  351         1911  
67             ),
68             $self->query_params,
69             );
70             }
71              
72 1     1 0 4 sub dbi_driver { return undef }
73              
74             sub _dsn_params {
75 87     87   129 my $self = shift;
76 87         123 my @params = $self->dbi_params;
77 87         1315 my @kvpairs;
78 87         164 while (@params) {
79 208         476 push @kvpairs => join '=', shift @params, shift @params;
80             }
81 87         496 return join ';' => @kvpairs;
82             }
83              
84             sub dbi_dsn {
85 76     76 0 25329 my $self = shift;
86 76 100       170 my $driver = $self->dbi_driver or return $self->_dsn_params;
87 75         170 return join ':' => 'dbi', $driver, $self->_dsn_params;
88             }
89              
90             1;