File Coverage

blib/lib/DBICx/Sugar.pm
Criterion Covered Total %
statement 59 83 71.0
branch 27 46 58.7
condition 1 2 50.0
subroutine 11 13 84.6
pod 5 6 83.3
total 103 150 68.6


line stmt bran cond sub pod time code
1             package DBICx::Sugar;
2              
3 5     5   670911 use strict;
  5         56  
  5         189  
4 5     5   37 use warnings;
  5         12  
  5         212  
5 5     5   36 use Carp qw(croak);
  5         13  
  5         327  
6 5     5   37 use Exporter qw(import);
  5         11  
  5         192  
7 5     5   1817 use Module::Load;
  5         6137  
  5         37  
8 5     5   1932 use YAML qw(LoadFile);
  5         34006  
  5         5525  
9              
10             our $VERSION = '0.0200'; # VERSION
11              
12             our @EXPORT_OK = qw(config get_config add_schema_to_config rset resultset schema);
13              
14             my $_config;
15             my $_schemas = {};
16              
17             sub config {
18 28     28 0 13448 my ($data) = @_;
19 28 100       123 if ($data) {
20 5 50       33 croak 'config data must be a hashref' unless 'HASH' eq ref $data;
21 5         16 $_config = $data;
22             }
23 28 50       120 return $_config if $_config;
24 0         0 my $config_path;
25 0 0       0 if (-f 'config.yaml') {
    0          
26 0         0 $config_path = 'config.yaml';
27             } elsif (-f 'config.yml') {
28 0         0 $config_path = 'config.yml';
29             } else {
30 0         0 croak "could not find a config.yml or config.yaml file";
31             }
32 0         0 return $_config = LoadFile($config_path)->{dbicx_sugar};
33             }
34              
35 0     0 1 0 sub get_config { return $_config; }
36              
37             sub add_schema_to_config {
38 0     0 1 0 my ($schema_name, $schema_data) = @_;
39             croak "Schema name $schema_name already exists"
40 0 0       0 if exists $_config->{$schema_name};
41 0 0       0 croak "Schema data must be a hashref (schema name: $schema_name)"
42             unless 'HASH' eq ref $schema_data;
43 0         0 $_config->{$schema_name} = $schema_data;
44             }
45              
46             sub schema {
47 23     23 1 173381 my ( $name, $schema_cfg ) = @_;
48              
49 23         117 my $cfg = config();
50              
51             # We weren't asked for a specific name
52             # try to get one from the default config
53 23 100       93 if (not defined $name) {
54 10 50       24 my @names = keys %{$cfg}
  10         60  
55             or croak("No schemas are configured");
56              
57             # Either pick the only one in the config or the default
58 10 100       52 $name = @names == 1 ? $names[0] : 'default';
59             }
60              
61 23 100       790 my $options = $cfg->{$name}
62             or croak("The schema $name is not configured");
63              
64             # Schema specific configuration from the user
65 20 100       73 if ($schema_cfg) {
66             # Just return a new schema and do not save it
67 1         6 return _create_schema( $name, $schema_cfg );
68             }
69              
70             # Return existing schemas, either by name
71 19 100       189 return $_schemas->{$name} if $_schemas->{$name};
72              
73             # Or by alias
74 8 100       48 if ( my $alias = $options->{alias} ) {
75 2 100       214 $options = $cfg->{$alias}
76             or croak("The schema alias $alias does not exist in the config");
77 1 50       9 return $_schemas->{$alias} if $_schemas->{$alias};
78             }
79              
80             # Create schema
81 6         40 my $schema = _create_schema( $name, $options );
82              
83 6         73 return $_schemas->{$name} = $schema;
84             }
85              
86             sub resultset {
87 5     5 1 8817 my ($rset_name) = @_;
88 5         20 return schema()->resultset($rset_name);
89             }
90              
91 4     4 1 10806 sub rset { goto &resultset }
92              
93             sub _create_schema {
94 7     7   33 my ( $name, $options ) = @_;
95             my @conn_info = $options->{connect_info}
96 0         0 ? @{$options->{connect_info}}
97 7 50       74 : @$options{qw(dsn user password options)};
98 7 50       39 if ( exists $options->{pass} ) {
99 0         0 warn "The pass option is deprecated. Use password instead.";
100 0         0 $conn_info[2] = $options->{pass};
101             }
102              
103 7         21 my $schema;
104              
105 7 100       32 if ( my $schema_class = $options->{schema_class} ) {
106 6         24 $schema_class =~ s/-/::/g;
107 6         16 eval { load $schema_class };
  6         36  
108 6 50       492078 croak("Could not load schema_class $schema_class: $@") if $@;
109 6 50       34 if ( my $replicated = $options->{replicated} ) {
110 0         0 $schema = $schema_class->clone;
111 0         0 my %storage_options;
112 0         0 my @params = qw( balancer_type balancer_args pool_type pool_args );
113 0         0 for my $p ( @params ) {
114 0         0 my $value = $replicated->{$p};
115 0 0       0 $storage_options{$p} = $value if defined $value;
116             }
117 0         0 $schema->storage_type([ '::DBI::Replicated', \%storage_options ]);
118 0         0 $schema->connection( @conn_info );
119 0         0 $schema->storage->connect_replicants( @{$replicated->{replicants}});
  0         0  
120             } else {
121 6         59 $schema = $schema_class->connect( @conn_info );
122             }
123             } else {
124 1         3 my $dbic_loader = 'DBIx::Class::Schema::Loader';
125 1         4 eval { load $dbic_loader };
  1         7  
126 1 50       188 croak("You must provide a schema_class option or install $dbic_loader.")
127             if $@;
128 1   50     79 $dbic_loader->naming( $options->{schema_loader_naming} || 'v7' );
129 1         80 $schema = DBIx::Class::Schema::Loader->connect(@conn_info);
130             }
131              
132 7         234711 return $schema;
133             }
134              
135             # ABSTRACT: Just some syntax sugar for DBIx::Class
136              
137              
138             1;
139              
140             __END__
141              
142             =pod
143              
144             =encoding UTF-8
145              
146             =head1 NAME
147              
148             DBICx::Sugar - Just some syntax sugar for DBIx::Class
149              
150             =head1 VERSION
151              
152             version 0.0200
153              
154             =head1 SYNOPSIS
155              
156             use DBICx::Sugar qw(schema resultset rset);
157              
158             # all of the following are equivalent:
159              
160             $user = schema('default')->resultset('User')->find('bob');
161             $user = schema->resultset('User')->find('bob');
162             $user = resultset('User')->find('bob');
163             $user = rset('User')->find('bob');
164              
165             =head1 DESCRIPTION
166              
167             Just some syntax sugar for your DBIx::Class applications.
168             This was originally created to remove code duplication between
169             L<Dancer::Plugin::DBIC> and L<Dancer2::Plugin::DBIC>.
170              
171             =head1 CONFIGURATION
172              
173             Configuration can be automatically parsed from a `config.yaml` or `config.yml`
174             file in the current working directory, or it can be explicitly set with the
175             C<config> function:
176              
177             DBICx::Sugar::config({ default => { dsn => ... } });
178              
179             If you want the config to be autoloaded from a yaml config file, just make sure
180             to put your config data under a top level C<dbicx_sugar> key.
181              
182             =head2 simple example
183              
184             Here is a simple example. It defines one database named C<default>:
185              
186             dbicx_sugar:
187             default:
188             dsn: dbi:SQLite:dbname=myapp.db
189             schema_class: MyApp::Schema
190              
191             =head2 multiple schemas
192              
193             In this example, there are 2 databases configured named C<default> and C<foo>:
194              
195             dbicx_sugar:
196             default:
197             dsn: dbi:SQLite:dbname=myapp.db
198             schema_class: MyApp::Schema
199             foo:
200             dsn: dbi:Pg:dbname=foo
201             schema_class: Foo::Schema
202             user: bob
203             password: secret
204             options:
205             RaiseError: 1
206             PrintError: 1
207              
208             Each database configured must at least have a dsn option.
209             The dsn option should be the L<DBI> driver connection string.
210             All other options are optional.
211              
212             If you only have one schema configured, or one of them is named
213             C<default>, you can call C<schema> without an argument to get the only
214             or C<default> schema, respectively.
215              
216             If a schema_class option is not provided, then L<DBIx::Class::Schema::Loader>
217             will be used to dynamically load the schema by introspecting the database
218             corresponding to the dsn value.
219             You need L<DBIx::Class::Schema::Loader> installed for this to work.
220              
221             WARNING: Dynamic loading is not recommended for production environments.
222             It is almost always better to provide a schema_class option.
223              
224             The schema_class option should be the name of your L<DBIx::Class::Schema> class.
225             See L</"SCHEMA GENERATION">
226             Optionally, a database configuration may have user, password, and options
227             parameters as described in the documentation for C<connect()> in L<DBI>.
228              
229             =head2 connect_info
230              
231             Alternatively, you may also declare your connection information inside an
232             array named C<connect_info>:
233              
234             dbicx_sugar:
235             default:
236             schema_class: MyApp::Schema
237             connect_info:
238             - dbi:Pg:dbname=foo
239             - bob
240             - secret
241             -
242             RaiseError: 1
243             PrintError: 1
244              
245             =head2 replicated
246              
247             You can also add database read slaves to your configuration with the
248             C<replicated> config option.
249             This will automatically make your read queries go to a slave and your write
250             queries go to the master.
251             Keep in mind that this will require additional dependencies:
252             L<DBIx::Class::Optional::Dependencies#Storage::Replicated>
253             See L<DBIx::Class::Storage::DBI::Replicated> for more details.
254             Here is an example configuration that adds two read slaves:
255              
256             dbicx_sugar:
257             default:
258             schema_class: MyApp::Schema
259             dsn: dbi:Pg:dbname=master
260             replicated:
261             balancer_type: ::Random # optional
262             balancer_args: # optional
263             auto_validate_every: 5 # optional
264             master_read_weight:1 # optional
265             # pool_type and pool_args are also allowed and are also optional
266             replicants:
267             -
268             - dbi:Pg:dbname=slave1
269             - user1
270             - password1
271             -
272             quote_names: 1
273             pg_enable_utf8: 1
274             -
275             - dbi:Pg:dbname=slave2
276             - user2
277             - password2
278             -
279             quote_names: 1
280             pg_enable_utf8: 1
281              
282             =head2 alias
283              
284             Schema aliases allow you to reference the same underlying database by multiple
285             names.
286             For example:
287              
288             dbicx_sugar:
289             default:
290             dsn: dbi:Pg:dbname=master
291             schema_class: MyApp::Schema
292             slave1:
293             alias: default
294              
295             Now you can access the default schema with C<schema()>, C<schema('default')>,
296             or C<schema('slave1')>.
297             This can come in handy if, for example, you have master/slave replication in
298             your production environment but only a single database in your development
299             environment.
300             You can continue to reference C<schema('slave1')> in your code in both
301             environments by simply creating a schema alias in your development.yml config
302             file, as shown above.
303              
304             =head1 FUNCTIONS
305              
306             =head2 schema
307              
308             my $user = schema->resultset('User')->find('bob');
309              
310             Returns a L<DBIx::Class::Schema> object ready for you to use.
311             For performance, schema objects are cached in memory and are lazy loaded the
312             first time they are accessed.
313             If you have configured only one database, then you can simply call C<schema>
314             with no arguments.
315             If you have configured multiple databases,
316             you can still call C<schema> with no arguments if there is a database
317             named C<default> in the configuration.
318             With no argument, the C<default> schema is returned.
319             Otherwise, you B<must> provide C<schema()> with the name of the database:
320              
321             my $user = schema('foo')->resultset('User')->find('bob');
322              
323             =head2 resultset
324              
325             This is a convenience method that will save you some typing.
326             Use this B<only> when accessing the C<default> schema.
327              
328             my $user = resultset('User')->find('bob');
329              
330             is equivalent to:
331              
332             my $user = schema->resultset('User')->find('bob');
333              
334             =head2 rset
335              
336             my $user = rset('User')->find('bob');
337              
338             This is simply an alias for C<resultset>.
339              
340             =head2 get_config
341              
342             Returns the current configuration, like config does,
343             but does not look for a config file.
344              
345             Use this for introspection, eg:
346              
347             my $dbix_sugar_is_configured = get_config ? 1 : 0 ;
348              
349             =head2 add_schema_to_config
350              
351             This function does not touch the existing config.
352             It can be used if some other part of your app
353             has configured DBICx::Sugar but did not know about
354             the part that uses an extra schema.
355              
356             add_schema_to_config('schema_name', { dsn => ... });
357              
358             =head1 SCHEMA GENERATION
359              
360             Setting the schema_class option and having proper DBIx::Class classes
361             is the recommended approach for performance and stability.
362             You can use the L<dbicdump> command line tool provided by
363             L<DBIx::Class::Schema::Loader> to help you.
364             For example, if your app were named Foo, then you could run the following
365             from the root of your project directory:
366              
367             dbicdump -o dump_directory=./lib Foo::Schema dbi:SQLite:/path/to/foo.db
368              
369             For this example, your C<schema_class> setting would be C<'Foo::Schema'>.
370              
371             =head1 CONTRIBUTORS
372              
373             =over
374              
375             =item *
376              
377             Henk van Oers <L<https://github.com/hvoers>>
378              
379             =back
380              
381             =head1 AUTHOR
382              
383             Naveed Massjouni <naveed@vt.edu>
384              
385             =head1 COPYRIGHT AND LICENSE
386              
387             This software is copyright (c) 2015 by Naveed Massjouni.
388              
389             This is free software; you can redistribute it and/or modify it under
390             the same terms as the Perl 5 programming language system itself.
391              
392             =cut