The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# -*- mode: cperl; coding: latin-2 -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2006,2007,2008,2009 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.12';

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 @data;
    my @errors;
    if (eval { require YAML::Syck; 1 }) {
	@data = eval { YAML::Syck::LoadFile($file) };
	return @data if !$@;
	push @errors, $@;
    }
    if (eval { require YAML; 1 }) {
	@data = eval { YAML::LoadFile($file) };
	return @data if !$@;
	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, $@;
    }
    die "Cannot parse <$file>. Cumulated errors:\n" . join("\n", @errors) . "\n";
}

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).

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.

=item 

=back

=head1 AUTHOR

Slaven ReziƦ, E<lt>srezic@cpan.orgE<gt>

=head1 SEE ALSO

L<Kwalify>, L<kwalify(1)>, L<JSON>, L<YAML>.

=cut