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.000002';
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.
153 =head2 datetime_relative
155 Only available for MySQL and PostgreSQL at the moment, must be a value that DateTime::Format::*
156 can parse. For example:
160 class: 'RecentItems',
163 datetime_relative : "2007-10-30 00:00:00"
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.
173 Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0.
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>.
192 =head1 SET ATTRIBUTES
196 Required attribute. Specifies the DBIx::Class object class you wish to dump.
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.
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.
211 A hash specifying the conditions dumped objects must match. Essentially this is a JSON representation of a DBIx::Class search clause. For example:
217 cond: { name: 'Dave' }
221 This will dump all artists whose name is 'dave'. Essentially $artist_rs->search({ name => 'Dave' })->all.
223 Sometimes in a search clause it's useful to use scalar refs to do things like:
225 $artist_rs->search({ no1_singles => \'> no1_albums' })
227 This could be specified in the cond hash like so:
233 cond: { no1_singles: '\> no1_albums' }
237 So if the value starts with a backslash the value is made a scalar ref before being passed to search.
241 An array of relationships to be used in the cond clause.
247 cond: { 'cds.position': { '>': 4 } },
252 Fetch all artists who have cds with position greater than 4.
256 Must be an array of hashes. Specifies which rels to also dump. For example:
265 cond: { position: '2' }
270 Will cause the cds of artists 1 and 3 to be dumped where the cd position is 2.
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.
278 Specifies whether to fetch has_many rels for this set. Must be a hash containing keys fetch and quantity.
280 Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer.
282 Be careful here, dumping has_many rels can lead to a lot of data being dumped.
286 As with has_many but for might_have relationships. Quantity doesn't do anything in this case.
288 This value will be inherited by all fetches in this set. This is not true for the has_many attribute.
290 =head1 RULE ATTRIBUTES
294 Same as with L</SET ATTRIBUTES>
298 Same as with L</SET ATTRIBUTES>
302 Same as with L</SET ATTRIBUTES>
306 Same as with L</SET ATTRIBUTES>
310 Same as with L</SET ATTRIBUTES>
318 =item Arguments: \%$attrs
320 =item Return Value: $fixture_object
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
326 the directory in which your .json configs reside.
328 my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
336 unless (ref $params eq 'HASH') {
337 return DBIx::Class::Exception->throw('first arg to DBIx::Class::Fixtures->new() must be hash ref');
340 unless ($params->{config_dir}) {
341 return DBIx::Class::Exception->throw('config_dir param not specified');
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');
350 config_dir => $config_dir,
351 _inherited_attributes => [qw/datetime_relative might_have rules/],
352 debug => $params->{debug}
364 =item Arguments: \%$attrs
366 =item Return Value: 1
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
379 all => 1, # just dump everything that's in the schema
380 schema => $source_dbic_schema,
381 directory => '/home/me/app/fixtures' # output directory
384 In this case objects will be dumped to subdirectories in the specified directory. For example:
386 /home/me/app/fixtures/artist/1.fix
387 /home/me/app/fixtures/artist/3.fix
388 /home/me/app/fixtures/producer/5.fix
390 schema and directory are required attributes. also, one of config or all must be specified.
398 unless (ref $params eq 'HASH') {
399 return DBIx::Class::Exception->throw('first arg to dump must be hash ref');
402 foreach my $param (qw/schema directory/) {
403 unless ($params->{$param}) {
404 return DBIx::Class::Exception->throw($param . ' param not specified');
408 my $schema = $params->{schema};
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);
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');
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);
429 return DBIx::Class::Exception->throw('must pass config or set all');
432 my $output_dir = dir($params->{directory});
433 unless (-e $output_dir) {
434 $output_dir->mkpath ||
435 return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
438 $self->msg("generating fixtures");
439 my $tmp_output_dir = dir($output_dir, '-~dump~-' . $<);
441 if (-e $tmp_output_dir) {
442 $self->msg("- clearing existing $tmp_output_dir");
443 $tmp_output_dir->rmtree;
445 $self->msg("- creating $tmp_output_dir");
446 $tmp_output_dir->mkpath;
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);
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);
461 my $rs = $schema->resultset($source->{class});
462 $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
463 $self->msg("- dumping $source->{class}");
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} }));
473 DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity});
476 if ($source->{ids}) {
477 my @ids = @{$source->{ids}};
478 my @id_objects = grep { $_ } map { $rs->find($_) } @ids;
479 push (@objects, @id_objects);
481 unless ($source->{quantity} || $source->{ids}) {
482 DBIx::Class::Exception->throw('must specify either quantity or ids');
486 foreach my $object (@objects) {
487 $source_options{set_dir} = $tmp_output_dir;
488 $self->dump_object($object, { %options, %source_options } );
493 foreach my $dir ($output_dir->children) {
494 next if ($dir eq $tmp_output_dir);
495 $dir->remove || $dir->rmtree;
498 $self->msg("- moving temp dir to $output_dir");
499 move($_, dir($output_dir, $_->relative($_->parent)->stringify)) for $tmp_output_dir->children;
500 if (-e $output_dir) {
501 $self->msg("- clearing tmp dir $tmp_output_dir");
502 # delete existing fixture set
503 $tmp_output_dir->remove;
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;
517 my @inherited_attrs = @{$self->_inherited_attributes};
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');
525 my $exists = (-e $file->stringify) ? 1 : 0;
527 $self->msg('-- dumping ' . $file->stringify, 2);
528 my %ds = $object->get_columns;
530 my $formatter= $object->result_source->schema->storage->datetime_parser;
531 # mess with dates if specified
532 if ($set->{datetime_relative}) {
533 unless ($@ || !$formatter) {
535 if ($set->{datetime_relative} eq 'today') {
536 $dt = DateTime->today;
538 $dt = $formatter->parse_datetime($set->{datetime_relative}) unless ($@);
541 while (my ($col, $value) = each %ds) {
542 my $col_info = $object->result_source->column_info($col);
545 && $col_info->{_inflate_info}
546 && uc($col_info->{data_type}) eq 'DATETIME';
548 $ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt);
551 warn "datetime_relative not supported for this db driver at the moment";
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;
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});
564 # dump rels of object
565 my $s = $object->result_source;
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});
580 if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) {
581 $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} });
583 my %c_params = %{$params};
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});
590 $self->dump_object($_, \%c_params) foreach $related_rs->all;
595 return unless $set && $set->{fetch};
596 foreach my $fetch (@{$set->{fetch}}) {
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};
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} } );
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}} };
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});
618 $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all;
622 sub _generate_schema {
624 my $params = shift || {};
626 $self->msg("\ncreating schema");
627 # die 'must pass version param to generate_schema_from_ddl' unless $params->{version};
629 my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema";
630 eval "require $schema_class";
634 my $connection_details = $params->{connection_details};
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 ) {
640 return DBIx::Class::Exception->throw('connection details not valid');
642 my @tables = map { $pre_schema->source($_)->from } $pre_schema->sources;
643 my $dbh = $pre_schema->storage->dbh;
646 $self->msg("- clearing DB of existing tables");
647 eval { $dbh->do('SET foreign_key_checks=0') };
648 $dbh->do('drop table ' . $_) for (@tables);
650 # import new ddl file to db
651 my $ddl_file = $params->{ddl};
652 $self->msg("- deploying schema using $ddl_file");
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));
659 @data = grep { $_ && $_ !~ /^-- / } @data;
661 eval { $dbh->do($_) or warn "SQL was:\n $_"};
662 if ($@) { die "SQL was:\n $_\n$@"; }
664 $self->msg("- finished importing DDL into DB");
666 # load schema object from our new DB
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});
679 =item Arguments: \%$attrs
681 =item Return Value: 1
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
691 In this case the database app_dev will be cleared of all tables, then the specified DDL deployed to it,
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
694 custom insert methods are avoided which can to get in the way. In some cases you might not
695 have a DDL, and so this method will eventually allow a $schema object to be passed instead.
697 directory, dll and connection_details are all required attributes.
704 unless (ref $params eq 'HASH') {
705 return DBIx::Class::Exception->throw('first arg to populate must be hash ref');
708 foreach my $param (qw/directory/) {
709 unless ($params->{$param}) {
710 return DBIx::Class::Exception->throw($param . ' param not specified');
713 my $fixture_dir = dir(delete $params->{directory});
714 unless (-e $fixture_dir) {
715 return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir);
720 if ($params->{ddl} && $params->{connection_details}) {
721 $ddl_file = file(delete $params->{ddl});
722 unless (-e $ddl_file) {
723 return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file);
725 unless (ref $params->{connection_details} eq 'ARRAY') {
726 return DBIx::Class::Exception->throw('connection details must be an arrayref');
728 } elsif ($params->{schema}) {
729 return DBIx::Class::Exception->throw('passing a schema is not supported at the moment');
731 return DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
734 my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => delete $params->{connection_details}, %{$params} });
735 $self->msg("\nimporting fixtures");
736 my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
738 my $version_file = file($fixture_dir, '_dumper_version');
739 unless (-e $version_file) {
740 # return DBIx::Class::Exception->throw('no version file found');
743 if (-e $tmp_fixture_dir) {
744 $self->msg("- deleting existing temp directory $tmp_fixture_dir");
745 $tmp_fixture_dir->rmtree;
747 $self->msg("- creating temp dir");
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;
750 eval { $schema->storage->dbh->do('SET foreign_key_checks=0') };
753 my $formatter= $schema->storage->datetime_parser;
754 unless ($@ || !$formatter) {
756 if ($params->{datetime_relative_to}) {
757 $callbacks{'DateTime::Duration'} = sub {
758 $params->{datetime_relative_to}->clone->add_duration($_);
761 $callbacks{'DateTime::Duration'} = sub {
762 $formatter->format_datetime(DateTime->today->add_duration($_))
765 $callbacks{object} ||= "visit_ref";
766 $fixup_visitor = new Data::Visitor::Callback(%callbacks);
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;
779 $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
784 $self->msg("- fixtures imported");
785 $self->msg("- cleaning up");
786 $tmp_fixture_dir->rmtree;
787 eval { $schema->storage->dbh->do('SET foreign_key_checks=1') };
794 my $subject = shift || return;
795 my $level = shift || 1;
797 return unless $self->debug >= $level;
799 print Dumper($subject);
801 print $subject . "\n";
807 Luke Saunders <luke@shadowcatsystems.co.uk>
809 Initial development sponsored by and (c) Takkle, Inc. 2007
813 Ash Berlin <ash@shadowcatsystems.co.uk>
814 Matt S. Trout <mst@shadowcatsystems.co.uk>
818 This library is free software under the same license as perl itself