1 package DBIx::Class::Fixtures;
6 use DBIx::Class::Exception;
7 use Class::Accessor::Grouped;
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 );
18 use Class::C3::Componentised;
20 use base qw(Class::Accessor::Grouped);
22 our $namespace_counter = 0;
24 __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir _inherited_attributes debug schema_class/);
32 our $VERSION = '1.000001';
40 use DBIx::Class::Fixtures;
44 my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
47 config => 'set_config.json',
48 schema => $source_dbic_schema,
49 directory => '/home/me/app/fixtures'
53 directory => '/home/me/app/fixtures',
54 ddl => '/home/me/app/sql/ddl.sql',
55 connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password']
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.
65 =head1 DEFINE YOUR FIXTURE SET
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.
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.
90 The top level attributes are as follows:
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.
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:
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:
149 rules must be a hash keyed by class name.
155 To prevent repetition between configs you can include other configs. For example:
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.
170 =head2 datetime_relative
172 Only available for MySQL and PostgreSQL at the moment, must be a value that DateTime::Format::*
173 can parse. For example:
177 class: 'RecentItems',
180 datetime_relative : "2007-10-30 00:00:00"
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.
190 Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0.
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>.
209 =head1 SET ATTRIBUTES
213 Required attribute. Specifies the DBIx::Class object class you wish to dump.
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.
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.
228 A hash specifying the conditions dumped objects must match. Essentially this is a JSON representation of a DBIx::Class search clause. For example:
234 cond: { name: 'Dave' }
238 This will dump all artists whose name is 'dave'. Essentially $artist_rs->search({ name => 'Dave' })->all.
240 Sometimes in a search clause it's useful to use scalar refs to do things like:
242 $artist_rs->search({ no1_singles => \'> no1_albums' })
244 This could be specified in the cond hash like so:
250 cond: { no1_singles: '\> no1_albums' }
254 So if the value starts with a backslash the value is made a scalar ref before being passed to search.
258 An array of relationships to be used in the cond clause.
264 cond: { 'cds.position': { '>': 4 } },
269 Fetch all artists who have cds with position greater than 4.
273 Must be an array of hashes. Specifies which rels to also dump. For example:
282 cond: { position: '2' }
287 Will cause the cds of artists 1 and 3 to be dumped where the cd position is 2.
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.
295 Specifies whether to fetch has_many rels for this set. Must be a hash containing keys fetch and quantity.
297 Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer.
299 Be careful here, dumping has_many rels can lead to a lot of data being dumped.
303 As with has_many but for might_have relationships. Quantity doesn't do anything in this case.
305 This value will be inherited by all fetches in this set. This is not true for the has_many attribute.
307 =head1 RULE ATTRIBUTES
311 Same as with L</SET ATTRIBUTES>
315 Same as with L</SET ATTRIBUTES>
319 Same as with L</SET ATTRIBUTES>
323 Same as with L</SET ATTRIBUTES>
327 Same as with L</SET ATTRIBUTES>
335 =item Arguments: \%$attrs
337 =item Return Value: $fixture_object
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
343 the directory in which your .json configs reside.
345 my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
353 unless (ref $params eq 'HASH') {
354 return DBIx::Class::Exception->throw('first arg to DBIx::Class::Fixtures->new() must be hash ref');
357 unless ($params->{config_dir}) {
358 return DBIx::Class::Exception->throw('config_dir param not specified');
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');
367 config_dir => $config_dir,
368 _inherited_attributes => [qw/datetime_relative might_have rules/],
369 debug => $params->{debug}
381 =item Arguments: \%$attrs
383 =item Return Value: 1
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
396 all => 1, # just dump everything that's in the schema
397 schema => $source_dbic_schema,
398 directory => '/home/me/app/fixtures' # output directory
401 In this case objects will be dumped to subdirectories in the specified directory. For example:
403 /home/me/app/fixtures/artist/1.fix
404 /home/me/app/fixtures/artist/3.fix
405 /home/me/app/fixtures/producer/5.fix
407 schema and directory are required attributes. also, one of config or all must be specified.
415 unless (ref $params eq 'HASH') {
416 return DBIx::Class::Exception->throw('first arg to dump must be hash ref');
419 foreach my $param (qw/schema directory/) {
420 unless ($params->{$param}) {
421 return DBIx::Class::Exception->throw($param . ' param not specified');
425 my $schema = $params->{schema};
428 if ($params->{config}) {
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);
434 $config = Config::Any::JSON->load($config_file);
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');
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');
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);
451 my $include = Config::Any::JSON->load($include_file);
452 $self->msg($include);
453 $config = merge( $config, $include );
455 delete $config->{includes};
459 unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) {
460 return DBIx::Class::Exception->throw('config has no sets');
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);
470 return DBIx::Class::Exception->throw('must pass config or set all');
473 my $output_dir = dir($params->{directory});
474 unless (-e $output_dir) {
475 $output_dir->mkpath ||
476 return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
479 $self->msg("generating fixtures");
480 my $tmp_output_dir = dir($output_dir, '-~dump~-' . $<);
482 if (-e $tmp_output_dir) {
483 $self->msg("- clearing existing $tmp_output_dir");
484 $tmp_output_dir->rmtree;
486 $self->msg("- creating $tmp_output_dir");
487 $tmp_output_dir->mkpath;
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);
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);
502 my $rs = $schema->resultset($source->{class});
503 $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
504 $self->msg("- dumping $source->{class}");
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} }));
514 DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity});
517 if ($source->{ids}) {
518 my @ids = @{$source->{ids}};
519 my @id_objects = grep { $_ } map { $rs->find($_) } @ids;
520 push (@objects, @id_objects);
522 unless ($source->{quantity} || $source->{ids}) {
523 DBIx::Class::Exception->throw('must specify either quantity or ids');
527 foreach my $object (@objects) {
528 $source_options{set_dir} = $tmp_output_dir;
529 $self->dump_object($object, { %options, %source_options } );
534 foreach my $dir ($output_dir->children) {
535 next if ($dir eq $tmp_output_dir);
536 $dir->remove || $dir->rmtree;
539 $self->msg("- moving temp dir to $output_dir");
540 move($_, dir($output_dir, $_->relative($_->parent)->stringify)) for $tmp_output_dir->children;
541 if (-e $output_dir) {
542 $self->msg("- clearing tmp dir $tmp_output_dir");
543 # delete existing fixture set
544 $tmp_output_dir->remove;
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;
558 my @inherited_attrs = @{$self->_inherited_attributes};
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');
566 my $exists = (-e $file->stringify) ? 1 : 0;
568 $self->msg('-- dumping ' . $file->stringify, 2);
569 my %ds = $object->get_columns;
571 my $formatter= $object->result_source->schema->storage->datetime_parser;
572 # mess with dates if specified
573 if ($set->{datetime_relative}) {
574 unless ($@ || !$formatter) {
576 if ($set->{datetime_relative} eq 'today') {
577 $dt = DateTime->today;
579 $dt = $formatter->parse_datetime($set->{datetime_relative}) unless ($@);
582 while (my ($col, $value) = each %ds) {
583 my $col_info = $object->result_source->column_info($col);
586 && $col_info->{_inflate_info}
587 && uc($col_info->{data_type}) eq 'DATETIME';
589 $ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt);
592 warn "datetime_relative not supported for this db driver at the moment";
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;
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});
605 # dump rels of object
606 my $s = $object->result_source;
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});
621 if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) {
622 $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} });
624 my %c_params = %{$params};
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});
631 $self->dump_object($_, \%c_params) foreach $related_rs->all;
636 return unless $set && $set->{fetch};
637 foreach my $fetch (@{$set->{fetch}}) {
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};
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} } );
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}} };
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});
659 $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all;
663 sub _generate_schema {
665 my $params = shift || {};
667 $self->msg("\ncreating schema");
668 # die 'must pass version param to generate_schema_from_ddl' unless $params->{version};
670 my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema";
671 eval "require $schema_class";
675 my $connection_details = $params->{connection_details};
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 ) {
681 return DBIx::Class::Exception->throw('connection details not valid');
683 my @tables = map { $pre_schema->source($_)->from } $pre_schema->sources;
684 my $dbh = $pre_schema->storage->dbh;
687 $self->msg("- clearing DB of existing tables");
688 eval { $dbh->do('SET foreign_key_checks=0') };
689 $dbh->do('drop table ' . $_) for (@tables);
691 # import new ddl file to db
692 my $ddl_file = $params->{ddl};
693 $self->msg("- deploying schema using $ddl_file");
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));
700 @data = grep { $_ && $_ !~ /^-- / } @data;
702 eval { $dbh->do($_) or warn "SQL was:\n $_"};
703 if ($@) { die "SQL was:\n $_\n$@"; }
705 $self->msg("- finished importing DDL into DB");
707 # load schema object from our new DB
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});
720 =item Arguments: \%$attrs
722 =item Return Value: 1
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
732 In this case the database app_dev will be cleared of all tables, then the specified DDL deployed to it,
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
735 custom insert methods are avoided which can to get in the way. In some cases you might not
736 have a DDL, and so this method will eventually allow a $schema object to be passed instead.
738 directory, dll and connection_details are all required attributes.
745 unless (ref $params eq 'HASH') {
746 return DBIx::Class::Exception->throw('first arg to populate must be hash ref');
749 foreach my $param (qw/directory/) {
750 unless ($params->{$param}) {
751 return DBIx::Class::Exception->throw($param . ' param not specified');
754 my $fixture_dir = dir(delete $params->{directory});
755 unless (-e $fixture_dir) {
756 return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir);
761 if ($params->{ddl} && $params->{connection_details}) {
762 $ddl_file = file(delete $params->{ddl});
763 unless (-e $ddl_file) {
764 return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file);
766 unless (ref $params->{connection_details} eq 'ARRAY') {
767 return DBIx::Class::Exception->throw('connection details must be an arrayref');
769 } elsif ($params->{schema}) {
770 return DBIx::Class::Exception->throw('passing a schema is not supported at the moment');
772 return DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
775 my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => delete $params->{connection_details}, %{$params} });
776 $self->msg("\nimporting fixtures");
777 my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
779 my $version_file = file($fixture_dir, '_dumper_version');
780 unless (-e $version_file) {
781 # return DBIx::Class::Exception->throw('no version file found');
784 if (-e $tmp_fixture_dir) {
785 $self->msg("- deleting existing temp directory $tmp_fixture_dir");
786 $tmp_fixture_dir->rmtree;
788 $self->msg("- creating temp dir");
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;
791 eval { $schema->storage->dbh->do('SET foreign_key_checks=0') };
794 my $formatter= $schema->storage->datetime_parser;
795 unless ($@ || !$formatter) {
797 if ($params->{datetime_relative_to}) {
798 $callbacks{'DateTime::Duration'} = sub {
799 $params->{datetime_relative_to}->clone->add_duration($_);
802 $callbacks{'DateTime::Duration'} = sub {
803 $formatter->format_datetime(DateTime->today->add_duration($_))
806 $callbacks{object} ||= "visit_ref";
807 $fixup_visitor = new Data::Visitor::Callback(%callbacks);
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;
820 $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
825 $self->msg("- fixtures imported");
826 $self->msg("- cleaning up");
827 $tmp_fixture_dir->rmtree;
828 eval { $schema->storage->dbh->do('SET foreign_key_checks=1') };
835 my $subject = shift || return;
836 my $level = shift || 1;
837 return unless $self->debug >= $level;
839 print Dumper($subject);
841 print $subject . "\n";
847 Luke Saunders <luke@shadowcatsystems.co.uk>
849 Initial development sponsored by and (c) Takkle, Inc. 2007
853 Ash Berlin <ash@shadowcatsystems.co.uk>
854 Matt S. Trout <mst@shadowcatsystems.co.uk>
858 This library is free software under the same license as perl itself