pkwalify

#!/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 $parse_mod;
my $silent;
my $show_version;
GetOptions("f=s"       => \$schema_file,
	   "m|module=s" => \$parse_mod,
	   "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 (defined $parse_mod) {
	@try_order = ($parse_mod);
    } elsif ($file =~ m{\.json$}i) {
	@try_order = ('JSON::XS', 'JSON', 'YAML::Syck', 'YAML', 'YAML::XS');
    } else { # yaml or don't know
	@try_order = ('YAML::Syck', 'YAML', 'YAML::XS', '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::XS'   && eval { require YAML::XS; 1 }) {
	    my @data = eval { YAML::XS::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, $@;
	} else {
	    push @errors, "Unsupported module $try";
	}
    }
    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] [-m parse-mod] -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] [-m parse-mod] -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>, L<YAML::XS> or L<YAML::Syck> is
installed to parse YAML files, or either L<JSON> or L<JSON::XS> for
JSON files. Or the module specified on the command-line.

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 -m I<parse-mod>

Specify the YAML or JSON Perl module to use. Valid modules are:
L<YAML>, L<YAML::XS>, L<YAML::Syck>, L<JSON> and L<JSON::XS>.

=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::XS>,
L<YAML::Syck>.

=cut