annotate Lib/IMPL/DOM/Schema/Validator/RegExp.pm @ 103:c289ed9662ca

Schema beta 2 More strict validation, support for inflating a simple nodes and properties
author wizard
date Fri, 07 May 2010 18:17:40 +0400
parents df6b4f054957
children 196bf443b5e1
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
100
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
1 package IMPL::DOM::Schema::Validator::RegExp;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
2
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
3 use base qw(IMPL::DOM::Schema::Validator);
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
4
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
5 our %CTOR = (
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
6 'IMPL::DOM::Schema::Validator' => sub {
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
7 my %args = @_;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
8 $args{nodeName} ||= 'RegExp';
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
9 %args;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
10 }
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
11 );
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
12
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
13 use IMPL::Class::Property;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
14
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
15 BEGIN {
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
16 public property message => prop_all;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
17 }
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
18
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
19 sub CTOR {
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
20 my ($this) = @_;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
21
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
22 $this->message("A %Node.nodeName% doesn't match to the format %Schema.name%");
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
23 }
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
24
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
25 sub Validate {
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
26 my ($this,$node) = @_;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
27
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
28 my $rx = $this->nodeValue;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
29 return new IMPL::DOM::Schema::ValidationError(
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
30 Node => $node,
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
31 Source => $this,
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
32 Schema => $this->parentNode,
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
33 Message => $this->message
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
34 ) unless (not $node->isComplex) and $node->nodeValue =~ /$rx/;
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
35 }
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
36
df6b4f054957 Schema in progress
wizard
parents:
diff changeset
37 1;