File Coverage

lib/XML/Schema.pm

Criterion	Covered	Total	%
statement	40	66	60.6
branch	6	34	17.6
condition	7	44	15.9
subroutine	11	15	73.3
pod	1	8	12.5
total	65	167	38.9

#============================================================= -*-perl-*-
#
# XML::Schema
#
# DESCRIPTION
#   Modules for representing, constucting and utilising XML Schemata
#   in Perl.
#
# 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: Schema.pm,v 1.2 2001/12/20 13:26:27 abw Exp $
#
#========================================================================

package XML::Schema;

use strict;
use XML::Schema::Element;
use XML::Schema::Factory;
use XML::Schema::Scope;
use XML::Schema::Type;
use base qw( XML::Schema::Scope );
use vars qw( $VERSION $DEBUG $ERROR $ETYPE $FACTORY @OPTIONAL );

$VERSION  = 0.07;
$DEBUG    = 0 unless defined $DEBUG;
$ERROR    = '';
$ETYPE    = 'Schema';
$FACTORY  = 'XML::Schema::Factory';
@OPTIONAL = qw( element );


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

    $self->SUPER::init($config)
	|| return;

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

    # allow (but don't enfore) content model to be created by specifying
    # 'type', 'particle' or 'content' in config
#    $self->{ content } = $FACTORY->content($config);
#	|| return $self->error($FACTORY->error());
#
#    $self->TRACE("content => ", $self->{ content }) if $DEBUG;

    return $self;
}


sub element {
    my $self = shift;
    if (@_) {
	return ($self->{ element } = $self->SUPER::element(@_));
    }
    else {
	return $self->{ element }
	    || $self->error("no element defined");
    }
}

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

    $self->TRACE() if $DEBUG;

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


#------------------------------------------------------------------------
# content()
# content($item)
#
# Return the current content model for the schema (if any) when called
# without any args.  Sets the content model (converting it to a Content
# object if necessary) when called with an argument.
#------------------------------------------------------------------------

sub content {
    my $self = shift;

    return ($self->{ content }
	|| $self->error('schema has no content model'))
	unless @_;

    $self->TRACE("content: ", @_) if $DEBUG;

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

    return ($self->{ content } = $factory->create( content => @_ ))
	|| $self->error($factory->error());
}


#------------------------------------------------------------------------
# parser(@args)
#
# Create a parser object (XML::Schema::Parser by default) primed for
# validation against this schema.  Arguments are folded into a hash
# reference, if not already provided as such, and the 'schema' item is
# added, containing a reference to the $self schema object.
#------------------------------------------------------------------------

sub parser {
    my $self = shift;
    my $args = $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ };

    $args->{ schema } = $self;

    $self->TRACE("args => ", $args) if $DEBUG;

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

    return $factory->create( parser => $args )
	|| $self->error($factory->error());
}


#------------------------------------------------------------------------
# instance(@args)
#
# Create an instance object (XML::Schema::Instance by default) for
# representing the generated content created by parsing an instance
# document of this schema.  Arguments are folded into a hash
# reference, if not already provided as such, and the 'schema' item is
# added, containing a reference to the $self schema object.
#------------------------------------------------------------------------

sub instance {
    my $self = shift;
    my $args = $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ };

    $args->{ schema } = $self;

    $self->TRACE("args => ", $args) if $DEBUG;

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

    return $factory->create( instance => $args )
	|| $self->error($factory->error());
}


#------------------------------------------------------------------------
# handler(@args)
#
# Create a parser object (XML::Schema::Parser by default) for parsing
# instance documents according to the current schema.  Arguments are
# folded into a hash reference, if not already provided as such, and
# the 'schema' item is added, containing a reference to the $self
# schema object.
#------------------------------------------------------------------------

sub handler {
    my $self = shift;
    my $args = $_[0] && ref($_[0]) eq 'HASH' ? shift : { @_ };

    $args->{ schema } = $self;

    $self->TRACE("args => ", $args) if $DEBUG;

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

    return $factory->create( schema_handler => $args )
	|| $self->error($factory->error());
}


sub present {
    my ($self, $view) = @_;
    $view->view( schema => $self );
}

1;

__END__