JSON::Schema for data validation

lib/ModelSEED/Configuration.pm

@@ -63,6 +63,10 @@ use JSON qw(encode_json decode_json);
 use Try::Tiny;
 use File::Path qw(mkpath);
 use File::Basename qw(dirname);
+use Class::Autouse qw(
+    JSON::Schema
+);
+
 
 has filename => (
     is       => 'rw',
@@ -87,6 +91,14 @@ has JSON => (
     init_arg => undef
 );
 
+has validator => (
+    is       => 'ro',
+    isa      => 'JSON::Schema',
+    builder  => '_buildValidator',
+    lazy     => 1,
+    init_arg => undef
+);
+
 sub _buildConfig {
     my ($self) = @_;
     my $default = { error_dir => $ENV{HOME} . "/.modelseed_error" };
@@ -118,12 +130,31 @@ sub _buildFilename {
     return $filename;
 }
 
+sub _buildValidator {
+    my ($self) = @_;
+    my $dir = dirname($INC{'ModelSEED/Configuration.pm'});
+    my $schemaFile = "$dir/Configuration.schema.json";
+    local $/;
+    open(my $fh, "<", $schemaFile) || die "$!";
+    my $text = <$fh>;
+    close($fh);
+    my $json = $self->JSON->decode($text);
+    return JSON::Schema->new($json);
+}
+
 sub save {
     my ($self) = @_;
+    # Validate Config against schema
+    my $result = $self->validator->validate($self->config);
+    unless($result) {
+        die "Errors in configuration!\n".
+        join("\n", $result->errors) . "\n";
+    }
     open(my $fh, ">", $self->filename) ||
         die "Error saving " . $self->filename . ", $@";
     print $fh $self->JSON->encode($self->config);
     close($fh);
+    return 1;
 }
 
 # FIXME - kludge until MooseX::Singleton fixed
@@ -132,5 +163,6 @@ sub instance {
     return $class->new(@_);
 }
 
+
 __PACKAGE__->meta->make_immutable;
 1;

lib/ModelSEED/Configuration.schema.json

@@ -0,0 +1,50 @@
+{
+   "type" : "object",
+   "description" : "Configuration details for the ModelSEED",
+   "properties" : {
+      "error_log" : {
+         "type" : "string",
+         "description" : "Directory where error logs are stored"
+      },
+      "stores" : {         "type" : "array",
+         "description" : "An array of storage configurations",
+         "items" : {
+            "type" : "object",
+            "additionalProperties" : {},
+            "properties" : {
+               "class" : {
+                  "required" : true,
+                  "type" : "string"
+               }
+            }
+         }
+      },
+      "mapping" : {
+         "type" : "string",
+         "description" : "Alias for preferred mapping"
+      },
+      "biochemistry" : {
+         "type" : "string",
+         "description" : "Alias for preferred biochemistry"
+      },
+      "model" : {
+         "type" : "string",
+         "description" : "Alias for preferred model"
+      },
+      "login" : {
+         "type" : "object",
+         "description" : "Authentication information",
+         "properties" : {
+            "password" : {
+               "required" : true,
+               "type" : "string"
+            },
+            "username" : {
+               "required" : true,
+               "type" : "string"
+            }
+         }
+      }
+   },
+   "additionalProperties" : false
+}

lib/ModelSEED/t/Configuration.t

@@ -4,12 +4,13 @@ use ModelSEED::Configuration;
 use File::Temp qw(tempfile);
 use JSON;
 use Test::More;
+use Test::Exception;
 my $testCount = 0;
 
 my ($fh, $TMPDB) = tempfile();
 my $TESTINI = <<INI;
 {
-    "auth" : {
+    "login" : {
         "username" : "alice",
         "password" : "alice's password"
     },
@@ -35,13 +36,30 @@ INI
     my $data = $j->decode($TESTINI);
     is_deeply($c->config, $data, "JSON should go in correctly");
 
+    # test singleton interface
     TODO: {
         local $TODO = "Singleton destructor not working";
         my $d = ModelSEED::Configuration->instance;
         is_deeply($d, $c, "Should be singleton class");
     };
 
-    $testCount += 3;
+    # test save
+    ok $c->save(), "Save should return correctly";
+    # test save actually updates
+    {
+        $c->config->{login}->{username} = "bob";
+        $c->save();
+        my $d = ModelSEED::Configuration->new({filename => $temp_cfg_file});
+        is_deeply($d->config, $c->config, "Should contain same info");
+        is $d->config->{login}->{username}, "bob", "New instance should get data";
+    }
+    # test exception on invalid data being saved
+    {
+        $c->config->{model} = ["an", "array"];
+        dies_ok( sub { $c->save() }, "Should die when trying to save invalid data");
+    }
+
+    $testCount += 7;
 }