xmerl_xsd_type.erl

OTP是开放电信平台的简称

%%% The contents of this file are subject to the Erlang Public License,
%%% Version 1.0, (the "License"); you may not use this file except in
%%% compliance with the License. You may obtain a copy of the License at
%%% http://www.erlang.org/license/EPL1_0.txt
%%%
%%% Software distributed under the License is distributed on an "AS IS"
%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%%% the License for the specific language governing rights and limitations
%%% under the License.
%%%
%%%
%%% The Initial Developer of the Original Code is Ericsson Telecom
%%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%%% Telecom AB. All Rights Reserved.
%%%
%%%-------------------------------------------------------------------
%%% File    : xmerl_xsd_type.erl
%%% Author  : Bertil Karlsson <bertil@finrod>
%%% Description : 
%%%
%%% Created : 31 Mar 2006 by Bertil Karlsson <bertil@finrod>
%%%-------------------------------------------------------------------
-module(xmerl_xsd_type).

-export([check_simpleType/3,facet_fun/2,compare_floats/2,
	 replace_ws/2,collapse_ws/1]).

-export([fQuotient/2,fQuotient/3,modulo/2,modulo/3,maximumDayInMonthFor/2,
	 add_duration2dateTime/2,duration_atoms/1,dateTime_atoms/1,
	 normalize_dateTime/1]).

-export([compare_durations/2,compare_dateTime/2]).

-include("xmerl.hrl").
-include("xmerl_xsd.hrl").


-define(catch_exit(_Call_,_Value_,_ErrorCause_),
	case catch (_Call_) of
	    {'EXIT',_} ->
		{error,{type,_ErrorCause_,_Value_}};
	    {error,_} ->
		{error,{_ErrorCause_,_Value_}};
	    _ ->
		{ok,_Value_}
	end).

