xml utilities #290

Parent #72Owner #29Flags readSource hellcore/hellcore.db

Aliases: xml utilities, xml, xu

9 verbs · 14 properties · 0 children

Verbs

VerbSpecFlagsDefinerLines
parsethis none thisrxd#29052
find_styleobjectthis none thisrxd#29012
strip_whitespacethis none thisrxd#29023
parse_attributesthis none thisrxd#29019
recursive_tag_enderthis none thisrxd#29043
dumpthis none thisrxd#29023
parse_to_hashthis none thisrxd#29026
parse_attributes_to_hashthis none thisrxd#29015
parse_element_to_hashthis none thisrxd#29036

Properties

PropertyDefinerFlagsOwnerValue
tag_regex#290rc#29"%(<%([^/ ][^ >]*%)%(%( +[^> ]+=%(\"[^\"]+\"%|'[^']+'%|[^\"' >]+%)%)*%)[^=>]*/?>%)"
declaration_regex#290rc#29"%(<%?%([^/ ][^ >]*%)%(%( +[^> ]+=%(\"[^\"]+\"%|'[^']+'%|[^\"' >]+%)%)*%)[^=>]*/?%?>%)"
test_xml#290rc#29"<?xml version=\"1.0\" encoding=\"UTF-8\"?><hash><remaining-hits type=\"integer\">150</remaining-hits><hourly-limit type=\"integer\">150</hourly-limit><reset-time-in-seconds type=\"integer\">1247632849</reset-time-in-seconds><reset-time type=\"datetime\">2009-07-15T04:40:49+00:00</reset-time></hash>"
help_msg#72rc#29<clear>
aliases#1rc#29{"xml utilities", "xml", "xu"}
description#1rc#29<clear>
object_size#1r#29{12081, 1298434481}
hidden_verbs#1rc#29<clear>
phelp_msg#1rc#29<clear>
weight#1rc#29<clear>
owner_verbs#1rc#29<clear>
plural_name#1rc#29<clear>
client_image#1rc#29<clear>
listening#1rc#29<clear>

Ancestry

Ancestors (nearest first): #72 Generic Utilities Package → #1 root

Children: none

Call graph

calls n290_0 #290:parse n290_0->n290_0 n20_5 #20:from_list n290_0->n20_5 n290_3 #290:parse_attributes n290_0->n290_3 n290_4 #290:recursive_tag_ender n290_0->n290_4 n48_8 #48:suspend_if_needed n290_0->n48_8 n47_18 #47:iassoc n290_3->n47_18 n290_2 #290:strip_whitespace n20_9 #20:trim n290_2->n20_9 n290_5 #290:dump n290_5->n290_5 n290_6 #290:parse_to_hash n290_6->n20_5 n290_6->n290_4 n290_7 #290:parse_attributes_to_hash n290_6->n290_7 n290_8 #290:parse_element_to_hash n290_6->n290_8 n290_8->n290_4 n290_8->n48_8 n290_8->n20_9 n290_8->n290_7 n290_8->n290_8

Source

