use warnings;
use DBIx::Class::Exception;
-use Class::Accessor;
+use Class::Accessor::Grouped;
use Path::Class qw(dir file);
use File::Slurp;
use Config::Any::JSON;
use File::Copy qw/move/;
use Hash::Merge qw( merge );
use Data::Dumper;
+use Class::C3::Componentised;
-use base qw(Class::Accessor);
+use base qw(Class::Accessor::Grouped);
-our %db_to_parser = (
- 'mysql' => 'DateTime::Format::MySQL',
- 'pg' => 'DateTime::Format::Pg',
-);
+our $namespace_counter = 0;
-__PACKAGE__->mk_accessors(qw(config_dir _inherited_attributes debug schema_class ));
+__PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir _inherited_attributes debug schema_class/);
=head1 VERSION
-Version 1.000
+Version 1.001000
=cut
-our $VERSION = '1.000';
+our $VERSION = '1.001000';
=head1 NAME
$fixtures->populate({
directory => '/home/me/app/fixtures',
ddl => '/home/me/app/sql/ddl.sql',
- connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password']
+ connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'],
+ post_ddl => '/home/me/app/sql/post_ddl.sql',
});
=head1 DESCRIPTION
-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.
+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.
=head1 DEFINE YOUR FIXTURE SET
-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.
+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.
For example:
}]
}
-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.
+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.
+
+The top level attributes are as follows:
=head2 sets
-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.
+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.
=head2 rules
-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:
+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:
{
sets: [{
}
}
-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:
+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:
{
sets: [{
rules must be a hash keyed by class name.
+L</RULE ATTRIBUTES>
+
+=head2 includes
+
+To prevent repetition between configs you can include other configs. For example:
+
+ {
+ sets: [{
+ class: 'Producer',
+ ids: ['5']
+ }],
+ includes: [{
+ file: 'base.json'
+ }]
+ }
+
+Includes must be an arrayref of hashrefs where the hashrefs have key 'file' which is the name of another config
+file in the same directory. The original config is merged with its includes using Hash::Merge.
+
+=head2 datetime_relative
+
+Only available for MySQL and PostgreSQL at the moment, must be a value that DateTime::Format::*
+can parse. For example:
+
+ {
+ sets: [{
+ class: 'RecentItems',
+ ids: ['9']
+ }],
+ datetime_relative : "2007-10-30 00:00:00"
+ }
+
+This will work when dumping from a MySQL database and will cause any datetime fields (where datatype => 'datetime'
+in the column def of the schema class) to be dumped as a DateTime::Duration object relative to the date specified in
+the datetime_relative value. For example if the RecentItem object had a date field set to 2007-10-25, then when the
+fixture is imported the field will be set to 5 days in the past relative to the current time.
+
=head2 might_have
Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0.
{
- might_have: [{
+ might_have: {
fetch: 1
},
sets: [{
}]
}
-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>.
+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>.
=head1 SET ATTRIBUTES
=head2 ids
-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.
+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.
=head2 quantity
-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.
+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.
=head2 cond
Will cause the cds of artists 1 and 3 to be dumped where the cd position is 2.
-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.
+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.
=head2 has_many
Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer.
+Be careful here, dumping has_many rels can lead to a lot of data being dumped.
+
=head2 might_have
As with has_many but for might_have relationships. Quantity doesn't do anything in this case.
=back
-Returns a new DBIx::Class::Fixture object. %attrs has only valid key at the
-moment - 'config_dir' which is required and much contain a valid path to
+Returns a new DBIx::Class::Fixture object. %attrs has only two valid keys at the
+moment - 'debug' which determines whether to be verbose and 'config_dir' which is required and much contain a valid path to
the directory in which your .json configs reside.
my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
directory => '/home/me/app/fixtures' # output directory
});
+ or
+
+ $fixtures->dump({
+ all => 1, # just dump everything that's in the schema
+ schema => $source_dbic_schema,
+ directory => '/home/me/app/fixtures' # output directory
+ });
+
In this case objects will be dumped to subdirectories in the specified directory. For example:
/home/me/app/fixtures/artist/1.fix
/home/me/app/fixtures/artist/3.fix
/home/me/app/fixtures/producer/5.fix
-config, schema and directory are all required attributes.
+schema and directory are required attributes. also, one of config or all must be specified.
=cut
return DBIx::Class::Exception->throw('first arg to dump must be hash ref');
}
- foreach my $param (qw/config schema directory/) {
+ foreach my $param (qw/schema directory/) {
unless ($params->{$param}) {
return DBIx::Class::Exception->throw($param . ' param not specified');
}
}
- my $config_file = file($self->config_dir, $params->{config});
- unless (-e $config_file) {
- return DBIx::Class::Exception->throw('config does not exist at ' . $config_file);
- }
+ my $schema = $params->{schema};
+ my $config_file;
+ my $config;
+ if ($params->{config}) {
+ #read config
+ $config_file = file($self->config_dir, $params->{config});
+ unless (-e $config_file) {
+ return DBIx::Class::Exception->throw('config does not exist at ' . $config_file);
+ }
+ $config = Config::Any::JSON->load($config_file);
- my $config = Config::Any::JSON->load($config_file);
- unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) {
- return DBIx::Class::Exception->throw('config has no sets');
+ #process includes
+ if ($config->{includes}) {
+ $self->msg($config->{includes});
+ unless (ref $config->{includes} eq 'ARRAY') {
+ return DBIx::Class::Exception->throw('includes params of config must be an array ref of hashrefs');
+ }
+ foreach my $include_config (@{$config->{includes}}) {
+ unless ((ref $include_config eq 'HASH') && $include_config->{file}) {
+ return DBIx::Class::Exception->throw('includes params of config must be an array ref of hashrefs');
+ }
+
+ my $include_file = file($self->config_dir, $include_config->{file});
+ unless (-e $include_file) {
+ return DBIx::Class::Exception->throw('config does not exist at ' . $include_file);
+ }
+ my $include = Config::Any::JSON->load($include_file);
+ $self->msg($include);
+ $config = merge( $config, $include );
+ }
+ delete $config->{includes};
+ }
+
+ # validate config
+ unless ($config && $config->{sets} && ref $config->{sets} eq 'ARRAY' && scalar(@{$config->{sets}})) {
+ return DBIx::Class::Exception->throw('config has no sets');
+ }
+
+ $config->{might_have} = { fetch => 0 } unless (exists $config->{might_have});
+ $config->{has_many} = { fetch => 0 } unless (exists $config->{has_many});
+ $config->{belongs_to} = { fetch => 1 } unless (exists $config->{belongs_to});
+ } elsif ($params->{all}) {
+ $config = { might_have => { fetch => 0 }, has_many => { fetch => 0 }, belongs_to => { fetch => 0 }, sets => [map {{ class => $_, quantity => 'all' }} $schema->sources] };
+ print Dumper($config);
+ } else {
+ return DBIx::Class::Exception->throw('must pass config or set all');
}
my $output_dir = dir($params->{directory});
unless (-e $output_dir) {
- return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
+ $output_dir->mkpath ||
+ return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
}
- my $schema = $params->{schema};
-
$self->msg("generating fixtures");
- my $tmp_output_dir = dir($output_dir, '-~dump~-');
+ my $tmp_output_dir = dir($output_dir, '-~dump~-' . $<);
if (-e $tmp_output_dir) {
$self->msg("- clearing existing $tmp_output_dir");
$source = merge( $source, $rule ) if ($rule);
# fetch objects
- my $rs = $schema->resultset($source->{class});
- $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
+ my $rs = $schema->resultset($source->{class});
+
+ if ($source->{cond} and ref $source->{cond} eq 'HASH') {
+ # if value starts with / assume it's meant to be passed as a scalar ref to dbic
+ # ideally this would substitute deeply
+ $source->{cond} = { map { $_ => ($source->{cond}->{$_} =~ s/^\\//) ? \$source->{cond}->{$_} : $source->{cond}->{$_} } keys %{$source->{cond}} };
+ }
+
+ $rs = $rs->search($source->{cond}, { join => $source->{join} }) if ($source->{cond});
$self->msg("- dumping $source->{class}");
my @objects;
my %source_options = ( set => { %{$config}, %{$source} } );
# write dir and gen filename
my $source_dir = dir($params->{set_dir}, lc($object->result_source->from));
mkdir($source_dir->stringify, 0777);
- my $file = file($source_dir, join('-', map { $object->get_column($_) } sort $object->primary_columns) . '.fix');
+
+ # strip dir separators from file name
+ my $file = file($source_dir, join('-', map {
+ ( my $a = $object->get_column($_) ) =~ s|[/\\]|_|g; $a;
+ } sort $object->primary_columns) . '.fix');
# write file
my $exists = (-e $file->stringify) ? 1 : 0;
$self->msg('-- dumping ' . $file->stringify, 2);
my %ds = $object->get_columns;
- my $driver = $object->result_source->schema->storage->dbh->{Driver}->{Name};
- my $formatter= $db_to_parser{$driver};
- eval "require $formatter" if ($formatter);
-
+ my $formatter= $object->result_source->schema->storage->datetime_parser;
# mess with dates if specified
if ($set->{datetime_relative}) {
unless ($@ || !$formatter) {
$ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt);
}
} else {
- warn "datetime_relative not supported for $driver at the moment";
+ warn "datetime_relative not supported for this db driver at the moment";
}
}
my $mode = 0777; chmod $mode, $file->stringify;
}
+ # don't bother looking at rels unless we are actually planning to dump at least one type
+ return unless ($set->{might_have}->{fetch} || $set->{belongs_to}->{fetch} || $set->{has_many}->{fetch} || $set->{fetch});
+
# dump rels of object
my $s = $object->result_source;
unless ($exists) {
my $pre_schema;
my $connection_details = $params->{connection_details};
- unless( $pre_schema = $schema_class->connect(@{$connection_details}) ) {
+ $namespace_counter++;
+ my $namespace = "DBIx::Class::Fixtures::GeneratedSchema_" . $namespace_counter;
+ Class::C3::Componentised->inject_base( $namespace => $schema_class );
+ $pre_schema = $namespace->connect(@{$connection_details});
+ unless( $pre_schema ) {
return DBIx::Class::Exception->throw('connection details not valid');
}
- my @tables = map { $pre_schema->source($_)->from }$pre_schema->sources;
+ my @tables = map { $pre_schema->source($_)->from } $pre_schema->sources;
+ $self->msg("Tables to drop: [". join(', ', sort @tables) . "]");
my $dbh = $pre_schema->storage->dbh;
# clear existing db
$self->msg("- clearing DB of existing tables");
eval { $dbh->do('SET foreign_key_checks=0') };
- $dbh->do('drop table ' . $_) for (@tables);
+ foreach my $table (@tables) {
+ eval { $dbh->do('drop table ' . $table . ($params->{cascade} ? ' cascade' : '') ) };
+ }
# import new ddl file to db
my $ddl_file = $params->{ddl};
$self->msg("- deploying schema using $ddl_file");
- my $fh;
- open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)");
- my @data = split(/\n/, join('', <$fh>));
- @data = grep(!/^--/, @data);
- @data = split(/;/, join('', @data));
- close($fh);
- @data = grep { $_ && $_ !~ /^-- / } @data;
- for (@data) {
- eval { $dbh->do($_) or warn "SQL was:\n $_"};
+ my $data = _read_sql($ddl_file);
+ foreach (@$data) {
+ eval { $dbh->do($_) or warn "SQL was:\n $_"};
if ($@) { die "SQL was:\n $_\n$@"; }
}
$self->msg("- finished importing DDL into DB");
# load schema object from our new DB
- $self->msg("- loading fresh DBIC object from DB");
- my $schema = $schema_class->connect(@{$connection_details});
+ $namespace_counter++;
+ my $namespace2 = "DBIx::Class::Fixtures::GeneratedSchema_" . $namespace_counter;
+ Class::C3::Componentised->inject_base( $namespace2 => $schema_class );
+ my $schema = $namespace2->connect(@{$connection_details});
return $schema;
}
+sub _read_sql {
+ my $ddl_file = shift;
+ my $fh;
+ open $fh, "<$ddl_file" or die ("Can't open DDL file, $ddl_file ($!)");
+ my @data = split(/\n/, join('', <$fh>));
+ @data = grep(!/^--/, @data);
+ @data = split(/;/, join('', @data));
+ close($fh);
+ @data = grep { $_ && $_ !~ /^-- / } @data;
+ return \@data;
+}
=head2 populate
$fixtures->populate({
directory => '/home/me/app/fixtures', # directory to look for fixtures in, as specified to dump
ddl => '/home/me/app/sql/ddl.sql', # DDL to deploy
- connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'] # database to clear, deploy and then populate
+ connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'], # database to clear, deploy and then populate
+ post_ddl => '/home/me/app/sql/post_ddl.sql', # DDL to deploy after populating records, ie. FK constraints
+ cascade => 1, # use CASCADE option when dropping tables
});
-In this case the database app_dev will be cleared entirely of everything, then the DDL deployed to it,
+In this case the database app_dev will be cleared of all tables, then the specified DDL deployed to it,
then finally all fixtures found in /home/me/app/fixtures will be added to it. populate will generate
its own DBIx::Class schema from the DDL rather than being passed one to use. This is better as
-custom insert methods etc are avoided which tend to get in the way. In some cases you might not
+custom insert methods are avoided which can to get in the way. In some cases you might not
have a DDL, and so this method will eventually allow a $schema object to be passed instead.
+If needed, you can specify a post_ddl attribute which is a DDL to be applied after all the fixtures
+have been added to the database. A good use of this option would be to add foreign key constraints
+since databases like Postgresql cannot disable foreign key checks.
+
+If your tables have foreign key constraints you may want to use the cascade attribute which will
+make the drop table functionality cascade, ie 'DROP TABLE $table CASCADE'.
+
directory, dll and connection_details are all required attributes.
=cut
$tmp_fixture_dir->rmtree;
}
$self->msg("- creating temp dir");
- dircopy(dir($fixture_dir, $schema->source($_)->from), dir($tmp_fixture_dir, $schema->source($_)->from)) for $schema->sources;
+ 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;
eval { $schema->storage->dbh->do('SET foreign_key_checks=0') };
my $fixup_visitor;
- my $driver = $schema->storage->dbh->{Driver}->{Name};
- my $formatter= $db_to_parser{$driver};
- eval "require $formatter" if ($formatter);
+ my $formatter= $schema->storage->datetime_parser;
unless ($@ || !$formatter) {
my %callbacks;
if ($params->{datetime_relative_to}) {
my $rs = $schema->resultset($source);
my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from));
next unless (-e $source_dir);
+ my @rows;
while (my $file = $source_dir->next) {
next unless ($file =~ /\.fix$/);
next if $file->is_dir;
my $HASH1;
eval($contents);
$HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
- $rs->create($HASH1);
+ push(@rows, $HASH1);
}
+ $rs->populate(\@rows);
+ }
+
+ if ($params->{post_ddl}) {
+ my $data = _read_sql($params->{post_ddl});
+ foreach (@$data) {
+ eval { $schema->storage->dbh->do($_) or warn "SQL was:\n $_"};
+ if ($@) { die "SQL was:\n $_\n$@"; }
+ }
+ $self->msg("- finished importing post-populate DDL into DB");
}
$self->msg("- fixtures imported");
$self->msg("- cleaning up");
$tmp_fixture_dir->rmtree;
eval { $schema->storage->dbh->do('SET foreign_key_checks=1') };
+
+ return 1;
}
sub msg {
my $self = shift;
my $subject = shift || return;
my $level = shift || 1;
-
return unless $self->debug >= $level;
if (ref $subject) {
print Dumper($subject);
Luke Saunders <luke@shadowcatsystems.co.uk>
+ Initial development sponsored by and (c) Takkle, Inc. 2007
+
=head1 CONTRIBUTORS
Ash Berlin <ash@shadowcatsystems.co.uk>
Matt S. Trout <mst@shadowcatsystems.co.uk>
+ Drew Taylor <taylor.andrew.j@gmail.com>
+
+=head1 LICENSE
+
+ This library is free software under the same license as perl itself
=cut
projects / dbsrgits/DBIx-Class-Fixtures.git / blobdiff