File Coverage

blib/lib/Prancer/Plugin/Database.pm
Criterion Covered Total %
statement 67 71 94.3
branch 9 18 50.0
condition 9 25 36.0
subroutine 15 16 93.7
pod 0 1 0.0
total 100 131 76.3


line stmt bran cond sub pod time code
1             package Prancer::Plugin::Database;
2              
3 2     2   46737 use strict;
  2         3  
  2         66  
4 2     2   8 use warnings FATAL => 'all';
  2         2  
  2         59  
5              
6 2     2   462 use version;
  2         1367  
  2         9  
7             our $VERSION = '1.02';
8              
9 2     2   904 use Prancer::Plugin;
  2         27460  
  2         56  
10 2     2   11 use parent qw(Prancer::Plugin Exporter);
  2         3  
  2         8  
11              
12 2     2   6769 use Module::Load ();
  2         1858  
  2         39  
13 2     2   9 use Try::Tiny;
  2         2  
  2         94  
14 2     2   9 use Carp;
  2         2  
  2         214  
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 73513 my $class = shift;
24              
25             # already got an object
26 6 50       22 return $class if ref($class);
27              
28             # this is a singleton
29 6         10 my $instance = undef;
30             {
31 2     2   9 no strict 'refs';
  2         3  
  2         549  
  6         8  
32 6         6 $instance = \${"${class}::_instance"};
  6         22  
33 6 100       18 return $$instance if defined($$instance);
34             }
35              
36 5         16 my $self = bless({}, $class);
37              
38 5   50     24 my $config = ($self->config() && $self->config->get("database")) || {};
39 5 50 33     646 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         8 my $handles = {};
44 5         9 for my $key (keys %{$config}) {
  5         20  
45 7         32 my $subconfig = $config->{$key};
46              
47 7 50 33     69 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         12 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   207 Module::Load::load($module);
57              
58             # make sure it has necessary implementation details
59 7 50       427 die "${module} does not implement 'handle'\n" unless ($module->can("handle"));
60              
61             # make the connection to the database
62 7         31 $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         60 };
67             }
68 5         74 $self->{'_handles'} = $handles;
69              
70             # now export the keyword with a reference to $self
71             {
72             ## no critic (ProhibitNoStrict ProhibitNoWarnings)
73 2     2   19 no strict 'refs';
  2         3  
  2         57  
  5         6  
74 2     2   8 no warnings 'redefine';
  2         2  
  2         527  
75 5         6 *{"${\__PACKAGE__}::database"} = sub {
  5         127  
76 13 0 33 13   3779 my $this = ref($_[0]) && $_[0]->isa(__PACKAGE__) ?
    50 0        
77             shift : (defined($_[0]) && $_[0] eq __PACKAGE__) ?
78             bless({}, shift) : bless({}, __PACKAGE__);
79 13         27 return $self->_database(@_);
80 5         21 };
81             }
82              
83 5         243 $$instance = $self;
84 5         24 return $self;
85             }
86              
87             sub _database {
88 13     13   14 my $self = shift;
89 13   100     35 my $connection = shift || "default";
90              
91 13 100       61 if (!exists($self->{'_handles'}->{$connection})) {
92 1         184 croak "could not get connection to database: no connection named '${connection}'";
93             }
94              
95 12         39 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             dsn_extra:
132             RaiseError: 0
133             PrintError: 1
134             on_connect:
135             - SET search_path=public
136              
137             The "connection-name" can be anything you want it to be. This will be used when
138             requesting a connection from the plugin to determine which connection to return.
139             If only one connection is configured it may be prudent to call it "default" as
140             that is the name that Prancer will look for if no connection name is given.
141             For example:
142              
143             use Prancer::Plugin::Database qw(database);
144              
145             Prancer::Plugin::Database->load();
146              
147             my $dbh = database; # returns whatever connection is called "default"
148             my $dbh = database("foo"); # returns the connection called "foo"
149              
150             =head1 OPTIONS
151              
152             =over 4
153              
154             =item database
155              
156             B The name of the database to connect to.
157              
158             =item username
159              
160             The username to use when connecting. If this option is not set then the default
161             is the user running the application server or the current user.
162              
163             =item password
164              
165             The password to use when connecting. If this option is not set then the default
166             is to connect with no password.
167              
168             =item hostname
169              
170             The host name of the database server. If this option is not set then the
171             default is to connect to localhost.
172              
173             =item port
174              
175             The port number on which the database server is listening. If this option is
176             not set then the default is to connect on the database's default port.
177              
178             =item autocommit
179              
180             If set to a true value -- like 1, yes, or true -- then this will enable
181             autocommit. If set to a false value -- like 0, no, or false -- then this will
182             disable autocommit. By default, autocommit is enabled.
183              
184             =item charset
185              
186             The character set to connect to the database with. If this is set to "utf8"
187             then the database connection will attempt to make UTF8 data Just Work if
188             available.
189              
190             =item connection_check_threshold
191              
192             This sets the number of seconds that must elapse between calls to get a
193             database handle before performing a check to ensure that a database connection
194             still exists and will reconnect if one does not. This handles cases where the
195             database handle hasn't been used in a while and the underlying connection has
196             gone away. If this is not set then it will default to 30 seconds.
197              
198             =item dsn_extra
199              
200             If you have any further connection parameters that need to be appended to the
201             dsn then you can put them in the configuration as a hash. This hash will be
202             merged into the default parameters and overwrite any that are duplicated. The
203             dsn parameters set by default are C to 1, C to 1, and
204             C to 0. This option will take precedence over the C
205             flag above.
206              
207             =item on_connect
208              
209             This can be an array of commands execute on a successful connection. These will
210             be executed on every connection so if the connection goes away but is re-
211             established then these commands will be run again.
212              
213             =back
214              
215             =head1 CREDIT
216              
217             This module is derived from L. Thank you to David
218             Precious.
219              
220             =head1 COPYRIGHT
221              
222             Copyright 2014 Paul Lockaby. All rights reserved.
223              
224             This library is free software; you can redistribute it and/or modify it under
225             the same terms as Perl itself.
226              
227             =head1 SEE ALSO
228              
229             =over
230              
231             =item
232              
233             L
234              
235             =back
236              
237             =cut