#============================================================= -*-perl-*- # # XML::Schema::Type::Complex # # DESCRIPTION # Module implementing an object class for representing complex XML # Schema datatypes. Complex types are those that contain other # elements and/or carry attributes. # # AUTHOR # Andy Wardley # # COPYRIGHT # Copyright (C) 2001 Canon Research Centre Europe Ltd. # All Rights Reserved. # # This module is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. # # REVISION # $Id: Complex.pm,v 1.2 2001/12/20 13:26:28 abw Exp $ # #======================================================================== package XML::Schema::Type::Complex; use strict; use XML::Schema; use XML::Schema::Type; use XML::Schema::Scope; use XML::Schema::Scheduler; use base qw( XML::Schema::Scope XML::Schema::Type XML::Schema::Scheduler ); use vars qw( $VERSION $DEBUG $ERROR @OPTIONAL @SCHEDULES ); $VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; $ERROR = ''; @OPTIONAL = qw( annotation mixed scope ); @SCHEDULES = qw( start_element end_element start_child end_child text ); sub init { my ($self, $config) = @_; $self->SUPER::init($config) || return; # set by base class (Scope) constructor my $factory = $self->{ _FACTORY }; # tell attribute group to delegate to $self for types $config->{ scope } ||= $self; $config->{ name } ||= 'anon'; $config->{ name } = '_complex_type_$config->{ name }'; # create attribute group to manage attributes $self->{ attributes } = $factory->create( attribute_group => $config ) || return $self->error($factory->error()); # initialise scheduler $self->init_scheduler($config) || return; # required ?? $self->{ simple } = 0; $self->{ complex } = 1; my $content; if ($content = $config->{ content }) { if ($factory->isa( content => $content )) { return $content; } elsif ($content = $factory->create( content => $content )) { $self->{ content } = $content; } else { return $self->error($factory->error()); } } else { # TODO: this is laborious, need to find a better way my $ctype = $factory->module('content') || return $self->error($factory->error()); $factory->load($ctype) || return $self->error($factory->error()); my $ptype = $factory->module('particle') || return $self->error($factory->error()); $factory->load($ptype) || return $self->error($factory->error()); my $regex = join('|', $ctype->args(), $ptype->models()); if (grep(/^$regex$/, keys %$config)) { # create content model $self->{ content } = $factory->create( content => $config ) || return $self->error($factory->error()); } } return $self; } #------------------------------------------------------------------------ # attribute( ... ) # # Accessor method to fetch and update attributes. Delegates to # equivalent method of internal $self->{ attributes } attribute group # object. #------------------------------------------------------------------------ sub attribute { my $self = shift; my $agroup = $self->{ attributes }; return $agroup->attribute(@_) || $self->error($agroup->error()); } #------------------------------------------------------------------------ # attributes( ) # # Returns reference to the internal XML::Schema::Attribute::Group object # which manages attributes. #------------------------------------------------------------------------ sub attributes { my $self = shift; return $self->{ attributes }; } #------------------------------------------------------------------------ # content() # # Return a reference to the current content model object. Creates a # new content object via the current factory if called with # arguments. #------------------------------------------------------------------------ sub content { my $self = shift; return $self->{ content } unless @_; my $factory = $self->{ _FACTORY } || return $self->error("no factory defined"); $self->{ content } = $factory->create( content => @_ ) || return $self->error($factory->error()); } #------------------------------------------------------------------------ # sequence( @items ) # # Used to create a sequence content model, e.g. # # # # # # # #------------------------------------------------------------------------ sub sequence { my $self = shift; my $content = { }; while (! ref $_[0]) { my $key = shift; $content->{ $key } = shift; } $content->{ sequence } = [ @_ ]; $self->TRACE("content => ", $content) if $DEBUG; $self->content($content); } #------------------------------------------------------------------------ # choice( @items ) # # Used to create a choice content model, e.g. # # # # # # # #------------------------------------------------------------------------ sub choice { my $self = shift; my $content = { }; while (! ref $_[0]) { my $key = shift; $content->{ $key } = shift; } $content->{ choice } = [ @_ ]; $self->TRACE("choice => ", $content) if $DEBUG; $self->content($content); } #------------------------------------------------------------------------ # simpleContent( @items ) # # Used to create a simpleContent model for the complexType, e.g. # # 3.14 # # # # <---- simpleContent() # # # # # #------------------------------------------------------------------------ sub simpleContent { my $self = shift; $self->throw('simpleContent() not yet implemented'); } #------------------------------------------------------------------------ # complexContent( @items ) # # Used to create a complexContent model for the complexType, e.g. # # # # # # <---- complexContent() # # # # # # #------------------------------------------------------------------------ sub complexContent { my $self = shift; $self->throw('complexContent() not yet implemented'); } #======================================================================== # misc accessor methods #======================================================================== sub annotation { my $self = shift; return @_ ? ($self->{ annotation } = shift) : $self->{ annotation }; } sub simple { return 0; } sub complex { return 1; } sub mixed { my $self = shift; my $content = $self->{ content } || return $self->error("no content defined"); return $content->mixed(@_); } sub empty { my $self = shift; my $content = $self->{ content } || return $self->error("no content defined"); return $content->empty(@_); } sub element_only { my $self = shift; my $content = $self->{ content } || return $self->error("no content defined"); return $content->element_only(@_); } #======================================================================== # parser methods #======================================================================== #------------------------------------------------------------------------ # handler($instance, $element) # # Calls the complex_handler($self, $element) method on the $instance # reference. # # TODO: we could optimise away this chain of method calls by having the # instance Start() method unwrap the calls. #------------------------------------------------------------------------ sub handler { my ($self, $instance, $element) = @_; return $instance->complex_handler($self, $element) || $self->error($instance->error()); } sub present { my ($self, $view) = @_; $view->view( complex => $self ); } sub ID { my $self = shift; return 'ComplexType'; } 1; __END__ =head1 NAME XML::Schema::Type::Complex - class for complex XML Schema datatypes =head1 SYNOPSIS use XML::Schema::Type::Complex; my $complex = XML::Schema::Type::Complex->new( name => 'MyComplexType', attributes => { attr1 => XML::Schema::Attribute->new(@attr1_opts), attr2 => \@attr2_opts, # shorthand for above ... } content => [ ... ], # and more... ); # add new attribute my @opts = ( name => 'foo', ... ); my $attr = XML::Schema::Attribute->new(@opts); $complex->attribute($attr); # calls $attr->name() to get 'foo' $complex->attribute($attr, $attr); $complex->attribute(name => $attr); $complex->attribute(name => \@opts); # creates attribute for you ...TODO... =head1 DESCRIPTION This module implements an object class for representing XML Schema complex types. A complex type is one which carries attributes and/or contains other elements. [ TODO: This documentation is incomplete and mainly contains early design thoughts ] =head2 Instantiating Objects of a Complex Type The XML::Schema::Type::Simple base class module provides the instance($value) method for instantiating objects of the type (e.g. validating that the input is correct and then activating any scheduled actions). The XML::Schema::Type::Complex module implements a similar method which can be called as $complex->instance(\%attribs, \@content). Underneath the surface, the process of creating an instantance of an complex types (e.g. an object to represent an XML element) is a little more complicated. Because this module is typically used by an XML::Schema::Parser to instances from XML documents, the instantiation lifecycle closely follows the parser events: start tag, content, end tag. The three methods for instantiating an element of this class are therefore: $complex->start(@attribs); $complex->content(@content); $complex->end(); Or something like that... (still in development) =head1 AUTHOR Andy Wardley Eabw@kfs.orgE =head1 VERSION This is version $Revision: 1.2 $ of the XML::Schema::Type::Complex, distributed with version 0.1 of the XML::Schema module set. =head1 COPYRIGHT Copyright (C) 2001 Canon Research Centre Europe Ltd. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO See also L and L.