Commit | Line | Data |
e5963c1b |
1 | package DBIx::Class::Fixtures; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use DBIx::Class::Exception; |
4fb695f4 |
7 | use DBIx::Class::Fixtures::Schema; |
e5963c1b |
8 | use Class::Accessor; |
9 | use Path::Class qw(dir file); |
0fc424b7 |
10 | use Config::Any::JSON; |
11 | use Data::Dump::Streamer; |
4fb695f4 |
12 | use Data::Visitor::Callback; |
0fc424b7 |
13 | use File::Slurp; |
14 | use File::Path; |
4fb695f4 |
15 | use File::Copy::Recursive qw/dircopy/; |
0fc424b7 |
16 | use Hash::Merge qw( merge ); |
e5963c1b |
17 | use Data::Dumper; |
18 | |
19 | use base qw(Class::Accessor); |
20 | |
0fc424b7 |
21 | __PACKAGE__->mk_accessors(qw(config_dir _inherited_attributes debug)); |
e5963c1b |
22 | |
23 | =head1 VERSION |
24 | |
25 | Version 1.000 |
26 | |
27 | =cut |
28 | |
29 | our $VERSION = '1.000'; |
30 | |
31 | =head1 NAME |
32 | |
33 | =head1 SYNOPSIS |
34 | |
35 | use DBIx::Class::Fixtures; |
36 | |
37 | ... |
38 | |
39 | my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' }); |
40 | |
41 | $fixtures->dump({ |
42 | config => 'set_config.json', |
43 | schema => $source_dbic_schema, |
44 | directory => '/home/me/app/fixtures' |
45 | }); |
46 | |
47 | $fixtures->populate({ |
48 | directory => '/home/me/app/fixtures', |
49 | ddl => '/home/me/app/sql/ddl.sql', |
50 | connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] |
51 | }); |
52 | |
53 | =head1 DESCRIPTION |
54 | |
55 | =head1 AUTHOR |
56 | |
57 | =head1 CONTRIBUTORS |
58 | |
0fc424b7 |
59 | =head1 METHODS |
60 | |
61 | =head2 new |
e5963c1b |
62 | |
0fc424b7 |
63 | =cut |
e5963c1b |
64 | |
65 | sub new { |
66 | my $class = shift; |
67 | |
68 | my ($params) = @_; |
69 | unless (ref $params eq 'HASH') { |
70 | return DBIx::Class::Exception->throw('first arg to DBIx::Class::Fixtures->new() must be hash ref'); |
71 | } |
72 | |
73 | unless ($params->{config_dir}) { |
74 | return DBIx::Class::Exception->throw('config_dir param not specified'); |
75 | } |
76 | |
77 | my $config_dir = dir($params->{config_dir}); |
78 | unless (-e $params->{config_dir}) { |
79 | return DBIx::Class::Exception->throw('config_dir directory doesn\'t exist'); |
80 | } |
81 | |
82 | my $self = { |
0fc424b7 |
83 | config_dir => $config_dir, |
84 | _inherited_attributes => [qw/datetime_relative might_have rules/], |
85 | debug => $params->{debug} |
e5963c1b |
86 | }; |
87 | |
88 | bless $self, $class; |
89 | |
90 | return $self; |
91 | } |
92 | |
0fc424b7 |
93 | =head2 dump |
94 | |
95 | =cut |
96 | |
97 | sub dump { |
98 | my $self = shift; |
99 | |
100 | my ($params) = @_; |
101 | unless (ref $params eq 'HASH') { |
102 | return DBIx::Class::Exception->throw('first arg to dump must be hash ref'); |
103 | } |
104 | |
105 | foreach my $param (qw/config schema directory/) { |
106 | unless ($params->{$param}) { |
107 | return DBIx::Class::Exception->throw($param . ' param not specified'); |
108 | } |
109 | } |
110 | |
111 | my $config_file = file($self->config_dir, $params->{config}); |
112 | unless (-e $config_file) { |
113 | return DBIx::Class::Exception->throw('config does not exist at ' . $config_file); |
114 | } |
115 | |
116 | my $config = Config::Any::JSON->load($config_file); |
117 | unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) { |
118 | return DBIx::Class::Exception->throw('config has no sets'); |
119 | } |
120 | |
121 | my $output_dir = dir($params->{directory}); |
122 | unless (-e $output_dir) { |
123 | return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir); |
124 | } |
125 | |
126 | my $schema = $params->{schema}; |
127 | |
128 | $self->msg("generating fixtures\n"); |
129 | my $tmp_output_dir = dir($output_dir, '-~dump~-'); |
130 | |
131 | unless (-e $tmp_output_dir) { |
132 | $self->msg("- creating $tmp_output_dir"); |
133 | mkdir($tmp_output_dir, 0777); |
134 | }else { |
135 | $self->msg("- clearing existing $tmp_output_dir"); |
136 | # delete existing fixture set |
137 | system("rm -rf $tmp_output_dir/*"); |
138 | } |
139 | |
140 | # write version file (for the potential benefit of populate) |
141 | my $version_file = file($tmp_output_dir, '_dumper_version'); |
142 | write_file($version_file->stringify, $VERSION); |
143 | |
144 | $config->{rules} ||= {}; |
145 | my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}}; |
146 | my %options = ( is_root => 1 ); |
147 | foreach my $source (@sources) { |
148 | # apply rule to set if specified |
149 | my $rule = $config->{rules}->{$source->{class}}; |
150 | $source = merge( $source, $rule ) if ($rule); |
151 | |
152 | # fetch objects |
153 | my $rs = $schema->resultset($source->{class}); |
154 | $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond}); |
155 | $self->msg("- dumping $source->{class}"); |
156 | my @objects; |
157 | my %source_options = ( set => { %{$config}, %{$source} } ); |
158 | if ($source->{quantity}) { |
159 | $rs = $rs->search({}, { order_by => $source->{order_by} }) if ($source->{order_by}); |
160 | if ($source->{quantity} eq 'all') { |
161 | push (@objects, $rs->all); |
162 | } elsif ($source->{quantity} =~ /^\d+$/) { |
163 | push (@objects, $rs->search({}, { rows => $source->{quantity} })); |
164 | } else { |
165 | DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity}); |
166 | } |
167 | } |
168 | if ($source->{ids}) { |
169 | my @ids = @{$source->{ids}}; |
170 | my @id_objects = grep { $_ } map { $rs->find($_) } @ids; |
171 | push (@objects, @id_objects); |
172 | } |
173 | unless ($source->{quantity} || $source->{ids}) { |
174 | DBIx::Class::Exception->throw('must specify either quantity or ids'); |
175 | } |
176 | |
177 | # dump objects |
178 | foreach my $object (@objects) { |
179 | $source_options{set_dir} = $tmp_output_dir; |
180 | $self->dump_object($object, { %options, %source_options } ); |
181 | next; |
182 | } |
183 | } |
184 | |
185 | foreach my $dir ($output_dir->children) { |
186 | next if ($dir eq $tmp_output_dir); |
187 | $dir->remove || $dir->rmtree; |
188 | } |
189 | |
190 | $self->msg("- moving temp dir to $output_dir"); |
191 | system("mv $tmp_output_dir/* $output_dir/"); |
192 | if (-e $output_dir) { |
193 | $self->msg("- clearing tmp dir $tmp_output_dir"); |
194 | # delete existing fixture set |
195 | $tmp_output_dir->remove; |
196 | } |
197 | |
198 | $self->msg("done"); |
199 | |
200 | return 1; |
201 | } |
202 | |
203 | sub dump_object { |
204 | my ($self, $object, $params, $rr_info) = @_; |
205 | my $set = $params->{set}; |
206 | die 'no dir passed to dump_object' unless $params->{set_dir}; |
207 | die 'no object passed to dump_object' unless $object; |
208 | |
209 | my @inherited_attrs = @{$self->_inherited_attributes}; |
210 | |
211 | # write dir and gen filename |
212 | my $source_dir = dir($params->{set_dir}, lc($object->result_source->from)); |
213 | mkdir($source_dir->stringify, 0777); |
214 | my $file = file($source_dir, join('-', map { $object->get_column($_) } sort $object->primary_columns) . '.fix'); |
215 | |
216 | # write file |
217 | my $exists = (-e $file->stringify) ? 1 : 0; |
218 | unless ($exists) { |
219 | $self->msg('-- dumping ' . $file->stringify, 2); |
220 | my %ds = $object->get_columns; |
221 | |
222 | # mess with dates if specified |
223 | if ($set->{datetime_relative}) { |
224 | my $dt; |
225 | if ($set->{datetime_relative} eq 'today') { |
226 | $dt = DateTime->today; |
227 | } else { |
228 | require DateTime::Format::MySQL; |
229 | $dt = DateTime::Format::MySQL->parse_datetime($set->{datetime_relative}); |
230 | } |
231 | |
232 | while (my ($col, $value) = each %ds) { |
233 | my $col_info = $object->result_source->column_info($col); |
234 | |
235 | next unless $value |
236 | && $col_info->{_inflate_info} |
237 | && uc($col_info->{data_type}) eq 'DATETIME'; |
238 | |
239 | $ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt); |
240 | } |
241 | } |
242 | |
243 | # do the actual dumping |
244 | my $serialized = Dump(\%ds)->Out(); |
245 | write_file($file->stringify, $serialized); |
246 | my $mode = 0777; chmod $mode, $file->stringify; |
247 | } |
248 | |
249 | # dump rels of object |
250 | my $s = $object->result_source; |
251 | unless ($exists) { |
252 | foreach my $name (sort $s->relationships) { |
253 | my $info = $s->relationship_info($name); |
254 | my $r_source = $s->related_source($name); |
255 | # if belongs_to or might_have with might_have param set or has_many with has_many param set then |
256 | if (($info->{attrs}{accessor} eq 'single' && (!$info->{attrs}{join_type} || ($set->{might_have} && $set->{might_have}->{fetch}))) || $info->{attrs}{accessor} eq 'filter' || ($info->{attrs}{accessor} eq 'multi' && ($set->{has_many} && $set->{has_many}->{fetch}))) { |
257 | my $related_rs = $object->related_resultset($name); |
258 | my $rule = $set->{rules}->{$related_rs->result_source->source_name}; |
259 | # these parts of the rule only apply to has_many rels |
260 | if ($rule && $info->{attrs}{accessor} eq 'multi') { |
261 | $related_rs = $related_rs->search($rule->{cond}, { join => $rule->{join} }) if ($rule->{cond}); |
262 | $related_rs = $related_rs->search({}, { rows => $rule->{quantity} }) if ($rule->{quantity} && $rule->{quantity} ne 'all'); |
263 | $related_rs = $related_rs->search({}, { order_by => $rule->{order_by} }) if ($rule->{order_by}); |
264 | } |
265 | if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) { |
266 | $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} }); |
267 | } |
268 | my %c_params = %{$params}; |
269 | # inherit date param |
270 | my %mock_set = map { $_ => $set->{$_} } grep { $set->{$_} } @inherited_attrs; |
271 | $c_params{set} = \%mock_set; |
272 | # use Data::Dumper; print ' -- ' . Dumper($c_params{set}, $rule->{fetch}) if ($rule && $rule->{fetch}); |
273 | $c_params{set} = merge( $c_params{set}, $rule) if ($rule && $rule->{fetch}); |
274 | # use Data::Dumper; print ' -- ' . Dumper(\%c_params) if ($rule && $rule->{fetch}); |
5eab44a9 |
275 | $self->dump_object($_, \%c_params) foreach $related_rs->all; |
0fc424b7 |
276 | } |
277 | } |
278 | } |
279 | |
280 | return unless $set && $set->{fetch}; |
281 | foreach my $fetch (@{$set->{fetch}}) { |
282 | # inherit date param |
283 | $fetch->{$_} = $set->{$_} foreach grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs; |
284 | my $related_rs = $object->related_resultset($fetch->{rel}); |
285 | my $rule = $set->{rules}->{$related_rs->result_source->source_name}; |
286 | if ($rule) { |
287 | my $info = $object->result_source->relationship_info($fetch->{rel}); |
288 | if ($info->{attrs}{accessor} eq 'multi') { |
289 | $fetch = merge( $fetch, $rule ); |
290 | } elsif ($rule->{fetch}) { |
291 | $fetch = merge( $fetch, { fetch => $rule->{fetch} } ); |
292 | } |
293 | } |
294 | die "relationship " . $fetch->{rel} . " does not exist for " . $s->source_name unless ($related_rs); |
295 | if ($fetch->{cond} and ref $fetch->{cond} eq 'HASH') { |
296 | # if value starts with / assume it's meant to be passed as a scalar ref to dbic |
297 | # ideally this would substitute deeply |
298 | $fetch->{cond} = { map { $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_} : $fetch->{cond}->{$_} } keys %{$fetch->{cond}} }; |
299 | } |
300 | $related_rs = $related_rs->search($fetch->{cond}, { join => $fetch->{join} }) if ($fetch->{cond}); |
301 | $related_rs = $related_rs->search({}, { rows => $fetch->{quantity} }) if ($fetch->{quantity} && $fetch->{quantity} ne 'all'); |
302 | $related_rs = $related_rs->search({}, { order_by => $fetch->{order_by} }) if ($fetch->{order_by}); |
5eab44a9 |
303 | $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all; |
0fc424b7 |
304 | } |
305 | } |
306 | |
384c3f0c |
307 | sub _generate_schema { |
308 | my $self = shift; |
309 | my $params = shift || {}; |
384c3f0c |
310 | require DBI; |
311 | $self->msg("\ncreating schema"); |
312 | # die 'must pass version param to generate_schema_from_ddl' unless $params->{version}; |
313 | |
4fb695f4 |
314 | my $pre_schema; |
315 | my $connection_details = $params->{connection_details}; |
316 | unless( $pre_schema = DBIx::Class::Fixtures::Schema->connect(@{$connection_details}) ) { |
384c3f0c |
317 | return DBIx::Class::Exception->throw('connection details not valid'); |
318 | } |
4fb695f4 |
319 | my @tables = map { $pre_schema->source($_)->from }$pre_schema->sources; |
320 | my $dbh = $pre_schema->storage->dbh; |
384c3f0c |
321 | |
322 | # clear existing db |
323 | $self->msg("- clearing DB of existing tables"); |
4fb695f4 |
324 | eval { $dbh->do('SET foreign_key_checks=0') }; |
325 | $dbh->do('drop table ' . $_) for (@tables); |
384c3f0c |
326 | |
327 | # import new ddl file to db |
328 | my $ddl_file = $params->{ddl}; |
329 | $self->msg("- deploying schema using $ddl_file"); |
330 | my $fh; |
331 | open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)"); |
332 | my @data = split(/\n/, join('', <$fh>)); |
333 | @data = grep(!/^--/, @data); |
334 | @data = split(/;/, join('', @data)); |
335 | close($fh); |
336 | @data = grep { $_ && $_ !~ /^-- / } @data; |
337 | for (@data) { |
338 | eval { $dbh->do($_) or warn "SQL was:\n $_"}; |
339 | if ($@) { die "SQL was:\n $_\n$@"; } |
340 | } |
384c3f0c |
341 | $self->msg("- finished importing DDL into DB"); |
342 | |
343 | # load schema object from our new DB |
344 | $self->msg("- loading fresh DBIC object from DB"); |
345 | my $schema = DBIx::Class::Fixtures::Schema->connect(@{$connection_details}); |
346 | |
347 | # manually set the version then set DB version to it (upgrade) |
348 | # $Takkle::SchemaPopulate::VERSION = $params->{version}; |
349 | # $schema->upgrade(); # set version number |
350 | return $schema; |
351 | } |
352 | |
353 | sub populate { |
354 | my $self = shift; |
355 | my ($params) = @_; |
356 | unless (ref $params eq 'HASH') { |
357 | return DBIx::Class::Exception->throw('first arg to populate must be hash ref'); |
358 | } |
359 | |
360 | foreach my $param (qw/directory/) { |
361 | unless ($params->{$param}) { |
362 | return DBIx::Class::Exception->throw($param . ' param not specified'); |
363 | } |
364 | } |
365 | my $fixture_dir = dir($params->{directory}); |
366 | unless (-e $fixture_dir) { |
367 | return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir); |
368 | } |
369 | |
370 | my $ddl_file; |
371 | my $dbh; |
372 | if ($params->{ddl} && $params->{connection_details}) { |
4fb695f4 |
373 | $ddl_file = file($params->{ddl}); |
384c3f0c |
374 | unless (-e $ddl_file) { |
375 | return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file); |
376 | } |
377 | unless (ref $params->{connection_details} eq 'ARRAY') { |
378 | return DBIx::Class::Exception->throw('connection details must be an arrayref'); |
379 | } |
380 | } elsif ($params->{schema}) { |
381 | return DBIx::Class::Exception->throw('passing a schema is not supported at the moment'); |
382 | } else { |
383 | return DBIx::Class::Exception->throw('you must set the ddl and connection_details params'); |
384 | } |
385 | |
386 | my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => $params->{connection_details} }); |
4fb695f4 |
387 | $self->msg("\nimporting fixtures"); |
384c3f0c |
388 | my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<); |
389 | |
390 | my $version_file = file($fixture_dir, '_dumper_version'); |
391 | unless (-e $version_file) { |
392 | # return DBIx::Class::Exception->throw('no version file found'); |
393 | } |
394 | |
395 | if (-e $tmp_fixture_dir) { |
396 | $self->msg("- deleting existing temp directory $tmp_fixture_dir"); |
4fb695f4 |
397 | $tmp_fixture_dir->rmtree; |
384c3f0c |
398 | } |
399 | $self->msg("- creating temp dir"); |
4fb695f4 |
400 | dircopy(dir($fixture_dir, $schema->source($_)->from), dir($tmp_fixture_dir, $schema->source($_)->from)) for $schema->sources; |
384c3f0c |
401 | |
4fb695f4 |
402 | eval { $schema->storage->dbh->do('SET foreign_key_checks=0') }; |
384c3f0c |
403 | my $fixup_visitor; |
404 | my %callbacks; |
405 | if ($params->{datetime_relative_to}) { |
406 | $callbacks{'DateTime::Duration'} = sub { |
407 | $params->{datetime_relative_to}->clone->add_duration($_); |
408 | }; |
409 | } else { |
410 | $callbacks{'DateTime::Duration'} = sub { |
411 | DateTime->today->add_duration($_) |
412 | }; |
413 | } |
414 | $callbacks{object} ||= "visit_ref"; |
415 | $fixup_visitor = new Data::Visitor::Callback(%callbacks); |
416 | |
417 | foreach my $source (sort $schema->sources) { |
418 | $self->msg("- adding " . $source); |
419 | my $rs = $schema->resultset($source); |
420 | my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from)); |
421 | next unless (-e $source_dir); |
422 | while (my $file = $source_dir->next) { |
423 | next unless ($file =~ /\.fix$/); |
424 | next if $file->is_dir; |
425 | my $contents = $file->slurp; |
426 | my $HASH1; |
427 | eval($contents); |
428 | $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor; |
429 | $rs->find_or_create($HASH1); |
430 | } |
431 | } |
432 | |
433 | $self->msg("- fixtures imported"); |
434 | $self->msg("- cleaning up"); |
435 | $tmp_fixture_dir->rmtree; |
4fb695f4 |
436 | eval { $schema->storage->dbh->do('SET foreign_key_checks=1') }; |
384c3f0c |
437 | } |
438 | |
0fc424b7 |
439 | sub msg { |
440 | my $self = shift; |
441 | my $subject = shift || return; |
442 | return unless $self->debug; |
443 | if (ref $subject) { |
444 | print Dumper($subject); |
445 | } else { |
446 | print $subject . "\n"; |
447 | } |
448 | } |
e5963c1b |
449 | 1; |