File Coverage

blib/lib/Catalyst/Model/RapidApp/CoreSchema.pm
Criterion Covered Total %
statement 75 95 78.9
branch 6 18 33.3
condition 4 11 36.3
subroutine 21 25 84.0
pod 0 6 0.0
total 106 155 68.3


line stmt bran cond sub pod time code
1             package Catalyst::Model::RapidApp::CoreSchema;
2 1     1   424 use Moose;
  1         2  
  1         7  
3             extends 'Catalyst::Model::DBIC::Schema';
4              
5 1     1   5894 use strict;
  1         3  
  1         26  
6 1     1   6 use warnings;
  1         2  
  1         27  
7              
8 1     1   5 use RapidApp::Util qw(:all);
  1         2  
  1         427  
9              
10 1     1   7 use Types::Standard qw(:all);
  1         2  
  1         20  
11              
12 1     1   39482 use Catalyst::Utils;
  1         3  
  1         23  
13 1     1   4 use Module::Runtime;
  1         2  
  1         10  
14 1     1   36 use Digest::MD5 qw(md5_hex);
  1         2  
  1         58  
15 1     1   5 use Try::Tiny;
  1         2  
  1         62  
16 1     1   7 use Path::Class qw(file dir);
  1         1  
  1         44  
17              
18 1     1   1064 use DBIx::Class::Schema::Loader;
  1         10222  
  1         5  
19 1     1   944 use DBIx::Class::Schema::Diff;
  1         474066  
  1         68  
