docs and config substitutions
John Napiorkowski [Mon, 13 Feb 2012 16:42:36 +0000 (11:42 -0500)]
Makefile.PL
lib/DBIx/Class/Fixtures.pm
lib/DBIx/Class/Fixtures/External/File.pm
t/18-extra.t
t/var/configs/extra.json

index 77a9dbb..42bff91 100644 (file)
@@ -16,12 +16,15 @@ requires 'JSON::Syck' => 0.26;
 requires 'Data::Dump::Streamer' => 2.05;
 requires 'Hash::Merge' => 0.10;
 requires 'Scalar::Util';
+requires 'MIME::Base64';
+requires 'File::Spec::Functions';
 
 requires 'DateTime::Format::SQLite' => 0.10;
 requires 'DateTime::Format::MySQL' => 0;
 requires 'DateTime::Format::Pg' => 0;
 
-build_requires 'Test::More'       => 0.7;
+test_requires 'Test::More';
+test_requires 'DBIx::Class::InflateColumn::FS';
 
 tests_recursive();
 
index 50b9fdf..aef6647 100644 (file)
@@ -7,6 +7,7 @@ use DBIx::Class 0.08100;
 use DBIx::Class::Exception;
 use Class::Accessor::Grouped;
 use Path::Class qw(dir file);
+use File::Spec::Functions 'catfile', 'catdir';
 use Config::Any::JSON;
 use Data::Dump::Streamer;
 use Data::Visitor::Callback;
@@ -16,13 +17,14 @@ use File::Copy qw/move/;
 use Hash::Merge qw( merge );
 use Data::Dumper;
 use Class::C3::Componentised;
+use MIME::Base64;
 
 use base qw(Class::Accessor::Grouped);
 
 our $namespace_counter = 0;
 
 __PACKAGE__->mk_group_accessors( 'simple' => qw/config_dir
-    _inherited_attributes debug schema_class dumped_objects/);
+    _inherited_attributes debug schema_class dumped_objects config_attrs/);
 
 =head1 VERSION
 
@@ -30,7 +32,7 @@ Version 1.001013
 
 =cut
 
-our $VERSION = '1.001013';
+our $VERSION = '1.001014';
 
 =head1 NAME
 
@@ -343,6 +345,40 @@ 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:
+
+    "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
 
 =head2 cond
@@ -365,6 +401,34 @@ Same as with L</SET 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
+
+=heade catdir
+
+Create the path to a directory from a list
+
 =head1 METHODS
 
 =head2 new
