File Coverage

lib/XML/Schema/Scope.pm

Criterion	Covered	Total	%
statement	74	86	86.0
branch	35	56	62.5
condition	17	31	54.8
subroutine	10	11	90.9
pod	1	7	14.2
total	137	191	71.7

#============================================================= -*-perl-*-
#
# XML::Schema::Scope
#
# DESCRIPTION
#   Module implementing a mixin object class for providing type
#   management within a particular scope.
#
# 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: Scope.pm,v 1.2 2001/12/20 13:26:27 abw Exp $
#
#========================================================================

package XML::Schema::Scope;

use strict;
use XML::Schema;
use base qw( XML::Schema::Base );
use vars qw( $VERSION $DEBUG $ERROR @OPTIONAL );

$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
$DEBUG   = 0 unless defined $DEBUG;
$ERROR   = '';

@OPTIONAL  = qw( scope );


#------------------------------------------------------------------------
# init(\%config)
#
# Initialiser method called by base class new() constructor method.
#------------------------------------------------------------------------

sub init {
    my ($self, $config) = @_;

    $self->init_mandopt($config)
	|| return;

    $self->{ _FACTORY } ||= $XML::Schema::FACTORY;

    # need to think about instantiating objects for types?
    $self->{ _TYPES } = $config->{ types } || { };

    # ditto for attribute_groups?
    $self->{ _ATTRIBUTE_GROUPS } = { };

    return $self;
}



#========================================================================
# Type management methods
#
# * type($name)
#   type($type_obj)
#
# * types()
#
# * simpleType(\%type_options)
#
# * complexType(\%type_options)
#
#========================================================================

#------------------------------------------------------------------------
# type($name)
# type($name, $type_obj)
#
# Direct way to fetch/store types against names.
#------------------------------------------------------------------------

sub type {
    my $self = shift;
    my $name = shift;
    my ($type, $scope, $factory, $simple, $class);

    return ($self->{ _TYPES }->{ $name } = shift)
	if @_;

    return $type
	if ($type = $self->{ _TYPES }->{ $name });

    # delegate to any defined 'scope' if type not found
    if ($scope = $self->{ scope }) {
	$self->TRACE("delegating $name to $scope") if $DEBUG;
	return $scope->type($name)
	    || $self->error($scope->error());
    }

    # otherwise look for it as a builtin simple type
    $factory = $self->{ _FACTORY }
	|| return $self->error("no factory defined");

    $simple = $factory->module('simple')
	|| return $self->error($factory->error());

    if ($class = $simple->builtin($name)) {
	return $class->new()
	    || $self->error($class->error());
    }
    else {
	return $self->error("no such type: $name");
    }
}


#------------------------------------------------------------------------
# types()
#
# Return reference to hash array of internal type definitions.
#------------------------------------------------------------------------

sub types {
    my $self = shift;
    return $self->{ _TYPES };
}


#------------------------------------------------------------------------
# simpleType(\%type_options)
#
# Method for creating a simpleType object and adding it to the internal
# type definition facility.
#------------------------------------------------------------------------

sub simpleType {
    my $self = shift;
    my $factory = $self->{ _FACTORY };
    my ($name, $args, $type);

    if (ref $_[0]) {
	# hash array or simple type object
	$args = shift;
    }
    elsif (scalar @_ == 1) {
	# name requesting specific type
	$name = shift;
	return $self->type($name);
    }
    else {
	$args = { @_ };
    }

    if ($factory->isa( simple => $args )) {
	$type = $args;
    }
    else {
	$type = $factory->create( simple => $args )
	    || return $self->error( $factory->error() );
    }
    defined ($name = $type->name())
	|| return $self->error('no name specified for simpleType');

    $self->TRACE("name => ", $type->ID) if $DEBUG;

    return $self->type($name => $type);
}


#------------------------------------------------------------------------
# complexType(\%type_options)
#
# Method for creating a complexType object and adding it to the internal
# type definition facility.
#------------------------------------------------------------------------

sub complexType {
    my $self = shift;
    my $factory = $self->{ _FACTORY };
    my ($name, $args, $type);

    if (ref $_[0]) {
	# hash array or complex type object
	$args = shift;
    }
    elsif (scalar @_ == 1) {
	# name requesting specific type
	$name = shift;
	return $self->type->{ $name };
    }
    else {
	$args = { @_ };
    }

    if ($factory->isa( complex => $args )) {
	$type = $args;
	# define scope of complex type unless already set
	$type->scope($self)
	    unless defined $type->scope();

    }
    else {
	# define scope of complex type unless already set
	$args->{ scope } = $self
	    if UNIVERSAL::isa($args, 'HASH')
		&& ! exists $args->{ scope };

	$type = $factory->create( complex => $args )
	    || return $self->error( $factory->error() );
    }
    defined ($name = $type->name())
	|| return $self->error('no name specified for complexType');

    $self->TRACE("name => ", $type->ID) if $DEBUG;

    return $self->type($name => $type);

}



#========================================================================
# Element management methods
#========================================================================

sub element {
    my $self = shift;
    my $factory = $self->{ _FACTORY }
	|| return $self->error("no factory defined");

    if (@_) {
	if ($factory->isa( element => $_[0] )) {
	    $self->TRACE("returning element") if $DEBUG;
	    return shift;
	}
	else {
	    my $args = UNIVERSAL::isa($_[0], 'HASH') ? shift : { @_ };
	    $args->{ scope } = $self unless exists $args->{ scope };
	    $self->TRACE("creating element") if $DEBUG;
	     return $factory->create( element => $args )
		 || $self->error($factory->error());
	}
    }
    else {
	return $self->error("no element arguments");
    }
}


#========================================================================
# Attribute Group management methods
#========================================================================


#------------------------------------------------------------------------
# attribute_group()
# attribute_group($new_group)
#------------------------------------------------------------------------

sub attribute_group {
    my ($self, $group) = @_;
    my $name;

    # return entire hash if called with no arguments
    return $self->{ _ATTRIBUTE_GROUPS }
        unless defined $group;

    # create and register new attribute group if group is a reference to
    # a group object or hash of configuration options for an attribute
    # group, otherwise...

    if (ref $group) {
	my $factory = $self->factory();

	# coerce into attribute group object, if not already so
	$group = $factory->create( attribute_group => $group )
	    || return $self->error( $factory->error() )
		unless $factory->isa( attribute_group => $group );

	# by what name should we reference this group?
	$name = $group->name();

	return $self->error("no name specified for attribute group")
	    unless defined $name;

	# install it
	$self->{ _ATTRIBUTE_GROUPS }->{ $name } = $group;
    }
    else {
	$name = $group;
	$group = $self->{ _ATTRIBUTE_GROUPS }->{ $name }
	    || return $self->error("no such attribute group: $name");
    }

    return $group;
}



1;

__END__