usr
/
share
/
perl5
/
vendor_perl
/
CPAN
/
Go to Home Directory
+
Upload
Create File
root@0UT1S:~$
Execute
By Order of Mr.0UT1S
[DIR] ..
N/A
[DIR] API
N/A
[DIR] Exception
N/A
[DIR] FTP
N/A
[DIR] HTTP
N/A
[DIR] Kwalify
N/A
[DIR] LWP
N/A
[DIR] Meta
N/A
[DIR] Plugin
N/A
Admin.pm
7.60 KB
Rename
Delete
Author.pm
6.68 KB
Rename
Delete
Bundle.pm
9.60 KB
Rename
Delete
CacheMgr.pm
7.48 KB
Rename
Delete
Complete.pm
5.88 KB
Rename
Delete
Debug.pm
2.05 KB
Rename
Delete
DeferredCode.pm
189 bytes
Rename
Delete
Distribution.pm
158.74 KB
Rename
Delete
Distroprefs.pm
11.71 KB
Rename
Delete
Distrostatus.pm
972 bytes
Rename
Delete
FTP.pm
41.63 KB
Rename
Delete
FirstTime.pm
70.05 KB
Rename
Delete
HandleConfig.pm
22.75 KB
Rename
Delete
Index.pm
21.70 KB
Rename
Delete
InfoObj.pm
6.75 KB
Rename
Delete
Kwalify.pm
3.35 KB
Rename
Delete
Meta.pm
29.56 KB
Rename
Delete
Mirrors.pm
16.30 KB
Rename
Delete
Module.pm
21.87 KB
Rename
Delete
Nox.pm
953 bytes
Rename
Delete
Plugin.pm
3.14 KB
Rename
Delete
Prompt.pm
567 bytes
Rename
Delete
Queue.pm
6.78 KB
Rename
Delete
Shell.pm
71.88 KB
Rename
Delete
Tarzip.pm
16.32 KB
Rename
Delete
URL.pm
588 bytes
Rename
Delete
Version.pm
4.29 KB
Rename
Delete
=head1 NAME CPAN::Kwalify - Interface between CPAN.pm and Kwalify.pm =head1 SYNOPSIS use CPAN::Kwalify; validate($schema_name, $data, $file, $doc); =head1 DESCRIPTION =over =item _validate($schema_name, $data, $file, $doc) $schema_name is the name of a supported schema. Currently only C<distroprefs> is supported. $data is the data to be validated. $file is the absolute path to the file the data are coming from. $doc is the index of the document within $doc that is to be validated. The last two arguments are only there for better error reporting. Relies on being called from within CPAN.pm. Dies if something fails. Does not return anything useful. =item yaml($schema_name) Returns the YAML text of that schema. Dies if something fails. =back =head1 AUTHOR Andreas Koenig C<< <andk@cpan.org> >> =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L<http://www.perl.com/perl/misc/Artistic.html> =cut use strict; package CPAN::Kwalify; use vars qw($VERSION $VAR1); $VERSION = "5.50"; use File::Spec (); my %vcache = (); my $schema_loaded = {}; sub _validate { my($schema_name,$data,$abs,$y) = @_; my $yaml_module = CPAN->_yaml_module; if ( $CPAN::META->has_inst($yaml_module) && $CPAN::META->has_inst("Kwalify") ) { my $load = UNIVERSAL::can($yaml_module,"Load"); unless ($schema_loaded->{$schema_name}) { eval { my $schema_yaml = yaml($schema_name); $schema_loaded->{$schema_name} = $load->($schema_yaml); }; if ($@) { # we know that YAML.pm 0.62 cannot parse the schema, # so we try a fallback my $content = do { my $path = __FILE__; $path =~ s/\.pm$//; $path = File::Spec->catfile($path, "$schema_name.dd"); local *FH; open FH, $path or die "Could not open '$path': $!"; local $/; <FH>; }; $VAR1 = undef; eval $content; if (my $err = $@) { die "parsing of '$schema_name.dd' failed: $err"; } $schema_loaded->{$schema_name} = $VAR1; } } } if (my $schema = $schema_loaded->{$schema_name}) { my $mtime = (stat $abs)[9]; for my $k (keys %{$vcache{$abs}}) { delete $vcache{$abs}{$k} unless $k eq $mtime; } return if $vcache{$abs}{$mtime}{$y}++; eval { Kwalify::validate($schema, $data) }; if (my $err = $@) { my $info = {}; yaml($schema_name, info => $info); die "validation of distropref '$abs'[$y] against schema '$info->{path}' failed: $err"; } } } sub _clear_cache { %vcache = (); } sub yaml { my($schema_name, %opt) = @_; my $content = do { my $path = __FILE__; $path =~ s/\.pm$//; $path = File::Spec->catfile($path, "$schema_name.yml"); if ($opt{info}) { $opt{info}{path} = $path; } local *FH; open FH, $path or die "Could not open '$path': $!"; local $/; <FH>; }; return $content; } 1; # Local Variables: # mode: cperl # cperl-indent-level: 4 # End:
Save