1=head1 NAME
2
3CPAN::Kwalify - Interface between CPAN.pm and Kwalify.pm
4
5=head1 SYNOPSIS
6
7  use CPAN::Kwalify;
8  validate($schema_name, $data, $file, $doc);
9
10=head1 DESCRIPTION
11
12=over
13
14=item _validate($schema_name, $data, $file, $doc)
15
16$schema_name is the name of a supported schema. Currently only
17C<distroprefs> is supported. $data is the data to be validated. $file
18is the absolute path to the file the data are coming from. $doc is the
19index of the document within $doc that is to be validated. The last
20two arguments are only there for better error reporting.
21
22Relies on being called from within CPAN.pm.
23
24Dies if something fails. Does not return anything useful.
25
26=item yaml($schema_name)
27
28Returns the YAML text of that schema. Dies if something fails.
29
30=back
31
32=head1 AUTHOR
33
34Andreas Koenig C<< <andk@cpan.org> >>
35
36=head1 LICENSE
37
38This program is free software; you can redistribute it and/or
39modify it under the same terms as Perl itself.
40
41See L<http://www.perl.com/perl/misc/Artistic.html>
42
43
44
45=cut
46
47
48use strict;
49
50package CPAN::Kwalify;
51use vars qw($VERSION $VAR1);
52$VERSION = "5.50";
53
54use File::Spec ();
55
56my %vcache = ();
57
58my $schema_loaded = {};
59
60sub _validate {
61    my($schema_name,$data,$abs,$y) = @_;
62    my $yaml_module = CPAN->_yaml_module;
63    if (
64        $CPAN::META->has_inst($yaml_module)
65        &&
66        $CPAN::META->has_inst("Kwalify")
67       ) {
68        my $load = UNIVERSAL::can($yaml_module,"Load");
69        unless ($schema_loaded->{$schema_name}) {
70            eval {
71                my $schema_yaml = yaml($schema_name);
72                $schema_loaded->{$schema_name} = $load->($schema_yaml);
73            };
74            if ($@) {
75                # we know that YAML.pm 0.62 cannot parse the schema,
76                # so we try a fallback
77                my $content = do {
78                    my $path = __FILE__;
79                    $path =~ s/\.pm$//;
80                    $path = File::Spec->catfile($path, "$schema_name.dd");
81                    local *FH;
82                    open FH, $path or die "Could not open '$path': $!";
83                    local $/;
84                    <FH>;
85                };
86                $VAR1 = undef;
87                eval $content;
88                if (my $err = $@) {
89                    die "parsing of '$schema_name.dd' failed: $err";
90                }
91                $schema_loaded->{$schema_name} = $VAR1;
92            }
93        }
94    }
95    if (my $schema = $schema_loaded->{$schema_name}) {
96        my $mtime = (stat $abs)[9];
97        for my $k (keys %{$vcache{$abs}}) {
98            delete $vcache{$abs}{$k} unless $k eq $mtime;
99        }
100        return if $vcache{$abs}{$mtime}{$y}++;
101        eval { Kwalify::validate($schema, $data) };
102        if (my $err = $@) {
103            my $info = {}; yaml($schema_name, info => $info);
104            die "validation of distropref '$abs'[$y] against schema '$info->{path}' failed: $err";
105        }
106    }
107}
108
109sub _clear_cache {
110    %vcache = ();
111}
112
113sub yaml {
114    my($schema_name, %opt) = @_;
115    my $content = do {
116        my $path = __FILE__;
117        $path =~ s/\.pm$//;
118        $path = File::Spec->catfile($path, "$schema_name.yml");
119        if ($opt{info}) {
120            $opt{info}{path} = $path;
121        }
122        local *FH;
123        open FH, $path or die "Could not open '$path': $!";
124        local $/;
125        <FH>;
126    };
127    return $content;
128}
129
1301;
131
132# Local Variables:
133# mode: cperl
134# cperl-indent-level: 4
135# End:
136
137