Commit | Line | Data |
---|---|---|
810a0276 SP |
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; | |
8ce4ea0b | 51 | use vars qw($VERSION $VAR1); |
5254b38e | 52 | $VERSION = "5.50"; |
810a0276 SP |
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 | }; | |
8ce4ea0b | 86 | $VAR1 = undef; |
810a0276 | 87 | eval $content; |
5254b38e SP |
88 | if (my $err = $@) { |
89 | die "parsing of '$schema_name.dd' failed: $err"; | |
90 | } | |
810a0276 SP |
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) }; | |
5254b38e SP |
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"; | |
810a0276 SP |
105 | } |
106 | } | |
107 | } | |
108 | ||
2b3bde2a SP |
109 | sub _clear_cache { |
110 | %vcache = (); | |
111 | } | |
112 | ||
810a0276 | 113 | sub yaml { |
5254b38e | 114 | my($schema_name, %opt) = @_; |
810a0276 SP |
115 | my $content = do { |
116 | my $path = __FILE__; | |
117 | $path =~ s/\.pm$//; | |
118 | $path = File::Spec->catfile($path, "$schema_name.yml"); | |
5254b38e SP |
119 | if ($opt{info}) { |
120 | $opt{info}{path} = $path; | |
121 | } | |
810a0276 SP |
122 | local *FH; |
123 | open FH, $path or die "Could not open '$path': $!"; | |
124 | local $/; | |
125 | <FH>; | |
126 | }; | |
127 | return $content; | |
128 | } | |
129 | ||
130 | 1; | |
131 | ||
132 | # Local Variables: | |
133 | # mode: cperl | |
134 | # cperl-indent-level: 4 | |
135 | # End: | |
136 |