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   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;