@@ -395,6 +459,32 @@ determines whether to be verbose
 
 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( {
@@ -426,7 +516,8 @@ sub new {
               debug => $params->{debug} || 0,
               ignore_sql_errors => $params->{ignore_sql_errors},
               dumped_objects => {},
-              use_create => $params->{use_create} || 0
+              use_create => $params->{use_create} || 0,
+              config_attrs => $params->{config_attrs} || {},
   };
 
   bless $self, $class;
@@ -557,6 +648,11 @@ sub dump {
                  ->openw
                  ->print($VERSION);
 
+  # write our current config set
+  $tmp_output_dir->file('_config_set')
+                 ->openw
+                 ->print( Dumper $config );
+
   $config->{rules} ||= {};
   my @sources = sort { $a->{class} cmp $b->{class} } @{delete $config->{sets}};
 
@@ -696,6 +792,46 @@ sub dump_rs {
 sub dump_object {
   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) = @_;
+          catfile(@args);
+        },
+        catdir => sub {
+          my ($self, @args) = @_;
+          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;
 
@@ -720,12 +856,26 @@ sub dump_object {
       join('-', map { s|[/\\]|_|g; $_; } @pk_vals) . '.fix'
   );
 
-
   # write file
   unless ($exists) {
     $self->msg('-- dumping ' . $file->stringify, 2);
     my %ds = $object->get_columns;
 
+    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;
@@ -1122,6 +1272,55 @@ sub populate {
   $self->msg("\nimporting fixtures");
   my $tmp_fixture_dir = dir($fixture_dir, "-~populate~-" . $<);
   my $version_file = file($fixture_dir, '_dumper_version');
+  my $config_set_path = 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) = @_;
+          catfile(@args);
+        },
+        catdir => sub {
+          my ($self, @args) = @_;
+          catdir(@args);
+        },
+      };
+
+      my $subsre = join( '|', keys %$subs ); 
+      $_ =~ s{__($subsre)(?:\((.+?)\))?__}{ $subs->{ $1 }->( $self, $2 ? split( /,/, $2 ) : () ) }eg;
+
+      return $_;
+    }
+  );
+  
+  $v->visit( $config_set );
+
+
+  my %sets_by_src;
+  if($config_set) {
+    %sets_by_src = map { delete($_->{class}) => $_ }
+      @{$config_set->{sets}}
+  }
+
 #  DBIx::Class::Exception->throw('no version file found');
 #    unless -e $version_file;
 
@@ -1173,6 +1372,18 @@ sub populate {
           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 );
           } else {
index 13ff2eb..97fd5fb 100644 (file)
@@ -21,16 +21,84 @@ sub _save {
   close($fh);
 }
 
-sub fetch {
+sub backup {
   my ($class, $key, $args) = @_;
   my $path = catfile($args->{path}, $key);
-  return my $fetched = $class->_load($path);
+  return $class->_load($path);
 }
 
-sub write {
+sub restore {
   my ($class, $key, $content, $args) = @_;
   my $path = catfile($args->{path}, $key);
   $class->_save($path, $content);
 }
 
 1;
+
+=head1 NAME
+
+DBIx::Class::Fixtures::External::File - save and restore external data
+
+=head1 SYNOPSIS
+
+    my $fixtures = DBIx::Class::Fixtures
+      ->new({
+        config_dir => 't/var/configs',
+        config_attrs => { photo_dir => './t/var/files' });
+
+    {
+        "sets": [{
+            "class": "Photo",
+            "quantity": "all",
+            "external": {
+                "file": {
+                    "class": "File",
+                    "args": {"path":"__ATTR(photo_dir)__"}
+                }
+            }
+        }]
+    }
+
+=head1 DESCRIPTION
+
+Sometimes your database fields are pointers to external data.  The classic
+example is you are using L<DBIx::Class::InflateColumn::FS> to manage blob
+data.  In these cases it may be desirable to backup and restore the external
+data via fixtures.
+
+This module performs this function and can also serve as an example for your
+possible custom needs.
+
+=head1 METHODS
+
+This module defines the following methods
+
+=head2 backup
+
+Accepts: Value of Database Field, $args
+
+Given the value of a database field (which is some sort of pointer to the location
+of an actual file, and a hashref of args (passed in the args key of your config
+set), slurp up the file and return to to be saved in the fixure.
+
+=head2 restore
+
+Accepts: Value of Database Field, Content, $args
+
+Given the value of a database field, some blob content and $args, restore the
+file to the filesystem
+
+=head1 AUTHOR
+
+    See L<DBIx::Class::Fixtures> for author information.
+
+=head1 CONTRIBUTORS
+
+    See L<DBIx::Class::Fixtures> for contributor information.
+
+=head1 LICENSE
+
+    See L<DBIx::Class::Fixtures> for license information.
+
+=cut
+
index af117e9..2bbb0e1 100644 (file)
@@ -23,6 +23,7 @@ close($fh);
 my $fixtures = DBIx::Class::Fixtures
   ->new({
     config_dir => 't/var/configs',
+    config_attrs => { photo_dir => './t/var/files' },
     debug => 0 });
 
 ok(
index 1a15315..53408c3 100644 (file)
@@ -5,7 +5,7 @@
         "external": {
             "file": {
                 "class": "File",
-                "args": {"path":"./t/var/files"}
+                "args": {"path":"__ATTR(photo_dir)__"}
             }
         }
        }]