view Lib/Form/Filter/Regexp.pm @ 165:76515373dac0

Added Class::Template, Rewritten SQL::Schema 'use parent' directive instead of 'use base'
author wizard
date Sat, 23 Apr 2011 23:06:48 +0400
parents 16ada169ca75
children
line wrap: on
line source

package Form::Filter::Regexp;
use strict;
use Common;
use Form::Filter;
use parent qw(Form::Filter);

BEGIN {
    DeclareProperty Regexp => ACCESS_READ;
}

sub CTOR {
    my ($this,@args) = @_;
    
    $this->SUPER::CTOR(@args[0,1]);

    my $re = $args[2] or die new Exception('A regular expression is required');

    $this->{$Regexp} = qr/$re/;
}

sub SUPPORTED_CONTEXT { Form::Filter::CTX_SINGLE | Form::Filter::CTX_EXISTENT }

sub Invoke {
    my ($this,$object) = @_;

    if ($object->isa('Form::ValueItem')) {
        my $re = $this->{$Regexp};
        if ($object->isEmpty or $object->Value =~ m/$re/) {
            return new Form::FilterResult(State => Form::FilterResult::STATE_SUCCESS);
        } else {
            return new Form::FilterResult(Sate => Form::FilterResult::STATE_ERROR, Message => $this->FormatMessage($object), Target => $object );
        }
    } else {
        die new Exception('Only a value items can be verified against a regular expression');
    }
}

1;