document the `excludes` option for dump
[dbsrgits/DBIx-Class-Fixtures.git] / lib / DBIx / Class / Fixtures.pm
index ca67622..7a2c4af 100644 (file)
@@ -23,7 +23,7 @@ our $namespace_counter = 0;
 __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
     _inherited_attributes debug schema_class dumped_objects config_attrs/);
 
-our $VERSION = '1.001_029';
+our $VERSION = '1.001037';
 
 $VERSION = eval $VERSION;
 
@@ -557,7 +557,8 @@ or
  $fixtures->dump({
    all => 1, # just dump everything that's in the schema
    schema => $source_dbic_schema,
-   directory => '/home/me/app/fixtures' # output directory
+   directory => '/home/me/app/fixtures', # output directory
+   #excludes => [ qw/Foo MyView/ ], # optionally exclude certain sources
  });
 
 In this case objects will be dumped to subdirectories in the specified
@@ -567,9 +568,14 @@ directory. For example:
  /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
+C<schema> and C<directory> are required attributes. also, one of C<config> or C<all> must
 be specified.
 
+The optional parameter C<excludes> takes an array ref of source names and can be
+used to exclue those sources when dumping the whole schema. This is useful if
+you have views in there, since those do not need fixtures and will currently result
+in an error when they are created and then used with C<populate>.
+
 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.
@@ -848,7 +854,14 @@ sub dump_object {
   # write file
   unless ($exists) {
     $self->msg('-- dumping ' . "$file", 2);
-    my %ds = $object->get_columns;
+
+    # get_columns will return virtual columns; we just want stored columns.
+    # columns_info keys seems to be the actual storage column names, so we'll
+    # use that.
+    my $col_info = $src->columns_info;
+    my @column_names = keys %$col_info;
+    my %columns = $object->get_columns;
+    my %ds; @ds{@column_names} = @columns{@column_names};
 
     if($set->{external}) {
       foreach my $field (keys %{$set->{external}}) {
@@ -1394,6 +1407,8 @@ sub populate {
         ## 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
+        ## Will completely ignore sequences in Oracle due to having to drop
+        ## and recreate them
 
         my $table = $rs->result_source->name;
         for my $column(my @columns =  $rs->result_source->columns) {
@@ -1402,10 +1417,18 @@ sub populate {
              $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");
+              if ( $dbh->{Driver}->{Name} eq "Oracle" ) {
+                $self->msg("- Cannot change sequence values in Oracle");
+              } else {
+                $self->msg(
+         my $sql = sprintf("SELECT setval(?, (SELECT max(%s) FROM %s));",$dbh->quote_identifier($column),$dbh->quote_identifier($table))
+             );
+                my $sth = $dbh->prepare($sql);
+                   $sth->bind_param(1,$sequence);
+
+                my $rv = $sth->execute or die $sth->errstr;
+                $self->msg("- $sql");
+              }
             });
           }
         }
@@ -1556,16 +1579,22 @@ sub _name_for_source {
 
   Matt S. Trout <mst@shadowcatsystems.co.uk>
 
+  John Napiorkowski <jjnapiork@cpan.org>
+
   Drew Taylor <taylor.andrew.j@gmail.com>
 
   Frank Switalski <fswitalski@gmail.com>
 
   Chris Akins <chris.hexx@gmail.com>
 
+  Tom Bloor <t.bloor@shadowcat.co.uk>
+
+  Samuel Kaufman <skaufman@cpan.org>
+
 =head1 LICENSE
 
   This library is free software under the same license as perl itself
 
 =cut
 
-1;
+1;
\ No newline at end of file