Permalink
Find file
Fetching contributors…
Cannot retrieve contributors at this time
executable file 203 lines (159 sloc) 4.16 KB
#!/usr/bin/perl -w
# -*- mode: cperl; coding: latin-2 -*-
#
# Author: Slaven Rezic
#
# 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.
#
# Mail: slaven@rezic.de
# WWW: http://www.rezic.de/eserte/
#
use strict;
use vars qw($VERSION);
$VERSION = '1.13';
use Kwalify;
use Getopt::Long;
my $schema_file;
my $silent;
my $show_version;
GetOptions("f=s" => \$schema_file,
"s|silent" => \$silent,
"v|version" => \$show_version,
"h|help" => sub { print usage(); exit 0 },
)
or die usage();
if ($show_version) {
version();
exit;
}
if (!defined $schema_file) {
die usage("-f option is mandatory");
}
my $data_file = shift @ARGV;
if (!defined $data_file) {
die usage("datafile is mandatory");
}
my(@schema) = read_file($schema_file);
if (@schema != 1) {
print "<$schema_file> does not contain exactly one schema, cannot handle this.";
exit 1;
}
my $schema = $schema[0];
my(@data) = read_file($data_file);
my $errors = 0;
my $document_index = 0;
for my $data (@data) {
my $document_label = $data_file . '#' . $document_index;
eval { Kwalify::validate($schema, $data) };
if ($@) {
print "$document_label: INVALID\n$@\n";
$errors++;
} else {
if (!$silent) {
print "$document_label: valid.\n";
}
}
$document_index++;
}
exit $errors;
sub read_file {
my $file = shift;
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');
}
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 (!@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";
}
}
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 {
my($msg) = @_;
if (defined $msg) {
$msg .= "\n";
} else {
$msg = "";
}
<<EOF;
${msg}usage: $0 [-v] [-s] -f schema.yml data.yml
$0 -f schema.json data.json
EOF
}
sub version {
print <<EOF;
pkwalify $VERSION
Kwalify.pm $Kwalify::VERSION
perl $]
EOF
}
__END__
=encoding iso-8859-2
=head1 NAME
pkwalify - Kwalify schema for data structures
=head1 SYNOPSIS
pkwalify [-v] [-s] -f schemafile datafile
=head1 DESCRIPTION
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.
=head2 OPTIONS
=over
=item -f I<schemafile>
Specify a schema file, either as YAML or JSON. Required.
=item -s
Be silent if the document is valid.
=item -v
Show script and module versions and exit.
=item -h --help
Show summary of options.
=back
=head1 AUTHOR
Slaven Reziæ, E<lt>srezic@cpan.orgE<gt>
=head1 SEE ALSO
L<Kwalify>, L<kwalify(1)>, L<JSON>, L<JSON::XS>, L<YAML>, L<YAML::Syck>.
=cut