support for JSON::XS, and better ordering

Now the suffix of the schema/data file is used to try either a YAML or JSON parser first. An XS-based parser is preferred over a pure perl one (YAML::Syck over YAML, JSON::XS over JSON). New: JSON::XS support. Documentation is updated and mentions the parser modules.
eserte · Jul 16, 2015 · 0952308 · 0952308
1 parent dc8dd12
commit 0952308
Showing 1 changed file with 53 additions and 29 deletions.
diff --git a/pkwalify b/pkwalify
@@ -4,7 +4,7 @@
 #
 # Author: Slaven Rezic
 #
-# Copyright (C) 2006,2007,2008,2009 Slaven Rezic. All rights reserved.
+# Copyright (C) 2006,2007,2008,2009,2015 Slaven Rezic. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 #
@@ -14,7 +14,7 @@
 
 use strict;
 use vars qw($VERSION);
-$VERSION = '1.12';
+$VERSION = '1.13';
 
 use Kwalify;
 use Getopt::Long;
@@ -71,35 +71,56 @@ exit $errors;
 
 sub read_file {
     my $file = shift;
-    my @data;
-    my @errors;
-    if (eval { require YAML::Syck; 1 }) {
-	@data = eval { YAML::Syck::LoadFile($file) };
-	return @data if !$@;
-	push @errors, $@;
+
+    my @try_order;
+    if ($file =~ m{\.json$}i) {
+	@try_order = ('JSON::XS', 'JSON', 'YAML::Syck', 'YAML');
+    } else { # yaml or don't know
+	@try_order = ('YAML::Syck', 'YAML', 'JSON::XS', 'JSON');
     }
-    if (eval { require YAML; 1 }) {
-	@data = eval { YAML::LoadFile($file) };
-	return @data if !$@;
-	push @errors, $@;
+
+    my @errors;
+    for my $try (@try_order) {
+	if      ($try eq 'YAML::Syck' && eval { require YAML::Syck; 1 }) {
+	    my @data = eval { YAML::Syck::LoadFile($file) };
+	    return @data if !$@;
+	    push @errors, $@;
+	} elsif ($try eq 'YAML'       && eval { require YAML; 1 }) {
+	    my @data = eval { YAML::LoadFile($file) };
+	    return @data if !$@;
+	    push @errors, $@;
+	} elsif ($try eq 'JSON::XS'   && eval { require JSON::XS; 1 }) {
+	    my @data = eval { JSON::XS::decode_json(slurp_file($file)) };
+	    return @data if !$@;
+	    push @errors, $@;
+	} elsif ($try eq 'JSON'       && eval { require JSON; 1 }) {
+	    my $data = eval {
+		my $json = slurp_file($file);
+		if (defined &JSON::from_json) {
+		    JSON::from_json($json, {utf8 => 1});
+		} else { # old style
+		    JSON::jsonToObj($json);
+		}
+	    };
+	    return ($data) if $data && !$@;
+	    push @errors, $@;
+	}
     }
-    if (eval { require JSON; 1 }) {
-	my $data = eval {
-	    open JSON, "< $file"
-		or die "Can't open <$file>: $!";
-	    local $/ = undef;
-	    my $json = <JSON>;
-	    close JSON;
-	    if (defined &JSON::from_json) {
-		JSON::from_json($json, {utf8 => 1});
-	    } else {
-		JSON::jsonToObj($json);
-	    }
-	};
-	return ($data) if $data && !$@;
-	push @errors, $@;
+    if (!@errors) {
+	die "Cannot parse <$file>. Try to install a YAML and/or JSON parsing module first.\n";
+    } else {
+	die "Cannot parse <$file>. Cumulated errors:\n" . join("\n", @errors) . "\n";
     }
-    die "Cannot parse <$file>. Cumulated errors:\n" . join("\n", @errors) . "\n";
+}
+
+sub slurp_file {
+    my $file = shift;
+    open FH, "< $file"
+	or die "Can't open <$file>: $!";
+    local $/ = undef;
+    my $json = <FH>;
+    close FH;
+    $json;
 }
 
 sub usage {
@@ -141,6 +162,9 @@ B<pkwalify> validates the data from I<datafile> (which may be a
 L<YAML> or L<JSON> file) against a schema defined with I<schemafile>
 (which also may be a YAML or JSON file).
 
+It is required that either L<YAML> or L<YAML::Syck> is installed to
+parse YAML files, or either L<JSON> or L<JSON::XS> for JSON files.
+
 The program returns the number of errors found in the datafile. An
 exit status 0 means no errors.
 
@@ -174,7 +198,7 @@ Slaven Rezi
 
 =head1 SEE ALSO
 
-L<Kwalify>, L<kwalify(1)>, L<JSON>, L<YAML>.
+L<Kwalify>, L<kwalify(1)>, L<JSON>, L<JSON::XS>, L<YAML>, L<YAML::Syck>.
 
 =cut