File Coverage

blib/lib/XML/Validator/Schema/Parser.pm

Criterion	Covered	Total	%
statement	12	149	8.0
branch	0	92	0.0
condition	0	74	0.0
subroutine	4	7	57.1
pod	2	3	66.6
total	18	325	5.5

package XML::Validator::Schema::Parser;
use strict;
use warnings;

=head1 NAME

XML::Validator::Schema::Parser - XML Schema Document Parser

=head1 DESCRIPTION

This is an internal module used by XML::Validator::Schema to parse XML
Schema documents.

=cut

use base 'XML::SAX::Base';
use XML::Validator::Schema::Util qw(_attr _err);

sub new {
    my $pkg  = shift;
    my $opt  = (@_ == 1)  ? { %{shift()} } : {@_};
    my $self = bless $opt, $pkg;

    # start with a dummy root node and an empty stack of elements
    $self->{node_stack} = $self->{schema}{node_stack};

    return $self;
}

sub start_element {
    my ($self, $data) = @_;
    my $node_stack = $self->{node_stack};
    my $mother = @$node_stack ? $node_stack->[-1] : undef;
    my $name = $data->{LocalName};

    # make sure schema comes first
    _err("Root element must be , fount <$name> instead.")
      if  @$node_stack == 0 and $name ne 'schema';

    # starting up?
    if ($name eq 'schema') {
        my $node = XML::Validator::Schema::RootNode->new;
        $node->name('<<>>');
        push(@$node_stack, $node);

        # make sure elementFormDefault and attributeFormDefault are
        # 'unqualified' if declared since that's all we're up to
        for (qw(elementFormDefault attributeFormDefault)) {
            my $a = _attr($data, $_);
            _err("$_ in  must be 'unqualified', ".
                        "'qualified' is not supported.")
              if $a and $a ne 'unqualified';
        }

        # ignoring targetSchema intentionally.  With both Defaults
        # unqualified there isn't much point looking at it.
    }

    # handle element declaration
    elsif ($name eq 'element') {
        my $node;
        if (_attr($data, 'ref')) {
            $node = XML::Validator::Schema::ElementRefNode->parse($data);
        } else {
            # create a new node for the element
            $node = XML::Validator::Schema::ElementNode->parse($data);
        }

        # add to current node's daughter list and become the current node
        $mother->add_daughter($node);
        push @$node_stack, $node;
    }

    elsif ($name eq 'attribute') {
        # check anonymous/named constraints
        my $name = _attr($data, 'name');
        _err("Anonymous global simpleType not allowed.")
          if not $name and $mother->is_root;

        # parse it into an AttributeNode and tell Mom about it
        my $node = XML::Validator::Schema::AttributeNode->parse($data);
        $mother->add_daughter($node);
        push @$node_stack, $node;
    }

    elsif ($name eq 'simpleContent') {
        _err("Found simpleContent outside a complexType.")
          unless $mother->{is_complex} or
            $mother->isa('XML::Validator::Schema::ComplexTypeNode');

        $mother->{simple_content} = 1;
    }

    elsif ($name eq 'extension') {
        _err("Found illegal  outside simpleContent.")
          unless $mother->{simple_content};

        # extract simpleType from base
        my $base = _attr($data, 'base');
        _err("Found  without required 'base' attribute.")
          unless $base;
        $mother->{type_name} = $base;
        $mother->{unresolved_type} = 1;
    }

    elsif ($name eq 'simpleType') {
        my $name = _attr($data, 'name');
        if ($name) {
            _err("Named simpleType must be global.")
              unless $mother->is_root;

            # this is a named type, parse it into an SimpleTypeNode
            # and tell Mom about it
            my $node = XML::Validator::Schema::SimpleTypeNode->parse($data);
            $mother->add_daughter($node);
            push @$node_stack, $node;

        } else {
            _err("Anonymous global simpleType not allowed.")
              if $mother->is_root;

            _err("Found  illegally combined with .")
              if $mother->{is_complex};

            # this is a named type, parse it into a SimpleTypeNode
            # and tell Mom about it
            my $node = XML::Validator::Schema::SimpleTypeNode->parse($data);
            $mother->add_daughter($node);
            push @$node_stack, $node;

        }
    }

    elsif ($name eq 'restriction') {
        _err("Found  outside a  definition.")
          unless $mother->isa('XML::Validator::Schema::SimpleTypeNode');
        $mother->parse_restriction($data);
    }

    elsif ( $name eq 'union' ) {
        _err("Found  outside a  definition.")
          unless $mother->isa('XML::Validator::Schema::SimpleTypeNode');
        # The union might just have a 'memberTypes' attribute or it might
        # contain a bunch of inline anonymous simpleTypes.

        my $node = XML::Validator::Schema::ModelNode->parse($data);
        my $gran = $mother->{mother};

        $mother->add_daughter($node);

        # At parse time,  the only node that gets inspected is the
        # grandmother node,  so let's load everything required at runtime
        # onto that
        $mother->{got_union} = 1;
        $node->{is_union} = 1;
        $node->{next_instance} = 0;
        $gran->{members} = [];       # array of member ElementNodes

        if ( _attr($data,'memberTypes') ) {
          # Stuff stolen pretty indiscriminately from SimpleTypeNode
          my @mts = split(/ +/,_attr($data,'memberTypes'));
          foreach my $m ( @mts ) {
              my $mbr = XML::Validator::Schema::ElementNode->new();
              my $mt  = XML::Validator::Schema::SimpleTypeNode->new();
              $mt->{base} = $m;
              # Why mother->root?  well any old valid ref to root will do and
              # I can't find one anywhere else...
              my $base = $mother->root->{type_library}->find(name => $mt->{base});
              my $type = $base->derive();
              $mbr->{type} = $type;
              $mbr->add_daughter($mt);
              push(@{$gran->{members}},$mbr);
              $node->{next_instance} ++;
          }
        }

        $node ->{name} = $gran->{name} . '__';
        push @$node_stack,$node;

    }

    elsif ($name eq 'whiteSpace'   or
           $name eq 'pattern'      or
           $name eq 'enumeration'  or
           $name eq 'length'       or
           $name eq 'minLength'    or
           $name eq 'maxLength'    or
           $name eq 'minInclusive' or
           $name eq 'minExclusive' or
           $name eq 'maxInclusive' or
           $name eq 'maxExclusive' or
           $name eq 'totalDigits' or
           $name eq 'fractionDigits') {
        _err("Found <$name> outside a  definition.")
          unless $mother->isa('XML::Validator::Schema::SimpleTypeNode');
        $mother->parse_facet($data);
    }

    elsif ($name eq 'complexType') {
        my $name = _attr($data, 'name');
        if ($name) {
            _err("Named complexType must be global.")
              unless $mother->is_root;

            # this is a named type, parse it into an ComplexTypeNode
            # and tell Mom about it
            my $node = XML::Validator::Schema::ComplexTypeNode->parse($data);
            $mother->add_daughter($node);
            push @$node_stack, $node;


        } else {
            _err("Anonymous global complexType not allowed.")
              if $mother->is_root;

            # anonymous complexTypes are just noted and passed on
            $mother->{is_complex} = 1;
        }

    }

    elsif ($name eq 'sequence' or $name eq 'choice' or $name eq 'all') {
        # create a new node for the model
        my $node = XML::Validator::Schema::ModelNode->parse($data);

        # add to current node's daughter list and become the current node
        $mother->add_daughter($node);
        push @$node_stack, $node;

        # all needs special support due to the restrictions on its use
        $mother->{is_all} = 1 if $name eq 'all';
    }

    elsif ($name eq 'annotation' or $name eq 'documentation') {
        # skip
    }

    else {
        # getting here is bad news
        _err("Unrecognized element '<$name>' found.");
    }
}

