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