xmerl_xpath_pred.erl

OTP是开放电信平台的简称

    string_value(Obj).

string_value(#xmlObj{type=nodeset,value=[]}) ->
    ?string("");
string_value(N=#xmlObj{type=nodeset}) ->
    string_value(hd(N#xmlObj.value));
string_value(N=#xmlObj{}) ->
    string_value(N#xmlObj.value);
%% Needed also string_value for root_nodes, elements (concatenation of
%% al decsendant text nodes) and attribute nodes (normalized value).
string_value(A=#xmlNode{type=attribute}) ->
    #xmlAttribute{value=AttVal}=A#xmlNode.node,
    ?string(AttVal);
string_value(El=#xmlNode{type=element}) ->
    #xmlElement{content=C} = El#xmlNode.node,
    TextValue = fun(#xmlText{value=T},_Fun) -> T;
			(#xmlElement{content=Cont},Fun) -> Fun(Cont,Fun);
			(_,_) -> []
		     end,
    TextDecendants=fun(X) -> TextValue(X,TextValue) end,
    ?string(lists:flatten(lists:map(TextDecendants,C)));
string_value(infinity) -> ?string("Infinity");
string_value(neg_infinity) -> ?string("-Infinity");
string_value(A) when atom(A) ->
    ?string(atom_to_list(A));
string_value(N) when integer(N) ->
    ?string(integer_to_list(N));
string_value(N) when float(N) ->
    N1 = round(N * 10000000000000000),
    ?string(strip_zeroes(integer_to_list(N1))).

strip_zeroes(Str) ->
    strip_zs(lists:reverse(Str), 15).

strip_zs([H|T], 0) ->
    lists:reverse(T) ++ [$., H];
strip_zs("0" ++ T, N) ->
    strip_zs(T, N-1);
strip_zs([H|T], N) ->
    strip_zs(T, N-1, [H]).

strip_zs([H|T], 0, Acc) ->
    lists:reverse(T) ++ [$.,H|Acc];
strip_zs([H|T], N, Acc) ->
    strip_zs(T, N-1, [H|Acc]).


%% string: concat(string, string, string*)
concat(C, Args = [_, _|_]) ->
    Strings = [mk_string(C, A) || A <- Args],
    ?string(lists:concat(Strings)).

%% boolean: starts-with(string, string)
'starts-with'(C, [A1, A2]) ->
    ?boolean(lists:prefix(mk_string(C, A1), mk_string(C, A2))).

%% boolean: contains(string, string)
contains(C, [A1, A2]) ->
    Pos = string:str(mk_string(C, A1), mk_string(C, A2)),
    ?boolean(Pos > 0).

%% string: substring-before(string, string)
'substring-before'(C, [A1, A2]) ->
    S1 = mk_string(C, A1),
    S2 = mk_string(C, A2),
    Pos = string:str(S1, S2),
    ?string(string:substr(S1, 1, Pos)).

%% string: substring-after(string, string)
'substring-after'(C, [A1, A2]) ->
    S1 = mk_string(C, A1),
    S2 = mk_string(C, A2),
    case string:str(S1, S2) of
	0 ->
	    ?string([]);
	Pos ->
	    ?string(string:substr(S1, Pos))
    end.

%% string: substring(string, number, number?)
substring(C, [A1, A2]) ->
    S = mk_string(C, A1),
    Pos = mk_integer(C, A2),
    ?string(string:substr(S, Pos));
substring(C, [A1, A2, A3]) ->
    S = mk_string(C, A1),
    Pos = mk_integer(C, A2),
    Length = mk_integer(C, A3),
    ?string(string:substr(S, Pos, Length)).


%% number: string-length(string?)
'string-length'(C = #xmlContext{context_node = N}, []) ->
    length(mk_string(C, string_value(N)));

'string-length'(C, [A]) ->
    length(mk_string(C, A)).


%% string: normalize-space(string?)
'normalize-space'(C = #xmlContext{context_node = N}, []) ->
    normalize(mk_string(C, string_value(N)));

'normalize-space'(C, [A]) ->
    normalize(mk_string(C, A)).


%% string: translate(string, string, string)
translate(C, [A1, A2, A3]) ->
    S1 = mk_string(C, A1),
    S2 = mk_string(C, A2),
    S3 = mk_string(C, A3),
    ?string(translate1(S1, translations(S2, S3))).

translate1([H|T], Xls) ->
    case lists:keysearch(H, 1, Xls) of
	{value, {_, remove}} ->
	    translate1(T, Xls);
	{value, {_, replace, H1}} ->
	    [H1|translate1(T, Xls)];
	false ->
	    [H|translate1(T, Xls)]
    end;
translate1([], _) ->
    [].

translations([H|T], [H1|T1]) ->
    [{H, replace, H1}|translations(T, T1)];
translations(Rest, []) ->
    [{X, remove} || X <- Rest];
translations([], _Rest) ->
    [].



%% boolean: boolean(object)
boolean(C, [Arg]) ->
    ?boolean(mk_boolean(C, Arg)).

%% boolean: not(boolean) ->
fn_not(C, [Arg]) ->
    ?boolean(not(mk_boolean(C, Arg))).

%% boolean: true() ->
fn_true(_C, []) ->
    ?boolean(true).

%% boolean: false() ->
fn_false(_C, []) ->
    ?boolean(false).

%% boolean: lang(string) ->
lang(C = #xmlContext{context_node = N}, [Arg]) ->
    S = mk_string(C, Arg),
    Lang = 
	case N of
	    #xmlElement{language = L} -> L;
	    #xmlAttribute{language = L} -> L;
	    #xmlText{language = L} -> L;
	    #xmlComment{language = L} -> L;
	    _ -> []
	end,
    case Lang of
	[] ->
	    ?boolean(false);
	_ ->
	    ?boolean(match_lang(upcase(S), upcase(Lang)))
    end.


upcase([H|T]) when H >= $a, H =< $z ->
    [H+($A-$a)|upcase(T)];
upcase([H|T]) ->
    [H|upcase(T)];
upcase([]) ->
    [].

match_lang([H|T], [H|T1]) ->
    match_lang(T, T1);
match_lang([], "-" ++ _) ->
    true;
match_lang([], []) ->
    true;
match_lang(_, _) ->
    false.
	


%% number: number(object)
number(C = #xmlContext{context_node = N}, []) ->
    ?number(mk_number(C, string(C, N)));
number(C, [Arg]) ->
    ?number(mk_number(C, Arg)).


sum(C, [Arg]) ->
    NS = mk_nodeset(C, Arg),
    lists:foldl(
      fun(N, Sum) ->
	      Sum + mk_number(C, string(C, N))
      end, 0, NS).

floor(C, [Arg]) ->
    Num = mk_number(C, Arg),
    case trunc(Num) of
	Num1 when Num1 > Num ->
	    ?number(Num1-1);
	Num1 ->
	    ?number(Num1)
    end.

ceiling(C, [Arg]) ->
    Num = mk_number(C, Arg),
    case trunc(Num) of
	Num1 when Num1 < Num ->
	    ?number(Num1+1);
	Num1 ->
	    ?number(Num1)
    end.


round(C, [Arg]) ->
    case mk_number(C, Arg) of
	A when atom(A) ->
	    A;
	N when integer(N) ->
	    N;
	F when float(F) ->
	    round(F)
    end.


select_on_attribute([E = #xmlElement{attributes = Attrs}|T], K, V, Acc) ->
    case lists:keysearch(K, #xmlAttribute.name, Attrs) of
	{value, #xmlAttribute{value = V}} ->
	    select_on_attribute(T, K, V, [E|Acc]);
	_ ->
	    select_on_attribute(T, K, V, Acc)
    end;
select_on_attribute([], _K, _V, Acc) ->
    Acc.


%%%%

mk_nodeset(_C0, #xmlContext{nodeset = NS}) ->
    NS;
mk_nodeset(_C0, #xmlObj{type = nodeset, value = NS}) ->
    NS;
mk_nodeset(C0, Expr) ->
    case expr(Expr, C0) of
	#xmlObj{type = nodeset, value = NS} ->
	    NS;
	Other ->
	    exit({expected_nodeset, Other})
    end.


default_nodeset(#xmlContext{context_node = N}) ->
    [N].


mk_object(_C0, Obj = #xmlObj{}) ->
    Obj;
mk_object(C0, Expr) ->
    expr(Expr, C0).


mk_string(_C0, #xmlObj{type = string, value = V}) ->
    V;
mk_string(C0, Expr) ->
    mk_string(C0, expr(Expr, C0)).



mk_integer(_C0, #xmlObj{type = number, value = V}) when float(V)  ->
    round(V);
mk_integer(_C0, #xmlObj{type = number, value = V}) when integer(V)  ->
    V;
mk_integer(C, Expr) ->
    mk_integer(C, expr(Expr, C)).


mk_number(_C, #xmlObj{type = string, value = V}) ->
    scan_number(V);
mk_number(_C, #xmlObj{type = number, value = V}) ->
    V;
mk_number(C, N=#xmlObj{type = nodeset}) ->
    mk_number(C,string_value(N));
mk_number(_C, #xmlObj{type = boolean, value = false}) ->
    0;
mk_number(_C, #xmlObj{type = boolean, value = true}) ->
    1;
mk_number(C, Expr) ->
    mk_number(C, expr(Expr, C)).


mk_boolean(_C, #xmlObj{type = boolean, value = V}) -> 
    V;
mk_boolean(_C, #xmlObj{type = number, value = 0}) ->
    false;
mk_boolean(_C, #xmlObj{type = number, value = V}) when float(V) ; integer(V) ->
    true;
mk_boolean(_C, #xmlObj{type = nodeset, value = []}) ->
    false;
mk_boolean(_C, #xmlObj{type = nodeset, value = _V}) ->
    true;
mk_boolean(_C, #xmlObj{type = string, value = []}) ->
    false;
mk_boolean(_C, #xmlObj{type = string, value = _V}) ->
    true;
mk_boolean(C, Expr) ->
    mk_boolean(C, expr(Expr, C)).


normalize([H|T]) when ?whitespace(H) ->
    normalize(T);
normalize(Str) ->
    ContF = fun(_ContF, RetF, _S) ->
		    RetF()
	    end,
    normalize(Str,
	      #xmerl_scanner{acc_fun = fun() -> exit(acc_fun) end,
			     event_fun = fun() -> exit(event_fun) end,
			     hook_fun = fun() -> exit(hook_fun) end,
			     continuation_fun = ContF},
	      []).


normalize(Str = [H|_], S, Acc) when ?whitespace(H) ->
    case xmerl_scan:accumulate_whitespace(Str, S, preserve, Acc) of
	{" " ++ Acc1, [], _S1} ->
	    lists:reverse(Acc1);
	{Acc1, [], _S1} ->
	    lists:reverse(Acc1);
	{Acc1, T1, S1} ->
	    normalize(T1, S1, Acc1)
    end;
normalize([H|T], S, Acc) ->
    normalize(T, S, [H|Acc]);
normalize([], _S, Acc) ->
    lists:reverse(Acc).


scan_number([H|T]) when ?whitespace(H) ->
    scan_number(T);
scan_number("-" ++ T) ->
    case catch xmerl_xpath_scan:scan_number(T) of
	{{number, N}, Tail} ->
	    case is_all_white(Tail) of
		true ->
		    N;
		false ->
		    'NaN'
	    end;
	_Other ->
	    'NaN'
    end;
scan_number(T) ->
    case catch xmerl_xpath_scan:scan_number(T) of
	{{number, N}, Tail} ->
	    case is_all_white(Tail) of
		true ->
		    N;
		false ->
		    'NaN'
	    end;
	_Other ->
	    'NaN'
    end.

is_all_white([H|T]) when ?whitespace(H) ->
    is_all_white(T);
is_all_white([_H|_T]) ->
    false;
is_all_white([]) ->
    true.