20              
21             BEGIN {
22 1     1   8 require DBIx::Class::Optional::Dependencies;
23 1 50       5 unless ( DBIx::Class::Optional::Dependencies->req_ok_for('deploy') ) {
24             die(
25             "Required DBIx::Class 'deploy' dependencies missing: "
26 0         0 . ( values %{ DBIx::Class::Optional::Dependencies->req_errorlist_for('deploy') } )[0]
  0         0  
27             );
28             }
29             }
30              
31             # --------------------
32             # User can set their own sqlite file/path by doing this in main app class:
33             #
34             # __PACKAGE__->config(
35             # 'Model::RapidApp::CoreSchema' => {
36             # sqlite_file => '/path/to/coreschema.db'
37             # }
38             # );
39             #
40             # OR, relative path is local to the app home dir:
41             # __PACKAGE__->config(
42             # 'Model::RapidApp::CoreSchema' => {
43             # sqlite_file => 'my_coreschema.db'
44             # }
45             # );
46             #
47             # They can also set/override 'schema_class' and 'connect_info'
48             # in the same place
49             #
50             # --------------------
51              
52             # New: this needs to be outside like this to avoid running afoul of
53             # nasty/complex load order problems with Model::DBIC
54             before 'COMPONENT' => sub {
55             my $class = shift;
56             my $app_class = ref $_[0] || $_[0];
57            
58             my $home = Catalyst::Utils::home($app_class) || Catalyst::Utils::class2tempdir($app_class,1);
59             my $cust_cnf = try{$app_class->config->{'Model::RapidApp::CoreSchema'}} || {};
60            
61             $cust_cnf->{sqlite_file} ||= 'rapidapp_coreschema.db';
62             my $db_file = file($cust_cnf->{sqlite_file});
63             $db_file = file(dir($home),$db_file) if ($db_file->is_relative);
64            
65             $class->config(
66             schema_class => 'RapidApp::CoreSchema',
67            
68             connect_info => {
69             dsn => join('','dbi:SQLite:dbname=',$db_file),
70             sqlite_unicode => q{1},
71             on_connect_call => q{use_foreign_keys},
72             quote_names => q{1},
73             },
74            
75             # Allow user-defined config overrides:
76             %$cust_cnf
77             );
78             };
79              
80             sub BUILD {
81 1     1 0 23590 my $self = shift;
82 1         29 $self->_auto_deploy_schema( $self->schema );
83             }
84              
85             has 'init_admin_password', is => 'ro', isa => Str, default => 'pass';
86              
87             sub dsn {
88 1     1 0 3 my $self = shift;
89 1         7 return $self->config->{connect_info}{dsn};
90             }
91              
92             sub connect_user {
93 0     0 0 0 my $self = shift;
94 0         0 return $self->config->{connect_info}{user};
95             }
96              
97             sub connect_password {
98 0     0 0 0 my $self = shift;
99 0         0 return $self->config->{connect_info}{password};
100             }
101              
102             # dsn for the "reference" coreschema database/file. This is used only for the
103             # purposes of schema comparison
104             has 'ref_dsn', is => 'ro', isa => 'Str', lazy => 1, default => sub {
105             my $self = shift;
106             my $path = file(
107             dir(RapidApp->share_dir)->subdir('coreschema'),
108             'ref_sqlite.db'
109             )->resolve;
110             return join('','dbi:SQLite:dbname=',$path);
111             };
112              
113             sub _auto_deploy_schema {
114 1     1   11 my $self = shift;
115 1         3 my $schema = shift;
116            
117 1         7 my $deploy_statements = $schema->deployment_statements;
118 1         251473 my $md5 = $self->get_clean_md5($deploy_statements);
119 1         12 my $Rs = $schema->resultset('DeployInfo');
120 1         846 my $Source = $Rs->result_source;
121 1         162 my $table = $schema->class($Source->source_name)->table;
122 1   33     146 $table = (split(/\./,$table,2))[1] || $table; #<-- get 'table' for both 'db.table' and 'table' format
123 1         3 my $deployRow;
124            
125             try {
126 1     1   44 $deployRow = $Rs->find($md5);
127             }
128             catch {
129             # Assume exception is due to not being deployed yet and try to deploy:
130 1     1   7180 $schema->deploy;
131            
132 1         433984 $Rs->create({
133             md5 => $md5,
134             schema_class => $self->schema_class,
135             schema_version => (eval '$' . $self->schema_class . '::VERSION'),
136             comment => 'DO NOT REMOVE THIS ROW',
137             deployed_ddl => $deploy_statements,
138             deployed_ts => DateTime->now( time_zone => 'local' ),
139             });
140            
141 1         6 $self->_insert_default_rows($schema);
142 1         11 };
143            
144             # If we've already been deployed and the ddl checksum matches:
145 1 50       9 return 1 if ($deployRow);
146            
147 1         183 my $count = $Rs->count;
148 1         4696 my $dsn = $self->dsn;
149            
150 1 50       94 die "Database error; deploy_info table ('$table') exists but is empty in CoreSchema database '$dsn'"
151             unless ($count > 0);
152            
153 1 50       4 die "Database error; multiple rows in deploy_info table ('$table') in CoreSchema database '$dsn'"
154             if ($count > 1);
155            
156 1 50       5 my $exist_md5 = $Rs->first->md5 or die "Database error; found deploy_info row in table '$table' " .
157             "in CoreSchema database '$dsn', but it appears to be corrupt (no md5 checksum).";
158            
159 1 50       27 return 1 if ($md5 eq $exist_md5);
160            
161             # If we're here, it means the md5 of the existing coreschema didn't match, but
162             # that doesn't mean that the differences make it unsafe to use. Any change in
163             # the generated deploy statements, even trivial things like quotes/whitespace,
164             # will come out as a different checksum. So, we'll perform an actual diff to
165             # compare to see what the actual, effective differences are, using the reference
166             # sqlite database file. We're doing this instead of using the actual CoreSchema
167             # classes we already have because we're not interested in differences that can
168             # be caused by specific loaded components, and other code-level changes that
169             # might show up. (See also GitHub Issue #47)
170            
171 0         0 my $Differ = DBIx::Class::Schema::Diff->new(
172             old_schema => $self->_load_connect_schema_ref,
173             new_schema => $self->_load_connect_schema
174             );
175            
176 0 0       0 unless( $Differ->diff ) {
177             # If there are no changes at all, then we're already done...
178            
179             # Future:
180             #
181             # It is fully expected that in later versions of RapidApp there will be
182             # changes to the CoreSchema. Once that happens, these will be handled
183             # either dynamically or via Migrations/DeploymentHandler to alter the
184             # schema from known older versions to the latest. This code isn't present
185             # because it hasn't happened yet -- we're still on Version 1 of the
186             # schema...
187             #
188             # But, the larger plan is to *dynamically* handle schema changes, including
189             # support for merging of user defined schemas with the CoreSchema as well
190             # as user-supplied databases to be used as the CoreSchema. Obviously,
191             # neither checksum or version checks are useful for these dynamic scenarios,
192             # which is why the plan is to define a set of specific rules and tests
193             # that will be required for a schema to be determined as suitable as the
194             # CoreSchema. It is expected that DBIx::Class::Schema::Diff will do the
195             # heavy lifting for this.
196             #
197             # None of this is happening yet, as this is a big subproject on its own,
198             # but the code has been structured with this in mind. For now, the only
199             # check we're doing with Schema::Diff is "all or nothing", but it supports
200             # fine-grained filtering (and, in fact, this planned RapidApp feature is
201             # the entire reason I wrote DBIx::Class::Schema::Diff in the first place,
202             # so in that sense a lot of the work for this has already been done, just
203             # not yet within the RapidApp code base itself).
204            
205            
206             # TODO: for faster startup next time, add/save the new md5 so we can skip
207             # all this diff work...
208            
209            
210 0         0 return 1;
211             }
212            
213            
214 0         0 die join("\n",'','',
215             " The selected CoreSchema database '$dsn' ",
216             " already has a deployed schema but it does not match ",
217             " the current schema.",'',
218             " deployed checksum : $exist_md5",
219             " expected checksum : $md5",'','',
220             " Differences from the reference schema (detected by DBIx::Class::Schema::Diff):",
221             '','',
222             Dumper( $Differ->diff ),'','',''
223             );
224             }
225              
226              
227             # Need to strip out comments and blank lines to make sure the md5s will be consistent
228             sub clean_deploy_statements {
229 1     1 0 3 my ($self, $deploy_statements) = @_;
230             return join("\n", grep {
231 1   100     77 ! /^\-\-/ &&
  160         453  
232             ! /^\s*$/
233             } split(/\r?\n/,$deploy_statements) );
234             }
235              
236             sub get_clean_md5 {
237 1     1 0 4 my ($self, $deploy_statements) = @_;
238 1         6 my $clean = $self->clean_deploy_statements($deploy_statements);
239 1         27 return md5_hex($clean);
240             }
241              
242             sub _insert_default_rows {
243 1     1   195 my $self = shift;
244 1         3 my $schema = shift;
245            
246 1         8 $schema->resultset('NavtreeNode')->create({
247             id => 0,
248             pid => undef,
249             text => 'DUMMY ROOT NODE',
250             ordering => 0
251             });
252            
253 1         8 $schema->resultset('User')->create({
254             username => 'admin',
255             set_pw => $self->init_admin_password
256             });
257            
258 1         9 $schema->resultset('Role')->create({
259             role => 'administrator',
260             description => 'Full Control'
261             });
262            
263 1         6 $schema->resultset('UserToRole')->create({
264             username => 'admin',
265             role => 'administrator',
266             });
267              
268             }
269              
270              
271             # TODO: clean up these package namespaces after we're done with them...
272             sub _load_connect_schema {
273 0     0     my $self = shift;
274 0   0       my $class = shift || 'RapidApp::CoreSchemaLoad';
275 0   0       my $dsn = shift || $self->dsn;
276 0           my $user = shift;
277 0           my $password = shift;
278 0 0         $user = $self->connect_user unless defined $user;
279 0 0         $password = $self->connect_password unless defined $password;
280 0           return DBIx::Class::Schema::Loader::make_schema_at(
281             $class => {
282             naming => { ALL => 'v7'},
283             use_namespaces => 1,
284             use_moose => 1,
285             debug => 0,
286             },[ $dsn, $user, $password ]
287             );
288             }
289             sub _load_connect_schema_ref {
290 0     0     my $self = shift;
291 0           $self->_load_connect_schema('RapidApp::CoreSchemaLoadRef',$self->ref_dsn,'','');
292             }
293              
294              
295             1;
296              
297             __END__
298              
299             =head1 NAME
300              
301             Catalyst::Model::RapidApp::CoreSchema - DBIC model for the CoreSchema database
302              
303             =head1 SYNOPSIS
304              
305             package MyApp;
306            
307             use Catalyst qw/ RapidApp::CoreSchema /;
308              
309             =head1 DESCRIPTION
310              
311             This is the Catalyst model which is automatically injected by the
312             L<RapidApp::CoreSchema|Catalyst::Plugin::RapidApp::CoreSchema> plugin and is not
313             intended to be loaded directly.
314              
315             With the default configuration, this model automatically initializes and deploys itself
316             to an SQLite database file in the root of the application named C<rapidapp_coreschema.db>.
317              
318             The CoreSchema database is a common location used for persistence by multiple optional
319             "Core" plugins, such as L<AuthCore|Catalyst::Plugin::RapidApp::AuthCore> and
320             L<NavCore|Catalyst::Plugin::RapidApp::NavCore>
321              
322             =head1 SEE ALSO
323              
324             =over
325              
326             =item *
327              
328             L<RapidApp>
329              
330             =item *
331              
332             L<RapidApp::Manual::Plugins>
333              
334             =item *
335              
336             L<Catalyst::Plugin::RapidApp::CoreSchema>
337              
338             =item *
339              
340             L<Catalyst::Plugin::RapidApp::CoreSchemaAdmin>
341              
342             =item *
343              
344             L<Catalyst>
345              
346             =back
347              
348             =head1 AUTHOR
349              
350             Henry Van Styn <vanstyn@cpan.org>
351              
352             =head1 COPYRIGHT AND LICENSE
353              
354             This software is copyright (c) 2013 by IntelliTree Solutions llc.
355              
356             This is free software; you can redistribute it and/or modify it under
357             the same terms as the Perl 5 programming language system itself.
358              
359             =cut