#============================================================= -*-perl-*-
#
# XML::Schema::Type::Builtin
#
# DESCRIPTION
# Definitions of the various simple types built in to XML Schema.
#
# 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: Builtin.pm,v 1.2 2001/12/20 13:26:27 abw Exp $
#
# TODO
# Not yet implemented
# * uriReference - consult RFC 2396 and RFC 2732
# * ID - should access document instance to store ID usage
# * IDREF - should access document instance to check ID exists
# * IDREFS - as above, and requires list functionality
# * ENTITY - should access document instance to check ENTITY declared
# * ENTITIES - as above, and requires list functionality
# * NMTOKENS - requires list
# * NOTATION - need document instance to check NOTATION defined
#
# Incomplete:
# * float/double - need validation of mantissa length
# * long/unsignedLong - can't validate numbers which exceed bounds
# * QName - needs namespace resolution against prefix
#
#========================================================================
package XML::Schema::Type::Builtin;
use strict;
use XML::Schema::Type::Simple;
use vars qw( $VERSION $DEBUG );
$VERSION = sprintf("%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
#========================================================================
# Primitive datatypes
#
# Based on XML Schema Part 2: Datatypes, W3C Candidate Recommendation,
# 24 October 2000, section 3.2.
#========================================================================
#------------------------------------------------------------------------
# string
#------------------------------------------------------------------------
package XML::Schema::Type::string;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR );
#------------------------------------------------------------------------
# boolean
#------------------------------------------------------------------------
package XML::Schema::Type::boolean;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
enumeration => {
value => [ 'true', 'false' ],
errmsg => 'value is not boolean (true/false)',
},
);
#------------------------------------------------------------------------
# double
# IEEE double precision 64-bit floating point number.
#------------------------------------------------------------------------
package XML::Schema::Type::double;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
my $value = $instance->{ value };
return $type->error('value is empty')
unless length $value;
return $type->error("value is not a valid $type->{ name }")
unless $value =~ /
^
([+-])? # sign ($1)
(?:
(INF) # infinity ($2)
| (NaN) # not a number ($3)
| (\d+(?:\.\d+)?) # mantissa ($4)
(?:[eE] # exponent
([+-])? # sign ($5)
(\d+) # value ($6)
)?
)
$
/x;
$instance->{ sign } = $1 || '';
$instance->{ infinity } = $2 ? 1 : 0;
$instance->{ nan } = $3 ? 1 : 0;
$instance->{ mantissa } = $4 || '';
$instance->{ exp_sign } = $5 || '';
$instance->{ exp_value } = $6 || '';
$instance->{ exponent } = ($5 || '') . ($6 || '');
# TODO: need to test bounds of mantissa ( < 2^53 )
my $exp = $instance->{ exponent };
return $type->error('double exponent is not valid (-1075 <= e <= 970)')
if $exp && ($exp < -1075 || $exp > 970);
return 1;
}
#------------------------------------------------------------------------
# float
# IEEE single precision 32-bit floating point number. Derived from
# double with an additional constraint check on the bounds of the
# mantissa and exponent.
#------------------------------------------------------------------------
package XML::Schema::Type::float;
use base qw( XML::Schema::Type::double );
use vars qw( $ERROR @FACETS );
@FACETS = (
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
# TODO: need to test bounds of mantissa ( < 2^24 )
my $exp = $instance->{ exponent };
return $type->error('float exponent is not valid (-149 <= e <= 104)')
if $exp && ($exp < -149 || $exp > 104);
return 1;
}
#------------------------------------------------------------------------
# decimal
# Arbitrary precision decimal number.
#------------------------------------------------------------------------
package XML::Schema::Type::decimal;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
my $value = $instance->{ value };
return $type->error('value is empty')
unless length $value;
return $type->error("value is not a decimal")
unless $value =~ /
^
([+-])? # sign ($1)
0*(\d+) # integer ($2)
(?:\.(\d+)0*)? # fraction ($3)
$
/x;
@$instance{ qw( sign integer fraction ) } = ($1, $2, $3);
$instance->{ scale } = length $3;
$instance->{ precision } = $instance->{ scale } + length $2;
return 1;
}
#------------------------------------------------------------------------
# timeDuration
# A duration of time as in the extended format as defined in [ISO 8601
# Date and Time Formats]. e.g. P7Y1M4DT7H3M12.8S: 7 years, 1 month, 4
# days, 7 hours, 3 minutes and 12.8 seconds.
#------------------------------------------------------------------------
package XML::Schema::Type::timeDuration;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
\&prepare, # install direct call to subroutine
);
sub prepare {
my ($instance, $type) = @_;
my $value = $instance->{ value };
return $type->error('value is empty')
unless length $value;
return $type->error("value is not a valid timeDuration")
unless $value =~ /
^
(-)? # sign ($1)
P([^T]*) # date ($2)
(?:T(.+))? # time ($3)
$
/x;
return $type->error("value must specify at least one date/time item")
unless length $2 or $3;
$instance->{ sign } = $1;
$instance->{ date } = $2 || '';
$instance->{ time } = $3 || '';
return $type->error("value contains an invalid date element")
unless $instance->{ date } =~ /
^
(?:(\d+)Y)? # years ($1)
(?:(\d+)M)? # months ($2)
(?:(\d+)D)? # days ($3)
$
/x;
@$instance{ qw( years months days ) } = ($1, $2, $3);
$instance->{ zero_date } = ($1 || $2 || $3) ? 0 : 1;
return $type->error("value contains an invalid time element")
unless $instance->{ time } =~ /
^
(?:(\d+)H)? # hours ($1)
(?:(\d+)M)? # minutes ($2)
(?:(\d(?:\.\d+)?)S)? # seconds ($3)
$
/x;
@$instance{ qw( hours minutes seconds ) } = ($1, $2, $3);
$instance->{ zero_time } = ($1 || $2 || $3) ? 0 : 1;
$instance->{ zero } = $instance->{ zero_date }
&& $instance->{ zero_time };
return 1;
}
#------------------------------------------------------------------------
# recurringDuration
# Note that period and duration do not affect the parser implemented in
# the prepare() method. Derived types that specify an alternate or
# truncated lexical format should implement their own prepare()
# method.
#------------------------------------------------------------------------
package XML::Schema::Type::recurringDuration;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
sub { $_[1]->prepare($_[0]) }, # install hook to call object method
);
sub init {
my $self = shift;
return undef
unless $self->SUPER::init(@_);
return $self->error('duration not defined')
unless $self->facet('duration');
return $self->error('period not defined')
unless $self->facet('period');
return $self;
}
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid recurringDuration")
unless $value =~ /
^
([+-])? # sign ($1)
(\d{2,}) # century ($2)
(\d{2}) - # year ($3)
(\d{2}) - # month ($4)
(\d{2}) T # day ($5)
(\d{2}) : # hour ($6)
(\d{2}) : # minute ($7)
(\d{2}(?:.\d+)?) # second ($8)
(?: # optional time zone
(Z) # UTC ($9)
| ([-+]) # sign ($10)
(\d{2}) : # hours ($11)
(\d{2}) # minutes ($12)
)?
$
/x;
@$instance{ qw( sign century year month day hour minute second ) }
= ($1, $2, $3, $4, $5, $6, $7, $8 );
$instance->{ UTC } = $9 ? 1 : 0;
my $zone = $instance->{ zone } = { };
@$zone{ qw( sign hour minute ) } = ($10, $11, $12);
return 1;
}
#------------------------------------------------------------------------
# binary
# Arbitrary binary data. Must be derived to specify encoding.
#------------------------------------------------------------------------
package XML::Schema::Type::binary;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
);
sub init {
my $self = shift;
return undef
unless $self->SUPER::init(@_);
return $self->error('encoding not defined')
unless $self->facet('encoding');
return $self;
}
#------------------------------------------------------------------------
# uriReference
# Uniform Resource Identifier as defined in Section 4 of [RFC 2396] and
# amended by [RFC 2732].
#------------------------------------------------------------------------
package XML::Schema::Type::uriReference;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
sub { die "uriReference not yet implemented\n" },
);
#------------------------------------------------------------------------
# ENTITY
#------------------------------------------------------------------------
package XML::Schema::Type::ENTITY;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
sub { die "ENTITY not yet implemented\n" },
);
#------------------------------------------------------------------------
# QName
#------------------------------------------------------------------------
package XML::Schema::Type::QName;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse',
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
my $value = $instance->{ value };
return $type->error('value is empty')
unless length $value;
return $type->error("value is not a valid QName")
unless $value =~ /
^
(?:
([a-zA-Z_][\w\-.]*?) # prefix ($1)
:
)?
([a-zA-Z_][\w\-.]*?) # local ($2)
$
/x;
$instance->{ prefix } = $1 || '';
$instance->{ local } = $2;
# TODO: need to validate prefix to a namespace
$instance->{ namespace } = '???';
return 1;
}
#========================================================================
# Derived datatypes
#
# Based on XML Schema Part 2: Datatypes, W3C Candidate Recommendation,
# 24 October 2000, section 3.3.
#========================================================================
#------------------------------------------------------------------------
# CDATA
# As per string but with newlines, carriage returns and tabs converted
# to spaces.
#------------------------------------------------------------------------
package XML::Schema::Type::CDATA;
use base qw( XML::Schema::Type::string );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'replace'
);
#------------------------------------------------------------------------
# token
# As per CDATA but with adjacent spaces collapsed to a single space
# and leading and trailing spaces removed. Note derivation from
# string rather than CDATA.
#------------------------------------------------------------------------
package XML::Schema::Type::token;
use base qw( XML::Schema::Type::string );
use vars qw( $ERROR @FACETS );
@FACETS = (
whiteSpace => 'collapse'
);
#------------------------------------------------------------------------
# language
# Derived from token, with a pattern constraint to represent natural
# language identifiers as defined by RFC 1766.
#------------------------------------------------------------------------
package XML::Schema::Type::language;
use base qw( XML::Schema::Type::token );
use vars qw( $ERROR @FACETS );
@FACETS = (
pattern => {
value => '^([a-zA-Z]{2}|[iI]-[a-zA-Z]+|[xX]-[a-zA-Z]+)(-[a-zA-Z]+)*$',
errmsg => 'value is not a language',
}
);
#------------------------------------------------------------------------
# IDREFS
#------------------------------------------------------------------------
package XML::Schema::Type::IDREFS;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
sub { die "IDREFS not yet implemented\n" },
);
#------------------------------------------------------------------------
# ENTITIES
#------------------------------------------------------------------------
package XML::Schema::Type::ENTITIES;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
sub { die "ENTITIES not yet implemented\n" },
);
#------------------------------------------------------------------------
# NMTOKEN
# String matching the NMTOKEN attribute type from [XML 1.0
# Recommendation (Second Edition)].
#------------------------------------------------------------------------
package XML::Schema::Type::NMTOKEN;
use base qw( XML::Schema::Type::token );
use vars qw( $ERROR @FACETS );
@FACETS = (
pattern => {
value => '^[\w\-_.:]+$',
errmsg => 'value is not a valid NMTOKEN',
}
);
#------------------------------------------------------------------------
# NMTOKENS
#------------------------------------------------------------------------
package XML::Schema::Type::NMTOKENS;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
sub { die "NMTOKENS not yet implemented\n" },
);
#------------------------------------------------------------------------
# Name
# String matching the 'Name' production of [XML 1.0 Recommendation
# (Second Edition)].
#------------------------------------------------------------------------
package XML::Schema::Type::Name;
use base qw( XML::Schema::Type::token );
use vars qw( $ERROR @FACETS );
@FACETS = (
pattern => {
value => '^[a-zA-Z_:][\w\-_.:]*$',
errmsg => 'value is not a valid Name',
}
);
#------------------------------------------------------------------------
# NCName
# Non-colonized name, a string matching the 'NCName' production of
# [Namespaces in XML].
#------------------------------------------------------------------------
package XML::Schema::Type::NCName;
use base qw( XML::Schema::Type::token );
use vars qw( $ERROR @FACETS );
@FACETS = (
pattern => {
value => '^[a-zA-Z_][\w\-.]*$',
errmsg => 'value is not a valid NCName',
}
);
#------------------------------------------------------------------------
# ID
# String matching the ID attribute type from [XML 1.0 Recommendation
# (Second Edition)].
#------------------------------------------------------------------------
package XML::Schema::Type::ID;
use base qw( XML::Schema::Type::Name );
use vars qw( $ERROR @FACETS );
@FACETS = (
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
$instance->{ magic } = [ ID => $instance->{ value } ];
return 1;
}
#------------------------------------------------------------------------
# IDREF
#------------------------------------------------------------------------
package XML::Schema::Type::IDREF;
use base qw( XML::Schema::Type::Name );
use vars qw( $ERROR @FACETS );
@FACETS = (
\&prepare,
);
sub prepare {
my ($instance, $type) = @_;
$instance->{ magic } = [ IDREF => $instance->{ value } ];
return 1;
}
#------------------------------------------------------------------------
# NOTATION
#------------------------------------------------------------------------
package XML::Schema::Type::NOTATION;
use base qw( XML::Schema::Type::Simple );
use vars qw( $ERROR @FACETS );
@FACETS = (
sub { die "NOTATION not yet implemented\n" },
);
#------------------------------------------------------------------------
# integer
#------------------------------------------------------------------------
package XML::Schema::Type::integer;
use base qw( XML::Schema::Type::decimal );
use vars qw( $ERROR @FACETS );
@FACETS = (
scale => {
value => 0,
fixed => 1,
errmsg => 'value is not an integer',
},
);
#------------------------------------------------------------------------
# nonPositiveInteger
# An integer value less than or equal to 0
#------------------------------------------------------------------------
package XML::Schema::Type::nonPositiveInteger;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => {
value => 0,
errmsg => 'value is positive',
},
);
#------------------------------------------------------------------------
# negativeInteger
# An integer value less than 0
#------------------------------------------------------------------------
package XML::Schema::Type::negativeInteger;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => {
value => -1,
errmsg => 'value is not negative'
},
);
#------------------------------------------------------------------------
# long
# An integer in the range -9223372036854775808 to 9223372036854775807.
# See comments in docs/nonconform relating to failure to correctly
# validate long numbers.
#------------------------------------------------------------------------
package XML::Schema::Type::long;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => -9223372036854775808,
maxInclusive => 9223372036854775807,
);
#------------------------------------------------------------------------
# int
# An integer value in the range -2147483648 to 2147483647. Note that
# we derive directly from integer rather than long.
#------------------------------------------------------------------------
package XML::Schema::Type::int;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => -2147483648,
maxInclusive => 2147483647,
);
#------------------------------------------------------------------------
# short
# An integer value in the range -32768 to 32767. Note that
# we derive directly from integer rather than int.
#------------------------------------------------------------------------
package XML::Schema::Type::short;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => -32768,
maxInclusive => 32767,
);
#------------------------------------------------------------------------
# byte
# An integer in the range -128 to 127. Again, this is derived
# directly from integer rather than via short.
#------------------------------------------------------------------------
package XML::Schema::Type::byte;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => -128,
maxInclusive => 127,
);
#------------------------------------------------------------------------
# nonNegativeInteger
# An integer value greater than or equal to 0
#------------------------------------------------------------------------
package XML::Schema::Type::nonNegativeInteger;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => {
value => 0,
errmsg => 'value is negative',
},
);
#------------------------------------------------------------------------
# unsignedLong
# An integer in the range 0 to 18446744073709551615
# See comments in docs/nonconform relating to failure to correctly
# validate long numbers.
#------------------------------------------------------------------------
package XML::Schema::Type::unsignedLong;
use base qw( XML::Schema::Type::nonNegativeInteger );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => 18446744073709551615,
);
#------------------------------------------------------------------------
# unsignedInt
# An integer in the range 0 to 4294967295. This is derived directly
# from nonNegativeInteger rather than via unsignedLong.
#------------------------------------------------------------------------
package XML::Schema::Type::unsignedInt;
use base qw( XML::Schema::Type::nonNegativeInteger );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => 4294967295,
);
#------------------------------------------------------------------------
# unsignedShort
# An integer in the range 0 to 65535. This is derived directly
# from nonNegativeInteger rather than via unsignedInt.
#------------------------------------------------------------------------
package XML::Schema::Type::unsignedShort;
use base qw( XML::Schema::Type::nonNegativeInteger );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => 65535,
);
#------------------------------------------------------------------------
# unsignedByte
# An unsigned byte in the range 0 to 255. Again, this is derived
# directly from nonNegativeInteger rather than via unsignedShort.
#------------------------------------------------------------------------
package XML::Schema::Type::unsignedByte;
use base qw( XML::Schema::Type::nonNegativeInteger );
use vars qw( $ERROR @FACETS );
@FACETS = (
maxInclusive => 255,
);
#------------------------------------------------------------------------
# positiveInteger
# An integer value greater than 0
#------------------------------------------------------------------------
package XML::Schema::Type::positiveInteger;
use base qw( XML::Schema::Type::integer );
use vars qw( $ERROR @FACETS );
@FACETS = (
minInclusive => {
value => 1,
errmsg => 'value is not positive',
},
);
#------------------------------------------------------------------------
# timeInstant
#------------------------------------------------------------------------
package XML::Schema::Type::timeInstant;
use base qw( XML::Schema::Type::recurringDuration );
use vars qw( $ERROR @FACETS );
@FACETS = (
period => { value => 'P0Y', fixed => 1 },
duration => { value => 'P0Y', fixed => 1 },
);
#------------------------------------------------------------------------
# time
#------------------------------------------------------------------------
package XML::Schema::Type::time;
use base qw( XML::Schema::Type::recurringDuration );
use vars qw( $ERROR @FACETS );
@FACETS = (
period => { value => 'P1D', fixed => 1 },
duration => { value => 'P0Y', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid date")
unless $value =~ /
^
(\d{2}) : # hour ($1)
(\d{2}) : # minute ($2)
(\d{2}(?:.\d+)?) # second ($3)
(?: # optional time zone
(Z) # UTC ($4)
| ([-+]) # sign ($5)
(\d{2}) : # hours ($6)
(\d{2}) # minutes ($7)
)?
$
/x;
@$instance{ qw( hour minute second ) } = ($1, $2, $3);
$instance->{ UTC } = $4 ? 1 : 0;
my $zone = $instance->{ zone } = { };
@$zone{ qw( sign hour minute ) } = ($5, $6, $7);
return 1;
}
#------------------------------------------------------------------------
# timePeriod
#------------------------------------------------------------------------
package XML::Schema::Type::timePeriod;
use base qw( XML::Schema::Type::recurringDuration );
use vars qw( $ERROR @FACETS );
@FACETS = (
period => { value => 'P0Y', fixed => 1 },
);
#------------------------------------------------------------------------
# date
#------------------------------------------------------------------------
package XML::Schema::Type::date;
use base qw( XML::Schema::Type::timePeriod );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P1D', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid date")
unless $value =~ /
^
([-+]?) # sign ($1)
(\d{2,}) # century ($2)
(\d{2}) - # year ($3)
(\d{2}) - # month ($4)
(\d{2}) # day ($5)
$
/x;
@$instance{ qw( sign century year month day ) } = ( $1, $2, $3, $4, $5 );
return 1;
}
#------------------------------------------------------------------------
# month
#------------------------------------------------------------------------
package XML::Schema::Type::month;
use base qw( XML::Schema::Type::timePeriod );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P1M', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid month")
unless $value =~ /
^
([-+]?) # sign ($1)
(\d{2,}) # century ($2)
(\d{2}) - # year ($3)
(\d{2}) # month ($4)
$
/x;
@$instance{ qw( sign century year month ) } = ( $1, $2, $3, $4 );
return 1;
}
#------------------------------------------------------------------------
# year
#------------------------------------------------------------------------
package XML::Schema::Type::year;
use base qw( XML::Schema::Type::timePeriod );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P1Y', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid year")
unless $value =~ /
^
([-+]?) # sign ($1)
(\d{2,}) # century ($2)
(\d{2}) # year ($3)
$
/x;
@$instance{ qw( sign century year ) } = ( $1, $2, $3 );
return 1;
}
#------------------------------------------------------------------------
# century
#------------------------------------------------------------------------
package XML::Schema::Type::century;
use base qw( XML::Schema::Type::timePeriod );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P100Y', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid century")
unless $value =~ /
^
([-+]?) # sign ($1)
(\d{2,}) # century ($2)
$
/x;
@$instance{ qw( sign century ) } = ( $1, $2 );
return 1;
}
#------------------------------------------------------------------------
# recurringDate
#------------------------------------------------------------------------
package XML::Schema::Type::recurringDate;
use base qw( XML::Schema::Type::recurringDuration );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P1D', fixed => 1 },
period => { value => 'P1Y', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid recurringDate")
unless $value =~ /
^
--
(\d{2}) - # month ($1)
(\d{2}) # day ($2)
$
/x;
@$instance{ qw( month day ) } = ( $1, $2 );
return 1;
}
#------------------------------------------------------------------------
# recurringDay
#------------------------------------------------------------------------
package XML::Schema::Type::recurringDay;
use base qw( XML::Schema::Type::recurringDuration );
use vars qw( $ERROR @FACETS );
@FACETS = (
duration => { value => 'P1D', fixed => 1 },
period => { value => 'P1M', fixed => 1 },
);
sub prepare {
my ($self, $instance) = @_;
my $value = $instance->{ value };
return $self->error('value is empty')
unless length $value;
return $self->error("value is not a valid recurringDay")
unless $value =~ /
^
---
(\d{2}) # day ($1)
$
/x;
$instance->{ day } = $1;
return 1;
}
1;
__END__
=head1 NAME
XML::Schema::Type::Builtin - built in datatypes for XML Schema
=head1 SYNOPSIS
use XML::Schema::Type::Builtin;
=head1 DESCRIPTION
This module implements the simple datatype built in to XML Schema.
=head1 AUTHOR
Andy Wardley E<lt>abw@kfs.orgE<gt>
=head1 VERSION
This is version $Revision: 1.2 $ of the XML::Schema::Type::Builtin,
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>.