File Coverage

blib/lib/Prancer/Plugin/Database.pm
Criterion Covered Total %
statement 67 71 94.3
branch 9 18 50.0
condition 8 23 34.7
subroutine 15 16 93.7
pod 0 1 0.0
total 99 129 76.7


line stmt bran cond sub pod time code
1             package Prancer::Plugin::Database;
2              
3 2     2   62147 use strict;
  2         5  
  2         82  
4 2     2   11 use warnings FATAL => 'all';
  2         4  
  2         84  
5              
6 2     2   453 use version;
  2         1374  
  2         11  
7             our $VERSION = '1.01';
8              
9 2     2   1219 use Prancer::Plugin;
  2         18114  
  2         60  
10 2     2   14 use parent qw(Prancer::Plugin Exporter);
  2         2  
  2         9  
11              
12 2     2   1263 use Module::Load ();
  2         2111  
  2         57  
13 2     2   14 use Try::Tiny;
  2         2  
  2         123  
14 2     2   9 use Carp;
  2         3  
  2         231  
15              
16             our @EXPORT_OK = qw(database);
17             our %EXPORT_TAGS = ('all' => [ @EXPORT_OK ]);
18              
19             # even though this *should* work automatically, it was not
20             our @CARP_NOT = qw(Prancer Try::Tiny);
21              
22             sub load {
23 6     6 0 102961 my $class = shift;
24              
25             # already got an object
26 6 50       27 return $class if ref($class);
27              
28             # this is a singleton
29 6         13 my $instance = undef;
30             {
31 2     2   39 no strict 'refs';
  2         4  
  2         630  
  6         10  
32 6         9 $instance = \${"${class}::_instance"};
  6         36  
33 6 100       28 return $$instance if defined($$instance);
34             }
35              
36 5         15 my $self = bless({}, $class);
37              
38 5         39 my $config = $self->config->get("database");
39 5 50 33     823 unless (defined($config) && ref($config) && ref($config) eq "HASH") {
      33        
40 0         0 croak "could not initialize database connection: no configuration found";
41             }
42              
43 5         12 my $handles = {};
44 5         9 for my $key (keys %{$config}) {
  5         28  
45 7         50 my $subconfig = $config->{$key};
46              
47 7 50 33     88 unless (defined($subconfig) && ref($subconfig) && ref($subconfig) eq "HASH" && $subconfig->{'driver'}) {
      33        
      33        
48 0         0 croak "could not initialize database connection '${key}': no database driver configuration";
49             }
50              
51 7         17 my $module = $subconfig->{'driver'};
52              
53             # try to load the module and make sure it has required subroutines
54             try {
55             # load the module
56 7     7   319 Module::Load::load($module);
57              
58             # make sure it has necessary implementation details
59 7 50       609 die "${module} does not implement 'handle'\n" unless ($module->can("handle"));
60              
61             # make the connection to the database
62 7         43 $handles->{$key} = $module->new($subconfig->{'options'}, $key);
63             } catch {
64 0 0   0   0 my $error = (defined($_) ? $_ : "unknown");
65 0         0 croak "could not initialize database connection '${key}': not able to load ${module}: ${error}";
66 7         88 };
67             }
68 5         111 $self->{'_handles'} = $handles;
69              
70             # now export the keyword with a reference to $self
71             {
72             ## no critic (ProhibitNoStrict ProhibitNoWarnings)
73 2     2   20 no strict 'refs';
  2         3  
  2         53  
  5         12  
74 2     2   6 no warnings 'redefine';
  2         3  
  2         588  
75 5         8 *{"${\__PACKAGE__}::database"} = sub {
  5         176  
76 13 0 33 13   5521 my $this = ref($_[0]) && $_[0]->isa(__PACKAGE__) ?
    50 0        
77             shift : (defined($_[0]) && $_[0] eq __PACKAGE__) ?
78             bless({}, shift) : bless({}, __PACKAGE__);
79 13         35 return $self->_database(@_);
80 5         35 };
81             }
82              
83 5         313 $$instance = $self;
84 5         40 return $self;
85             }
86              
87             sub _database {
88 13     13   19 my $self = shift;
89 13   100     107 my $connection = shift || "default";
90              
91 13 100       103 if (!exists($self->{'_handles'}->{$connection})) {
92 1         240 croak "could not get connection to database: no connection named '${connection}'";
93             }
94              
95 12         64 return $self->{'_handles'}->{$connection}->handle();
96             }
97              
98             1;
99              
100             =head1 NAME
101              
102             Prancer::Plugin::Database
103              
104             =head1 SYNOPSIS
105              
106             This plugin enables connections to a database and exports a keyword to access
107             those configured connections.
108              
109             It's important to remember that when running your application in a single-
110             threaded, single-process application server like, say, L, all users of
111             your application will use the same database connection. If you are using
112             callbacks then this becomes very important and you will want to take care to
113             avoid crossing transactions or expecting a database connection or transaction
114             to be in the same state it was before a callback.
115              
116             To use a database connector, add something like this to your configuration
117             file:
118              
119             database:
120             connection-name:
121             driver: Prancer::Plugin::Database::Driver::DriverName
122             options:
123             username: test
124             password: test
125             database: test
126             hostname: localhost
127             port: 5432
128             autocommit: true
129             charset: utf8
130             connection_check_threshold: 10
131              
132             The "connection-name" can be anything you want it to be. This will be used when
133             requesting a connection from the plugin to determine which connection to return.
134             If only one connection is configured it may be prudent to call it "default" as
135             that is the name that Prancer will look for if no connection name is given.
136             For example:
137              
138             use Prancer::Plugin::Database qw(database);
139              
140             Prancer::Plugin::Database->load();
141              
142             my $dbh = database; # returns whatever connection is called "default"
143             my $dbh = database("foo"); # returns the connection called "foo"
144              
145             =head1 OPTIONS
146              
147             =over 4
148              
149             =item database
150              
151             B The name of the database to connect to.
152              
153             =item username
154              
155             The username to use when connecting. If this option is not set then the default
156             is the user running the application server or the current user.
157              
158             =item password
159              
160             The password to use when connecting. If this option is not set then the default
161             is to connect with no password.
162              
163             =item hostname
164              
165             The host name of the database server. If this option is not set then the
166             default is to connect to localhost.
167              
168             =item port
169              
170             The port number on which the database server is listening. If this option is
171             not set then the default is to connect on the database's default port.
172              
173             =item autocommit
174              
175             If set to a true value -- like 1, yes, or true -- then this will enable
176             autocommit. If set to a false value -- like 0, no, or false -- then this will
177             disable autocommit. By default, autocommit is enabled.
178              
179             =item charset
180              
181             The character set to connect to the database with. If this is set to "utf8"
182             then the database connection will attempt to make UTF8 data Just Work if
183             available.
184              
185             =item connection_check_threshold
186              
187             This sets the number of seconds that must elapse between calls to get a
188             database handle before performing a check to ensure that a database connection
189             still exists and will reconnect if one does not. This handles cases where the
190             database handle hasn't been used in a while and the underlying connection has
191             gone away. If this is not set then it will default to 30 seconds.
192              
193             =back
194              
195             =head1 CREDIT
196              
197             This module is derived from L. Thank you to David
198             Precious.
199              
200             =head1 COPYRIGHT
201              
202             Copyright 2014 Paul Lockaby. All rights reserved.
203              
204             This library is free software; you can redistribute it and/or modify it under
205             the same terms as Perl itself.
206              
207             =head1 SEE ALSO
208              
209             =over
210              
211             =item
212              
213             L
214              
215             =back
216              
217             =cut