-define(is_whitespace(__WS__),
	__WS__==16#20; __WS__==16#9;__WS__==16#a; __WS__==16#d).

check_simpleType(Name,Value,S) when is_list(Name) ->
    ?debug("simpleType name a list: "++Name++"~n",[]),
    check_simpleType(list_to_atom(Name),Value,S);
check_simpleType(string,Value,_S) ->
    case [X||X <- Value,
	     xmerl_lib:is_char(X)] of
	Value ->
	    {ok,Value};
	_ ->
	    {error,{value_not_string,Value}}
    end;
check_simpleType(normalizedString,Value,_S) ->
    case [X||X <- Value,xmerl_lib:is_char(X),
	     ns_whitespace(X)==false] of
	Value ->
	    {ok,Value};
	_ ->
	    {error,{value_not_normalizedString,Value}}
    end;
check_simpleType(boolean,"true",_S) -> {ok,"true"};
check_simpleType(boolean,"false",_S) -> {ok,"false"};
check_simpleType(boolean,"1",_S) -> {ok,"1"};
check_simpleType(boolean,"0",_S) -> {ok,"0"};
check_simpleType(boolean,Other,_S) -> {error,{value_not_boolean,Other}};
check_simpleType(decimal,Value,_S) ->
    ?catch_exit(check_decimal(Value),Value,invalid_decimal);
check_simpleType(integer,Value,_S) ->
    ?catch_exit(check_integer(Value),Value,invalid_integer);

% float values: m * 2^e, where m is an integer whose absolute value is
% less than 2^24, and e is an integer between -149 and 104, inclusive.
check_simpleType(float,Value,_S) ->
    ?catch_exit(check_float(Value),Value,invalid_float);
% double values: m * 2^e, where m is an integer whose absolute value
% is less than 2^53, and e is an integer between -1075 and 970,
% inclusive.
check_simpleType(double,Value,_S) ->
    ?catch_exit(check_double(Value),Value,invalid_double);
% extended format PnYnMnDTnHnMnS where n is an integer. The n value
% before S may include decimal fraction.
check_simpleType(duration,Value,_S) ->
    ?catch_exit(check_duration(Value),Value,invalid_duration);	
check_simpleType(dateTime,Value,_S) ->
    ?catch_exit(check_dateTime(Value),Value,invalid_dateTime);
check_simpleType(time,Value,_S) ->
    ?catch_exit(check_time(Value),Value,invalid_time);
check_simpleType(date,Value,_S) ->
    ?catch_exit(check_date(Value),Value,invalid_date);
check_simpleType(gYearMonth,Value,_S) ->
    ?catch_exit(check_gYearMonth(Value),Value,invalid_gYearMonth);
check_simpleType(gYear,Value,_S) ->
    ?catch_exit(check_gYear(Value),Value,invalid_gYear);
check_simpleType(gMonthDay,Value,_S) ->
    ?catch_exit(check_gMonthDay(Value),Value,invalid_gMonthDay);
check_simpleType(gDay,Value,_S) ->
    ?catch_exit(check_gDay(Value),Value,invalid_gDay);
check_simpleType(gMonth,Value,_S) ->
    ?catch_exit(check_gMonth(Value),Value,invalid_gMonth);
check_simpleType(hexBinary,Value,_S) ->
    IsEven = fun(X) ->
		   case X rem 2 of
		       0 -> true;
		       _ -> false
		   end
	   end,
    IsHex = fun(X) when X >= $A, X =< $F -> true;
	       (X) when X >= $a, X =< $f -> true;
	       (X) when X >= $0, X =< $9 -> true;
	       (_) -> false
	    end,
    case [X|| X<-Value,
	      IsEven(length(Value)),
	      IsHex(X)] of
	Value ->
	    {ok,Value};
	_ -> {error,{value_not_hexBinary,Value}}
    end;
check_simpleType(base64Binary,Value,_S) ->
    check_base64Binary(Value);
check_simpleType(anyURI,Value,S) ->
    case xmerl_uri:parse(Value) of
	{error,_} ->
	    %% might be a relative uri, then it has to be a path in the context
	    case catch file:read_file_info(filename:join(S#xsd_state.xsd_base,Value)) of
		{ok,_} ->
		    {ok,Value};
		_ ->
		    {error,{value_not_anyURI,Value}}
	    end;
	_ ->
	    {ok,Value}
    end;
check_simpleType('QName',Value,_S) ->
    case xmerl_lib:is_name(Value) of
	true ->
	    {ok,Value};
	_ ->
	    {error,{value_not_QName,Value}}
    end;
check_simpleType('NOTATION',Value,_S) ->
    {ok,Value}; %% Must provide for check of all QNames in schema.
check_simpleType(token,Value,_S) ->
    ?catch_exit(check_token(Value),Value,invalid_token);
%% conform to the pattern [a-zA-Z]{1,8}(-[a-zA-Z0-9]{1,8})*
check_simpleType(language,Value,_S) ->
    ?catch_exit(check_language(Value),Value,illegal_language);
check_simpleType('NMTOKEN',Value,_S) ->
    ?catch_exit(check_NMTOKEN(Value),Value,illegal_NMTOKEN);
check_simpleType('NMTOKENS',Value,_S) ->
    ?catch_exit(check_NMTOKENS(Value),Value,illegal_NMTOKENS);
check_simpleType('Name',Value,_S) ->
    ?catch_exit(check_Name(Value),Value,illegal_name);
check_simpleType('NCName',Value,_S) ->
    ?catch_exit(check_NCName(Value),Value,illegal_name);
check_simpleType('ID',Value,_S) ->
    ?catch_exit(check_ID(Value),Value,illegal_ID);
check_simpleType('IDREF',Value,_S) ->
    ?catch_exit(check_IDREF(Value),Value,illegal_IDREF);
check_simpleType('IDREFS',Value,_S) ->
    ?catch_exit(check_IDREFS(Value),Value,illegal_IDREFS);
check_simpleType('ENTITY',Value,_S) ->
    ?catch_exit(check_ENTITY(Value),Value,illegal_ENTITY);
check_simpleType('ENTITIES',Value,_S) ->
    ?catch_exit(check_ENTITIES(Value),Value,illegal_ENTITIES);
check_simpleType(nonPositiveInteger,Value,_S) ->
    ?catch_exit(check_nonPositiveInteger(Value),Value,
		illegal_nonPositiveInteger);
check_simpleType(negativeInteger,Value,_S) ->
    ?catch_exit(check_negativeInteger(Value),Value,
		illegal_negativeInteger);
check_simpleType(long,Value,_S) ->
    ?catch_exit(check_long(Value),Value,illegal_long);
check_simpleType(int,Value,_S) ->
    ?catch_exit(check_int(Value),Value,illegal_int);
check_simpleType(short,Value,_S) ->
    ?catch_exit(check_short(Value),Value,illegal_short);
check_simpleType(byte,Value,_S) ->
    ?catch_exit(check_byte(Value),Value,illegal_byte);
check_simpleType(nonNegativeInteger,Value,_S) ->
    ?catch_exit(check_nonNegativeInteger(Value),Value,
		illegal_nonNegativeInteger);
check_simpleType(unsignedLong,Value,_S) ->
    ?catch_exit(check_unsignedLong(Value),Value,illegal_unsignedLong);
check_simpleType(unsignedInt,Value,_S) ->
    ?catch_exit(check_unsignedInt(Value),Value,illegal_unsignedInt);
check_simpleType(unsignedShort,Value,_S) ->
    ?catch_exit(check_unsignedShort(Value),Value,illegal_unsignedShort);
check_simpleType(unsignedByte,Value,_S) ->
    ?catch_exit(check_unsignedByte(Value),Value,illegal_unsignedByte);
check_simpleType(positiveInteger,Value,_S) ->
    ?catch_exit(check_positiveInteger(Value),Value,illegal_positiveInteger);
check_simpleType(Unknown,Value,_S) ->
    {error,{unknown_type,Unknown,Value}}.

check_decimal(Value) ->
    case string:tokens(Value,".") of
	L when length(L) == 1; length(L) == 2 ->
	    [list_to_integer(X)||X <- L],
	    {ok,Value};
	_ ->
	    {error,{value_not_decimal,Value}}
    end.
%%     I=string:chr(Value,$.),
%%     {NumberDot,Decimal}=lists:split(I,Value),
%%     Number=string:strip(NumberDot,right,$.),
%%     case catch {list_to_integer(Number),list_to_integer(Decimal)} of
%% 	{'EXIT',_} ->
%% 	    {error,{value_not_decimal,Value}};
%% 	_ -> {ok,Value}
%%     end.

check_float(V="-INF") ->
    {ok,V};
check_float(V="INF") ->
    {ok,V};
check_float(V="NaN") ->
    {ok,V};
check_float(Value) ->
%%     Pred = fun(X) when X==$e;X==$E -> false;(_) -> true end,
%%     {Mantissa,Exponent}=lists:splitwith(Pred,Value),
%%     SkipEe = fun([]) -> [];(L) -> tl(L) end,
    case string:tokens(Value,"eE") of
	[Mantissa,Exponent] ->
	    {ok,_} = check_decimal(Mantissa),
	    {ok,_} = check_integer(Exponent);
	[Mantissa] ->
	    check_decimal(Mantissa)
    end,
    {ok,Value}.
%%     case {check_decimal(Mantissa),
%% 	  check_simpleType(integer,SkipEe(Exponent))} of
%% 	{{ok,_},{ok,_}} ->
%% 	    {ok,Value};
%% 	_ ->
%% 	    {error,{value_not_float,Value}}
%%     end.

check_double(Value) ->
    check_float(Value).


%% format PnYnMnDTnHnMnS
%% P is always present
%% T is absent iff all time items are absent
%% At least one duration item must be present
check_duration("-"++Value) ->
    check_duration(Value);
check_duration("P"++Value) ->
    {Date,Time}=lists:splitwith(fun($T) -> false;(_) -> true end,Value),
    {ok,_} = check_duration_date(Date,["Y","M","D"]),
    {ok,_} = check_duration_time(Time,["T","H","M","S"]).
	    
check_duration_date("",_) ->
    {ok,""};
check_duration_date(Date,[H|T]) ->
    case string:tokens(Date,H) of
	[Date] ->
	    check_duration_date(Date,T);
	[DateItem] ->
	    {ok,_} = check_positive_integer(DateItem);
	[DateItem,Rest] ->
	    {ok,_} = check_positive_integer(DateItem),
	    check_duration_date(Rest,T)
    end.
%% Time any combination of TnHnMfS
%% n unsigned integers and f unsigned decimal
%%check_duration_time(Time,["T","H","M","S"]) 
check_duration_time("",[_H|_T]) ->
    {ok,""};
check_duration_time(Time,[S]) ->
    [Sec] = string:tokens(Time,S),
    {ok,_} = check_decimal(Sec);
check_duration_time("T"++Time,TTokens) ->
    [_H|_] = Time,
    check_duration_time(Time,tl(TTokens));
check_duration_time(Time,[H|T]) ->
    case string:tokens(Time,H) of
	[Time] ->
	    check_duration_time(Time,T);
	[TimeItem] ->
	    {ok,_} = check_positive_integer(TimeItem);
	[TimeItem,Rest] ->
	    {ok,_} = check_positive_integer(TimeItem),
	    check_duration_time(Rest,T)
    end.

check_positive_integer(Value) ->
    case catch list_to_integer(Value) of
	Int when is_integer(Int),Int>=0 ->
	    {ok,Int};
	_ ->
	    {error,{value_not_integer,Value}}
    end.


%% check_integer and thereof derived types
check_integer(Value) ->
    {ok,list_to_integer(Value)}.
    
check_nonPositiveInteger(Value) ->
    check_constr_int(Value,undefined,0,illegal_nonPositiveInteger).

check_negativeInteger(Value) ->
    check_constr_int(Value,undefined,-1,illegal_negativeInteger).

check_long(Value) ->
    check_constr_int(Value,-9223372036854775808,
		     9223372036854775807,illegal_long).

check_int(Value) ->
    check_constr_int(Value,-2147483648,2147483647,illegal_int).

check_short(Value) ->
    check_constr_int(Value,-32768,32767,illegal_short).

check_byte(Value) ->
    check_constr_int(Value,-128,127,illegal_byte).

check_nonNegativeInteger(Value) ->
    check_constr_int(Value,0,undefined,illegal_nonNegativeInteger).

check_unsignedLong(Value) ->
    check_constr_int(Value,0,18446744073709551615,illegal_unsignedLong).

check_unsignedInt(Value) ->
    check_constr_int(Value,0,4294967295,illegal_unsignedInt).

check_unsignedShort(Value) ->
    check_constr_int(Value,0,65535,illegal_unsignedShort).

check_unsignedByte(Value) ->
    check_constr_int(Value,0,255,illegal_unsignedByte).

check_positiveInteger(Value) ->
    check_constr_int(Value,1,undefined,illegal_positiveInteger).

check_constr_int(Value,undefined,Max,ErrMsg) ->
    case check_integer(Value) of
	{ok,Int} when Int =< Max ->
	    {ok,Int};
	_ ->
	    {error,{ErrMsg}}
    end;
check_constr_int(Value,Min,Max,ErrMsg) ->
    case check_integer(Value) of
	{ok,Int} when Int >= Min, Int =< Max ->
	    {ok,Int};
	_ ->
	    {error,{ErrMsg}}
    end.

%% DateTime on form: '-'? yyyy '-' mm '-' dd 'T' hh ':' mm ':' ss 
%% ('.' s+)? (zzzzzz)?
check_dateTime("-"++DateTime) ->
    check_dateTime(DateTime);
check_dateTime("+"++_DateTime) ->
    {error,{invalid_dateTime,plus_sign}};
check_dateTime(DateTime) ->
    [Date,Time] = string:tokens(DateTime,"T"),
    [Y,M,D] = string:tokens(Date,"-"),
    check_year(Y),
    {ok,_} = check_positive_integer(M),
    {ok,_} = check_positive_integer(D),
    check_time(Time).

check_year(Y) when length(Y)>4 ->
    Y = string:strip(Y,left,$0),
    {ok,list_to_integer(Y)};
check_year(Y) ->
    case list_to_integer(Y) of
	Year when Year =/= 0 ->
	    {ok,Year};
	_ ->
	    {error,{invalid_year,Y}}
    end.

check_month(Str) ->
    case check_positive_integer(Str) of
	{ok,Int} when Int >= 1,Int =< 12 ->
	    {ok,Int};
	_ -> 
	    {error,{invalid_month,Str}}
    end.
check_day(Str) ->
    case check_positive_integer(Str) of
	{ok,Int} when Int >= 1,Int =< 31 ->
	    {ok,Int};
	_ -> 
	    {error,{invalid_day,Str}}
    end.


check_time(Time) ->
    %% hh:mm:ss (.s+)? TZ
    {HMS,TZ} =
    case lists:split(8,Time) of
	{T,"."++SecFractionsTZ} ->
	    OnlyDigits = fun(X) when X>=$0,X=<$9 ->true;(_)->false end,
	    {SecFrac,TZone} = lists:splitwith(OnlyDigits,SecFractionsTZ),
	    {ok,_} = check_positive_integer(SecFrac),
	    {T,TZone};
	{T,TZone} ->
	    {T,TZone}
    end,
    [H,M,S] = string:tokens(HMS,":"),
    {ok,_} = check_hour(H),
    {ok,_} = check_minute(M),
    {ok,_} = check_second(S),
    case TZ of
	[] ->
	    {ok,Time}; %% timezone optional
	_ ->
	    check_timezone(TZ)
    end.

check_hour(Str) ->
    case check_positive_integer(Str) of
	{ok,H} when H >= 0,H =< 24 ->
	    {ok,H};
	_ ->
	    {error,{invalid_hour,Str}}
    end.
check_minute(Str) ->
    case check_positive_integer(Str) of
	{ok,H} when H >= 0,H =< 60 ->
	    {ok,H};
	_ ->
	    {error,{invalid_minute,Str}}
    end.
check_second(Str) ->
    case check_positive_integer(Str) of
	{ok,H} when H >= 0,H =< 60 ->
	    {ok,H};
	_ ->
	    {error,{invalid_second,Str}}
    end.

check_timezone("Z") ->
    {ok,"Z"};
check_timezone(TZ) ->
    [H,M] = string:tokens(TZ,":"),
    case check_integer(H) of
	{ok,H2} when H2 >= -13, H2 =< 13 ->
	    case check_positive_integer(M) of
		{ok,M2} when M2 >= 0, M2 =< 59 ->
		    {ok,{H2,M2}};
		_ ->
		    {error,{invalid_timezone,TZ,M}}
	    end;
	{ok,H2} when H2==14;H2==-14 ->
	    case check_positive_integer(M) of
		{ok,0} ->
		    {ok,{H2,0}};
		_ ->
		    {error,{invalid_timezone,TZ}}
	    end;
	_ ->
	    {error,{invalid_timezone,TZ}}
    end.


%%  the form: '-'? yyyy '-' mm '-' dd zzzzzz?
check_date("-"++Date) ->
    check_date(Date);
check_date("+"++_Date) ->
    {error,{invalid_date,plus_sign}};
check_date(Date) ->
    {Year,Month,Day} =
    case string:tokens(Date,"-+Z") of
	[Y,M,D,TZ] ->
	    {ok,_}=check_timezone(TZ),
	    {Y,M,D};
	[Y,M,D] ->
	    {Y,M,D}
    end,
    {ok,_}=check_year(Year),
    {ok,_}=check_month(Month),
    {ok,_}=check_day(Day).
    
%% gYearMonth on the form: '-'? ccyy '-' mm zzzzzz?
check_gYearMonth("-"++Value) ->
    check_gYearMonth(Value);
check_gYearMonth("+"++_Value) ->
    {error,{invalid_gYearMonth,plus_sign}};
check_gYearMonth(Value) ->
    {Year,Month} =
    case string:tokens(Value,"-+Z") of
	[Y,M,TZ] ->
	    {ok,_} = check_timezone(TZ),
	    {Y,M};
	[Y,M] ->
	    {Y,M}
    end,
    {ok,_} = check_year(Year),
    {ok,_} = check_month(Month).

%% gYear on the form: '-'? ccyy zzzzzz?
check_gYear("-"++Value) ->
    check_gYear(Value);
check_gYear("+"++_Value) ->
    {error,{invalid_gYear,plus_sign}};
check_gYear(Value) ->
    Year =
	case string:tokens(Value,"-+Z") of
	    [Y,TZ] ->
		{ok,_} = check_timezone(TZ),
		Y;
	    [Y] ->
		Y
	end,
    {ok,_} = check_year(Year).