#============================================================= -*-perl-*- # # XML::Schema::Content.pm # # DESCRIPTION # Module implementing a class to represent a content model being either # 'empty', having a 'simple' type, or a pair of particle and model type, # which can be one of 'mixed' or 'element-only'. # # 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: Content.pm,v 1.1.1.1 2001/08/29 14:30:17 abw Exp $ # #======================================================================== package XML::Schema::Content; use strict; use XML::Schema; use base qw( XML::Schema::Base ); use vars qw( $VERSION $DEBUG $ERROR $ETYPE @ARGS ); $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); $DEBUG = 0 unless defined $DEBUG; $ERROR = ''; $ETYPE = 'content'; @ARGS = qw( type content particle mixed empty ); *FACTORY = \$XML::Schema::FACTORY; # alias min() to minOccurs() and max() to maxOccurs() *minOccurs = \&min; *maxOccurs = \&max; #------------------------------------------------------------------------ # init() # # Called automatically by base class new() method. #------------------------------------------------------------------------ sub init { my ($self, $config) = @_; my ($type, $content, $particle, $mixed); my $factory = $self->{ FACTORY } ||= $config->{ FACTORY } || $XML::Schema::FACTORY; $self->TRACE("config => ", $config) if $DEBUG; $self->{ type } = undef; # if ($type = $config->{ type }) { # # simple type content # $self->{ type } = $type; # $self->TRACE("set type to $type") if $DEBUG; # } # elsif ($particle = $config->{ particle }) { if ($particle = $config->{ particle }) { # particle specified directly, mixed flag also allowed $self->{ particle } = $particle; $self->{ mixed } = $config->{ mixed } ? 1 : 0; } elsif (! $config->{ empty }) { if ($particle = $factory->create( particle => $config )) { # have a bash at creating a particle anyway $self->{ particle } = $particle; } else { my $error = $factory->error(); # HACK: this might be an empty/text only content model so # we ignore particle errors that report a missing particle return $self->error($error) unless $error =~ /^particle expects one of:/; } } $self->{ mixed } = $config->{ mixed } ? 1 : 0; return $self; } sub model { my $self = shift; return $self->{ type } || $self->{ particle } || $self->error("no particle defined in content model"); } sub type { return $_[0]->{ type }; } sub particle { my $self = shift; return $self->{ particle } || $self->error("no particle defined in content model"); } sub args { return @ARGS; } #------------------------------------------------------------------------ # mixed($flag) # # Used to set (if called with an argument) or get the current value # for the 'mixed' flag indicating if the complexType accepts mixed # content. #------------------------------------------------------------------------ sub mixed { my $self = shift; return @_ ? ($self->{ mixed } = shift) : $self->{ mixed }; } #------------------------------------------------------------------------ # element_only($flag) # # The inverse of mixed(). Returns true if mixed is false and vice # verse. Can also be used to update the mixed flag wih the correct # truth inversion performed. #------------------------------------------------------------------------ sub element_only { my $self = shift; return @_ ? ! ($self->{ mixed } = ! shift) : ! $self->{ mixed }; } #------------------------------------------------------------------------ # empty() # # Returns true if the content model is empty. #------------------------------------------------------------------------ sub empty { return ($_[0]->{ type } || $_[0]->{ particle }) ? 0 : 1; } sub ID { return 'Content'; } 1;