annotate Lib/Form/Filter/Regexp.pm @ 0:03e58a454b20

Создан репозитарий
author Sergey
date Tue, 14 Jul 2009 12:54:37 +0400
parents
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package Form::Filter::Regexp;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use Form::Filter;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 use base qw(Form::Filter);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 DeclareProperty Regexp => ACCESS_READ;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 sub CTOR {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 my ($this,@args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 $this->SUPER::CTOR(@args[0,1]);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 my $re = $args[2] or die new Exception('A regular expression is required');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 $this->{$Regexp} = qr/$re/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 sub SUPPORTED_CONTEXT { Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 sub Invoke {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 my ($this,$object) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 if ($object->isa('Form::ValueItem')) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 my $re = $this->{$Regexp};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 if ($object->isEmpty or $object->Value =~ m/$re/) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 return new Form::FilterResult(State => Form::FilterResult::STATE_SUCCESS);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 return new Form::FilterResult(Sate => Form::FilterResult::STATE_ERROR, Message => $this->FormatMessage($object), Target => $object );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 die new Exception('Only a value items can be verified against a regular expression');
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 1;