1 package DBIx::Class::Fixtures;
6 use DBIx::Class::Exception;
8 use Path::Class qw(dir file);
10 use Config::Any::JSON;
11 use Data::Dump::Streamer;
12 use Data::Visitor::Callback;
14 use File::Copy::Recursive qw/dircopy/;
15 use File::Copy qw/move/;
16 use Hash::Merge qw( merge );
19 use base qw(Class::Accessor);
22 'mysql' => 'DateTime::Format::MySQL',
23 'pg' => 'DateTime::Format::Pg',
26 __PACKAGE__->mk_accessors(qw(config_dir _inherited_attributes debug schema_class ));
34 our $VERSION = '1.000';
42 use DBIx::Class::Fixtures;
46 my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
49 config => 'set_config.json',
50 schema => $source_dbic_schema,
51 directory => '/home/me/app/fixtures'
55 directory => '/home/me/app/fixtures',
56 ddl => '/home/me/app/sql/ddl.sql',
57 connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password']
62 Dump fixtures from source database to filesystem then import to another database (with same schema) at any time. Use as a constant dataset for running tests against or for populating development databases when impractical to use production clones. Describe fixture set using relations and conditions based on your DBIx::Class schema.
64 =head1 DEFINE YOUR FIXTURE SET
66 Fixture sets are currently defined in .json files which must reside in your config_dir (e.g. /home/me/app/fixture_configs/a_fixture_set.json). They describe which data to pull and dump from the source database.
84 This will fetch artists with primary keys 1 and 3, the producer with primary key 5 and two of producer 5's artists where 'artists' is a has_many DBIx::Class rel from Producer to Artist.
88 Sets must be an array of hashes, as in the example given above. Each set defines a set of objects to be included in the fixtures. For details on valid set attributes see L</SET ATTRIBUTES> below.
92 Rules place general conditions on classes. For example if whenever an artist was dumped you also wanted all of their cds dumped too, then you could use a rule to specify this. For example:
116 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 has_many DBIx::Class relation from Artist to CD. This is eqivalent to:
140 rules must be a hash keyed by class name.
144 Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0.
159 Note: belongs_to rels are automatically dumped whether you like it or not, this is to avoid FKs to nowhere when importing. General rules on has_many rels are not accepted at this top level, but you can turn them on for individual sets - see L</SET ATTRIBUTES>.
161 =head1 SET ATTRIBUTES
165 Required attribute. Specifies the DBIx::Class object class you wish to dump.
169 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 just won't get dumped, no warnings or death.
173 Must be either an integer or the string 'all'. Specifying an integer will effectively set the 'rows' attribute on the resultset clause, specifying 'all' will cause the rows attribute to be left off and for all matching rows to be dumped. There's no randomising here, it's just the first x rows.
177 A hash specifying the conditions dumped objects must match. Essentially this is a JSON representation of a DBIx::Class search clause. For example:
183 cond: { name: 'Dave' }
187 This will dump all artists whose name is 'dave'. Essentially $artist_rs->search({ name => 'Dave' })->all.
189 Sometimes in a search clause it's useful to use scalar refs to do things like:
191 $artist_rs->search({ no1_singles => \'> no1_albums' })
193 This could be specified in the cond hash like so:
199 cond: { no1_singles: '\> no1_albums' }
203 So if the value starts with a backslash the value is made a scalar ref before being passed to search.
207 An array of relationships to be used in the cond clause.
213 cond: { 'cds.position': { '>': 4 } },
218 Fetch all artists who have cds with position greater than 4.
222 Must be an array of hashes. Specifies which rels to also dump. For example:
231 cond: { position: '2' }
236 Will cause the cds of artists 1 and 3 to be dumped where the cd position is 2.
238 Valid attributes are: 'rel', 'quantity', 'cond', 'has_many', 'might_have' and 'join'. rel is the name of the DBIx::Class rel to follow, the rest are the same as in the set attributes. quantity is necessary for has_many relationships, but not if using for belongs_to or might_have relationships.
242 Specifies whether to fetch has_many rels for this set. Must be a hash containing keys fetch and quantity.
244 Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer.
248 As with has_many but for might_have relationships. Quantity doesn't do anything in this case.
250 This value will be inherited by all fetches in this set. This is not true for the has_many attribute.
252 =head1 RULE ATTRIBUTES
256 Same as with L</SET ATTRIBUTES>
260 Same as with L</SET ATTRIBUTES>
264 Same as with L</SET ATTRIBUTES>
268 Same as with L</SET ATTRIBUTES>
272 Same as with L</SET ATTRIBUTES>
280 =item Arguments: \%$attrs
282 =item Return Value: $fixture_object
286 Returns a new DBIx::Class::Fixture object. %attrs has only valid key at the
287 moment - 'config_dir' which is required and much contain a valid path to
288 the directory in which your .json configs reside.
290 my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
298 unless (ref $params eq 'HASH') {
299 return DBIx::Class::Exception->throw('first arg to DBIx::Class::Fixtures->new() must be hash ref');
302 unless ($params->{config_dir}) {
303 return DBIx::Class::Exception->throw('config_dir param not specified');
306 my $config_dir = dir($params->{config_dir});
307 unless (-e $params->{config_dir}) {
308 return DBIx::Class::Exception->throw('config_dir directory doesn\'t exist');
312 config_dir => $config_dir,
313 _inherited_attributes => [qw/datetime_relative might_have rules/],
314 debug => $params->{debug}
326 =item Arguments: \%$attrs
328 =item Return Value: 1
333 config => 'set_config.json', # config file to use. must be in the config directory specified in the constructor
334 schema => $source_dbic_schema,
335 directory => '/home/me/app/fixtures' # output directory
338 In this case objects will be dumped to subdirectories in the specified directory. For example:
340 /home/me/app/fixtures/artist/1.fix
341 /home/me/app/fixtures/artist/3.fix
342 /home/me/app/fixtures/producer/5.fix
344 config, schema and directory are all required attributes.
352 unless (ref $params eq 'HASH') {
353 return DBIx::Class::Exception->throw('first arg to dump must be hash ref');
356 foreach my $param (qw/config schema directory/) {
357 unless ($params->{$param}) {
358 return DBIx::Class::Exception->throw($param . ' param not specified');
362 my $config_file = file($self->config_dir, $params->{config});
363 unless (-e $config_file) {
364 return DBIx::Class::Exception->throw('config does not exist at ' . $config_file);
367 my $config = Config::Any::JSON->load($config_file);
368 unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) {
369 return DBIx::Class::Exception->throw('config has no sets');
372 my $output_dir = dir($params->{directory});
373 unless (-e $output_dir) {
374 return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
377 my $schema = $params->{schema};
379 $self->msg("generating fixtures");
380 my $tmp_output_dir = dir($output_dir, '-~dump~-');
382 if (-e $tmp_output_dir) {
383 $self->msg("- clearing existing $tmp_output_dir");
384 $tmp_output_dir->rmtree;
386 $self->msg("- creating $tmp_output_dir");
387 $tmp_output_dir->mkpath;
389 # write version file (for the potential benefit of populate)
390 my $version_file = file($tmp_output_dir, '_dumper_version');
391 write_file($version_file->stringify, $VERSION);
393 $config->{rules} ||= {};
394 my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}};
395 my %options = ( is_root => 1 );
396 foreach my $source (@sources) {
397 # apply rule to set if specified
398 my $rule = $config->{rules}->{$source->{class}};
399 $source = merge( $source, $rule ) if ($rule);
402 my $rs = $schema->resultset($source->{class});
403 $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
404 $self->msg("- dumping $source->{class}");
406 my %source_options = ( set => { %{$config}, %{$source} } );
407 if ($source->{quantity}) {
408 $rs = $rs->search({}, { order_by => $source->{order_by} }) if ($source->{order_by});
409 if ($source->{quantity} eq 'all') {
410 push (@objects, $rs->all);
411 } elsif ($source->{quantity} =~ /^\d+$/) {
412 push (@objects, $rs->search({}, { rows => $source->{quantity} }));
414 DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity});
417 if ($source->{ids}) {
418 my @ids = @{$source->{ids}};
419 my @id_objects = grep { $_ } map { $rs->find($_) } @ids;
420 push (@objects, @id_objects);
422 unless ($source->{quantity} || $source->{ids}) {
423 DBIx::Class::Exception->throw('must specify either quantity or ids');
427 foreach my $object (@objects) {
428 $source_options{set_dir} = $tmp_output_dir;
429 $self->dump_object($object, { %options, %source_options } );
434 foreach my $dir ($output_dir->children) {
435 next if ($dir eq $tmp_output_dir);
436 $dir->remove || $dir->rmtree;
439 $self->msg("- moving temp dir to $output_dir");
440 move($_, dir($output_dir, $_->relative($_->parent)->stringify)) for $tmp_output_dir->children;
441 if (-e $output_dir) {
442 $self->msg("- clearing tmp dir $tmp_output_dir");
443 # delete existing fixture set
444 $tmp_output_dir->remove;
453 my ($self, $object, $params, $rr_info) = @_;
454 my $set = $params->{set};
455 die 'no dir passed to dump_object' unless $params->{set_dir};
456 die 'no object passed to dump_object' unless $object;
458 my @inherited_attrs = @{$self->_inherited_attributes};
460 # write dir and gen filename
461 my $source_dir = dir($params->{set_dir}, lc($object->result_source->from));
462 mkdir($source_dir->stringify, 0777);
463 my $file = file($source_dir, join('-', map { $object->get_column($_) } sort $object->primary_columns) . '.fix');
466 my $exists = (-e $file->stringify) ? 1 : 0;
468 $self->msg('-- dumping ' . $file->stringify, 2);
469 my %ds = $object->get_columns;
471 my $driver = $object->result_source->schema->storage->dbh->{Driver}->{Name};
472 my $formatter= $db_to_parser{$driver};
473 eval "require $formatter" if ($formatter);
475 # mess with dates if specified
476 if ($set->{datetime_relative}) {
477 unless ($@ || !$formatter) {
479 if ($set->{datetime_relative} eq 'today') {
480 $dt = DateTime->today;
482 $dt = $formatter->parse_datetime($set->{datetime_relative}) unless ($@);
485 while (my ($col, $value) = each %ds) {
486 my $col_info = $object->result_source->column_info($col);
489 && $col_info->{_inflate_info}
490 && uc($col_info->{data_type}) eq 'DATETIME';
492 $ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt);
495 warn "datetime_relative not supported for $driver at the moment";
499 # do the actual dumping
500 my $serialized = Dump(\%ds)->Out();
501 write_file($file->stringify, $serialized);
502 my $mode = 0777; chmod $mode, $file->stringify;
505 # dump rels of object
506 my $s = $object->result_source;
508 foreach my $name (sort $s->relationships) {
509 my $info = $s->relationship_info($name);
510 my $r_source = $s->related_source($name);
511 # if belongs_to or might_have with might_have param set or has_many with has_many param set then
512 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}))) {
513 my $related_rs = $object->related_resultset($name);
514 my $rule = $set->{rules}->{$related_rs->result_source->source_name};
515 # these parts of the rule only apply to has_many rels
516 if ($rule && $info->{attrs}{accessor} eq 'multi') {
517 $related_rs = $related_rs->search($rule->{cond}, { join => $rule->{join} }) if ($rule->{cond});
518 $related_rs = $related_rs->search({}, { rows => $rule->{quantity} }) if ($rule->{quantity} && $rule->{quantity} ne 'all');
519 $related_rs = $related_rs->search({}, { order_by => $rule->{order_by} }) if ($rule->{order_by});
521 if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) {
522 $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} });
524 my %c_params = %{$params};
526 my %mock_set = map { $_ => $set->{$_} } grep { $set->{$_} } @inherited_attrs;
527 $c_params{set} = \%mock_set;
528 # use Data::Dumper; print ' -- ' . Dumper($c_params{set}, $rule->{fetch}) if ($rule && $rule->{fetch});
529 $c_params{set} = merge( $c_params{set}, $rule) if ($rule && $rule->{fetch});
530 # use Data::Dumper; print ' -- ' . Dumper(\%c_params) if ($rule && $rule->{fetch});
531 $self->dump_object($_, \%c_params) foreach $related_rs->all;
536 return unless $set && $set->{fetch};
537 foreach my $fetch (@{$set->{fetch}}) {
539 $fetch->{$_} = $set->{$_} foreach grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs;
540 my $related_rs = $object->related_resultset($fetch->{rel});
541 my $rule = $set->{rules}->{$related_rs->result_source->source_name};
543 my $info = $object->result_source->relationship_info($fetch->{rel});
544 if ($info->{attrs}{accessor} eq 'multi') {
545 $fetch = merge( $fetch, $rule );
546 } elsif ($rule->{fetch}) {
547 $fetch = merge( $fetch, { fetch => $rule->{fetch} } );
550 die "relationship " . $fetch->{rel} . " does not exist for " . $s->source_name unless ($related_rs);
551 if ($fetch->{cond} and ref $fetch->{cond} eq 'HASH') {
552 # if value starts with / assume it's meant to be passed as a scalar ref to dbic
553 # ideally this would substitute deeply
554 $fetch->{cond} = { map { $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_} : $fetch->{cond}->{$_} } keys %{$fetch->{cond}} };
556 $related_rs = $related_rs->search($fetch->{cond}, { join => $fetch->{join} }) if ($fetch->{cond});
557 $related_rs = $related_rs->search({}, { rows => $fetch->{quantity} }) if ($fetch->{quantity} && $fetch->{quantity} ne 'all');
558 $related_rs = $related_rs->search({}, { order_by => $fetch->{order_by} }) if ($fetch->{order_by});
559 $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all;
563 sub _generate_schema {
565 my $params = shift || {};
567 $self->msg("\ncreating schema");
568 # die 'must pass version param to generate_schema_from_ddl' unless $params->{version};
570 my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema";
571 eval "require $schema_class";
575 my $connection_details = $params->{connection_details};
576 unless( $pre_schema = $schema_class->connect(@{$connection_details}) ) {
577 return DBIx::Class::Exception->throw('connection details not valid');
579 my @tables = map { $pre_schema->source($_)->from }$pre_schema->sources;
580 my $dbh = $pre_schema->storage->dbh;
583 $self->msg("- clearing DB of existing tables");
584 eval { $dbh->do('SET foreign_key_checks=0') };
585 $dbh->do('drop table ' . $_) for (@tables);
587 # import new ddl file to db
588 my $ddl_file = $params->{ddl};
589 $self->msg("- deploying schema using $ddl_file");
591 open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)");
592 my @data = split(/\n/, join('', <$fh>));
593 @data = grep(!/^--/, @data);
594 @data = split(/;/, join('', @data));
596 @data = grep { $_ && $_ !~ /^-- / } @data;
598 eval { $dbh->do($_) or warn "SQL was:\n $_"};
599 if ($@) { die "SQL was:\n $_\n$@"; }
601 $self->msg("- finished importing DDL into DB");
603 # load schema object from our new DB
604 $self->msg("- loading fresh DBIC object from DB");
605 my $schema = $schema_class->connect(@{$connection_details});
614 =item Arguments: \%$attrs
616 =item Return Value: 1
620 $fixtures->populate({
621 directory => '/home/me/app/fixtures', # directory to look for fixtures in, as specified to dump
622 ddl => '/home/me/app/sql/ddl.sql', # DDL to deploy
623 connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] # database to clear, deploy and then populate
626 In this case the database app_dev will be cleared entirely of everything, then the DDL deployed to it,
627 then finally all fixtures found in /home/me/app/fixtures will be added to it. populate will generate
628 its own DBIx::Class schema from the DDL rather than being passed one to use. This is better as
629 custom insert methods etc are avoided which tend to get in the way. In some cases you might not
630 have a DDL, and so this method will eventually allow a $schema object to be passed instead.
632 directory, dll and connection_details are all required attributes.
639 unless (ref $params eq 'HASH') {
640 return DBIx::Class::Exception->throw('first arg to populate must be hash ref');
643 foreach my $param (qw/directory/) {
644 unless ($params->{$param}) {
645 return DBIx::Class::Exception->throw($param . ' param not specified');
648 my $fixture_dir = dir(delete $params->{directory});
649 unless (-e $fixture_dir) {
650 return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir);
655 if ($params->{ddl} && $params->{connection_details}) {
656 $ddl_file = file(delete $params->{ddl});
657 unless (-e $ddl_file) {
658 return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file);
660 unless (ref $params->{connection_details} eq 'ARRAY') {
661 return DBIx::Class::Exception->throw('connection details must be an arrayref');
663 } elsif ($params->{schema}) {
664 return DBIx::Class::Exception->throw('passing a schema is not supported at the moment');
666 return DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
669 my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => delete $params->{connection_details}, %{$params} });
670 $self->msg("\nimporting fixtures");
671 my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
673 my $version_file = file($fixture_dir, '_dumper_version');
674 unless (-e $version_file) {
675 # return DBIx::Class::Exception->throw('no version file found');
678 if (-e $tmp_fixture_dir) {
679 $self->msg("- deleting existing temp directory $tmp_fixture_dir");
680 $tmp_fixture_dir->rmtree;
682 $self->msg("- creating temp dir");
683 dircopy(dir($fixture_dir, $schema->source($_)->from), dir($tmp_fixture_dir, $schema->source($_)->from)) for $schema->sources;
685 eval { $schema->storage->dbh->do('SET foreign_key_checks=0') };
688 my $driver = $schema->storage->dbh->{Driver}->{Name};
689 my $formatter= $db_to_parser{$driver};
690 eval "require $formatter" if ($formatter);
691 unless ($@ || !$formatter) {
693 if ($params->{datetime_relative_to}) {
694 $callbacks{'DateTime::Duration'} = sub {
695 $params->{datetime_relative_to}->clone->add_duration($_);
698 $callbacks{'DateTime::Duration'} = sub {
699 $formatter->format_datetime(DateTime->today->add_duration($_))
702 $callbacks{object} ||= "visit_ref";
703 $fixup_visitor = new Data::Visitor::Callback(%callbacks);
705 foreach my $source (sort $schema->sources) {
706 $self->msg("- adding " . $source);
707 my $rs = $schema->resultset($source);
708 my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from));
709 next unless (-e $source_dir);
710 while (my $file = $source_dir->next) {
711 next unless ($file =~ /\.fix$/);
712 next if $file->is_dir;
713 my $contents = $file->slurp;
716 $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
721 $self->msg("- fixtures imported");
722 $self->msg("- cleaning up");
723 $tmp_fixture_dir->rmtree;
724 eval { $schema->storage->dbh->do('SET foreign_key_checks=1') };
729 my $subject = shift || return;
730 my $level = shift || 1;
732 return unless $self->debug >= $level;
734 print Dumper($subject);
736 print $subject . "\n";
742 Luke Saunders <luke@shadowcatsystems.co.uk>
746 Ash Berlin <ash@shadowcatsystems.co.uk>
747 Matt S. Trout <mst@shadowcatsystems.co.uk>