Changeset 8023 for lang/perl/App-MadEye

Timestamp:

03/17/08 13:18:20 (8 months ago)

Author:

tokuhirom

Message:

Rule も kwalify できるようにした。

Location:

lang/perl/App-MadEye/trunk/lib/App/MadEye

Files:

• Plugin/Base.pm (modified) (2 diffs)
• Rule.pm (modified) (1 diff)
• Util.pm (modified) (2 diffs)

lang/perl/App-MadEye/trunk/lib/App/MadEye/Plugin/Base.pm

@@ -3 +3 @@
 use warnings;
 use base qw/Class::Component::Plugin/;
+use App::MadEye::Util qw/get_schema_from_pod/;
 use Kwalify ();
-use Pod::POM ();
-use List::Util qw/first/;
-use YAML ();
 
 sub new {
@@ -12 +10 @@
     my $self = $class->SUPER::new(@_);
 
-    my $parser = Pod::POM->new;
-    my $pom = $parser->parse(Class::Inspector->resolved_filename($class));
-    if (my $schema_node = first { $_->title eq 'SCHEMA' } $pom->head1) {
-        my $schema_content = $schema_node->content;
-        $schema_content =~ s/^    //gm;
-        my $schema = YAML::Load($schema_content);
-
+    if (my $schema = get_schema_from_pod($self)) {
         Kwalify::validate($schema, $self->config->{config});
     }

lang/perl/App-MadEye/trunk/lib/App/MadEye/Rule.pm

@@ -2 +2 @@
 use strict;
 use warnings;
+use App::MadEye::Util qw/get_schema_from_pod/;
+use Kwalify ();
 
 sub new {
     my ($class, $config) = @_;
     $config ||= {};
+    if (my $schema = get_schema_from_pod($class)) {
+        Kwalify::validate($schema, $config);
+    }
     bless {config => $config}, $class;
 }

lang/perl/App-MadEye/trunk/lib/App/MadEye/Util.pm

@@ -4 +4 @@
 use base qw/Exporter/;
 
-our @EXPORT = qw/timeout log_stopwatch/;
+our @EXPORT = qw/timeout log_stopwatch get_schema_from_pod/;
 
 use Sys::Syslog qw/:DEFAULT/;
+use Pod::POM ();
+use List::Util qw/first/;
+use YAML ();
 
 sub timeout($$&) {    ## no critic.
@@ -37 +40 @@
 }
 
+sub get_schema_from_pod {
+    my $target = shift;
+    my $proto = ref $target || $target;
+
+    my $parser = Pod::POM->new;
+    my $pom = $parser->parse(Class::Inspector->resolved_filename($proto));
+    if (my $schema_node = first { $_->title eq 'SCHEMA' } $pom->head1) {
+        my $schema_content = $schema_node->content;
+        $schema_content =~ s/^    //gm;
+        my $schema = YAML::Load($schema_content);
+        return $schema;
+    } else {
+        return; # 404 schema not found.
+    }
+}
+
 1;