use strict;
use warnings;
+use DBIx::Class 0.08100;
use DBIx::Class::Exception;
use Class::Accessor::Grouped;
-use Path::Class qw(dir file);
-use File::Slurp;
use Config::Any::JSON;
use Data::Dump::Streamer;
use Data::Visitor::Callback;
-use File::Path;
-use File::Copy::Recursive qw/dircopy/;
-use File::Copy qw/move/;
use Hash::Merge qw( merge );
use Data::Dumper;
use Class::C3::Componentised;
+use MIME::Base64;
+use IO::All;
+use File::Temp qw/tempdir/;
use base qw(Class::Accessor::Grouped);
our $namespace_counter = 0;
-__PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir _inherited_attributes debug schema_class/);
+__PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
+ _inherited_attributes debug schema_class dumped_objects config_attrs/);
-=head1 VERSION
+our $VERSION = '1.001_029';
-Version 0.999_01
-
-=cut
-
-our $VERSION = '0.999_01';
+$VERSION = eval $VERSION;
=head1 NAME
-DBIx::Class::Fixtures
+DBIx::Class::Fixtures - Dump data and repopulate a database using rules
=head1 SYNOPSIS
- use DBIx::Class::Fixtures;
+ use DBIx::Class::Fixtures;
- ...
+ ...
- my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
+ my $fixtures = DBIx::Class::Fixtures->new({
+ config_dir => '/home/me/app/fixture_configs'
+ });
- $fixtures->dump({
- config => 'set_config.json',
- schema => $source_dbic_schema,
- directory => '/home/me/app/fixtures'
- });
+ $fixtures->dump({
+ config => 'set_config.json',
+ schema => $source_dbic_schema,
+ directory => '/home/me/app/fixtures'
+ });
- $fixtures->populate({
- directory => '/home/me/app/fixtures',
- ddl => '/home/me/app/sql/ddl.sql',
- connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password']
- });
+ $fixtures->populate({
+ directory => '/home/me/app/fixtures',
+ ddl => '/home/me/app/sql/ddl.sql',
+ 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:
- {
- sets: [{
- class: 'Artist',
- ids: ['1', '3']
- }, {
- class: 'Producer',
- ids: ['5'],
- fetch: [{
- rel: 'artists',
- quantity: '2'
- }]
- }]
- }
-
-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.
+ {
+ "sets": [
+ {
+ "class": "Artist",
+ "ids": ["1", "3"]
+ },
+ {
+ "class": "Producer",
+ "ids": ["5"],
+ "fetch": [
+ {
+ "rel": "artists",
+ "quantity": "2"
+ }
+ ]
+ }
+ ]
+ }
+
+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": [
+ {
+ "class": "Artist",
+ "ids": ["1", "3"]
+ },
+ {
+ "class": "Producer",
+ "ids": ["5"],
+ "fetch": [
+ {
+ "rel": "artists",
+ "quantity": "2"
+ }
+ ]
+ }
+ ],
+ "rules": {
+ "Artist": {
+ "fetch": [ {
+ "rel": "cds",
+ "quantity": "all"
+ } ]
+ }
+ }
+ }
+
+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": [
{
- sets: [{
- class: 'Artist',
- ids: ['1', '3']
- }, {
- class: 'Producer',
- ids: ['5'],
- fetch: [{
- rel: 'artists',
- quantity: '2'
- }]
- }],
- rules: {
- Artist: {
- fetch: [{
- rel: 'cds',
- quantity: 'all'
- }]
- }
- }
- }
-
-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: [{
- class: 'Artist',
- ids: ['1', '3'],
- fetch: [{
- rel: 'cds',
- quantity: 'all'
- }]
- }, {
- class: 'Producer',
- ids: ['5'],
- fetch: [{
- rel: 'artists',
- quantity: '2',
- fetch: [{
- rel: 'cds',
- quantity: 'all'
- }]
- }]
- }]
- }
+ "class": "Artist",
+ "ids": ["1", "3"],
+ "fetch": [ {
+ "rel": "cds",
+ "quantity": "all"
+ } ]
+ },
+ {
+ "class": "Producer",
+ "ids": ["5"],
+ "fetch": [ {
+ "rel": "artists",
+ "quantity": "2",
+ "fetch": [ {
+ "rel": "cds",
+ "quantity": "all"
+ } ]
+ } ]
+ }
+ ]
+ }
rules must be a hash keyed by class name.
L</RULE ATTRIBUTES>
-=head2 datetime_relative
+=head2 includes
-Only available for MySQL and PostgreSQL at the moment, must be a value that DateTime::Format::*
-can parse. For example:
+To prevent repetition between configs you can include other configs. For
+example:
- {
- sets: [{
- class: 'RecentItems',
- ids: ['9']
- }],
- datetime_relative : "2007-10-30 00:00:00"
- }
+ {
+ "sets": [ {
+ "class": "Producer",
+ "ids": ["5"]
+ } ],
+ "includes": [
+ { "file": "base.json" }
+ ]
+ }
-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.
+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 L<Hash::Merge>.
-=head2 might_have
+=head2 datetime_relative
-Specifies whether to automatically dump might_have relationships. Should be a hash with one attribute - fetch. Set fetch to 1 or 0.
+Only available for MySQL and PostgreSQL at the moment, must be a value that
+DateTime::Format::* can parse. For example:
- {
- might_have: [{
- fetch: 1
- },
- sets: [{
- class: 'Artist',
- ids: ['1', '3']
- }, {
- class: 'Producer',
- ids: ['5']
- }]
- }
+ {
+ "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.
-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>.
+=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": { "fetch": 1 },
+ "sets": [
+ {
+ "class": "Artist",
+ "ids": ["1", "3"]
+ },
+ {
+ "class": "Producer",
+ "ids": ["5"]
+ }
+ ]
+ }
+
+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
-A hash specifying the conditions dumped objects must match. Essentially this is a JSON representation of a DBIx::Class search clause. For example:
+A hash specifying the conditions dumped objects must match. Essentially this is
+a JSON representation of a DBIx::Class search clause. For example:
- {
- sets: [{
- class: 'Artist',
- quantiy: 'all',
- cond: { name: 'Dave' }
- }]
- }
+ {
+ "sets": [{
+ "class": "Artist",
+ "quantiy": "all",
+ "cond": { "name": "Dave" }
+ }]
+ }
-This will dump all artists whose name is 'dave'. Essentially $artist_rs->search({ name => 'Dave' })->all.
+This will dump all artists whose name is 'dave'. Essentially
+$artist_rs->search({ name => 'Dave' })->all.
Sometimes in a search clause it's useful to use scalar refs to do things like:
-$artist_rs->search({ no1_singles => \'> no1_albums' })
+ $artist_rs->search({ no1_singles => \'> no1_albums' })
This could be specified in the cond hash like so:
- {
- sets: [{
- class: 'Artist',
- quantiy: 'all',
- cond: { no1_singles: '\> no1_albums' }
- }]
- }
+ {
+ "sets": [ {
+ "class": "Artist",
+ "quantiy": "all",
+ "cond": { "no1_singles": "\> no1_albums" }
+ } ]
+ }
-So if the value starts with a backslash the value is made a scalar ref before being passed to search.
+So if the value starts with a backslash the value is made a scalar ref before
+being passed to search.
=head2 join
An array of relationships to be used in the cond clause.
- {
- sets: [{
- class: 'Artist',
- quantiy: 'all',
- cond: { 'cds.position': { '>': 4 } },
- join: ['cds']
- }]
- }
+ {
+ "sets": [ {
+ "class": "Artist",
+ "quantiy": "all",
+ "cond": { "cds.position": { ">": 4 } },
+ "join": ["cds"]
+ } ]
+ }
Fetch all artists who have cds with position greater than 4.
Must be an array of hashes. Specifies which rels to also dump. For example:
- {
- sets: [{
- class: 'Artist',
- ids: ['1', '3'],
- fetch: [{
- rel: 'cds',
- quantity: '3',
- cond: { position: '2' }
- }]
- }]
- }
+ {
+ "sets": [ {
+ "class": "Artist",
+ "ids": ["1", "3"],
+ "fetch": [ {
+ "rel": "cds",
+ "quantity": "3",
+ "cond": { "position": "2" }
+ } ]
+ } ]
+ }
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
-Specifies whether to fetch has_many rels for this set. Must be a hash containing keys fetch and quantity.
+Specifies whether to fetch has_many rels for this set. Must be a hash
+containing keys fetch and quantity.
-Set fetch to 1 if you want to fetch them, and quantity to either 'all' or an integer.
+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.
+As with has_many but for might_have relationships. Quantity doesn't do anything
+in this case.
+
+This value will be inherited by all fetches in this set. This is not true for
+the has_many attribute.
+
+=head2 external
+
+In some cases your database information might be keys to values in some sort of
+external storage. The classic example is you are using L<DBIx::Class::InflateColumn::FS>
+to store blob information on the filesystem. In this case you may wish the ability
+to backup your external storage in the same way your database data. The L</external>
+attribute lets you specify a handler for this type of issue. For example:
+
+ {
+ "sets": [{
+ "class": "Photo",
+ "quantity": "all",
+ "external": {
+ "file": {
+ "class": "File",
+ "args": {"path":"__ATTR(photo_dir)__"}
+ }
+ }
+ }]
+ }
+
+This would use L<DBIx::Class::Fixtures::External::File> to read from a directory
+where the path to a file is specified by the C<file> field of the C<Photo> source.
+We use the uninflated value of the field so you need to completely handle backup
+and restore. For the common case we provide L<DBIx::Class::Fixtures::External::File>
+and you can create your own custom handlers by placing a '+' in the namespace:
-This value will be inherited by all fetches in this set. This is not true for the has_many attribute.
+ "class": "+MyApp::Schema::SomeExternalStorage",
+
+Although if possible I'd love to get patches to add some of the other common
+types (I imagine storage in MogileFS, Redis, etc or even Amazon might be popular.)
+
+See L<DBIx::Class::Fixtures::External::File> for the external handler interface.
=head1 RULE ATTRIBUTES
Same as with L</SET ATTRIBUTES>
+=head1 RULE SUBSTITUTIONS
+
+You can provide the following substitution patterns for your rule values. An
+example of this might be:
+
+ {
+ "sets": [{
+ "class": "Photo",
+ "quantity": "__ENV(NUMBER_PHOTOS_DUMPED)__",
+ }]
+ }
+
+=head2 ENV
+
+Provide a value from %ENV
+
+=head2 ATTR
+
+Provide a value from L</config_attrs>
+
+=head2 catfile
+
+Create the path to a file from a list
+
+=head2 catdir
+
+Create the path to a directory from a list
+
=head1 METHODS
=head2 new
=back
-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.
+Returns a new DBIx::Class::Fixture object. %attrs can have the following
+parameters:
+
+=over
+
+=item config_dir:
+
+required. must contain a valid path to the directory in which your .json
+configs reside.
+
+=item debug:
+
+determines whether to be verbose
+
+=item ignore_sql_errors:
- my $fixtures = DBIx::Class::Fixtures->new({ config_dir => '/home/me/app/fixture_configs' });
+ignore errors on import of DDL etc
+
+=item config_attrs
+
+A hash of information you can use to do replacements inside your configuration
+sets. For example, if your set looks like:
+
+ {
+ "sets": [ {
+ "class": "Artist",
+ "ids": ["1", "3"],
+ "fetch": [ {
+ "rel": "cds",
+ "quantity": "__ATTR(quantity)__",
+ } ]
+ } ]
+ }
+
+ my $fixtures = DBIx::Class::Fixtures->new( {
+ config_dir => '/home/me/app/fixture_configs'
+ config_attrs => {
+ quantity => 100,
+ },
+ });
+
+You may wish to do this if you want to let whoever runs the dumps have a bit
+more control
+
+=back
+
+ my $fixtures = DBIx::Class::Fixtures->new( {
+ config_dir => '/home/me/app/fixture_configs'
+ } );
=cut
return DBIx::Class::Exception->throw('config_dir param not specified');
}
- my $config_dir = dir($params->{config_dir});
+ my $config_dir = io->dir($params->{config_dir});
unless (-e $params->{config_dir}) {
return DBIx::Class::Exception->throw('config_dir directory doesn\'t exist');
}
my $self = {
- config_dir => $config_dir,
- _inherited_attributes => [qw/datetime_relative might_have rules/],
- debug => $params->{debug}
+ config_dir => $config_dir,
+ _inherited_attributes => [qw/datetime_relative might_have rules belongs_to/],
+ debug => $params->{debug} || 0,
+ ignore_sql_errors => $params->{ignore_sql_errors},
+ dumped_objects => {},
+ use_create => $params->{use_create} || 0,
+ use_find_or_create => $params->{use_find_or_create} || 0,
+ config_attrs => $params->{config_attrs} || {},
};
bless $self, $class;
return $self;
}
+=head2 available_config_sets
+
+Returns a list of all the config sets found in the L</config_dir>. These will
+be a list of the json based files containing dump rules.
+
+=cut
+
+my @config_sets;
+sub available_config_sets {
+ @config_sets = scalar(@config_sets) ? @config_sets : map {
+ $_->filename;
+ } grep {
+ -f "$_" && $_=~/json$/;
+ } shift->config_dir->all;
+}
+
=head2 dump
=over 4
=back
- $fixtures->dump({
- config => 'set_config.json', # config file to use. must be in the config directory specified in the constructor
- schema => $source_dbic_schema,
- directory => '/home/me/app/fixtures' # output directory
- });
+ $fixtures->dump({
+ config => 'set_config.json', # config file to use. must be in the config
+ # directory specified in the constructor
+ schema => $source_dbic_schema,
+ 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:
-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
- /home/me/app/fixtures/artist/1.fix
- /home/me/app/fixtures/artist/3.fix
- /home/me/app/fixtures/producer/5.fix
+schema and directory are required attributes. also, one of config or all must
+be specified.
-config, schema and directory are all required attributes.
+Lastly, the C<config> parameter can be a Perl HashRef instead of a file name.
+If this form is used your HashRef should conform to the structure rules defined
+for the JSON representations.
=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);
+ if($params->{excludes} && !$params->{all}) {
+ return DBIx::Class::Exception->throw("'excludes' param only works when using the 'all' param");
}
- 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');
+ my $schema = $params->{schema};
+ my $config;
+ if ($params->{config}) {
+ $config = ref $params->{config} eq 'HASH' ?
+ $params->{config} :
+ do {
+ #read config
+ my $config_file = io->catfile($self->config_dir, $params->{config});
+ $self->load_config_file("$config_file");
+ };
+ } elsif ($params->{all}) {
+ my %excludes = map {$_=>1} @{$params->{excludes}||[]};
+ $config = {
+ might_have => { fetch => 0 },
+ has_many => { fetch => 0 },
+ belongs_to => { fetch => 0 },
+ sets => [
+ map {
+ { class => $_, quantity => 'all' };
+ } grep {
+ !$excludes{$_}
+ } $schema->sources],
+ };
+ } else {
+ DBIx::Class::Exception->throw('must pass config or set all');
}
- my $output_dir = dir($params->{directory});
- unless (-e $output_dir) {
+ my $output_dir = io->dir($params->{directory});
+ unless (-e "$output_dir") {
$output_dir->mkpath ||
- return DBIx::Class::Exception->throw('output directory does not exist at ' . $output_dir);
+ 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 = io->dir(tempdir);
- if (-e $tmp_output_dir) {
+ if (-e "$tmp_output_dir") {
$self->msg("- clearing existing $tmp_output_dir");
$tmp_output_dir->rmtree;
}
$tmp_output_dir->mkpath;
# write version file (for the potential benefit of populate)
- my $version_file = file($tmp_output_dir, '_dumper_version');
- write_file($version_file->stringify, $VERSION);
+ $tmp_output_dir->file('_dumper_version')->print($VERSION);
+
+ # write our current config set
+ $tmp_output_dir->file('_config_set')->print( Dumper $config );
$config->{rules} ||= {};
my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}};
- my %options = ( is_root => 1 );
+
+ while ( my ($k,$v) = each %{ $config->{rules} } ) {
+ if ( my $source = eval { $schema->source($k) } ) {
+ $config->{rules}{$source->source_name} = $v;
+ }
+ }
+
foreach my $source (@sources) {
# apply rule to set if specified
my $rule = $config->{rules}->{$source->{class}};
$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} } );
if ($source->{quantity}) {
- $rs = $rs->search({}, { order_by => $source->{order_by} }) if ($source->{order_by});
- if ($source->{quantity} eq 'all') {
- push (@objects, $rs->all);
- } elsif ($source->{quantity} =~ /^\d+$/) {
- push (@objects, $rs->search({}, { rows => $source->{quantity} }));
- } else {
- DBIx::Class::Exception->throw('invalid value for quantity - ' . $source->{quantity});
+ $rs = $rs->search({}, { order_by => $source->{order_by} })
+ if $source->{order_by};
+
+ if ($source->{quantity} =~ /^\d+$/) {
+ $rs = $rs->search({}, { rows => $source->{quantity} });
+ } elsif ($source->{quantity} ne 'all') {
+ DBIx::Class::Exception->throw("invalid value for quantity - $source->{quantity}");
}
}
- if ($source->{ids}) {
+ elsif ($source->{ids} && @{$source->{ids}}) {
my @ids = @{$source->{ids}};
- my @id_objects = grep { $_ } map { $rs->find($_) } @ids;
- push (@objects, @id_objects);
+ my (@pks) = $rs->result_source->primary_columns;
+ die "Can't dump multiple col-pks using 'id' option" if @pks > 1;
+ $rs = $rs->search_rs( { $pks[0] => { -in => \@ids } } );
}
- unless ($source->{quantity} || $source->{ids}) {
+ else {
DBIx::Class::Exception->throw('must specify either quantity or ids');
}
- # dump objects
- foreach my $object (@objects) {
- $source_options{set_dir} = $tmp_output_dir;
- $self->dump_object($object, { %options, %source_options } );
- next;
- }
+ $source_options{set_dir} = $tmp_output_dir;
+ $self->dump_rs($rs, \%source_options );
}
- foreach my $dir ($output_dir->children) {
- next if ($dir eq $tmp_output_dir);
- $dir->remove || $dir->rmtree;
+ # clear existing output dir
+ foreach my $child ($output_dir->all) {
+ if ($child->is_dir) {
+ next if ("$child" eq "$tmp_output_dir");
+ if (grep { $_ =~ /\.fix/ } $child->all) {
+ $child->rmtree;
+ }
+ } elsif ($child =~ /_dumper_version$/) {
+ $child->unlink;
+ }
}
$self->msg("- moving temp dir to $output_dir");
- move($_, dir($output_dir, $_->relative($_->parent)->stringify)) for $tmp_output_dir->children;
- if (-e $output_dir) {
+ $tmp_output_dir->copy("$output_dir");
+
+ if (-e "$output_dir") {
$self->msg("- clearing tmp dir $tmp_output_dir");
# delete existing fixture set
- $tmp_output_dir->remove;
+ $tmp_output_dir->rmtree;
}
$self->msg("done");
return 1;
}
+sub load_config_file {
+ my ($self, $config_file) = @_;
+ DBIx::Class::Exception->throw("config does not exist at $config_file")
+ unless -e "$config_file";
+
+ my $config = Config::Any::JSON->load($config_file);
+
+ #process includes
+ if (my $incs = $config->{includes}) {
+ $self->msg($incs);
+ DBIx::Class::Exception->throw(
+ 'includes params of config must be an array ref of hashrefs'
+ ) unless ref $incs eq 'ARRAY';
+
+ foreach my $include_config (@$incs) {
+ DBIx::Class::Exception->throw(
+ 'includes params of config must be an array ref of hashrefs'
+ ) unless (ref $include_config eq 'HASH') && $include_config->{file};
+
+ my $include_file = $self->config_dir->file($include_config->{file});
+
+ DBIx::Class::Exception->throw("config does not exist at $include_file")
+ unless -e "$include_file";
+
+ my $include = Config::Any::JSON->load($include_file);
+ $self->msg($include);
+ $config = merge( $config, $include );
+ }
+ delete $config->{includes};
+ }
+
+ # validate config
+ return DBIx::Class::Exception->throw('config has no sets')
+ unless $config && $config->{sets} &&
+ ref $config->{sets} eq 'ARRAY' && scalar @{$config->{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};
+
+ return $config;
+}
+
+sub dump_rs {
+ my ($self, $rs, $params) = @_;
+
+ while (my $row = $rs->next) {
+ $self->dump_object($row, $params);
+ }
+}
+
sub dump_object {
- my ($self, $object, $params, $rr_info) = @_;
+ my ($self, $object, $params) = @_;
my $set = $params->{set};
+
+ my $v = Data::Visitor::Callback->new(
+ plain_value => sub {
+ my ($visitor, $data) = @_;
+ my $subs = {
+ ENV => sub {
+ my ( $self, $v ) = @_;
+ if (! defined($ENV{$v})) {
+ return "";
+ } else {
+ return $ENV{ $v };
+ }
+ },
+ ATTR => sub {
+ my ($self, $v) = @_;
+ if(my $attr = $self->config_attrs->{$v}) {
+ return $attr;
+ } else {
+ return "";
+ }
+ },
+ catfile => sub {
+ my ($self, @args) = @_;
+ "".io->catfile(@args);
+ },
+ catdir => sub {
+ my ($self, @args) = @_;
+ "".io->catdir(@args);
+ },
+ };
+
+ my $subsre = join( '|', keys %$subs );
+ $_ =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $self, $2 ? split( /,/, $2 ) : () ) }eg;
+
+ return $_;
+ }
+ );
+
+ $v->visit( $set );
+
die 'no dir passed to dump_object' unless $params->{set_dir};
die 'no object passed to dump_object' unless $object;
my @inherited_attrs = @{$self->_inherited_attributes};
+ my @pk_vals = map {
+ $object->get_column($_)
+ } $object->primary_columns;
+
+ my $key = join("\0", @pk_vals);
+
+ my $src = $object->result_source;
+ my $exists = $self->dumped_objects->{$src->name}{$key}++;
+
+
# 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');
+ my $source_dir = io->catdir($params->{set_dir}, $self->_name_for_source($src));
+ $source_dir->mkpath(0, 0777);
+
+ # Convert characters not allowed on windows
+ my $file = io->catfile("$source_dir",
+ join('-', map { s|[/\\:\*\|\?"<>]|_|g; $_; } @pk_vals) . '.fix'
+ );
# write file
- my $exists = (-e $file->stringify) ? 1 : 0;
unless ($exists) {
- $self->msg('-- dumping ' . $file->stringify, 2);
+ $self->msg('-- dumping ' . "$file", 2);
my %ds = $object->get_columns;
- my $formatter= $object->result_source->schema->storage->datetime_parser;
+ if($set->{external}) {
+ foreach my $field (keys %{$set->{external}}) {
+ my $key = $ds{$field};
+ my ($plus, $class) = ( $set->{external}->{$field}->{class}=~/^(\+)*(.+)$/);
+ my $args = $set->{external}->{$field}->{args};
+
+ $class = "DBIx::Class::Fixtures::External::$class" unless $plus;
+ eval "use $class";
+
+ $ds{external}->{$field} =
+ encode_base64( $class
+ ->backup($key => $args),'');
+ }
+ }
+
# mess with dates if specified
if ($set->{datetime_relative}) {
+ my $formatter= $object->result_source->schema->storage->datetime_parser;
unless ($@ || !$formatter) {
my $dt;
if ($set->{datetime_relative} eq 'today') {
next unless $value
&& $col_info->{_inflate_info}
- && uc($col_info->{data_type}) eq 'DATETIME';
+ && (
+ (uc($col_info->{data_type}) eq 'DATETIME')
+ or (uc($col_info->{data_type}) eq 'DATE')
+ or (uc($col_info->{data_type}) eq 'TIME')
+ or (uc($col_info->{data_type}) eq 'TIMESTAMP')
+ or (uc($col_info->{data_type}) eq 'INTERVAL')
+ );
$ds{$col} = $object->get_inflated_column($col)->subtract_datetime($dt);
}
# do the actual dumping
my $serialized = Dump(\%ds)->Out();
- write_file($file->stringify, $serialized);
- my $mode = 0777; chmod $mode, $file->stringify;
+
+ $file->print($serialized);
}
+ # don't bother looking at rels unless we are actually planning to dump at least one type
+ my ($might_have, $belongs_to, $has_many) = map {
+ $set->{$_}{fetch} || $set->{rules}{$src->source_name}{$_}{fetch}
+ } qw/might_have belongs_to has_many/;
+
+ return unless $might_have
+ || $belongs_to
+ || $has_many
+ || $set->{fetch};
+
# dump rels of object
- my $s = $object->result_source;
unless ($exists) {
- foreach my $name (sort $s->relationships) {
- my $info = $s->relationship_info($name);
- my $r_source = $s->related_source($name);
- # if belongs_to or might_have with might_have param set or has_many with has_many param set then
- 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}))) {
- my $related_rs = $object->related_resultset($name);
+ foreach my $name (sort $src->relationships) {
+ my $info = $src->relationship_info($name);
+ my $r_source = $src->related_source($name);
+ # if belongs_to or might_have with might_have param set or has_many with
+ # has_many param set then
+ if (
+ ( $info->{attrs}{accessor} eq 'single' &&
+ (!$info->{attrs}{join_type} || $might_have)
+ )
+ || $info->{attrs}{accessor} eq 'filter'
+ ||
+ ($info->{attrs}{accessor} eq 'multi' && $has_many)
+ ) {
+ my $related_rs = $object->related_resultset($name);
my $rule = $set->{rules}->{$related_rs->result_source->source_name};
# these parts of the rule only apply to has_many rels
- if ($rule && $info->{attrs}{accessor} eq 'multi') {
- $related_rs = $related_rs->search($rule->{cond}, { join => $rule->{join} }) if ($rule->{cond});
- $related_rs = $related_rs->search({}, { rows => $rule->{quantity} }) if ($rule->{quantity} && $rule->{quantity} ne 'all');
- $related_rs = $related_rs->search({}, { order_by => $rule->{order_by} }) if ($rule->{order_by});
+ if ($rule && $info->{attrs}{accessor} eq 'multi') {
+ $related_rs = $related_rs->search(
+ $rule->{cond},
+ { join => $rule->{join} }
+ ) if ($rule->{cond});
+
+ $related_rs = $related_rs->search(
+ {},
+ { rows => $rule->{quantity} }
+ ) if ($rule->{quantity} && $rule->{quantity} ne 'all');
+
+ $related_rs = $related_rs->search(
+ {},
+ { order_by => $rule->{order_by} }
+ ) if ($rule->{order_by});
+
}
- if ($set->{has_many}->{quantity} && $set->{has_many}->{quantity} =~ /^\d+$/) {
- $related_rs = $related_rs->search({}, { rows => $set->{has_many}->{quantity} });
+ if ($set->{has_many}{quantity} &&
+ $set->{has_many}{quantity} =~ /^\d+$/) {
+ $related_rs = $related_rs->search(
+ {},
+ { rows => $set->{has_many}->{quantity} }
+ );
}
+
my %c_params = %{$params};
# inherit date param
- my %mock_set = map { $_ => $set->{$_} } grep { $set->{$_} } @inherited_attrs;
+ my %mock_set = map {
+ $_ => $set->{$_}
+ } grep { $set->{$_} } @inherited_attrs;
+
$c_params{set} = \%mock_set;
- # use Data::Dumper; print ' -- ' . Dumper($c_params{set}, $rule->{fetch}) if ($rule && $rule->{fetch});
- $c_params{set} = merge( $c_params{set}, $rule) if ($rule && $rule->{fetch});
- # use Data::Dumper; print ' -- ' . Dumper(\%c_params) if ($rule && $rule->{fetch});
- $self->dump_object($_, \%c_params) foreach $related_rs->all;
- }
+ $c_params{set} = merge( $c_params{set}, $rule)
+ if $rule && $rule->{fetch};
+
+ $self->dump_rs($related_rs, \%c_params);
+ }
}
}
-
+
return unless $set && $set->{fetch};
foreach my $fetch (@{$set->{fetch}}) {
# inherit date param
- $fetch->{$_} = $set->{$_} foreach grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs;
+ $fetch->{$_} = $set->{$_} foreach
+ grep { !$fetch->{$_} && $set->{$_} } @inherited_attrs;
my $related_rs = $object->related_resultset($fetch->{rel});
my $rule = $set->{rules}->{$related_rs->result_source->source_name};
+
if ($rule) {
my $info = $object->result_source->relationship_info($fetch->{rel});
if ($info->{attrs}{accessor} eq 'multi') {
} elsif ($rule->{fetch}) {
$fetch = merge( $fetch, { fetch => $rule->{fetch} } );
}
- }
- die "relationship " . $fetch->{rel} . " does not exist for " . $s->source_name unless ($related_rs);
+ }
+
+ die "relationship $fetch->{rel} does not exist for " . $src->source_name
+ unless ($related_rs);
+
if ($fetch->{cond} and ref $fetch->{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
- $fetch->{cond} = { map { $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_} : $fetch->{cond}->{$_} } keys %{$fetch->{cond}} };
+ # if value starts with \ assume it's meant to be passed as a scalar ref
+ # to dbic. ideally this would substitute deeply
+ $fetch->{cond} = { map {
+ $_ => ($fetch->{cond}->{$_} =~ s/^\\//) ? \$fetch->{cond}->{$_}
+ : $fetch->{cond}->{$_}
+ } keys %{$fetch->{cond}} };
}
- $related_rs = $related_rs->search($fetch->{cond}, { join => $fetch->{join} }) if ($fetch->{cond});
- $related_rs = $related_rs->search({}, { rows => $fetch->{quantity} }) if ($fetch->{quantity} && $fetch->{quantity} ne 'all');
- $related_rs = $related_rs->search({}, { order_by => $fetch->{order_by} }) if ($fetch->{order_by});
- $self->dump_object($_, { %{$params}, set => $fetch }) foreach $related_rs->all;
+
+ $related_rs = $related_rs->search(
+ $fetch->{cond},
+ { join => $fetch->{join} }
+ ) if $fetch->{cond};
+
+ $related_rs = $related_rs->search(
+ {},
+ { rows => $fetch->{quantity} }
+ ) if $fetch->{quantity} && $fetch->{quantity} ne 'all';
+ $related_rs = $related_rs->search(
+ {},
+ { order_by => $fetch->{order_by} }
+ ) if $fetch->{order_by};
+
+ $self->dump_rs($related_rs, { %{$params}, set => $fetch });
}
}
my $params = shift || {};
require DBI;
$self->msg("\ncreating schema");
- # die 'must pass version param to generate_schema_from_ddl' unless $params->{version};
my $schema_class = $self->schema_class || "DBIx::Class::Fixtures::Schema";
eval "require $schema_class";
my $pre_schema;
my $connection_details = $params->{connection_details};
+
$namespace_counter++;
- my $namespace = "DBIx::Class::Fixtures::GeneratedSchema_" . $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 { $self->_name_for_source($pre_schema->source($_)) } $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);
+ $pre_schema->storage->txn_do(sub {
+ $pre_schema->storage->with_deferred_fk_checks(sub {
+ 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 $data = _read_sql($ddl_file);
+ foreach (@$data) {
+ eval { $dbh->do($_) or warn "SQL was:\n $_"};
+ if ($@ && !$self->{ignore_sql_errors}) { die "SQL was:\n $_\n$@"; }
+ }
+ $self->msg("- finished importing DDL into DB");
+
+ # load schema object from our new DB
+ $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 = split(/;/, join('', @data));
close($fh);
@data = grep { $_ && $_ !~ /^-- / } @data;
- for (@data) {
- eval { $dbh->do($_) or warn "SQL was:\n $_"};
- if ($@) { die "SQL was:\n $_\n$@"; }
- }
- $self->msg("- finished importing DDL into DB");
+ return \@data;
+}
- # load schema object from our new DB
- $self->msg("- loading fresh DBIC object from DB");
- my $schema = $namespace->connect(@{$connection_details});
- return $schema;
+=head2 dump_config_sets
+
+Works just like L</dump> but instead of specifying a single json config set
+located in L</config_dir> we dump each set named in the C<configs> parameter.
+
+The parameters are the same as for L</dump> except instead of a C<directory>
+parameter we have a C<directory_template> which is a coderef expected to return
+a scalar that is a root directory where we will do the actual dumping. This
+coderef get three arguments: C<$self>, C<$params> and C<$set_name>. For
+example:
+
+ $fixture->dump_all_config_sets({
+ schema => $schema,
+ configs => [qw/one.json other.json/],
+ directory_template => sub {
+ my ($fixture, $params, $set) = @_;
+ return io->catdir('var', 'fixtures', $params->{schema}->version, $set);
+ },
+ });
+
+=cut
+
+sub dump_config_sets {
+ my ($self, $params) = @_;
+ my $available_config_sets = delete $params->{configs};
+ my $directory_template = delete $params->{directory_template} ||
+ DBIx::Class::Exception->throw("'directory_template is required parameter");
+
+ for my $set (@$available_config_sets) {
+ my $localparams = $params;
+ $localparams->{directory} = $directory_template->($self, $localparams, $set);
+ $localparams->{config} = $set;
+ $self->dump($localparams);
+ $self->dumped_objects({}); ## Clear dumped for next go, if there is one!
+ }
}
+=head2 dump_all_config_sets
+
+ my %local_params = %$params;
+ my $local_self = bless { %$self }, ref($self);
+ $local_params{directory} = $directory_template->($self, \%local_params, $set);
+ $local_params{config} = $set;
+ $self->dump(\%local_params);
+
+
+Works just like L</dump> but instead of specifying a single json config set
+located in L</config_dir> we dump each set in turn to the specified directory.
+
+The parameters are the same as for L</dump> except instead of a C<directory>
+parameter we have a C<directory_template> which is a coderef expected to return
+a scalar that is a root directory where we will do the actual dumping. This
+coderef get three arguments: C<$self>, C<$params> and C<$set_name>. For
+example:
+
+ $fixture->dump_all_config_sets({
+ schema => $schema,
+ directory_template => sub {
+ my ($fixture, $params, $set) = @_;
+ return io->catdir('var', 'fixtures', $params->{schema}->version, $set);
+ },
+ });
+
+=cut
+
+sub dump_all_config_sets {
+ my ($self, $params) = @_;
+ $self->dump_config_sets({
+ %$params,
+ configs=>[$self->available_config_sets],
+ });
+}
=head2 populate
=back
- $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
- });
+ $fixtures->populate( {
+ # directory to look for fixtures in, as specified to dump
+ directory => '/home/me/app/fixtures',
+
+ # DDL to deploy
+ ddl => '/home/me/app/sql/ddl.sql',
+
+ # database to clear, deploy and then populate
+ connection_details => ['dbi:mysql:dbname=app_dev', 'me', 'password'],
+
+ # DDL to deploy after populating records, ie. FK constraints
+ post_ddl => '/home/me/app/sql/post_ddl.sql',
+
+ # use CASCADE option when dropping tables
+ cascade => 1,
+
+ # optional, set to 1 to run ddl but not populate
+ no_populate => 0,
-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 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.
+ # optional, set to 1 to run each fixture through ->create rather than have
+ # each $rs populated using $rs->populate. Useful if you have overridden new() logic
+ # that effects the value of column(s).
+ use_create => 0,
-directory, dll and connection_details are all required attributes.
+ # optional, same as use_create except with find_or_create.
+ # Useful if you are populating a persistent data store.
+ use_find_or_create => 0,
+
+ # Dont try to clean the database, just populate over whats there. Requires
+ # schema option. Use this if you want to handle removing old data yourself
+ # no_deploy => 1
+ # schema => $schema
+ } );
+
+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 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'.
+
+C<directory> is a required attribute.
+
+If you wish for DBIx::Class::Fixtures to clear the database for you pass in
+C<dll> (path to a DDL sql file) and C<connection_details> (array ref of DSN,
+user and pass).
+
+If you wish to deal with cleaning the schema yourself, then pass in a C<schema>
+attribute containing the connected schema you wish to operate on and set the
+C<no_deploy> attribute.
=cut
sub populate {
my $self = shift;
my ($params) = @_;
- unless (ref $params eq 'HASH') {
- return DBIx::Class::Exception->throw('first arg to populate must be hash ref');
- }
+ DBIx::Class::Exception->throw('first arg to populate must be hash ref')
+ unless ref $params eq 'HASH';
- foreach my $param (qw/directory/) {
- unless ($params->{$param}) {
- return DBIx::Class::Exception->throw($param . ' param not specified');
- }
- }
- my $fixture_dir = dir(delete $params->{directory});
- unless (-e $fixture_dir) {
- return DBIx::Class::Exception->throw('fixture directory does not exist at ' . $fixture_dir);
- }
+ DBIx::Class::Exception->throw('directory param not specified')
+ unless $params->{directory};
+
+ my $fixture_dir = io->dir(delete $params->{directory});
+ DBIx::Class::Exception->throw("fixture directory '$fixture_dir' does not exist")
+ unless -d "$fixture_dir";
my $ddl_file;
- my $dbh;
+ my $dbh;
+ my $schema;
if ($params->{ddl} && $params->{connection_details}) {
- $ddl_file = file(delete $params->{ddl});
- unless (-e $ddl_file) {
+ $ddl_file = io->file(delete $params->{ddl});
+ unless (-e "$ddl_file") {
return DBIx::Class::Exception->throw('DDL does not exist at ' . $ddl_file);
}
unless (ref $params->{connection_details} eq 'ARRAY') {
return DBIx::Class::Exception->throw('connection details must be an arrayref');
}
- } elsif ($params->{schema}) {
- return DBIx::Class::Exception->throw('passing a schema is not supported at the moment');
+ $schema = $self->_generate_schema({
+ ddl => "$ddl_file",
+ connection_details => delete $params->{connection_details},
+ %{$params}
+ });
+ } elsif ($params->{schema} && $params->{no_deploy}) {
+ $schema = $params->{schema};
} else {
- return DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
+ DBIx::Class::Exception->throw('you must set the ddl and connection_details params');
}
- my $schema = $self->_generate_schema({ ddl => $ddl_file, connection_details => delete $params->{connection_details}, %{$params} });
+
+ return 1 if $params->{no_populate};
+
$self->msg("\nimporting fixtures");
- my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
+ my $tmp_fixture_dir = io->dir(tempdir());
+ my $config_set_path = io->file($fixture_dir, '_config_set');
+ my $config_set = -e "$config_set_path" ? do { my $VAR1; eval($config_set_path->slurp); $VAR1 } : '';
+
+ my $v = Data::Visitor::Callback->new(
+ plain_value => sub {
+ my ($visitor, $data) = @_;
+ my $subs = {
+ ENV => sub {
+ my ( $self, $v ) = @_;
+ if (! defined($ENV{$v})) {
+ return "";
+ } else {
+ return $ENV{ $v };
+ }
+ },
+ ATTR => sub {
+ my ($self, $v) = @_;
+ if(my $attr = $self->config_attrs->{$v}) {
+ return $attr;
+ } else {
+ return "";
+ }
+ },
+ catfile => sub {
+ my ($self, @args) = @_;
+ io->catfile(@args);
+ },
+ catdir => sub {
+ my ($self, @args) = @_;
+ io->catdir(@args);
+ },
+ };
+
+ my $subsre = join( '|', keys %$subs );
+ $_ =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $self, $2 ? split( /,/, $2 ) : () ) }eg;
+
+ return $_;
+ }
+ );
+
+ $v->visit( $config_set );
+
- my $version_file = file($fixture_dir, '_dumper_version');
- unless (-e $version_file) {
-# return DBIx::Class::Exception->throw('no version file found');
+ my %sets_by_src;
+ if($config_set) {
+ %sets_by_src = map { delete($_->{class}) => $_ }
+ @{$config_set->{sets}}
}
- if (-e $tmp_fixture_dir) {
+ if (-e "$tmp_fixture_dir") {
$self->msg("- deleting existing temp directory $tmp_fixture_dir");
$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;
+ $tmp_fixture_dir->mkpath();
+ for ( map { $self->_name_for_source($schema->source($_)) } $schema->sources) {
+ my $from_dir = io->catdir($fixture_dir, $_);
+ next unless -e "$from_dir";
+ $from_dir->copy( io->catdir($tmp_fixture_dir, $_)."" );
+ }
- eval { $schema->storage->dbh->do('SET foreign_key_checks=0') };
+ unless (-d "$tmp_fixture_dir") {
+ DBIx::Class::Exception->throw("Unable to create temporary fixtures dir: $tmp_fixture_dir: $!");
+ }
my $fixup_visitor;
- my $formatter= $schema->storage->datetime_parser;
+ my $formatter = $schema->storage->datetime_parser;
unless ($@ || !$formatter) {
my %callbacks;
if ($params->{datetime_relative_to}) {
$formatter->format_datetime(DateTime->today->add_duration($_))
};
}
- $callbacks{object} ||= "visit_ref";
+ $callbacks{object} ||= "visit_ref";
$fixup_visitor = new Data::Visitor::Callback(%callbacks);
}
- foreach my $source (sort $schema->sources) {
- $self->msg("- adding " . $source);
- my $rs = $schema->resultset($source);
- my $source_dir = dir($tmp_fixture_dir, lc($rs->result_source->from));
- next unless (-e $source_dir);
- while (my $file = $source_dir->next) {
- next unless ($file =~ /\.fix$/);
- next if $file->is_dir;
- my $contents = $file->slurp;
- my $HASH1;
- eval($contents);
- $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
- $rs->create($HASH1);
- }
- }
+
+ $schema->storage->txn_do(sub {
+ $schema->storage->with_deferred_fk_checks(sub {
+ my @sorted_source_names = $self->_get_sorted_sources( $schema );
+ foreach my $source (@sorted_source_names) {
+ $self->msg("- adding " . $source);
+ my $rs = $schema->resultset($source);
+ my $source_dir = io->catdir($tmp_fixture_dir, $self->_name_for_source($rs->result_source));
+ next unless (-e "$source_dir");
+ my @rows;
+ while (my $file = $source_dir->next) {
+ next unless ($file =~ /\.fix$/);
+ next if $file->is_dir;
+ my $contents = $file->slurp;
+ my $HASH1;
+ eval($contents);
+ $HASH1 = $fixup_visitor->visit($HASH1) if $fixup_visitor;
+ if(my $external = delete $HASH1->{external}) {
+ my @fields = keys %{$sets_by_src{$source}->{external}};
+ foreach my $field(@fields) {
+ my $key = $HASH1->{$field};
+ my $content = decode_base64 ($external->{$field});
+ my $args = $sets_by_src{$source}->{external}->{$field}->{args};
+ my ($plus, $class) = ( $sets_by_src{$source}->{external}->{$field}->{class}=~/^(\+)*(.+)$/);
+ $class = "DBIx::Class::Fixtures::External::$class" unless $plus;
+ eval "use $class";
+ $class->restore($key, $content, $args);
+ }
+ }
+ if ( $params->{use_create} ) {
+ $rs->create( $HASH1 );
+ } elsif( $params->{use_find_or_create} ) {
+ $rs->find_or_create( $HASH1 );
+ } else {
+ push(@rows, $HASH1);
+ }
+ }
+ $rs->populate(\@rows) if scalar(@rows);
+
+ ## Now we need to do some db specific cleanup
+ ## this probably belongs in a more isolated space. Right now this is
+ ## to just handle postgresql SERIAL types that use Sequences
+
+ my $table = $rs->result_source->name;
+ for my $column(my @columns = $rs->result_source->columns) {
+ my $info = $rs->result_source->column_info($column);
+ if(my $sequence = $info->{sequence}) {
+ $self->msg("- updating sequence $sequence");
+ $rs->result_source->storage->dbh_do(sub {
+ my ($storage, $dbh, @cols) = @_;
+ $self->msg(my $sql = "SELECT setval('${sequence}', (SELECT max($column) FROM ${table}));");
+ my $sth = $dbh->prepare($sql);
+ my $rv = $sth->execute or die $sth->errstr;
+ $self->msg("- $sql");
+ });
+ }
+ }
+
+ }
+ });
+ });
+ $self->do_post_ddl( {
+ schema=>$schema,
+ post_ddl=>$params->{post_ddl}
+ } ) if $params->{post_ddl};
$self->msg("- fixtures imported");
$self->msg("- cleaning up");
$tmp_fixture_dir->rmtree;
- eval { $schema->storage->dbh->do('SET foreign_key_checks=1') };
-
return 1;
}
+# the overall logic is modified from SQL::Translator::Parser::DBIx::Class->parse
+sub _get_sorted_sources {
+ my ( $self, $dbicschema ) = @_;
+
+
+ my %table_monikers = map { $_ => 1 } $dbicschema->sources;
+
+ my %tables;
+ foreach my $moniker (sort keys %table_monikers) {
+ my $source = $dbicschema->source($moniker);
+
+ my $table_name = $source->name;
+ my @primary = $source->primary_columns;
+ my @rels = $source->relationships();
+
+ my %created_FK_rels;
+ foreach my $rel (sort @rels) {
+ my $rel_info = $source->relationship_info($rel);
+
+ # Ignore any rel cond that isn't a straight hash
+ next unless ref $rel_info->{cond} eq 'HASH';
+
+ my @keys = map {$rel_info->{cond}->{$_} =~ /^\w+\.(\w+)$/} keys(%{$rel_info->{cond}});
+
+ # determine if this relationship is a self.fk => foreign.pk (i.e. belongs_to)
+ my $fk_constraint;
+ if ( exists $rel_info->{attrs}{is_foreign_key_constraint} ) {
+ $fk_constraint = $rel_info->{attrs}{is_foreign_key_constraint};
+ } elsif ( $rel_info->{attrs}{accessor}
+ && $rel_info->{attrs}{accessor} eq 'multi' ) {
+ $fk_constraint = 0;
+ } else {
+ $fk_constraint = not $source->_compare_relationship_keys(\@keys, \@primary);
+ }
+
+ # Dont add a relation if its not constraining
+ next unless $fk_constraint;
+
+ my $rel_table = $source->related_source($rel)->source_name;
+ # Make sure we don't create the same relation twice
+ my $key_test = join("\x00", sort @keys);
+ next if $created_FK_rels{$rel_table}->{$key_test};
+
+ if (scalar(@keys)) {
+ $created_FK_rels{$rel_table}->{$key_test} = 1;
+
+ # calculate dependencies: do not consider deferrable constraints and
+ # self-references for dependency calculations
+ if (! $rel_info->{attrs}{is_deferrable} and $rel_table ne $table_name) {
+ $tables{$moniker}{$rel_table}++;
+ }
+ }
+ }
+ $tables{$moniker} = {} unless exists $tables{$moniker};
+ }
+
+ # resolve entire dep tree
+ my $dependencies = {
+ map { $_ => _resolve_deps ($_, \%tables) } (keys %tables)
+ };
+
+ # return the sorted result
+ return sort {
+ keys %{$dependencies->{$a} || {} } <=> keys %{ $dependencies->{$b} || {} }
+ ||
+ $a cmp $b
+ } (keys %tables);
+}
+
+sub _resolve_deps {
+ my ( $question, $answers, $seen ) = @_;
+ my $ret = {};
+ $seen ||= {};
+
+ my %seen = map { $_ => $seen->{$_} + 1 } ( keys %$seen );
+ $seen{$question} = 1;
+
+ for my $dep (keys %{ $answers->{$question} }) {
+ return {} if $seen->{$dep};
+ my $subdeps = _resolve_deps( $dep, $answers, \%seen );
+ $ret->{$_} += $subdeps->{$_} for ( keys %$subdeps );
+ ++$ret->{$dep};
+ }
+ return $ret;
+}
+
+sub do_post_ddl {
+ my ($self, $params) = @_;
+
+ my $schema = $params->{schema};
+ my $data = _read_sql($params->{post_ddl});
+ foreach (@$data) {
+ eval { $schema->storage->dbh->do($_) or warn "SQL was:\n $_"};
+ if ($@ && !$self->{ignore_sql_errors}) { die "SQL was:\n $_\n$@"; }
+ }
+ $self->msg("- finished importing post-populate DDL into DB");
+}
+
sub msg {
my $self = shift;
my $subject = shift || return;
my $level = shift || 1;
-
return unless $self->debug >= $level;
if (ref $subject) {
print Dumper($subject);
}
}
+# Helper method for ensuring that the name used for a given source
+# is always the same (This is used to name the fixture directories
+# for example)
+
+sub _name_for_source {
+ my ($self, $source) = @_;
+
+ return ref $source->name ? $source->source_name : $source->name;
+}
+
=head1 AUTHOR
Luke Saunders <luke@shadowcatsystems.co.uk>
=head1 CONTRIBUTORS
Ash Berlin <ash@shadowcatsystems.co.uk>
+
Matt S. Trout <mst@shadowcatsystems.co.uk>
+ Drew Taylor <taylor.andrew.j@gmail.com>
+
+ Frank Switalski <fswitalski@gmail.com>
+
+ Chris Akins <chris.hexx@gmail.com>
+
=head1 LICENSE
This library is free software under the same license as perl itself
projects / dbsrgits/DBIx-Class-Fixtures.git / blobdiff