File Coverage

lib/XML/Schema/Type/Union.pm

Criterion	Covered	Total	%
statement	28	28	100.0
branch	6	6	100.0
condition	1	2	50.0
subroutine	6	6	100.0
pod	1	2	50.0
total	42	44	95.4

#============================================================= -*-perl-*-
#
# XML::Schema::Type::Union
#
# DESCRIPTION
#   Module implementing the XML Schema union datatype.
#
# 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: Union.pm,v 1.1.1.1 2001/08/29 14:30:17 abw Exp $
#
#========================================================================

package XML::Schema::Type::Union;

use strict;
use XML::Schema::Type::Simple;
use base qw( XML::Schema::Type::Simple );
use vars qw( $VERSION $DEBUG $ERROR @MANDATORY );

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

@MANDATORY = qw( memberTypes );

sub init {
    my ($self, $config) = @_;
    $self->SUPER::init($config)
	|| return;
    $self->{ _VARIETY } = 'union';
    return $self;
}

sub validate_instance {
    my ($self, $infoset) = @_;

    $self->SUPER::validate_instance($infoset)
	|| return;

    my $value = $infoset->{ text };
    my ($newval, @errors);

    my $members = $self->{ memberTypes }
	|| return $self->error('union has no memberTypes');

    foreach my $member (@$members) {
	$newval = $member->instance($value);
	if ($newval) {
	    $infoset->{ value } = $newval;
	    return 1;
	}
	push(@errors, $member->name() . ': ' . $member->error());
    }
    return $self->error("invalid union: ", join(', ', @errors));
}

1;

__END__