parse

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1"$xml:parse(text) => {tagname, {{attribute, value}, {attribute, value}}, {textpart1, {tagename, {{attribute, value}, {attribute, value}}, {textpart1}}, textpart2, {... tag ...} ... text ...}}";
2"Returns a very confusing tree list thingy. should be easy to work with, though.";
3"The 'text' argument to this verb is assumed to be a list of strings. It is put into one string. Useless whitespace is not removed, the stylesheet/renderer must do this (this is to permit some tags to not have extra whitespace). .. sigh, it's the little details that makes this so much more difficult that I thought it would be. :)";
4"This code stolen from MOOzilla's HTML parser and ported to the MOO.";
5"Slightly modified to XML parsing, but it probably will accept invalid XML and do the best it can at parsing.";
6{text, ?data = {}} = args;
7if (typeof(text) == LIST)
8text = $su:from_list(text, "/*-");
9endif
10"oh dear lord. -- Dax, Lao.";
11tagRegex = "%(<%([^/ ][^ >]*%)%(%( +[^> ]+=%(\"[^\"]+\"%|'[^']+'%|[^\"' >]+%)%)*%)[^=>]*/?>%)";
12if (data == {})
13"Strip out all tags that are in the form of <?... ... ... ?>";
14while (m = match(text, "%(<%?%([^/ ][^ >]*%)%(%( +[^> ]+=%(\"[^\"]+\"%|'[^']+'%|[^\"' >]+%)%)*%)[^=>]*/?%?>%)"))
15text = tostr(`text[1..m[1] - 1] ! E_RANGE => ""', `text[m[2] + 1..$] ! E_RANGE => ""');
16endwhile
17match = match(text, tagRegex);
18if (!match)
19return {text};
20endif
21data = {text[match[3][2][1]..match[3][2][2]], this:parse_attributes(text, match), {}};
22end = this:recursive_tag_ender(`text[match[2] + 1..$] ! E_RANGE => ""', data[1]);
23text = end[1];
24endif
25"begin recursive iterative recursive function to set data[3] to be the rest of the document.";
26while (dataArray = match(text, tagRegex))
27left = `text[1..dataArray[1] - 1] ! E_RANGE => ""';
28right = `text[dataArray[2] + 1..$] ! E_RANGE => ""';
29if (left != "")
30data[3] = listappend(data[3], left);
31endif
32tagName = text[dataArray[3][2][1]..dataArray[3][2][2]];
33tag = {tagName, this:parse_attributes(text, dataArray), {}};
34"str = left;";
35if (text[dataArray[1]..dataArray[2]][$ - 1] == "/")
36"single tag, no recursive end.";
37if (tag[1][$] == "/")
38tag[1] = tag[1][1..$ - 1];
39endif
40else
41recMatch = this:recursive_tag_ender(right, tagName);
42right = recMatch[3];
43tag = this:parse(recMatch[1], tag);
44endif
45data[3] = listappend(data[3], tag);
46text = right;
47$command_utils:suspend_if_needed();
48endwhile
49if (text != "")
50data[3] = listappend(data[3], text);
51endif
52return data;

find_styleobject

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

none

Source

1"Find a style-object for this user and for a certain document type.";
2{who, dt} = args;
3xso = `#0.("xso-" + dt) ! E_PROPNF';
4if (xso == E_PROPNF)
5raise(E_PROPNF, ("There is no $xso-" + dt) + "! Unrenderable.");
6endif
7for x in (xso:descendants())
8if (x.rendering_object == who.output_rendering_object)
9return x;
10endif
11endfor
12return xso;

strip_whitespace

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

none

Source

1"This verb does black magic.";
2"It tries to strip unimportant whitespace from text. Important whitespace must be denoted by a -*/ for a linebreak, or a &amp;nbsp; for a blank space.";
3{text} = args;
4"Strip unimportant whitespace after unimportant linefeeds.";
5while (index(text, "/*- "))
6text = strsub(text, "/*- ", "/*-");
7endwhile
8"Strip unimportant linefeeds.";
9text = strsub(text, "-*//*-", "-*/");
10text = strsub(text, "/*-", " ");
11text = $su:trim(text);
12"Large sections of whitespace first, to reduce ticks.";
13while (index(text, "      "))
14text = strsub(text, "      ", " ");
15endwhile
16while (index(text, "  "))
17text = strsub(text, "  ", " ");
18endwhile
19"Two important linebreaks together must have a space between, so $su:explode can work right on them.";
20while (index(text, "-*/-*/"))
21text = strsub(text, "-*/-*/", "-*/ -*/");
22endwhile
23return text;

parse_attributes

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1"Given a match for a tag from $xml:parse's nasty regex, and the text itself, parse and return the attributes in a list.";
2{text, match} = args;
3attributes = {};
4atts = text[match[3][3][1]..match[3][3][2]];
5attrData = {};
6simpAttrRegex = "^ *%([^ =]+%)=%([^ >]+%)";
7dqotAttrRegex = "^ *%([^ =]+%)=\"%([^\"]+%)\"";
8sqotAttrRegex = "^ *%([^ =]+%)='%([^']+%)'";
9while (((attrData = match(atts, dqotAttrRegex)) || (attrData = match(atts, sqotAttrRegex))) || (attrData = match(atts, simpAttrRegex)))
10name = atts[attrData[3][1][1]..attrData[3][1][2]];
11data = atts[attrData[3][2][1]..attrData[3][2][2]];
12atts = `atts[attrData[2] + 1..$] ! E_RANGE => ""';
13if (i = $list_utils:iassoc(name, attributes))
14attributes[i][2] = data;
15else
16attributes = {@attributes, {name, data}};
17endif
18endwhile
19return attributes;

recursive_tag_ender

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1"This function takes two arguments and returns an array.";
2"Arg1: The text to the right of a tag match.   \"hello <big>friend!</big></big> <big>How are you!</big>\"";
3"Arg2: The text name of the tag you matched.   \"big\"";
4"";
5"Retval (array of length 3):";
6" Item 1: The text inside the tag.              \"hello <big>friend!</big>\"";
7" Item 2: The text of the end tag.              \"</big>\"";
8" Item 3: The remainder of the text.            \" <big>How are you!</big>\"";
9{right, tagName} = args;
10endTagRegex = ("</" + tagName) + " *>";
11"specificTagRegex = (\"<\" + tagName) + \"%( +[^ ]+=%(\\\"[^\\\"]+\\\"%|'[^']+'%|[^ >]+%)%)*%(>%|[^=>]*>%)\";";
12specificTagRegex = ("<" + tagName) + "%( +[^ >]+=%(\"[^\"]+\"%|'[^']+'%|[^\"' >]+%)[^=>]*%)*>";
13"catches unending tags.";
14if (!match(right, endTagRegex))
15return {right, ("</" + tagName) + ">", ""};
16endif
17if (match(right, specificTagRegex))
18insideTag = "";
19remainder = right;
20while (matchData = match(remainder, specificTagRegex))
21leftC = `remainder[1..matchData[1] - 1] ! E_RANGE => ""';
22rightC = `remainder[matchData[2] + 1..$] ! E_RANGE => ""';
23matchedT = remainder[matchData[1]..matchData[2]];
24if (subMatch = match(leftC, endTagRegex))
25"Yes, we found a specific tag. But, we PASSED an end tag. Doh, eh?";
26retval = {insideTag + `leftC[1..subMatch[1] - 1] ! E_RANGE => ""', leftC[subMatch[1]..subMatch[2]], (`leftC[subMatch[2] + 1..$] ! E_RANGE => ""' + matchedT) + rightC};
27return retval;
28endif
29rec = this:(verb)(rightC, tagName);
30remainder = rec[3];
31insideTag = (((insideTag + leftC) + matchedT) + rec[1]) + rec[2];
32endwhile
33if (matchData = match(remainder, endTagRegex))
34return {insideTag + `remainder[1..matchData[1] - 1] ! E_RANGE => ""', remainder[matchData[1]..matchData[2]], `remainder[matchData[2] + 1..$] ! E_RANGE => ""'};
35else
36"catches confusing unending tags, and possibly some weirdo tag.";
37return {insideTag, ("</" + tagName) + ">", remainder};
38endif
39elseif (matchData = match(right, endTagRegex))
40return {`right[1..matchData[1] - 1] ! E_RANGE => ""', right[matchData[1]..matchData[2]], `right[matchData[2] + 1..$] ! E_RANGE => ""'};
41else
42return {right, ("</" + tagName) + ">", ""};
43endif

dump

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1{xml, ?indent = 0} = args;
2{tag, attribs, kids} = xml;
3t = tostr("<", tag);
4for x in (attribs)
5t = tostr(t, " ", x[1], "=\"", x[2], "\" ");
6endfor
7if (kids)
8t = tostr(t, ">");
9r = {};
10for x in (kids)
11if (typeof(x) == STR)
12r = {@r, x};
13elseif (typeof(x) == LIST)
14r = {@r, @this:dump(x, indent + 1)};
15endif
16endfor
17return {t, @r, tostr("</", tag, ">")};
18else
19t = tostr(t, "/>");
20return {t};
21endif
22"Last modified by manta (#7165) on Wed Sep 19 12:49:58 2001 MDT.";
23"This verb previously owned by manta (#7165), and chowned to $slacker upon dewizarding (Sat Aug 17 14:50:06 2002 MDT).";

parse_to_hash

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

none

Source

1"$xml:parse(text) => {tagname, {{attribute, value}, {attribute, value}}, {textpart1, {tagename, {{attribute, value}, {attribute, value}}, {textpart1}}, textpart2, {... tag ...} ... text ...}}";
2"Returns a very confusing tree list thingy. should be easy to work with, though.";
3"The 'text' argument to this verb is assumed to be a list of strings. It is put into one string. Useless whitespace is not removed, the stylesheet/renderer must do this (this is to permit some tags to not have extra whitespace). .. sigh, it's the little details that makes this so much more difficult that I thought it would be. :)";
4"This code stolen from MOOzilla's HTML parser and ported to the MOO.";
5"Slightly modified to XML parsing, but it probably will accept invalid XML and do the best it can at parsing.";
6{text} = args;
7if (typeof(text) == LIST)
8text = $su:from_list(text, "/*-");
9endif
10"Strip out all tags that are in the form of <?... ... ... ?>";
11while (m = match(text, this.declaration_regex))
12text = tostr(`text[1..m[1] - 1] ! E_RANGE => ""', `text[m[2] + 1..$] ! E_RANGE => ""');
13endwhile
14"Let's get busy.";
15match = match(text, this.tag_regex);
16if (!match)
17return [];
18endif
19name = text[match[3][2][1]..match[3][2][2]];
20data = [];
21if (length(attributes = this:parse_attributes_to_hash(text, match)))
22data["@attributes"] = attributes;
23endif
24end = this:recursive_tag_ender(`text[match[2] + 1..$] ! E_RANGE => ""', name);
25text = end[1];
26return [name -> this:parse_element_to_hash(text, data)];

parse_attributes_to_hash

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1"Given a match for a tag from $xml:parse's nasty regex, and the text itself, parse and return the attributes in a list.";
2{text, match} = args;
3attributes = [];
4atts = text[match[3][3][1]..match[3][3][2]];
5attrData = {};
6simpAttrRegex = "^ *%([^ =]+%)=%([^ >]+%)";
7dqotAttrRegex = "^ *%([^ =]+%)=\"%([^\"]+%)\"";
8sqotAttrRegex = "^ *%([^ =]+%)='%([^']+%)'";
9while (((attrData = match(atts, dqotAttrRegex)) || (attrData = match(atts, sqotAttrRegex))) || (attrData = match(atts, simpAttrRegex)))
10name = atts[attrData[3][1][1]..attrData[3][1][2]];
11data = atts[attrData[3][2][1]..attrData[3][2][2]];
12atts = `atts[attrData[2] + 1..$] ! E_RANGE => ""';
13attributes[name] = data;
14endwhile
15return attributes;

parse_element_to_hash

Spec this none thisFlags rxdOwner #29Definer #290

Referenced by

Source

1{text, parent} = args;
2"oh dear lord. -- Dax, Lao.";
3while (dataArray = match(text, this.tag_regex))
4left = `text[1..dataArray[1] - 1] ! E_RANGE => ""';
5right = `text[dataArray[2] + 1..$] ! E_RANGE => ""';
6name = text[dataArray[3][2][1]..dataArray[3][2][2]];
7child = [];
8if (length(attributes = this:parse_attributes_to_hash(text, dataArray)))
9child["@attributes"] = attributes;
10endif
11if (text[dataArray[1]..dataArray[2]][$ - 1] == "/")
12"single tag, no recursive end.";
13if (name[$] == "/")
14name = name[1..$ - 1];
15endif
16else
17recMatch = this:recursive_tag_ender(right, name);
18right = recMatch[3];
19child = this:parse_element_to_hash(recMatch[1], child);
20endif
21if (name in parent)
22if (typeof(data[name]) == HASH)
23parent[name] = {parent[name]};
24endif
25parent[name] = listappend(parent[name], child);
26else
27parent[name] = child;
28endif
29text = right;
30$cu:sin();
31endwhile
32text = $su:trim(text);
33if (text)
34parent["@text"] = text;
35endif
36return parent;