first prototype of external storage and tests

diff --git a/lib/DBIx/Class/Fixtures/External/File.pm b/lib/DBIx/Class/Fixtures/External/File.pm
new file mode 100644 (file)
index 0000000..13ff2eb
--- /dev/null
+++ b/lib/DBIx/Class/Fixtures/External/File.pm
@@ -0,0 +1,36 @@
+package DBIx::Class::Fixtures::External::File;
+
+use strict;
+use warnings;
+
+use File::Spec::Functions 'catfile';
+
+sub _load {
+  my ($class, $path) = @_;
+  open(my $fh, '<', $path)
+    || die "can't open $path: $!";
+  local $/ = undef;
+  my $content = <$fh>;
+}
+
+sub _save {
+  my ($class, $path, $content) = @_;
+  open (my $fh, '>', $path)
+    || die "can't open $path: $!";
+  print $fh $content;
+  close($fh);
+}
+
+sub fetch {
+  my ($class, $key, $args) = @_;
+  my $path = catfile($args->{path}, $key);
+  return my $fetched = $class->_load($path);
+}
+
+sub write {
+  my ($class, $key, $content, $args) = @_;
+  my $path = catfile($args->{path}, $key);
+  $class->_save($path, $content);
+}
+
+1;

diff --git a/t/18-extra.t b/t/18-extra.t
new file mode 100644 (file)
index 0000000..af117e9
--- /dev/null
+++ b/t/18-extra.t
@@ -0,0 +1,60 @@
+use DBIx::Class::Fixtures;
+use Test::More;
+use File::Path 'rmtree';
+
+use lib qw(t/lib);
+use ExtraTest::Schema;
+
+(my $schema = ExtraTest::Schema->connect(
+  'DBI:SQLite::memory:','',''))->init_schema;
+
+open(my $fh, '<', 't/18-extra.t') ||
+  die "Can't open the filehandle, test is trash!";
+
+ok my $row = $schema
+  ->resultset('Photo')
+  ->create({
+    photographer=>'john',
+    file=>$fh,
+  });
+
+close($fh);
+
+my $fixtures = DBIx::Class::Fixtures
+  ->new({
+    config_dir => 't/var/configs',
+    debug => 0 });
+
+ok(
+  $fixtures->dump({
+    config => 'extra.json',
+    schema => $schema,
+    directory => "t/var/fixtures/photos" }),
+  'fetch dump executed okay');
+
+ok my $key = $schema->resultset('Photo')->first->file;
+
+ok -e $key, 'File Created';
+
+ok $schema->resultset('Photo')->delete;
+
+ok ! -e $key, 'File Deleted';
+
+ok(
+  $fixtures->populate({
+    no_deploy => 1,
+    schema => $schema,
+    directory => "t/var/fixtures/photos"}),
+  'populated');
+
+is $key, $schema->resultset('Photo')->first->file,
+  'key is key';
+
+ok -e $key, 'File Restored';
+
+done_testing;
+
+END {
+  rmtree 't/var/files';
+  rmtree 't/var/fixtures/photos';
+}

diff --git a/t/lib/ExtraTest/Schema.pm b/t/lib/ExtraTest/Schema.pm
new file mode 100644 (file)
index 0000000..e43643b
--- /dev/null
+++ b/t/lib/ExtraTest/Schema.pm
@@ -0,0 +1,61 @@
+package ExtraTest::Schema::Result::Photo;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Core';
+
+__PACKAGE__->load_components(qw/InflateColumn::FS/);
+__PACKAGE__->table('photo');
+
+__PACKAGE__->add_columns(
+  photo_id => {
+       data_type => 'integer',
+       is_auto_increment => 1,
+  },
+  photographer => {
+    data_type => 'varchar',
+    size => 40,
+  },
+  file => {
+       data_type => 'varchar',
+       size => 255,
+    is_fs_column => 1,
+    fs_column_path =>'./t/var/files',
+  });
+
+__PACKAGE__->set_primary_key('photo_id');
+
+package ExtraTest::Schema;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Schema';
+
+__PACKAGE__->register_class(
+  Photo => 'ExtraTest::Schema::Result::Photo');
+
+sub load_sql {
+  local $/ = undef;
+  my $sql = <DATA>;
+}
+
+sub init_schema {
+  my $sql = (my $schema = shift)
+    ->load_sql;
+
+  ($schema->storage->dbh->do($_) ||
+   die "Error on SQL: $_\n")
+    for split(/;\n/, $sql);
+}
+
+1;
+
+__DATA__
+CREATE TABLE photo (
+  photo_id INTEGER PRIMARY KEY NOT NULL,
+  photographer varchar(40) NOT NULL,
+  file varchar(255) NOT NULL
+)
+

diff --git a/t/var/configs/extra.json b/t/var/configs/extra.json
new file mode 100644 (file)
index 0000000..1a15315
--- /dev/null
+++ b/t/var/configs/extra.json
@@ -0,0 +1,12 @@
+{
+       "sets": [{
+               "class": "Photo",
+               "quantity": "all",
+        "external": {
+            "file": {
+                "class": "File",
+                "args": {"path":"./t/var/files"}
+            }
+        }
+       }]
+}