#============================================================= -*-perl-*-
#
# XML::Schema::Facet
#
# DESCRIPTION
# Module implementing a base object class for representing XML
# Schema facets. A facet is a mechanism for specifying optional
# properties which constrain the value space of a datatype.
#
# 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: Facet.pm,v 1.1.1.1 2001/08/29 14:30:17 abw Exp $
#
#========================================================================
package XML::Schema::Facet;
use strict;
use base qw( XML::Schema::Base );
use vars qw( $VERSION $DEBUG $ERROR @MANDATORY @OPTIONAL );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
@MANDATORY = qw( value );
@OPTIONAL = qw( annotation name errmsg );
#------------------------------------------------------------------------
# new()
#
# Specialised constructor which extracts the facet name from the last
# element of the package name. e.g. for XML:Schema::Facet::minLength
# the facet name is 'minLength'. The $NAME package variable may be
# defined to override this behaviour and specify an alternate facet
# name.
#------------------------------------------------------------------------
sub new {
my $class = shift;
# make "new($n)" equivalent to "new(value => $n)"
unshift(@_, 'value') if @_ == 1 && ref $_[0] ne 'HASH';
$class->SUPER::new(@_);
}
sub init {
my ($self, $config) = @_;
my ($mand, $option) = @{ $self->_baseargs( qw( @MANDATORY %OPTIONAL ) ) };
$self->_mandatory($mand, $config)
|| return;
$self->_optional($option, $config)
|| return;
$self->{ name } ||= do {
my $class = ref $self;
$class =~ /.*::(\w+)$/;
$1;
};
return $self;
}
sub install {
my ($self, $facets, $table) = @_;
# $self->DEBUG("installing $self into type as $self->{ name }\n");
push(@$facets, $self);
$table->{ $self->{ name } } = $self;
return 1;
}
sub name {
my $self = shift;
return $self->{ name };
}
sub value {
my $self = shift;
return $self->{ value };
}
sub annotation {
my $self = shift;
return $self->{ annotation };
}
sub valid {
my ($self, $instance, $type) = @_;
return 1;
}
sub invalid {
my ($self, $msg) = @_;
$self->error($self->{ errmsg } ||
"$msg (required $self->{ name }: $self->{ value })");
}
sub accept {
my ($self, $visitor) = @_;
$visitor->visit_facet($self);
}
1;
__END__
=head1 NAME
XML::Schema::Facet - base class for XML Schema facets
=head1 SYNOPSIS
package XML::Schema::Facet::MyFacet;
use base qw( XML::Schema::Facet );
my $facet = XML::Schema::Facet::MyFacet->new(...);
my $instance = {
value => 'some data value',
};
print $facet->valid($instance) ? "valid" : "invalid";
=head1 DESCRIPTION
The XML::Schema::Facet module is a base class for objects that
represent XML Schema facets.
=head1 AUTHOR
Andy Wardley E<lt>abw@kfs.orgE<gt>
=head1 VERSION
This is version $Revision: 1.1.1.1 $ of the XML::Schema::Facet
distributed with version 0.1 of the XML::Schema module set.
=head1 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.
=head1 SEE ALSO
See also L<XML::Schema> and L<XML::Schema::Type::Simple>.