Commit | Line | Data |
e5963c1b |
1 | package DBIx::Class::Fixtures; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use DBIx::Class::Exception; |
b099fee9 |
7 | use Class::Accessor::Grouped; |
e5963c1b |
8 | use Path::Class qw(dir file); |
6116de11 |
9 | use File::Slurp; |
0fc424b7 |
10 | use Config::Any::JSON; |
11 | use Data::Dump::Streamer; |
4fb695f4 |
12 | use Data::Visitor::Callback; |
0fc424b7 |
13 | use File::Path; |
4fb695f4 |
14 | use File::Copy::Recursive qw/dircopy/; |
6116de11 |
15 | use File::Copy qw/move/; |
0fc424b7 |
16 | use Hash::Merge qw( merge ); |
e5963c1b |
17 | use Data::Dumper; |
aa9f3cc7 |
18 | use Class::C3::Componentised; |
e5963c1b |
19 | |
b099fee9 |
20 | use base qw(Class::Accessor::Grouped); |
e5963c1b |
21 | |
aa9f3cc7 |
22 | our $namespace_counter = 0; |
0566a82d |
23 | |
b099fee9 |
24 | __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir _inherited_attributes debug schema_class/); |
e5963c1b |
25 | |
26 | =head1 VERSION |
27 | |
b450a678 |
28 | Version 1.000001 |
e5963c1b |
29 | |
30 | =cut |
31 | |
b450a678 |
32 | our $VERSION = '1.000001'; |
e5963c1b |
33 | |
34 | =head1 NAME |
35 | |
9f96b203 |
36 | DBIx::Class::Fixtures |
37 | |
e5963c1b |
38 | =head1 SYNOPSIS |
39 | |
40 | use DBIx::Class::Fixtures; |
41 | |
42 | ... |
43 | |
44 | my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' }); |
45 | |
46 | $fixtures->dump({ |
47 | config => 'set_config.json', |
48 | schema => $source_dbic_schema, |
49 | directory => '/home/me/app/fixtures' |
50 | }); |
51 | |
52 | $fixtures->populate({ |
53 | directory => '/home/me/app/fixtures', |
54 | ddl => '/home/me/app/sql/ddl.sql', |
55 | connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] |
56 | }); |
57 | |
58 | =head1 DESCRIPTION |
59 | |
b099fee9 |
60 | Dump fixtures from source database to filesystem then import to another database (with same schema) |
61 | at any time. Use as a constant dataset for running tests against or for populating development databases |
62 | when impractical to use production clones. Describe fixture set using relations and conditions based |
63 | on your DBIx::Class schema. |
a5561f96 |
64 | |
65 | =head1 DEFINE YOUR FIXTURE SET |
66 | |
b099fee9 |
67 | Fixture sets are currently defined in .json files which must reside in your config_dir |
68 | (e.g. /home/me/app/fixture_configs/a_fixture_set.json). They describe which data to pull and dump |
69 | from the source database. |
a5561f96 |
70 | |
71 | For example: |
72 | |
73 | { |
74 | sets: [{ |
75 | class: 'Artist', |
76 | ids: ['1', '3'] |
77 | }, { |
78 | class: 'Producer', |
79 | ids: ['5'], |
80 | fetch: [{ |
81 | rel: 'artists', |
82 | quantity: '2' |
83 | }] |
84 | }] |
85 | } |
e5963c1b |
86 | |
b099fee9 |
87 | This will fetch artists with primary keys 1 and 3, the producer with primary key 5 and two of producer 5's |
88 | artists where 'artists' is a has_many DBIx::Class rel from Producer to Artist. |
a5561f96 |
89 | |
95566320 |
90 | The top level attributes are as follows: |
91 | |
a5561f96 |
92 | =head2 sets |
93 | |
b099fee9 |
94 | Sets must be an array of hashes, as in the example given above. Each set defines a set of objects to be |
95 | included in the fixtures. For details on valid set attributes see L</SET ATTRIBUTES> below. |
a5561f96 |
96 | |
97 | =head2 rules |
98 | |
b099fee9 |
99 | Rules place general conditions on classes. For example if whenever an artist was dumped you also wanted all |
100 | of their cds dumped too, then you could use a rule to specify this. For example: |
a5561f96 |
101 | |
102 | { |
103 | sets: [{ |
104 | class: 'Artist', |
105 | ids: ['1', '3'] |
106 | }, { |
107 | class: 'Producer', |
108 | ids: ['5'], |
109 | fetch: [{ |
110 | rel: 'artists', |
111 | quantity: '2' |
112 | }] |
113 | }], |
114 | rules: { |
115 | Artist: { |
116 | fetch: [{ |
117 | rel: 'cds', |
118 | quantity: 'all' |
119 | }] |
120 | } |
121 | } |
122 | } |
6116de11 |
123 | |
b099fee9 |
124 | In this case all the cds of artists 1, 3 and all producer 5's artists will be dumped as well. Note that 'cds' is a |
125 | has_many DBIx::Class relation from Artist to CD. This is eqivalent to: |
a5561f96 |
126 | |
127 | { |
128 | sets: [{ |
129 | class: 'Artist', |
130 | ids: ['1', '3'], |
131 | fetch: [{ |
132 | rel: 'cds', |
133 | quantity: 'all' |
134 | }] |
135 | }, { |
136 | class: 'Producer', |
137 | ids: ['5'], |
138 | fetch: [{ |
139 | rel: 'artists', |
140 | quantity: '2', |
141 | fetch: [{ |
142 | rel: 'cds', |
143 | quantity: 'all' |
144 | }] |
145 | }] |
146 | }] |
147 | } |
148 | |
149 | rules must be a hash keyed by class name. |
150 | |
95566320 |
151 | L</RULE ATTRIBUTES> |
152 | |
153 | =head2 datetime_relative |
154 | |
b099fee9 |
155 | Only available for MySQL and PostgreSQL at the moment, must be a value that DateTime::Format::* |
156 | can parse. For example: |
95566320 |
157 | |
158 | { |
159 | sets: [{ |
160 | class: 'RecentItems', |
161 | ids: ['9'] |
162 | }], |
163 | datetime_relative : "2007-10-30 00:00:00" |
164 | } |
165 | |
b099fee9 |
166 | This will work when dumping from a MySQL database and will cause any datetime fields (where datatype => 'datetime' |
167 | in the column def of the schema class) to be dumped as a DateTime::Duration object relative to the date specified in |
168 | the datetime_relative value. For example if the RecentItem object had a date field set to 2007-10-25, then when the |
169 | fixture is imported the field will be set to 5 days in the past relative to the current time. |
95566320 |
170 | |
a5561f96 |
171 | =head2 might_have |
172 | |
173 | Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0. |
174 | |
175 | { |
176 | might_have: [{ |
177 | fetch: 1 |
178 | }, |
179 | sets: [{ |
180 | class: 'Artist', |
181 | ids: ['1', '3'] |
182 | }, { |
183 | class: 'Producer', |
184 | ids: ['5'] |
185 | }] |
186 | } |
187 | |
b099fee9 |
188 | Note: belongs_to rels are automatically dumped whether you like it or not, this is to avoid FKs to nowhere when importing. |
189 | General rules on has_many rels are not accepted at this top level, but you can turn them on for individual |
190 | sets - see L</SET ATTRIBUTES>. |
a5561f96 |
191 | |
192 | =head1 SET ATTRIBUTES |
193 | |
194 | =head2 class |
195 | |
196 | Required attribute. Specifies the DBIx::Class object class you wish to dump. |
197 | |
198 | =head2 ids |
199 | |
b099fee9 |
200 | Array of primary key ids to fetch, basically causing an $rs->find($_) for each. If the id is not in the source db then it |
201 | just won't get dumped, no warnings or death. |
a5561f96 |
202 | |
203 | =head2 quantity |
204 | |
b099fee9 |
205 | Must be either an integer or the string 'all'. Specifying an integer will effectively set the 'rows' attribute on the resultset clause, |
206 | specifying 'all' will cause the rows attribute to be left off and for all matching rows to be dumped. There's no randomising |
207 | here, it's just the first x rows. |
a5561f96 |
208 | |
209 | =head2 cond |
210 | |
211 | A hash specifying the conditions dumped objects must match. Essentially this is a JSON representation of a DBIx::Class search clause. For example: |
212 | |
213 | { |
214 | sets: [{ |
215 | class: 'Artist', |
216 | quantiy: 'all', |
217 | cond: { name: 'Dave' } |
218 | }] |
219 | } |
220 | |
221 | This will dump all artists whose name is 'dave'. Essentially $artist_rs->search({ name => 'Dave' })->all. |
222 | |
223 | Sometimes in a search clause it's useful to use scalar refs to do things like: |
224 | |
225 | $artist_rs->search({ no1_singles => \'> no1_albums' }) |
226 | |
227 | This could be specified in the cond hash like so: |
228 | |
229 | { |
230 | sets: [{ |
231 | class: 'Artist', |
232 | quantiy: 'all', |
233 | cond: { no1_singles: '\> no1_albums' } |
234 | }] |
235 | } |
236 | |
237 | So if the value starts with a backslash the value is made a scalar ref before being passed to search. |
238 | |
239 | =head2 join |
240 | |
241 | An array of relationships to be used in the cond clause. |
242 | |
243 | { |
244 | sets: [{ |
245 | class: 'Artist', |
246 | quantiy: 'all', |
247 | cond: { 'cds.position': { '>': 4 } }, |
248 | join: ['cds'] |
249 | }] |
250 | } |
251 | |
252 | Fetch all artists who have cds with position greater than 4. |
253 | |
254 | =head2 fetch |
255 | |
256 | Must be an array of hashes. Specifies which rels to also dump. For example: |
257 | |
258 | { |
259 | sets: [{ |
260 | class: 'Artist', |
261 | ids: ['1', '3'], |
262 | fetch: [{ |
263 | rel: 'cds', |
264 | quantity: '3', |
265 | cond: { position: '2' } |
266 | }] |
267 | }] |
268 | } |
269 | |
270 | Will cause the cds of artists 1 and 3 to be dumped where the cd position is 2. |
271 | |
b099fee9 |
272 | Valid attributes are: 'rel', 'quantity', 'cond', 'has_many', 'might_have' and 'join'. rel is the name of the DBIx::Class |
273 | rel to follow, the rest are the same as in the set attributes. quantity is necessary for has_many relationships, |
274 | but not if using for belongs_to or might_have relationships. |
a5561f96 |
275 | |
276 | =head2 has_many |
277 | |
278 | Specifies whether to fetch has_many rels for this set. Must be a hash containing keys fetch and quantity. |
279 | |
280 | Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer. |
281 | |
95566320 |
282 | Be careful here, dumping has_many rels can lead to a lot of data being dumped. |
283 | |
a5561f96 |
284 | =head2 might_have |
285 | |
286 | As with has_many but for might_have relationships. Quantity doesn't do anything in this case. |
287 | |
288 | This value will be inherited by all fetches in this set. This is not true for the has_many attribute. |
289 | |
290 | =head1 RULE ATTRIBUTES |
291 | |
292 | =head2 cond |
293 | |
294 | Same as with L</SET ATTRIBUTES> |
295 | |
296 | =head2 fetch |
297 | |
298 | Same as with L</SET ATTRIBUTES> |
299 | |
300 | =head2 join |
301 | |
302 | Same as with L</SET ATTRIBUTES> |
303 | |
304 | =head2 has_many |
305 | |
306 | Same as with L</SET ATTRIBUTES> |
307 | |
308 | =head2 might_have |
309 | |
310 | Same as with L</SET ATTRIBUTES> |
e5963c1b |
311 | |
0fc424b7 |
312 | =head1 METHODS |
313 | |
314 | =head2 new |
e5963c1b |
315 | |
a5561f96 |
316 | =over 4 |
317 | |
318 | =item Arguments: \%$attrs |
319 | |
320 | =item Return Value: $fixture_object |
321 | |
322 | =back |
323 | |
95566320 |
324 | Returns a new DBIx::Class::Fixture object. %attrs has only two valid keys at the |
325 | moment - 'debug' which determines whether to be verbose and 'config_dir' which is required and much contain a valid path to |
a5561f96 |
326 | the directory in which your .json configs reside. |
327 | |
328 | my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' }); |
329 | |
0fc424b7 |
330 | =cut |
e5963c1b |
331 | |
332 | sub new { |
333 | my $class = shift; |
334 | |
335 | my ($params) = @_; |
336 | unless (ref $params eq 'HASH') { |
337 | return DBIx::Class::Exception->throw('first arg to DBIx::Class::Fixtures->new() must be hash ref'); |
338 | } |
339 | |
340 | unless ($params->{config_dir}) { |
341 | return DBIx::Class::Exception->throw('config_dir param not specified'); |
342 | } |
343 | |
344 | my $config_dir = dir($params->{config_dir}); |
345 | unless (-e $params->{config_dir}) { |
346 | return DBIx::Class::Exception->throw('config_dir directory doesn\'t exist'); |
347 | } |
348 | |
349 | my $self = { |
0fc424b7 |
350 | config_dir => $config_dir, |
351 | _inherited_attributes => [qw/datetime_relative might_have rules/], |
352 | debug => $params->{debug} |
e5963c1b |
353 | }; |
354 | |
355 | bless $self, $class; |
356 | |
357 | return $self; |
358 | } |
359 | |
0fc424b7 |
360 | =head2 dump |
361 | |
a5561f96 |
362 | =over 4 |
363 | |
364 | =item Arguments: \%$attrs |
365 | |
366 | =item Return Value: 1 |
367 | |
368 | =back |
369 | |
370 | $fixtures->dump({ |
371 | config => 'set_config.json', # config file to use. must be in the config directory specified in the constructor |
372 | schema => $source_dbic_schema, |
373 | directory => '/home/me/app/fixtures' # output directory |
374 | }); |
375 | |
2ef30e95 |
376 | or |
377 | |
378 | $fixtures->dump({ |
379 | all => 1, # just dump everything that's in the schema |
380 | schema => $source_dbic_schema, |
381 | directory => '/home/me/app/fixtures' # output directory |
382 | }); |
383 | |
a5561f96 |
384 | In this case objects will be dumped to subdirectories in the specified directory. For example: |
385 | |
386 | /home/me/app/fixtures/artist/1.fix |
387 | /home/me/app/fixtures/artist/3.fix |
388 | /home/me/app/fixtures/producer/5.fix |
389 | |
2ef30e95 |
390 | schema and directory are required attributes. also, one of config or all must be specified. |
a5561f96 |
391 | |
0fc424b7 |
392 | =cut |
393 | |
394 | sub dump { |
395 | my $self = shift; |
396 | |
397 | my ($params) = @_; |
398 | unless (ref $params eq 'HASH') { |
399 | return DBIx::Class::Exception->throw('first arg to dump must be hash ref'); |
400 | } |
401 | |
2ef30e95 |
402 | foreach my $param (qw/schema directory/) { |
0fc424b7 |
403 | unless ($params->{$param}) { |
404 | return DBIx::Class::Exception->throw($param . ' param not specified'); |
405 | } |
406 | } |
407 | |
2ef30e95 |
408 | my $schema = $params->{schema}; |
409 | my $config_file; |
410 | my $config; |
411 | if ($params->{config}) { |
412 | $config_file = file($self->config_dir, $params->{config}); |
413 | unless (-e $config_file) { |
414 | return DBIx::Class::Exception->throw('config does not exist at ' . $config_file); |
415 | } |
416 | |
417 | $config = Config::Any::JSON->load($config_file); |
418 | unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) { |
419 | return DBIx::Class::Exception->throw('config has no sets'); |
420 | } |
0fc424b7 |
421 | |
2ef30e95 |
422 | $config->{might_have} = { fetch => 0 } unless (exists $config->{might_have}); |
423 | $config->{has_many} = { fetch => 0 } unless (exists $config->{has_many}); |
424 | $config->{belongs_to} = { fetch => 1 } unless (exists $config->{belongs_to}); |
425 | } elsif ($params->{all}) { |
426 | $config = { might_have => { fetch => 0 }, has_many => { fetch => 0 }, belongs_to => { fetch => 0 }, sets => [map {{ class => $_, quantity => 'all' }} $schema->sources] }; |
427 | print Dumper($config); |
428 | } else { |
429 | return DBIx::Class::Exception->throw('must pass config or set all'); |
0fc424b7 |
430 | } |
431 | |
432 | my $output_dir = dir($params->{directory}); |
433 | unless (-e $output_dir) { |
d85d888e |
434 | $output_dir->mkpath || |
2ef30e95 |
435 | return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir); |
0fc424b7 |
436 | } |
437 | |
9f96b203 |
438 | $self->msg("generating fixtures"); |
f251ab7e |
439 | my $tmp_output_dir = dir($output_dir, '-~dump~-' . $<); |
0fc424b7 |
440 | |
6116de11 |
441 | if (-e $tmp_output_dir) { |
0fc424b7 |
442 | $self->msg("- clearing existing $tmp_output_dir"); |
6116de11 |
443 | $tmp_output_dir->rmtree; |
0fc424b7 |
444 | } |
6116de11 |
445 | $self->msg("- creating $tmp_output_dir"); |
446 | $tmp_output_dir->mkpath; |
0fc424b7 |
447 | |
448 | # write version file (for the potential benefit of populate) |
449 | my $version_file = file($tmp_output_dir, '_dumper_version'); |
450 | write_file($version_file->stringify, $VERSION); |
451 | |
452 | $config->{rules} ||= {}; |
453 | my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}}; |
454 | my %options = ( is_root => 1 ); |
455 | foreach my $source (@sources) { |
456 | # apply rule to set if specified |
457 | my $rule = $config->{rules}->{$source->{class}}; |
458 | $source = merge( $source, $rule ) if ($rule); |
459 | |
460 | # fetch objects |
2ef30e95 |
461 | my $rs = $schema->resultset($source->{class}); |
462 | $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond}); |
0fc424b7 |
463 | $self->msg("- dumping $source->{class}"); |
464 | my @objects; |
465 | my %source_options = ( set => { %{$config}, %{$source} } ); |
466 | if ($source->{quantity}) { |
467 | $rs = $rs->search({}, { order_by => $source->{order_by} }) if ($source->{order_by}); |
468 | if ($source->{quantity} eq 'all') { |
469 | push (@objects, $rs->all); |
470 | } elsif ($source->{quantity} =~ /^\d+$/) { |
471 | push (@objects, $rs->search({}, { rows => $source->{quantity} })); |
472 | } else { |
473 | DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity}); |
474 | } |
475 | } |
476 | if ($source->{ids}) { |
477 | my @ids = @{$source->{ids}}; |
478 | my @id_objects = grep { $_ } map { $rs->find($_) } @ids; |
479 | push (@objects, @id_objects); |
480 | } |
481 | unless ($source->{quantity} || $source->{ids}) { |
482 | DBIx::Class::Exception->throw('must specify either quantity or ids'); |
483 | } |
484 | |
485 | # dump objects |
486 | foreach my $object (@objects) { |
487 | $source_options{set_dir} = $tmp_output_dir; |
488 | $self->dump_object($object, { %options, %source_options } ); |
489 | next; |
490 | } |
491 | } |
492 | |
493 | foreach my $dir ($output_dir->children) { |
494 | next if ($dir eq $tmp_output_dir); |
495 | $dir->remove || $dir->rmtree; |
496 | } |
497 | |
498 | $self->msg("- moving temp dir to $output_dir"); |
6116de11 |
499 | move($_, dir($output_dir, $_->relative($_->parent)->stringify)) for $tmp_output_dir->children; |
0fc424b7 |
500 | if (-e $output_dir) { |
501 | $self->msg("- clearing tmp dir $tmp_output_dir"); |
502 | # delete existing fixture set |
503 | $tmp_output_dir->remove; |
504 | } |
505 | |
506 | $self->msg("done"); |
507 | |
508 | return 1; |
509 | } |
510 | |
511 | sub dump_object { |
512 | my ($self, $object, $params, $rr_info) = @_; |
513 | my $set = $params->{set}; |
514 | die 'no dir passed to dump_object' unless $params->{set_dir}; |
515 | die 'no object passed to dump_object' unless $object; |
516 | |
517 | my @inherited_attrs = @{$self->_inherited_attributes}; |
518 | |
519 | # write dir and gen filename |
520 | my $source_dir = dir($params->{set_dir}, lc($object->result_source->from)); |
521 | mkdir($source_dir->stringify, 0777); |
522 | my $file = file($source_dir, join('-', map { $object->get_column($_) } sort $object->primary_columns) . '.fix'); |
523 | |
524 | # write file |
525 | my $exists = (-e $file->stringify) ? 1 : 0; |
526 | unless ($exists) { |
527 | $self->msg('-- dumping ' . $file->stringify, 2); |
528 | my %ds = $object->get_columns; |
529 | |
b099fee9 |
530 | my $formatter= $object->result_source->schema->storage->datetime_parser; |
0fc424b7 |
531 | # mess with dates if specified |
0566a82d |
532 | if ($set->{datetime_relative}) { |
533 | unless ($@ || !$formatter) { |
534 | my $dt; |
535 | if ($set->{datetime_relative} eq 'today') { |
536 | $dt = DateTime->today; |
537 | } else { |
538 | $dt = $formatter->parse_datetime($set->{datetime_relative}) unless ($@); |
539 | } |
0fc424b7 |
540 | |
0566a82d |
541 | while (my ($col, $value) = each %ds) { |
542 | my $col_info = $object->result_source->column_info($col); |
0fc424b7 |
543 | |
0566a82d |
544 | next unless $value |
545 | && $col_info->{_inflate_info} |
546 | && uc($col_info->{data_type}) eq 'DATETIME'; |
0fc424b7 |
547 | |
0566a82d |
548 | $ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt); |
549 | } |
550 | } else { |
b099fee9 |
551 | warn "datetime_relative not supported for this db driver at the moment"; |
0fc424b7 |
552 | } |
553 | } |
554 | |
555 | # do the actual dumping |
556 | my $serialized = Dump(\%ds)->Out(); |
557 | write_file($file->stringify, $serialized); |
558 | my $mode = 0777; chmod $mode, $file->stringify; |
559 | } |
560 | |
2ef30e95 |
561 | # don't bother looking at rels unless we are actually planning to dump at least one type |
562 | return unless ($set->{might_have}->{fetch} || $set->{belongs_to}->{fetch} || $set->{has_many}->{fetch} || $set->{fetch}); |
563 | |
0fc424b7 |
564 | # dump rels of object |
565 | my $s = $object->result_source; |
566 | unless ($exists) { |
567 | foreach my $name (sort $s->relationships) { |
568 | my $info = $s->relationship_info($name); |
569 | my $r_source = $s->related_source($name); |
570 | # if belongs_to or might_have with might_have param set or has_many with has_many param set then |
571 | 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}))) { |
572 | my $related_rs = $object->related_resultset($name); |
573 | my $rule = $set->{rules}->{$related_rs->result_source->source_name}; |
574 | # these parts of the rule only apply to has_many rels |
575 | if ($rule && $info->{attrs}{accessor} eq 'multi') { |
576 | $related_rs = $related_rs->search($rule->{cond}, { join => $rule->{join} }) if ($rule->{cond}); |
577 | $related_rs = $related_rs->search({}, { rows => $rule->{quantity} }) if ($rule->{quantity} && $rule->{quantity} ne 'all'); |
578 | $related_rs = $related_rs->search({}, { order_by => $rule->{order_by} }) if ($rule->{order_by}); |
579 | } |
580 | if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) { |
581 | $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} }); |
582 | } |
583 | my %c_params = %{$params}; |
584 | # inherit date param |
585 | my %mock_set = map { $_ => $set->{$_} } grep { $set->{$_} } @inherited_attrs; |
586 | $c_params{set} = \%mock_set; |
587 | # use Data::Dumper; print ' -- ' . Dumper($c_params{set}, $rule->{fetch}) if ($rule && $rule->{fetch}); |
588 | $c_params{set} = merge( $c_params{set}, $rule) if ($rule && $rule->{fetch}); |
589 | # use Data::Dumper; print ' -- ' . Dumper(\%c_params) if ($rule && $rule->{fetch}); |
5eab44a9 |
590 | $self->dump_object($_, \%c_params) foreach $related_rs->all; |
0fc424b7 |
591 | } |
592 | } |
593 | } |
594 | |
595 | return unless $set && $set->{fetch}; |
596 | foreach my $fetch (@{$set->{fetch}}) { |
597 | # inherit date param |
598 | $fetch->{$_} = $set->{$_} foreach grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs; |
599 | my $related_rs = $object->related_resultset($fetch->{rel}); |
600 | my $rule = $set->{rules}->{$related_rs->result_source->source_name}; |
601 | if ($rule) { |
602 | my $info = $object->result_source->relationship_info($fetch->{rel}); |
603 | if ($info->{attrs}{accessor} eq 'multi') { |
604 | $fetch = merge( $fetch, $rule ); |
605 | } elsif ($rule->{fetch}) { |
606 | $fetch = merge( $fetch, { fetch => $rule->{fetch} } ); |
607 | } |
608 | } |
609 | die "relationship " . $fetch->{rel} . " does not exist for " . $s->source_name unless ($related_rs); |
610 | if ($fetch->{cond} and ref $fetch->{cond} eq 'HASH') { |
611 | # if value starts with / assume it's meant to be passed as a scalar ref to dbic |
612 | # ideally this would substitute deeply |
613 | $fetch->{cond} = { map { $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_} : $fetch->{cond}->{$_} } keys %{$fetch->{cond}} }; |
614 | } |
615 | $related_rs = $related_rs->search($fetch->{cond}, { join => $fetch->{join} }) if ($fetch->{cond}); |
616 | $related_rs = $related_rs->search({}, { rows => $fetch->{quantity} }) if ($fetch->{quantity} && $fetch->{quantity} ne 'all'); |
617 | $related_rs = $related_rs->search({}, { order_by => $fetch->{order_by} }) if ($fetch->{order_by}); |
5eab44a9 |
618 | $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all; |
0fc424b7 |
619 | } |
620 | } |
621 | |
384c3f0c |
622 | sub _generate_schema { |
623 | my $self = shift; |
624 | my $params = shift || {}; |
384c3f0c |
625 | require DBI; |
626 | $self->msg("\ncreating schema"); |
627 | # die 'must pass version param to generate_schema_from_ddl' unless $params->{version}; |
628 | |
c06f7b96 |
629 | my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema"; |
9a9a7832 |
630 | eval "require $schema_class"; |
631 | die $@ if $@; |
632 | |
4fb695f4 |
633 | my $pre_schema; |
634 | my $connection_details = $params->{connection_details}; |
aa9f3cc7 |
635 | $namespace_counter++; |
636 | my $namespace = "DBIx::Class::Fixtures::GeneratedSchema_" . $namespace_counter; |
637 | Class::C3::Componentised->inject_base( $namespace => $schema_class ); |
638 | $pre_schema = $namespace->connect(@{$connection_details}); |
639 | unless( $pre_schema ) { |
384c3f0c |
640 | return DBIx::Class::Exception->throw('connection details not valid'); |
641 | } |
aa9f3cc7 |
642 | my @tables = map { $pre_schema->source($_)->from } $pre_schema->sources; |
4fb695f4 |
643 | my $dbh = $pre_schema->storage->dbh; |
384c3f0c |
644 | |
645 | # clear existing db |
646 | $self->msg("- clearing DB of existing tables"); |
4fb695f4 |
647 | eval { $dbh->do('SET foreign_key_checks=0') }; |
648 | $dbh->do('drop table ' . $_) for (@tables); |
384c3f0c |
649 | |
650 | # import new ddl file to db |
651 | my $ddl_file = $params->{ddl}; |
652 | $self->msg("- deploying schema using $ddl_file"); |
653 | my $fh; |
654 | open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)"); |
655 | my @data = split(/\n/, join('', <$fh>)); |
656 | @data = grep(!/^--/, @data); |
657 | @data = split(/;/, join('', @data)); |
658 | close($fh); |
659 | @data = grep { $_ && $_ !~ /^-- / } @data; |
660 | for (@data) { |
661 | eval { $dbh->do($_) or warn "SQL was:\n $_"}; |
662 | if ($@) { die "SQL was:\n $_\n$@"; } |
663 | } |
384c3f0c |
664 | $self->msg("- finished importing DDL into DB"); |
665 | |
666 | # load schema object from our new DB |
b4c67f96 |
667 | $namespace_counter++; |
668 | my $namespace2 = "DBIx::Class::Fixtures::GeneratedSchema_" . $namespace_counter; |
669 | Class::C3::Componentised->inject_base( $namespace2 => $schema_class ); |
670 | my $schema = $namespace2->connect(@{$connection_details}); |
384c3f0c |
671 | return $schema; |
672 | } |
673 | |
a5561f96 |
674 | |
675 | =head2 populate |
676 | |
677 | =over 4 |
678 | |
679 | =item Arguments: \%$attrs |
680 | |
681 | =item Return Value: 1 |
682 | |
683 | =back |
684 | |
685 | $fixtures->populate({ |
686 | directory => '/home/me/app/fixtures', # directory to look for fixtures in, as specified to dump |
687 | ddl => '/home/me/app/sql/ddl.sql', # DDL to deploy |
688 | connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] # database to clear, deploy and then populate |
689 | }); |
690 | |
95566320 |
691 | In this case the database app_dev will be cleared of all tables, then the specified DDL deployed to it, |
a5561f96 |
692 | then finally all fixtures found in /home/me/app/fixtures will be added to it. populate will generate |
693 | its own DBIx::Class schema from the DDL rather than being passed one to use. This is better as |
95566320 |
694 | custom insert methods are avoided which can to get in the way. In some cases you might not |
a5561f96 |
695 | have a DDL, and so this method will eventually allow a $schema object to be passed instead. |
696 | |
697 | directory, dll and connection_details are all required attributes. |
698 | |
699 | =cut |
700 | |
384c3f0c |
701 | sub populate { |
702 | my $self = shift; |
703 | my ($params) = @_; |
704 | unless (ref $params eq 'HASH') { |
705 | return DBIx::Class::Exception->throw('first arg to populate must be hash ref'); |
706 | } |
707 | |
708 | foreach my $param (qw/directory/) { |
709 | unless ($params->{$param}) { |
710 | return DBIx::Class::Exception->throw($param . ' param not specified'); |
711 | } |
712 | } |
9a9a7832 |
713 | my $fixture_dir = dir(delete $params->{directory}); |
384c3f0c |
714 | unless (-e $fixture_dir) { |
715 | return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir); |
716 | } |
717 | |
718 | my $ddl_file; |
719 | my $dbh; |
720 | if ($params->{ddl} && $params->{connection_details}) { |
9a9a7832 |
721 | $ddl_file = file(delete $params->{ddl}); |
384c3f0c |
722 | unless (-e $ddl_file) { |
723 | return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file); |
724 | } |
725 | unless (ref $params->{connection_details} eq 'ARRAY') { |
726 | return DBIx::Class::Exception->throw('connection details must be an arrayref'); |
727 | } |
728 | } elsif ($params->{schema}) { |
729 | return DBIx::Class::Exception->throw('passing a schema is not supported at the moment'); |
730 | } else { |
731 | return DBIx::Class::Exception->throw('you must set the ddl and connection_details params'); |
732 | } |
733 | |
9a9a7832 |
734 | my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => delete $params->{connection_details}, %{$params} }); |
4fb695f4 |
735 | $self->msg("\nimporting fixtures"); |
384c3f0c |
736 | my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<); |
737 | |
738 | my $version_file = file($fixture_dir, '_dumper_version'); |
739 | unless (-e $version_file) { |
740 | # return DBIx::Class::Exception->throw('no version file found'); |
741 | } |
742 | |
743 | if (-e $tmp_fixture_dir) { |
744 | $self->msg("- deleting existing temp directory $tmp_fixture_dir"); |
4fb695f4 |
745 | $tmp_fixture_dir->rmtree; |
384c3f0c |
746 | } |
747 | $self->msg("- creating temp dir"); |
0caf5ad6 |
748 | dircopy(dir($fixture_dir, $schema->source($_)->from), dir($tmp_fixture_dir, $schema->source($_)->from)) for grep { -e dir($fixture_dir, $schema->source($_)->from) } $schema->sources; |
384c3f0c |
749 | |
4fb695f4 |
750 | eval { $schema->storage->dbh->do('SET foreign_key_checks=0') }; |
0566a82d |
751 | |
384c3f0c |
752 | my $fixup_visitor; |
b099fee9 |
753 | my $formatter= $schema->storage->datetime_parser; |
0566a82d |
754 | unless ($@ || !$formatter) { |
755 | my %callbacks; |
756 | if ($params->{datetime_relative_to}) { |
757 | $callbacks{'DateTime::Duration'} = sub { |
758 | $params->{datetime_relative_to}->clone->add_duration($_); |
759 | }; |
760 | } else { |
761 | $callbacks{'DateTime::Duration'} = sub { |
762 | $formatter->format_datetime(DateTime->today->add_duration($_)) |
763 | }; |
764 | } |
765 | $callbacks{object} ||= "visit_ref"; |
766 | $fixup_visitor = new Data::Visitor::Callback(%callbacks); |
384c3f0c |
767 | } |
384c3f0c |
768 | foreach my $source (sort $schema->sources) { |
769 | $self->msg("- adding " . $source); |
770 | my $rs = $schema->resultset($source); |
771 | my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from)); |
772 | next unless (-e $source_dir); |
773 | while (my $file = $source_dir->next) { |
774 | next unless ($file =~ /\.fix$/); |
775 | next if $file->is_dir; |
776 | my $contents = $file->slurp; |
777 | my $HASH1; |
778 | eval($contents); |
779 | $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor; |
0566a82d |
780 | $rs->create($HASH1); |
384c3f0c |
781 | } |
782 | } |
783 | |
784 | $self->msg("- fixtures imported"); |
785 | $self->msg("- cleaning up"); |
786 | $tmp_fixture_dir->rmtree; |
4fb695f4 |
787 | eval { $schema->storage->dbh->do('SET foreign_key_checks=1') }; |
b099fee9 |
788 | |
789 | return 1; |
384c3f0c |
790 | } |
791 | |
0fc424b7 |
792 | sub msg { |
793 | my $self = shift; |
794 | my $subject = shift || return; |
9a9a7832 |
795 | my $level = shift || 1; |
796 | |
797 | return unless $self->debug >= $level; |
0fc424b7 |
798 | if (ref $subject) { |
799 | print Dumper($subject); |
800 | } else { |
801 | print $subject . "\n"; |
802 | } |
803 | } |
a5561f96 |
804 | |
805 | =head1 AUTHOR |
806 | |
807 | Luke Saunders <luke@shadowcatsystems.co.uk> |
808 | |
3b4f6e76 |
809 | Initial development sponsored by and (c) Takkle, Inc. 2007 |
810 | |
a5561f96 |
811 | =head1 CONTRIBUTORS |
812 | |
813 | Ash Berlin <ash@shadowcatsystems.co.uk> |
814 | Matt S. Trout <mst@shadowcatsystems.co.uk> |
815 | |
3b4f6e76 |
816 | =head1 LICENSE |
817 | |
818 | This library is free software under the same license as perl itself |
819 | |
a5561f96 |
820 | =cut |
821 | |
e5963c1b |
822 | 1; |