XML::Schema::Type::Complex - class for complex XML Schema datatypes

    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...

    $complex->start(@attribs);
    $complex->content(@content);
    $complex->end();

#============================================================= -*-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 <abw@kfs.org>
#
# 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.
#
# <complexType name="personType">
#   <sequence>		
#     <element name="name"  type="string"/>
#     <element name="email" type="string"/>
#   </sequence>
# </complextype>
#------------------------------------------------------------------------

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.
#
# <complexType name="personType">
#   <choice>		
#     <element name="employee" type="employeeType"/>
#     <element name="customer" type="customerType"/>
#   </choice>
# </complextype>
#------------------------------------------------------------------------

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.
#
# <price currency="EUR">3.14</price>
#
# <element name="price" type="internationalPrice"/>
# <complexType name="internationalPrice">
#   <simpleContent>				<---- simpleContent()
#     <extension base="decimal">
#       <attribute name="currency" type="string"/>
#     </extension>
#   </simpleContent>
# </complexType>
#------------------------------------------------------------------------

sub simpleContent {
    my $self = shift;
    $self->throw('simpleContent() not yet implemented');
}


#------------------------------------------------------------------------
# complexContent( @items )
#
# Used to create a complexContent model for the complexType, e.g.
#
# <price currency="EUR" value="3.14"/>
# 
# <element name="price" type="internationalPrice"/>
# <complexType name="internationalPrice">
#   <complexContent>				<---- complexContent()
#     <restriction base="anyType">
#       <attribute name="currency" type="string"/>
#       <attribute name="value" type="decimal"/>
#     </restriction>
#   </complexContent>
# </complexType>
#------------------------------------------------------------------------

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__