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