sub end_element {
    my ($self, $data) = @_;
    my $node_stack = $self->{node_stack};
    my $node = $node_stack->[-1];
    my $name = $data->{LocalName};

    # all done?
    if ($name eq 'schema') {
        croak("Module done broke, man.  That element stack ain't empty!")
          unless @$node_stack == 1;

        # finish up
        $node_stack->[-1]->compile();

        return;
    }

    # end of an element?
    if ($name eq 'element') {
        $node->compile();
        pop @$node_stack;
        return;
    }

    # end of a model?
    if ($name eq 'sequence' or $name eq 'choice' or $name eq 'all') {
        pop @$node_stack;
        return;
    }

    # end of a named complexType?
    if ($name eq 'complexType' and
        $node->isa('XML::Validator::Schema::ComplexTypeNode')) {
        $node->compile;

        $node->mother->remove_daughter($node);
        pop @{$self->{node_stack}};
        return;
    }

    # end of a union?
    if ( $name eq 'union' ) {
        # Fail if it has no members
        if ( $node->{is_union} ) {
            if ( not defined($node->{next_instance}) ) {
                die "Node is_union but has no next_instance!";
            }else {
                if ( $node->{next_instance} == 0 ) {
		    _err("Union defined with no members");
                }
            }
        } else {
            die "Node is a a union but not is_union - something is wrong.";
        }
        pop @$node_stack;
        return;
    }

    # end of named simpleType?
    if ( $name eq 'simpleType' and
         $node->isa('XML::Validator::Schema::SimpleTypeNode')
       )
    {
        $node->check_constraints();
        my $type = $node->compile();
        # If the node doesn't have a name, set parent's type
        # to be the type of this node
        $node->mother->{type} = $type unless $node->{name};
        $node->mother->remove_daughter($node);
        pop @{$self->{node_stack}};
        return;
    }

    # end of an attribute?
    if ($name eq 'attribute' and
        $node->isa('XML::Validator::Schema::AttributeNode')) {
        my $attr   = $node->compile();
        my $mother = $node->mother();
        my $name   = $attr->{name};

        if ($name and $mother->is_root) {
            # named attribute in the root gets added to the attribute library
            $mother->{attribute_library}->add(name => $name,
                                              obj  => $attr);
        } else {
            # attribute in an element goes on the attr array
            push @{$mother->{attr} ||= []}, $attr;
        }

        $node->mother->remove_daughter($node);
        pop @{$self->{node_stack}};
        return;
    }

    # it's ok to fall off the end here, not all elements recognized in
    # start_element need finalizing.
}

1;