Commit | Line | Data |
810a0276 |
1 | =head1 NAME |
2 | |
3 | CPAN::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 |
17 | C<distroprefs> is supported. $data is the data to be validated. $file |
18 | is the absolute path to the file the data are coming from. $doc is the |
19 | index of the document within $doc that is to be validated. The last |
20 | two arguments are only there for better error reporting. |
21 | |
22 | Relies on being called from within CPAN.pm. |
23 | |
24 | Dies if something fails. Does not return anything useful. |
25 | |
26 | =item yaml($schema_name) |
27 | |
28 | Returns the YAML text of that schema. Dies if something fails. |
29 | |
30 | =back |
31 | |
32 | =head1 AUTHOR |
33 | |
34 | Andreas Koenig C<< <andk@cpan.org> >> |
35 | |
36 | =head1 LICENSE |
37 | |
38 | This program is free software; you can redistribute it and/or |
39 | modify it under the same terms as Perl itself. |
40 | |
41 | See L<http://www.perl.com/perl/misc/Artistic.html> |
42 | |
43 | |
44 | |
45 | =cut |
46 | |
47 | |
48 | use strict; |
49 | |
50 | package CPAN::Kwalify; |
51 | use vars qw($VERSION); |
52 | $VERSION = sprintf "%.6f", substr(q$Rev: 1418 $,4)/1000000 + 5.4; |
53 | |
54 | use File::Spec (); |
55 | |
56 | my %vcache = (); |
57 | |
58 | my $schema_loaded = {}; |
59 | |
60 | sub _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 | our $VAR1 = undef; |
87 | eval $content; |
88 | die "parsing of '$schema_name.dd' failed: $@" if $@; |
89 | $schema_loaded->{$schema_name} = $VAR1; |
90 | } |
91 | } |
92 | } |
93 | if (my $schema = $schema_loaded->{$schema_name}) { |
94 | my $mtime = (stat $abs)[9]; |
95 | for my $k (keys %{$vcache{$abs}}) { |
96 | delete $vcache{$abs}{$k} unless $k eq $mtime; |
97 | } |
98 | return if $vcache{$abs}{$mtime}{$y}++; |
99 | eval { Kwalify::validate($schema, $data) }; |
100 | if ($@) { |
101 | die "validation of distropref '$abs'[$y] failed: $@"; |
102 | } |
103 | } |
104 | } |
105 | |
2b3bde2a |
106 | sub _clear_cache { |
107 | %vcache = (); |
108 | } |
109 | |
810a0276 |
110 | sub yaml { |
111 | my($schema_name) = @_; |
112 | my $content = do { |
113 | my $path = __FILE__; |
114 | $path =~ s/\.pm$//; |
115 | $path = File::Spec->catfile($path, "$schema_name.yml"); |
116 | local *FH; |
117 | open FH, $path or die "Could not open '$path': $!"; |
118 | local $/; |
119 | <FH>; |
120 | }; |
121 | return $content; |
122 | } |
123 | |
124 | 1; |
125 | |
126 | # Local Variables: |
127 | # mode: cperl |
128 | # cperl-indent-level: 4 |
129 | # End: |
130 | |