view Lib/IMPL/DOM/Schema/Property.pm @ 37:c2e7f7c96bcd

performance improvements, DOM reworked (a little)
author Sergey
date Mon, 23 Nov 2009 00:59:06 +0300
parents 9dd67fa91ee3
children 16ada169ca75
line wrap: on
line source

package IMPL::DOM::Schema::Property;
use strict;
use warnings;

use base qw(IMPL::DOM::Schema::SimpleNode);
require IMPL::DOM::Schema;
require IMPL::DOM::Node;
use IMPL::Class::Property;

__PACKAGE__->PassThroughArgs;

BEGIN {
    public property RequiredMessage => prop_all;
}

our %CTOR = (
    'IMPL::DOM::Schema::SimpleNode' => sub {
        my %args = @_;
        
        $args{maxOccur} = 1;
        $args{minOccur} = delete $args{optional} ? 0 : 1;
        $args{nodeName} ||= 'Property';
        
        return %args;
    }
);

sub CTOR {
    my ($this,%args) = @_;
    
    $this->RequiredMessage($args{RequiredMessage} || 'A property %Schema.name% is required in the %Node.qname%');
}

sub Validate {
    my ($this,$node) = @_;
    
    if ($this->minOccur) {
        my $prop = $this->name;
        my $nodeProp = new IMPL::DOM::Node(nodeName => '::property', nodeValue => $node->$prop() || $node->nodePropety($prop));
        
        if (! $nodeProp->nodeValue) {
            return new IMPL::DOM::Schema::ValidationError(
                Message => $this->RequiredMessage,
                Node => $node,
                Schema => $this
            );
        }
        return $this->SUPER::Validate($nodeProp);
    } else {
        return ();
    }
}

1;