File Coverage

blib/lib/Mojo/DB/Connector/Base.pm
Criterion Covered Total %
statement 22 46 47.8
branch 6 22 27.2
condition 4 6 66.6
subroutine 6 7 85.7
pod 0 1 0.0
total 38 82 46.3


line stmt bran cond sub pod time code
1             package Mojo::DB::Connector::Base;
2 10     10   4369 use Mojo::Base -role;
  10         24  
  10         57  
3 10     10   8244 use Mojo::Parameters;
  10         20218  
  10         59  
4 10     10   4604 use Mojo::URL;
  10         45670  
  10         74  
5              
6             has env_prefix => sub { 'MOJO_DB_CONNECTOR_' };
7             has scheme => sub { shift->_attr_default('scheme', 'SCHEME', 'postgresql') };
8             has userinfo => sub { shift->_attr_default('userinfo', 'USERINFO', '') };
9             has host => sub { shift->_attr_default('host', 'HOST', 'localhost') };
10             has port => sub { shift->_attr_default('port', 'PORT', '5432') };
11             has database => sub { shift->_attr_default(sub { $_->path->to_string }, 'DATABASE', '') };
12             has options => sub {
13             my $options = shift->_attr_default(sub { $_->query->pairs }, 'OPTIONS', '');
14             return $options if ref $options;
15             return Mojo::Parameters->new($options)->pairs;
16             };
17             has url => sub {
18             my $env_url = $ENV{shift->env_prefix . 'URL'};
19             return unless $env_url;
20              
21             my $url = Mojo::URL->new($env_url);
22             # so database does not have a leading slash
23             $url->path->leading_slash(undef);
24              
25             return $url;
26             };
27             has strict_mode => sub { $ENV{shift->env_prefix . 'STRICT_MODE'} // 1 };
28              
29             has [qw(_required_mysql _required_pg)];
30              
31             sub new_connection {
32 1     1 0 162 my $self = shift;
33 1         5 my %config = $self->_config(@_);
34              
35 1         16 my ($package, $constructor);
36 1         3 my $scheme = $config{scheme};
37 1 50 33     9 if ($scheme eq 'mariadb' or $scheme eq 'mysql') {
    50          
38 0         0 $package = 'Mojo::mysql';
39 0 0       0 $constructor = $config{strict_mode} ? 'strict_mode' : 'new';
40              
41 0 0       0 if (not $self->_required_mysql) {
42 0 0       0 eval { require Mojo::mysql; 1 } or Carp::croak "Failed to require Mojo::mysql $@";
  0         0  
  0         0  
43 0         0 $self->_required_mysql(1);
44             }
45             } elsif ($scheme eq 'postgresql') {
46 0         0 $package = 'Mojo::Pg';
47 0         0 $constructor = 'new';
48              
49 0 0       0 if (not $self->_required_pg) {
50 0 0       0 eval { require Mojo::Pg; 1 } or Carp::croak "Failed to require Mojo::Pg $@";
  0         0  
  0         0  
51 0         0 $self->_required_pg(1);
52             }
53             } else {
54 1         30 Carp::croak "unknown scheme '$scheme'. Supported schemes are: mariadb, mysql, postgresql";
55             }
56              
57 0         0 return $package->$constructor($self->_to_url(%config)->to_unsafe_string);
58             }
59              
60             sub _to_url {
61 0     0   0 my ($self, %config) = @_;
62              
63             my $url =
64             Mojo::URL->new
65             ->scheme($config{scheme})
66             ->userinfo($config{userinfo})
67             ->host($config{host})
68             ->port($config{port})
69             ->path($config{database})
70 0         0 ;
71 0         0 $url->query($self->options);
72              
73 0 0       0 if ($config{options}) {
74 0 0       0 if ($config{replace_options}) {
75 0         0 $url->query(@{ $config{options} });
  0         0  
76             } else {
77 0         0 $url->query($config{options});
78             }
79             }
80              
81 0         0 return $url;
82             }
83              
84             sub _config {
85 1     1   2 my $self = shift;
86              
87             return (
88 1         3 (map { $_ => $self->$_ } qw(scheme userinfo host port database strict_mode)),
  6         57  
89             @_,
90             );
91             }
92              
93             sub _attr_default {
94 28     28   56 my ($self, $url_method, $env_suffix, $default) = @_;
95              
96 28 100       53 if (my $url = $self->url) {
97 6 100       53 return ref $url_method ? $url_method->(local $_ = $url) : $url->$url_method;
98             }
99              
100 22   100     102 return $ENV{$self->env_prefix . $env_suffix} // $default;
101             }
102              
103             1;
104             __END__