├── .gitattributes
├── .gitmodules
├── README.md
├── memory-operations-functional.xqy
├── memory-operations-pure-xquery.xqy
├── memory-operations.xqy
├── mlpm.json
├── node-operations.xqy
└── test
    ├── memory-operations-functional-test.xqy
    ├── memory-operations-pure-xquery-test.xqy
    └── memory-operations-test.xqy


/.gitattributes:
--------------------------------------------------------------------------------
 1 | # Auto detect text files and perform LF normalization
 2 | * text=auto
 3 | 
 4 | # Custom for Visual Studio
 5 | *.cs     diff=csharp
 6 | *.sln    merge=union
 7 | *.csproj merge=union
 8 | *.vbproj merge=union
 9 | *.fsproj merge=union
10 | *.dbproj merge=union
11 | 
12 | # Standard to msysgit
13 | *.doc	 diff=astextplain
14 | *.DOC	 diff=astextplain
15 | *.docx diff=astextplain
16 | *.DOCX diff=astextplain
17 | *.dot  diff=astextplain
18 | *.DOT  diff=astextplain
19 | *.pdf  diff=astextplain
20 | *.PDF	 diff=astextplain
21 | *.rtf	 diff=astextplain
22 | *.RTF	 diff=astextplain
23 | 


--------------------------------------------------------------------------------
/.gitmodules:
--------------------------------------------------------------------------------
1 | [submodule "xray"]
2 | 	path = xray
3 | 	url = https://github.com/robwhitby/xray.git
4 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # XQuery XML Memory Operations
 2 | This module is created to provide an optimized way to perform operations on XML in memory. With heavy use XPath axis, node comparisions, and set operators this library is able to make changes to XML while only reconstructing nodes within the direct path of the nodes being altered. It also provides a way to perform multiple operations, while only reconstructiing the XML tree once.
 3 | 
 4 | The goal is to provide a way to bring the functionality of the XQuery Update Facility 1.0 (http://www.w3.org/TR/xquery-update-10/) to MarkLogic.
 5 | 
 6 | ## Advanced Transform Statements
 7 | By calling mem:copy($node as node()) as xs:string the following calls to mem operations are stored and not actually executed until mem:execute($transaction-id as xs:string) is called. This allows the document to be rebuilt only once and increases performance.
 8 | 
 9 | You can just perform a copy and execute that will provide a copy of the node free from ancestors.
10 | 
11 | Examples of this is as follows:
12 |  ```xquery
13 | (: 
14 | copy $c := fn:root($file)
15 | modifiy (replace nodes $c/title with element title {"my new title"},
16 | 		insert nodes attribute new-attribute {"my new attribute"} as last into
17 | 			$c)
18 | return $c
19 | =>
20 | :)
21 | mem:copy(fn:root($file)) !
22 | ( 
23 | mem:replace(.,$file/title, element title {"my new title"}),
24 | mem:insert-child(.,$file, attribute new-attribute {"my new attribute"}),
25 | mem:execute(.))
26 | ```
27 | 
28 | By using mem:copy and passing in a node, you indicating what the new root should be.
29 | ```xquery
30 | (:
31 | let $oldx := /a/b/x
32 | return
33 |    copy $newx := $oldx
34 |    modify (rename node $newx as "newx", 
35 |            replace value of node $newx with $newx * 2)
36 |    return ($oldx, $newx)
37 | =>
38 | :)
39 | let $oldx := /a/b/x
40 | return
41 | 	($oldx,
42 | 	mem:copy($oldx) ! 
43 | 	(
44 | 	mem:rename(.,$oldx, fn:QName("","newx")),
45 | 	mem:replace-value(.,$oldx, $oldx * 5),
46 | 	mem:execute(.)
47 | 	)
48 | 	)
49 | (: 
50 | =>
51 | (<x>...</x>,<newx>...</newx>)
52 | :)
53 | ```
54 | 
55 | ## Other Operations
56 |  ```xquery
57 | (: See http://www.w3.org/TR/xquery-update-10/#id-delete :)
58 | mem:delete($file//comment()),
59 | (: See http://www.w3.org/TR/xquery-update-10/#id-insert :)
60 | mem:insert-after($file/title, element new-sibling-after {"my new sibling element"} ),
61 | mem:insert-before($file/title, element new-sibling-before {"my new sibling element"} ),
62 | mem:insert-child($file, attribute new-attribute {"my new attribute"} ),
63 | mem:insert-child-first($file, attribute new-attribute-2 {"my new attribute"} ),
64 | (: See http://www.w3.org/TR/xquery-update-10/#id-rename :)
65 | mem:rename($file//block, fn:QName('http://www.w3.org/1999/xhtml','p')),
66 | (: See http://www.w3.org/TR/xquery-update-10/#id-replacing-node :)
67 | mem:replace($file/title, element title {"my new title"} ),
68 | (: See http://www.w3.org/TR/xquery-update-10/#id-replacing-node-value :)
69 | mem:replace-value($file/title, "my new title" ),
70 | (: Transform by using a function reference :)
71 | mem:transform($title,function($node as node()) as node()* {element new-title {"This is so awesome!"}})
72 | ```
73 | 
74 | 


--------------------------------------------------------------------------------
/memory-operations-functional.xqy:
--------------------------------------------------------------------------------
  1 | xquery version "1.0-ml";
  2 | (:~
  3 | Copyright (c) 2013 Ryan Dew
  4 | 
  5 | Licensed under the Apache License, Version 2.0 (the "License");
  6 | you may not use this file except in compliance with the License.
  7 | You may obtain a copy of the License at
  8 | 
  9 |        http://www.apache.org/licenses/LICENSE-2.0
 10 | 
 11 | Unless required by applicable law or agreed to in writing, software
 12 | distributed under the License is distributed on an "AS IS" BASIS,
 13 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 14 | See the License for the specific language governing permissions and
 15 | limitations under the License.
 16 | 
 17 | @author Ryan Dew (ryan.j.dew@gmail.com)
 18 | @version 1.0.3
 19 | @description This is a module with function changing XML in memory by creating subtrees using the ancestor, preceding-sibling, and following-sibling axes
 20 | 				and intersect/except expressions. Requires MarkLogic 7+.
 21 | ~:)
 22 | module namespace mem-op-fun="http://maxdewpoint.blogspot.com/memory-operations/functional";
 23 | import module namespace mem-op="http://maxdewpoint.blogspot.com/memory-operations" at "memory-operations.xqy";
 24 | import module namespace node-op="http://maxdewpoint.blogspot.com/node-operations" at "node-operations.xqy";
 25 | declare default function namespace "http://www.w3.org/2005/xpath-functions";
 26 | declare namespace xdmp="http://marklogic.com/xdmp";
 27 | declare namespace map="http://marklogic.com/xdmp/map";
 28 | declare option xdmp:mapping "true";
 29 | declare option xdmp:copy-on-validate "true";
 30 | 
 31 | (: Queue insert a child into the node :)
 32 | declare function mem-op-fun:insert-child(
 33 |   $transaction-map as map:map,
 34 |   $parent-node as element()*,
 35 |   $new-nodes as node()*)
 36 | as map:map?
 37 | {
 38 |   mem-op-fun:queue(
 39 |     $transaction-map, $parent-node, $new-nodes, "insert-child")
 40 | };
 41 | 
 42 | (: Queue insert as first child into the node :)
 43 | declare function mem-op-fun:insert-child-first(
 44 |   $transaction-map as map:map,
 45 |   $parent-node as element()*,
 46 |   $new-nodes as node()*)
 47 | as map:map?
 48 | {
 49 |   mem-op-fun:queue(
 50 |     $transaction-map,
 51 |     $parent-node,
 52 |     $new-nodes,
 53 |     "insert-child-first")
 54 | };
 55 | 
 56 | (: Queue insert a sibling before the node :)
 57 | declare function mem-op-fun:insert-before(
 58 |   $transaction-map as map:map,
 59 |   $sibling as node()*,
 60 |   $new-nodes as node()*)
 61 | as map:map?
 62 | {
 63 |   mem-op-fun:queue(
 64 |     $transaction-map, $sibling, $new-nodes, "insert-before")
 65 | };
 66 | 
 67 | (: Queue insert a sibling after the node :)
 68 | declare function mem-op-fun:insert-after(
 69 |   $transaction-map as map:map,
 70 |   $sibling as node()*,
 71 |   $new-nodes as node()*)
 72 | as map:map?
 73 | {
 74 |   mem-op-fun:queue(
 75 |     $transaction-map, $sibling, $new-nodes, "insert-after")
 76 | };
 77 | 
 78 | (: Queue replace of the node :)
 79 | declare function mem-op-fun:replace(
 80 |   $transaction-map as map:map,
 81 |   $replace-nodes as node()*,
 82 |   $new-nodes as node()*)
 83 | as map:map?
 84 | {
 85 |   mem-op-fun:queue(
 86 |     $transaction-map,
 87 |     $replace-nodes except $replace-nodes/descendant::node(),
 88 |     $new-nodes,
 89 |     "replace")
 90 | };
 91 | 
 92 | (: Queue delete the node :)
 93 | declare function mem-op-fun:delete(
 94 |   $transaction-map as map:map,
 95 |   $delete-nodes as node()*)
 96 | as map:map?
 97 | {
 98 |   mem-op-fun:queue(
 99 |     $transaction-map,
100 |     $delete-nodes except $delete-nodes/descendant::node(),
101 |     (),
102 |     "replace")
103 | };
104 | 
105 | (: Queue renaming of node :)
106 | declare function mem-op-fun:rename(
107 |   $transaction-map as map:map,
108 |   $nodes-to-rename as node()*,
109 |   $new-name as xs:QName)
110 | as map:map?
111 | {
112 |   mem-op-fun:queue(
113 |     $transaction-map,
114 |     $nodes-to-rename,
115 |     element { $new-name } { },
116 |     "rename")
117 | };
118 | 
119 | (: Queue replacement of a value of an element or attribute :)
120 | declare function mem-op-fun:replace-value(
121 |   $transaction-map as map:map,
122 |   $nodes-to-change as node()*,
123 |   $value as xs:anyAtomicType?)
124 | as map:map?
125 | {
126 |   mem-op-fun:queue(
127 |     $transaction-map,
128 |     $nodes-to-change,
129 |     text { $value },
130 |     "replace-value")
131 | };
132 | 
133 | (: Queue replacement of contents of an element :)
134 | declare function mem-op-fun:replace-contents(
135 |   $transaction-map as map:map,
136 |   $nodes-to-change as node()*,
137 |   $contents as node()*)
138 | as map:map?
139 | {
140 |   mem-op-fun:queue(
141 |     $transaction-map,
142 |     $nodes-to-change,
143 |     $contents,
144 |     "replace-value")
145 | };
146 | 
147 | (: Queues the replacement of the node with the result of the passed function :)
148 | declare function mem-op-fun:transform(
149 |   $transaction-map as map:map,
150 |   $nodes-to-change as node()*,
151 |   $transform-function as function(node()) as node()*)
152 | as map:map?
153 | {
154 |   let $function-key as xs:string := mem-op:function-key($transform-function)
155 |   return 
156 |     map:new((
157 |       mem-op-fun:queue(
158 |         $transaction-map,
159 |         $nodes-to-change,
160 |         text { $function-key },
161 |         "transform"
162 |       ),
163 |       map:entry(
164 |         $function-key,
165 |         $transform-function
166 |       )
167 |     ))
168 | };
169 | 
170 | (: Select the root to return after transaction :)
171 | declare function mem-op-fun:copy($node-to-copy as node())
172 | as map:map
173 | {
174 |   map:entry("copy", $node-to-copy)
175 | };
176 | 
177 | (: Execute transaction :)
178 | declare function mem-op-fun:execute($transaction-map as map:map)
179 | as node()*
180 | {
181 |   if (exists(map:get($transaction-map, "nodes-to-modify")))
182 |   then
183 |     mem-op:process(
184 |       $transaction-map,
185 |       (: Ensure nodes to modify are in document order by using union :)
186 |       map:get($transaction-map, "nodes-to-modify") | (),
187 |       map:get($transaction-map, "modifier-nodes"),
188 |       map:get($transaction-map, "operation"),
189 |       map:get($transaction-map, "copy")
190 |     )
191 |   else
192 |     validate lax {
193 |       map:get($transaction-map, "copy")
194 |     },
195 |   map:clear($transaction-map)
196 | };
197 | 
198 | (: Begin private functions! :)
199 | 
200 | (: Queue actions for later execution :)
201 | declare %private 
202 | function mem-op-fun:queue(
203 |   $transaction-map as map:map,
204 |   $nodes-to-modify as node()+,
205 |   $modifier-nodes as node()*,
206 |   $operation as xs:string?)
207 | as map:map
208 | {
209 |   if (fn:exists($nodes-to-modify))
210 |   then 
211 |     (: Creates elements based off of generate-id (i.e., node is 12439f8e4a3, then we get back <mem-op:_12439f8e4a3/>) :)
212 |     let $modified-node-ids as element()* := mem-op:id-wrapper($nodes-to-modify) (: This line uses function mapping :)
213 |     return
214 |     (
215 |     mem-op:all-nodes-from-same-doc($nodes-to-modify,map:get($transaction-map,"copy")),
216 |     map:new((
217 |       $transaction-map,
218 |       map:entry(
219 |         "operation",
220 |         (<mem-op:operation>{
221 |            attribute operation { $operation },
222 |            $modified-node-ids
223 |         }</mem-op:operation>,
224 |         (: Ensure operations are accummulated :)
225 |         map:get($transaction-map, "operation"))
226 |       ),
227 |       map:entry(
228 |         "nodes-to-modify",
229 |         ($nodes-to-modify,
230 |          (: Ensure nodes to modify are accummulated :)
231 |          map:get($transaction-map, "nodes-to-modify"))
232 |       ),
233 |       map:entry(
234 |         "modifier-nodes",
235 |         (<mem-op:modifier-nodes>{
236 |              attribute mem-op:operation { $operation },
237 |              $modifier-nodes[self::attribute()],
238 |              $modified-node-ids,
239 |              $modifier-nodes[not(self::attribute())]
240 |          }</mem-op:modifier-nodes>,
241 |          (: Ensure nodes to modifier nodes are accummulated :)
242 |          map:get($transaction-map, "modifier-nodes"))
243 |       )
244 |     ))
245 |     )
246 |   else
247 |     $transaction-map
248 | };
249 | 


--------------------------------------------------------------------------------
/memory-operations-pure-xquery.xqy:
--------------------------------------------------------------------------------
  1 | xquery version "3.0";
  2 | 
  3 | (:~
  4 | Copyright (c) 2016 Ryan Dew
  5 | 
  6 | Licensed under the Apache License, Version 2.0 (the "License");
  7 | you may not use this file except in compliance with the License.
  8 | You may obtain a copy of the License at
  9 | 
 10 |        http://www.apache.org/licenses/LICENSE-2.0
 11 | 
 12 | Unless required by applicable law or agreed to in writing, software
 13 | distributed under the License is distributed on an "AS IS" BASIS,
 14 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 15 | See the License for the specific language governing permissions and
 16 | limitations under the License.
 17 | 
 18 | @author Ryan Dew (ryan.j.dew@gmail.com)
 19 | @version 1.0.7
 20 | @description This is a module with function changing XML in memory by creating subtrees using the ancestor, preceding-sibling, and following-sibling axes
 21 |         and intersect/except expressions. This version works with eXistDB and BaseX
 22 | ~:)
 23 | module namespace mem-op="http://maxdewpoint.blogspot.com/memory-operations";
 24 | import module namespace node-op="http://maxdewpoint.blogspot.com/node-operations" at "node-operations.xqy";
 25 | declare default function namespace "http://www.w3.org/2005/xpath-functions";
 26 | 
 27 | (: Queue insert a child into the node :)
 28 | declare function mem-op:insert-child(
 29 |   $transaction-map as map(*),
 30 |   $parent-node as element()*,
 31 |   $new-nodes as node()*)
 32 | as map(*)?
 33 | {
 34 |   mem-op:queue(
 35 |     $transaction-map, $parent-node, $new-nodes, "insert-child")
 36 | };
 37 | 
 38 | (: Queue insert as first child into the node :)
 39 | declare function mem-op:insert-child-first(
 40 |   $transaction-map as map(*),
 41 |   $parent-node as element()*,
 42 |   $new-nodes as node()*)
 43 | as map(*)?
 44 | {
 45 |   mem-op:queue(
 46 |     $transaction-map,
 47 |     $parent-node,
 48 |     $new-nodes,
 49 |     "insert-child-first")
 50 | };
 51 | 
 52 | (: Queue insert a sibling before the node :)
 53 | declare function mem-op:insert-before(
 54 |   $transaction-map as map(*),
 55 |   $sibling as node()*,
 56 |   $new-nodes as node()*)
 57 | as map(*)?
 58 | {
 59 |   mem-op:queue(
 60 |     $transaction-map, $sibling, $new-nodes, "insert-before")
 61 | };
 62 | 
 63 | (: Queue insert a sibling after the node :)
 64 | declare function mem-op:insert-after(
 65 |   $transaction-map as map(*),
 66 |   $sibling as node()*,
 67 |   $new-nodes as node()*)
 68 | as map(*)?
 69 | {
 70 |   mem-op:queue(
 71 |     $transaction-map, $sibling, $new-nodes, "insert-after")
 72 | };
 73 | 
 74 | (: Queue replace of the node :)
 75 | declare function mem-op:replace(
 76 |   $transaction-map as map(*),
 77 |   $replace-nodes as node()*,
 78 |   $new-nodes as node()*)
 79 | as map(*)?
 80 | {
 81 |   mem-op:queue(
 82 |     $transaction-map,
 83 |     $replace-nodes except $replace-nodes/descendant::node(),
 84 |     $new-nodes,
 85 |     "replace")
 86 | };
 87 | 
 88 | (: Queue delete the node :)
 89 | declare function mem-op:delete(
 90 |   $transaction-map as map(*),
 91 |   $delete-nodes as node()*)
 92 | as map(*)?
 93 | {
 94 |   mem-op:queue(
 95 |     $transaction-map,
 96 |     $delete-nodes except $delete-nodes/descendant::node(),
 97 |     (),
 98 |     "replace")
 99 | };
100 | 
101 | (: Queue renaming of node :)
102 | declare function mem-op:rename(
103 |   $transaction-map as map(*),
104 |   $nodes-to-rename as node()*,
105 |   $new-name as xs:QName)
106 | as map(*)?
107 | {
108 |   mem-op:queue(
109 |     $transaction-map,
110 |     $nodes-to-rename,
111 |     element { $new-name } { },
112 |     "rename")
113 | };
114 | 
115 | (: Queue replacement of a value of an element or attribute :)
116 | declare function mem-op:replace-value(
117 |   $transaction-map as map(*),
118 |   $nodes-to-change as node()*,
119 |   $value as xs:anyAtomicType?)
120 | as map(*)?
121 | {
122 |   mem-op:queue(
123 |     $transaction-map,
124 |     $nodes-to-change,
125 |     text { $value },
126 |     "replace-value")
127 | };
128 | 
129 | (: Queue replacement of contents of an element :)
130 | declare function mem-op:replace-contents(
131 |   $transaction-map as map(*),
132 |   $nodes-to-change as node()*,
133 |   $contents as node()*)
134 | as map(*)?
135 | {
136 |   mem-op:queue(
137 |     $transaction-map,
138 |     $nodes-to-change,
139 |     $contents,
140 |     "replace-value")
141 | };
142 | 
143 | (: Queues the replacement of the node with the result of the passed function :)
144 | declare function mem-op:transform(
145 |   $transaction-map as map(*),
146 |   $nodes-to-change as node()*,
147 |   $transform-function as function(node()) as node()*)
148 | as map(*)?
149 | {
150 |   let $function-key as xs:string := mem-op:function-key($transform-function)
151 |   return 
152 |     map:new((
153 |       mem-op:queue(
154 |         $transaction-map,
155 |         $nodes-to-change,
156 |         text { $function-key },
157 |         "transform"
158 |       ),
159 |       map:entry(
160 |         $function-key,
161 |         $transform-function
162 |       )
163 |     ))
164 | };
165 | 
166 | (: Select the root to return after transaction :)
167 | declare function mem-op:copy($node-to-copy as node())
168 | as map(*)
169 | {
170 |   map:entry("copy", $node-to-copy)
171 | };
172 | 
173 | (: Execute transaction :)
174 | declare function mem-op:execute($transaction-map as map(*))
175 | as node()*
176 | {
177 |   if (exists(map:get($transaction-map, "nodes-to-modify")))
178 |   then
179 |     mem-op:process(
180 |       $transaction-map,
181 |       (: Ensure nodes to modify are in document order by using union :)
182 |       map:get($transaction-map, "nodes-to-modify") | (),
183 |       map:get($transaction-map, "modifier-nodes"),
184 |       map:get($transaction-map, "operation"),
185 |       map:get($transaction-map, "copy")
186 |     )
187 |   else
188 |     mem-op:safe-copy(map:get($transaction-map, "copy"))
189 | };
190 | 
191 | (: Begin private functions! :)
192 | 
193 | (: Queue actions for later execution :)
194 | declare %private 
195 | function mem-op:queue(
196 |   $transaction-map as map(*),
197 |   $nodes-to-modify as node()+,
198 |   $modifier-nodes as node()*,
199 |   $operation as xs:string?)
200 | as map(*)
201 | {
202 |   if (fn:exists($nodes-to-modify))
203 |   then 
204 |     (: Creates elements based off of generate-id (i.e., node is 12439f8e4a3, then we get back <mem-op:_12439f8e4a3/>) :)
205 |     let $modified-node-ids as element()* := $nodes-to-modify ! mem-op:id-wrapper(.) 
206 |     return
207 |     (
208 |     mem-op:all-nodes-from-same-doc($nodes-to-modify,map:get($transaction-map,"copy")),
209 |     map:new((
210 |       $transaction-map,
211 |       map:entry(
212 |         "operation",
213 |         (<mem-op:operation>{
214 |            attribute operation { $operation },
215 |            $modified-node-ids
216 |         }</mem-op:operation>,
217 |         (: Ensure operations are accummulated :)
218 |         map:get($transaction-map, "operation"))
219 |       ),
220 |       map:entry(
221 |         "nodes-to-modify",
222 |         ($nodes-to-modify,
223 |          (: Ensure nodes to modify are accummulated :)
224 |          map:get($transaction-map, "nodes-to-modify"))
225 |       ),
226 |       map:entry(
227 |         "modifier-nodes",
228 |         (<mem-op:modifier-nodes>{
229 |              attribute mem-op:operation { $operation },
230 |              $modifier-nodes[. instance of attribute()],
231 |              $modified-node-ids,
232 |              $modifier-nodes[not(. instance of attribute())]
233 |          }</mem-op:modifier-nodes>,
234 |          (: Ensure nodes to modifier nodes are accummulated :)
235 |          map:get($transaction-map, "modifier-nodes"))
236 |       )
237 |     ))
238 |     )
239 |   else
240 |     $transaction-map
241 | };
242 | 
243 | (: Begin private functions! :)
244 | 
245 | declare function mem-op:all-nodes-from-same-doc($nodes as node()*,$parent-node as node()) as empty-sequence() {
246 |   (: NOTE: must use every in satisfies to account for multiple outermost nodes :)
247 |   if (every $n in node-op:outermost(($parent-node,$nodes)) satisfies $n is $parent-node)
248 |   then ()
249 |   else
250 |     error(xs:QName("mem-op:MIXEDSOURCES"), "The nodes to change are coming from multiple sources",$nodes)
251 | };
252 | 
253 | (: The process functions handle the core logic for handling forked paths that
254 |     need to be altered :)
255 | declare
256 | function mem-op:process(
257 |   $nodes-to-modify as node()+,
258 |   $new-nodes as node()*,
259 |   $operation)
260 | as node()*
261 | {
262 |   mem-op:all-nodes-from-same-doc($nodes-to-modify,root($nodes-to-modify[1])),
263 |   mem-op:safe-copy(mem-op:process((), $nodes-to-modify, $new-nodes, $operation, ()))
264 | };
265 | 
266 | declare
267 | function mem-op:process(
268 |   $transaction-map as map(*)?,
269 |   $nodes-to-modify as node()+,
270 |   $new-nodes as node()*,
271 |   $operation,
272 |   $root-node as node()?)
273 | as node()*
274 | {
275 |   mem-op:process(
276 |     $transaction-map,
277 |     $nodes-to-modify,
278 |     node-op:outermost($nodes-to-modify),
279 |     $new-nodes,
280 |     $operation,
281 |     $root-node
282 |   )
283 | };
284 | 
285 | declare
286 | function mem-op:process(
287 |   $transaction-map as map(*)?,
288 |   $nodes-to-modify as node()+,
289 |   $outermost-nodes-to-modify as node()+,
290 |   $new-nodes as node()*,
291 |   $operation,
292 |   $root-node as node()?)
293 | as node()*
294 | {
295 |   mem-op:process(
296 |     $transaction-map,
297 |     $nodes-to-modify,
298 |     $outermost-nodes-to-modify,
299 |     $nodes-to-modify,
300 |     $new-nodes,
301 |     $operation,
302 |     mem-op:find-ancestor-intersect($outermost-nodes-to-modify, 1, ())
303 |         except
304 |     (if (exists($root-node))
305 |      then $root-node/ancestor::node()
306 |      else ())
307 |   )
308 | };
309 | 
310 | declare %private
311 | function mem-op:process(
312 |   $transaction-map as map(*)?,
313 |   $nodes-to-modify as node()+,
314 |   $outermost-nodes-to-modify as node()+,
315 |   $all-nodes-to-modify as node()*,
316 |   $new-nodes as node()*,
317 |   $operation,
318 |   $common-ancestors as node()*)
319 | as node()*
320 | {
321 |   mem-op:process(
322 |     $transaction-map,
323 |     $nodes-to-modify,
324 |     $outermost-nodes-to-modify,
325 |     $all-nodes-to-modify,
326 |     $new-nodes,
327 |     $operation,
328 |     $common-ancestors,
329 |     (: get the first common parent of all the items to modify
330 |       (First going up the tree. Last in document order.) :)
331 |     $common-ancestors[last()])
332 | };
333 | 
334 | declare %private
335 | function mem-op:process(
336 |   $transaction-map as map(*)?,
337 |   $nodes-to-modify as node()+,
338 |   $outermost-nodes-to-modify as node()+,
339 |   $all-nodes-to-modify as node()*,
340 |   $new-nodes as node()*,
341 |   $operation,
342 |   $common-ancestors as node()*,
343 |   $common-parent as node()?)
344 | as node()*
345 | {
346 |   mem-op:process(
347 |     $transaction-map,
348 |     $nodes-to-modify,
349 |     $outermost-nodes-to-modify,
350 |     $all-nodes-to-modify,
351 |     $new-nodes,
352 |     $operation,
353 |     $common-ancestors,
354 |     $common-parent,
355 |     ($common-parent/node(), $common-parent/@*) intersect
356 |      $outermost-nodes-to-modify/ancestor-or-self::node())
357 | };
358 | 
359 | declare %private
360 | function mem-op:process(
361 |   $transaction-map as map(*)?,
362 |   $nodes-to-modify as node()+,
363 |   $outermost-nodes-to-modify as node()+,
364 |   $all-nodes-to-modify as node()*,
365 |   $new-nodes as node()*,
366 |   $operation,
367 |   $common-ancestors as node()*,
368 |   $common-parent as node()?,
369 |   $merging-nodes as node()*)
370 | as node()*
371 | {
372 |   mem-op:process(
373 |     $transaction-map,
374 |     $nodes-to-modify,
375 |     $outermost-nodes-to-modify,
376 |     $all-nodes-to-modify,
377 |     $new-nodes,
378 |     $operation,
379 |     $common-ancestors,
380 |     $common-parent,
381 |     $merging-nodes,
382 |     (: create new XML trees for all the unique paths to
383 |         the items to modify :)
384 |     <mem-op:trees>{
385 |         if (exists($common-parent))
386 |         then (
387 |         $merging-nodes !
388 |         mem-op:build-subtree(
389 |           $transaction-map,
390 |           .,
391 |           $nodes-to-modify,
392 |           $new-nodes,
393 |           $operation,
394 |           (: get all of the ancestors :)
395 |           $common-parent/ancestor-or-self::node())
396 |         ) else (
397 |             let $reference-node as node()? := $nodes-to-modify[1]/..
398 |             for $n in (if (exists($reference-node))
399 |                     then ($reference-node/@*,$reference-node/node()) intersect $nodes-to-modify/ancestor-or-self::node()
400 |                     else $outermost-nodes-to-modify)
401 |             return
402 |                 mem-op:build-subtree(
403 |                     $transaction-map,
404 |                     $n,
405 |                     $nodes-to-modify,
406 |                     $new-nodes,
407 |                     $operation,
408 |                     (: get all of the ancestors :)
409 |                     $nodes-to-modify[1]/ancestor::node())
410 |         )
411 |       }</mem-op:trees>)
412 | };
413 | 
414 | declare %private
415 | function mem-op:process(
416 |   $transaction-map as map(*)?,
417 |   $nodes-to-modify as node()+,
418 |   $outermost-nodes-to-modify as node()+,
419 |   $all-nodes-to-modify as node()*,
420 |   $new-nodes as node()*,
421 |   $operation,
422 |   $common-ancestors as node()*,
423 |   $common-parent as node()?,
424 |   $merging-nodes as node()*,
425 |   $trees as element(mem-op:trees))
426 | as node()*
427 | {
428 |   if (exists($common-parent))
429 |   then
430 |     mem-op:process-ancestors(
431 |       $transaction-map,
432 |       (: Ancestors of the common parent which will be used to walk up the XML tree. :)
433 |       reverse($common-ancestors except $common-parent),
434 |       $common-parent,
435 |       $operation,
436 |       $all-nodes-to-modify,
437 |       (: Nodes to modify that are part of the common ancestors :)
438 |       $all-nodes-to-modify intersect $common-ancestors,
439 |       $new-nodes,
440 |       mem-op:reconstruct-node-with-additional-modifications(
441 |         $transaction-map,
442 |         $common-parent,
443 |         mem-op:place-trees(
444 |           (: Reduce iterations by using outermost nodes :)
445 |           $outermost-nodes-to-modify except $common-parent,
446 |           (: Pass attributes and child nodes excluding ancestors of nodes to modify. :)
447 |           ($common-parent/node(), $common-parent/@*)
448 |             except
449 |           $merging-nodes,
450 |           (: New sub trees to put in place. :)
451 |           $trees),
452 |         $new-nodes,
453 |         (),
454 |         $all-nodes-to-modify,
455 |         $operation,
456 |         fn:false()
457 |       )
458 |     )
459 |   else
460 |     mem-op:place-trees(
461 |       (: Reduce iterations by using outermost nodes :)
462 |       $outermost-nodes-to-modify,
463 |       (: Pass attributes and child nodes excluding ancestors of nodes to modify. :)
464 |       let $copy-node as node()? :=
465 |           if (fn:exists($transaction-map))
466 |           then map:get($transaction-map,'copy')
467 |           else ()
468 |       let $reference-node as node()? := $nodes-to-modify[1]/..
469 |       return
470 |         (if (fn:empty($transaction-map) or ($copy-node << $reference-node or $reference-node is $copy-node))
471 |         then($reference-node/(@*|node()))
472 |         else ())
473 |         except
474 |       $nodes-to-modify/ancestor-or-self::node(),
475 |       (: New sub trees to put in place. :)
476 |       $trees)
477 | };
478 | 
479 | declare %private
480 | function mem-op:build-subtree(
481 |   $transaction-map as map(*)?,
482 |   $mod-node as node(),
483 |   $nodes-to-modify as node()*,
484 |   $new-nodes as node()*,
485 |   $operations,
486 |   $all-ancestors as node()*)
487 | as node()*
488 | {
489 |   mem-op:subtree(
490 |     $transaction-map,
491 |     $mod-node,
492 |     $nodes-to-modify intersect
493 |     ($mod-node/descendant-or-self::node(),
494 |      $mod-node/descendant-or-self::node()/@*),
495 |     $new-nodes,
496 |     $operations,
497 |     $all-ancestors)
498 | };
499 | 
500 | declare %private
501 | function mem-op:subtree(
502 |   $transaction-map as map(*)?,
503 |   $mod-node as node(),
504 |   $nodes-to-modify as node()*,
505 |   $new-nodes as node()*,
506 |   $operations,
507 |   $all-ancestors as node()*)
508 | as node()*
509 | {
510 |   let $mod-node-id-qn := mem-op:generate-id-qn($nodes-to-modify[1])
511 |   let $descendant-nodes-to-mod := $nodes-to-modify except $mod-node
512 |   return
513 |     mem-op:wrap-subtree(
514 |       $mod-node-id-qn,
515 |       if (empty($descendant-nodes-to-mod))
516 |       then
517 |         mem-op:process-subtree(
518 |           $transaction-map,
519 |           $mod-node/ancestor::node() except $all-ancestors,
520 |           $mod-node,
521 |           $mod-node-id-qn,
522 |           $new-nodes,
523 |           $operations,
524 |           ())
525 |       else
526 |         let $outermost-nodes-to-mod as node()+ := node-op:outermost($descendant-nodes-to-mod)
527 |         return
528 |           mem-op:process(
529 |             $transaction-map,
530 |             $descendant-nodes-to-mod,
531 |             $outermost-nodes-to-mod,
532 |             $nodes-to-modify,
533 |             $new-nodes,
534 |             $operations,
535 |             (: find the ancestors that all nodes to modify have in common :)
536 |             mem-op:find-ancestor-intersect(
537 |               $outermost-nodes-to-mod,
538 |               1,
539 |               ()
540 |             )
541 |               except
542 |             $all-ancestors)
543 |     )
544 | };
545 | 
546 | declare %private
547 | function mem-op:wrap-subtree(
548 |   $mod-node-id-qn as xs:QName,
549 |   $results as node()*
550 | )as node()*
551 | {
552 |   if ($results)
553 |   then
554 |     element { $mod-node-id-qn } {
555 |       $results
556 |     }
557 |   else ()
558 | };
559 | (: Creates a new subtree with the changes made based off of the operation.  :)
560 | declare %private
561 | function mem-op:process-subtree(
562 |   $transaction-map as map(*)?,
563 |   $ancestors as node()*,
564 |   $node-to-modify as node(),
565 |   $node-to-modify-id-qn as xs:QName,
566 |   $new-node as node()*,
567 |   $operations,
568 |   $ancestor-nodes-to-modify as node()*)
569 | as node()*
570 | {
571 |   mem-op:process-ancestors(
572 |     $transaction-map,
573 |     reverse($ancestors),
574 |     (),
575 |     $operations,
576 |     $node-to-modify,
577 |     $ancestor-nodes-to-modify,
578 |     $new-node,
579 |     mem-op:build-new-xml(
580 |       $transaction-map,
581 |       $node-to-modify,
582 |       typeswitch ($operations)
583 |        case xs:string return $operations
584 |        default return
585 |          $operations[*[node-name(.) eq $node-to-modify-id-qn]]/
586 |          @operation,
587 |       typeswitch ($new-node)
588 |        case element(mem-op:modifier-nodes)* return $new-node[*[node-name(.) eq $node-to-modify-id-qn]]
589 |        default return
590 |          <mem-op:modifier-nodes>{
591 |              attribute mem-op:operation { $operations },
592 |              $new-node
593 |            }</mem-op:modifier-nodes>))
594 | };
595 | 
596 | (: Find all of the common ancestors of a given set of nodes  :)
597 | declare %private
598 | function mem-op:find-ancestor-intersect(
599 |   $items as node()*,
600 |   $current-position as xs:integer,
601 |   $ancestor-intersect as node()*)
602 | as node()*
603 | {
604 |   if (empty($items))
605 |   then $ancestor-intersect
606 |   else if ($current-position gt 1)
607 |   (: if ancestor-intersect already exists intersect with the current item's ancestors :)
608 |   then
609 |     if (empty($ancestor-intersect))
610 |     (: short circuit if intersect is empty :)
611 |     then ()
612 |     else
613 |       $ancestor-intersect intersect head($items)/ancestor::node() intersect $items[fn:last()]/ancestor::node()
614 |   (: otherwise just use the current item's ancestors :)
615 |   else
616 |     mem-op:find-ancestor-intersect(
617 |       tail($items),
618 |       $current-position + 1,
619 |       head($items)/ancestor::node())
620 | };
621 | 
622 | (: Place newly created trees in proper order :)
623 | declare %private
624 | function mem-op:place-trees(
625 |   $nodes-to-modify as node()*,
626 |   $merging-nodes as node()*,
627 |   $trees as element(mem-op:trees)?)
628 | as node()*
629 | {
630 |   if (empty($nodes-to-modify) or empty($trees[*]))
631 |   then $merging-nodes
632 |   else (
633 |     let $tree-ids := $trees/* ! substring-after(local-name(.),'_')
634 |     let $count-of-trees := count($tree-ids)
635 |     for $tree at $pos in $trees/*
636 |     let $previous-tree-pos := $pos - 1
637 |     let $previous-tree-id := $tree-ids[position() eq $previous-tree-pos]
638 |     let $current-tree-id := $tree-ids[position() eq $pos]
639 |     let $previous-node-to-modify :=
640 |                            if (exists($previous-tree-id))
641 |                            then $nodes-to-modify[generate-id(.) eq $previous-tree-id][1]
642 |                            else ()
643 |     let $node-to-modify := $nodes-to-modify[generate-id(.) eq $current-tree-id][1]
644 |     let $nodes-inbetween := node-op:inbetween($merging-nodes, $previous-node-to-modify, $node-to-modify)
645 |     return
646 |       (
647 |         $nodes-inbetween,
648 |         $tree/(attribute::node()|child::node()),
649 |         if ($pos eq $count-of-trees)
650 |         then
651 |           node-op:inbetween($merging-nodes, $node-to-modify, ())
652 |         else ()
653 |       )
654 |   )
655 | };
656 | 
657 | (: Go up the tree to build new XML using tail recursion. This is used when there are no side
658 |   steps to merge in, only a direct path up the tree. $ancestors is expected to be passed in
659 |   REVERSE document order. :)
660 | declare %private
661 | function mem-op:process-ancestors(
662 |   $transaction-map as map(*)?,
663 |   $ancestors as node()*,
664 |   $last-ancestor as node()?,
665 |   $operations,
666 |   $nodes-to-modify as node()*,
667 |   $ancestor-nodes-to-modify as node()*,
668 |   $new-node as node()*,
669 |   $base as node()*)
670 | as node()*
671 | {
672 |   if (exists($ancestors))
673 |   then
674 |     mem-op:process-ancestors(
675 |       $transaction-map,
676 |       tail($ancestors),
677 |       head($ancestors),
678 |       $operations,
679 |       $nodes-to-modify,
680 |       $ancestor-nodes-to-modify,
681 |       $new-node,
682 |       mem-op:reconstruct-node-with-additional-modifications(
683 |         $transaction-map,
684 |         head($ancestors),
685 |         ($last-ancestor/preceding-sibling::node(),$base,$last-ancestor/following-sibling::node()),
686 |         $new-node,
687 |         $nodes-to-modify,
688 |         $ancestor-nodes-to-modify,
689 |         $operations,
690 |         fn:true()
691 |       )
692 |     )
693 |   else
694 |     $base
695 | };
696 | 
697 | (: Generic logic for rebuilding document/element nodes and passing in for  :)
698 | declare %private
699 | function mem-op:reconstruct-node-with-additional-modifications(
700 |   $transaction-map as map(*)?,
701 |   $node as node(),
702 |   $ordered-content as node()*,
703 |   $new-node as node()*,
704 |   $nodes-to-modify as node()*,
705 |   $ancestor-nodes-to-modify as node()*,
706 |   $operations,
707 |   $carry-over-attributes as xs:boolean)
708 | {
709 |   if (some $n in $ancestor-nodes-to-modify
710 |       satisfies $n is $node)
711 |   then
712 |     mem-op:process-subtree(
713 |       $transaction-map,
714 |       (),
715 |       mem-op:reconstruct-node($node,$ordered-content,$nodes-to-modify,$carry-over-attributes),
716 |       mem-op:generate-id-qn($node),
717 |       $new-node,
718 |       $operations,
719 |       ()
720 |     )
721 |   else
722 |     mem-op:reconstruct-node($node,$ordered-content,$nodes-to-modify,$carry-over-attributes)
723 | };
724 | 
725 | (: Generic logic for rebuilding document/element nodes :)
726 | declare %private
727 | function mem-op:reconstruct-node(
728 |   $node as node(),
729 |   $ordered-content as node()*,
730 |   $nodes-to-modify as node()*,
731 |   $carry-over-attributes as xs:boolean)
732 | {
733 |   typeswitch ($node)
734 |   case element() return
735 |        element { node-name($node) } {
736 |          if ($carry-over-attributes)
737 |          then $node/@* except $nodes-to-modify
738 |          else (),
739 |          $ordered-content
740 |        }
741 |   case document-node() return
742 |        document {
743 |          $ordered-content
744 |        }
745 |   default return ()
746 | };
747 | 
748 | (: Generate an id unique to a node in memory. Right now using fn:generate-id. :)
749 | declare
750 | function mem-op:id-wrapper($node as node())
751 | {
752 |   element {mem-op:generate-id-qn($node)} {()}
753 | };
754 | 
755 | (: Generate QName from node :)
756 | declare %private
757 | function mem-op:generate-id-qn($node as node())
758 | {
759 |   QName(
760 |       "http://maxdewpoint.blogspot.com/memory-operations",
761 |       concat("_", mem-op:generate-id($node)))
762 | };
763 | 
764 | (: Generate an id unique to a node in memory. Right now using fn:generate-id. :)
765 | declare %private
766 | function mem-op:generate-id($node as node())
767 | {
768 |   generate-id($node)
769 | };
770 | 
771 | (: Create a key to uniquely identify a function :)
772 | declare
773 | function mem-op:function-key($function as function(*))
774 | {
775 |     let $qname := (function-name($function),
776 |        xs:QName("_" || generate-id(element rand-el {})))[1]
777 |     return
778 |     namespace-uri-from-QName($qname) ||
779 |     ":" ||
780 |     local-name-from-QName($qname) ||
781 |     "#" ||
782 |     string(function-arity($function))
783 | };
784 | 
785 | (: This is where the transformations to the XML take place and this module can be extended. :)
786 | declare %private
787 | function mem-op:build-new-xml(
788 |   $transaction-map as map(*)?,
789 |   $node as node(),
790 |   $operations as xs:string*,
791 |   $modifier-nodes as element(mem-op:modifier-nodes)*)
792 | {
793 |   mem-op:build-new-xml(
794 |     $transaction-map,
795 |     $node,
796 |     mem-op:weighed-operations(distinct-values($operations)),
797 |     $modifier-nodes,
798 |     ()
799 |   )
800 | };
801 | 
802 | (: This function contains the logic for each of the operations is is going to be the most
803 |   likely place extensions will be made. :)
804 | declare %private
805 | function mem-op:build-new-xml(
806 |   $transaction-map as map(*)?,
807 |   $nodes as node()*,
808 |   $operations as xs:string*,
809 |   $modifier-nodes as element(mem-op:modifier-nodes)*,
810 |   $modifying-node as node()?)
811 | {
812 |   if (empty($operations) or empty($nodes))
813 |   then $nodes
814 |   else
815 |     let $node as node()? := if (count($nodes) eq 1) then $nodes else $modifying-node
816 |     let $pivot-pos as xs:integer? := $nodes/(if (. is $node) then position() else ())
817 |     let $operation as xs:string := head($operations)
818 |     let $last-in-wins as xs:boolean := $operation = ('replace-value')
819 |     let $reverse-mod-nodes as xs:boolean := $operation = ('insert-child')
820 |     let $mod-nodes as node()* :=
821 |       let $modifier-nodes :=
822 |             if ($last-in-wins)
823 |             then ($modifier-nodes[@mem-op:operation eq $operation])[1]
824 |             else if ($reverse-mod-nodes) 
825 |             then reverse($modifier-nodes[@mem-op:operation eq $operation])
826 |             else $modifier-nodes[@mem-op:operation eq $operation]      
827 |       return
828 |         ($modifier-nodes ! @node()[empty(self::attribute(mem-op:operation))],
829 |          $modifier-nodes ! node()[empty(self::mem-op:*)])
830 |     let $new-nodes :=
831 |       switch ($operation)
832 |       case "replace" return $mod-nodes
833 |       case "insert-child" return
834 |           element { node-name($node) } {
835 |             let $attributes-to-insert := $mod-nodes[self::attribute()],
836 |                 $attributes-to-insert-qns := $attributes-to-insert/node-name(.)
837 |             return
838 |               ($node/@*[not(node-name(.) = $attributes-to-insert-qns)],
839 |                $attributes-to-insert,
840 |                $node/node(),
841 |                $mod-nodes[exists(. except $attributes-to-insert)])
842 |           }
843 |         case "insert-child-first" return
844 |           element { node-name($node) } {
845 |             let $attributes-to-insert := $mod-nodes[self::attribute()],
846 |                 $attributes-to-insert-qns := $attributes-to-insert/node-name(.)
847 |             return
848 |               ($attributes-to-insert,
849 |                $node/@*[not(node-name(.) = $attributes-to-insert-qns)],
850 |                $mod-nodes[exists(. except $attributes-to-insert)],
851 |                $node/node())
852 |           }
853 |         case "insert-after" return ($node, $mod-nodes)
854 |         case "insert-before" return ($mod-nodes, $node)
855 |         case "rename" return
856 |           element { node-name(($mod-nodes[self::element()])[1]) } { $node/@*, $node/node() }
857 |         case "replace-value" return
858 |           typeswitch ($node)
859 |            case attribute() return attribute { node-name($node) } { $mod-nodes }
860 |            case element() return
861 |              element { node-name($node) } { $node/@*, $mod-nodes }
862 |            case processing-instruction() return
863 |              processing-instruction {
864 |                node-name($node)
865 |              } {
866 |                $mod-nodes
867 |              }
868 |            case comment() return
869 |              comment {
870 |                $mod-nodes
871 |              }
872 |            case text() return $mod-nodes
873 |            default return ()
874 |         case "transform" return
875 |           map:get(
876 |             $transaction-map,
877 |             string($mod-nodes))($node)
878 |         default return ()
879 |     let $n-nodes := 
880 |         unordered {(
881 |             $nodes[exists($pivot-pos) and position() lt $pivot-pos] except $node,
882 |             $new-nodes,
883 |             $nodes[exists($pivot-pos) and position() gt $pivot-pos] except $node
884 |         )}
885 |     return
886 |       mem-op:build-new-xml(
887 |         $transaction-map,
888 |         $n-nodes,
889 |         tail($operations),
890 |         $modifier-nodes,
891 |         if ($operation = ('insert-after','insert-before'))
892 |         then $node
893 |         else $new-nodes[1]
894 |       )
895 | };
896 | 
897 | (: Order the operations in such a way that the least amount of stomping on eachother occurs :)
898 | declare %private
899 | function mem-op:weighed-operations(
900 |   $operations as xs:string*) as xs:string*
901 | {
902 |   $operations[. eq "replace"],
903 |   $operations[. eq "replace-value"],
904 |   $operations[. eq "insert-child"],
905 |   $operations[. eq "insert-child-first"],
906 |   $operations[not(. = ("replace","replace-value","insert-child","insert-child-first","transform"))],
907 |   $operations[. eq "transform"]
908 | };
909 | 
910 | declare %private
911 | function mem-op:safe-copy(
912 |   $node as node())
913 | as node()? {
914 |   mem-op:reconstruct-node($node,$node/*,(),fn:true())
915 | };
916 | 


--------------------------------------------------------------------------------
/memory-operations.xqy:
--------------------------------------------------------------------------------
   1 | xquery version "1.0-ml";
   2 | (:~
   3 | Copyright (c) 2013 Ryan Dew
   4 | 
   5 | Licensed under the Apache License, Version 2.0 (the "License");
   6 | you may not use this file except in compliance with the License.
   7 | You may obtain a copy of the License at
   8 | 
   9 |        http://www.apache.org/licenses/LICENSE-2.0
  10 | 
  11 | Unless required by applicable law or agreed to in writing, software
  12 | distributed under the License is distributed on an "AS IS" BASIS,
  13 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  14 | See the License for the specific language governing permissions and
  15 | limitations under the License.
  16 | 
  17 | @author Ryan Dew (ryan.j.dew@gmail.com)
  18 | @version 1.0.7
  19 | @description This is a module with function changing XML in memory by creating subtrees using the ancestor, preceding-sibling, and following-sibling axes
  20 | 				and intersect/except expressions. Requires MarkLogic 6+.
  21 | ~:)
  22 | module namespace mem-op="http://maxdewpoint.blogspot.com/memory-operations";
  23 | import module namespace node-op="http://maxdewpoint.blogspot.com/node-operations" at "node-operations.xqy";
  24 | declare default function namespace "http://www.w3.org/2005/xpath-functions";
  25 | declare namespace xdmp="http://marklogic.com/xdmp";
  26 | declare namespace map="http://marklogic.com/xdmp/map";
  27 | declare option xdmp:mapping "true";
  28 | declare option xdmp:copy-on-validate "true";
  29 | declare %private variable $queue as map:map := map:map();
  30 | declare %private variable $transform-functions as map:map := map:map();
  31 | 
  32 | (: Insert a child into the node :)
  33 | declare function mem-op:insert-child(
  34 |   $parent-node as element()+,
  35 |   $new-nodes as node()*)
  36 | as node()?
  37 | {
  38 |   mem-op:process($parent-node, $new-nodes, "insert-child")
  39 | };
  40 | 
  41 | (: Queue insert a child into the node :)
  42 | declare function mem-op:insert-child(
  43 |   $transaction-id as xs:string,
  44 |   $parent-node as element()*,
  45 |   $new-nodes as node()*)
  46 | as empty-sequence()
  47 | {
  48 |   mem-op:queue(
  49 |     $transaction-id, $parent-node, $new-nodes, "insert-child")
  50 | };
  51 | 
  52 | (: Insert as first child into the node :)
  53 | declare function mem-op:insert-child-first(
  54 |   $parent-node as element()+,
  55 |   $new-nodes as node()*)
  56 | as node()?
  57 | {
  58 |   mem-op:process(
  59 |     $parent-node, $new-nodes, "insert-child-first")
  60 | };
  61 | 
  62 | (: Queue insert as first child into the node :)
  63 | declare function mem-op:insert-child-first(
  64 |   $transaction-id as xs:string,
  65 |   $parent-node as element()*,
  66 |   $new-nodes as node()*)
  67 | as empty-sequence()
  68 | {
  69 |   mem-op:queue(
  70 |     $transaction-id,
  71 |     $parent-node,
  72 |     $new-nodes,
  73 |     "insert-child-first")
  74 | };
  75 | 
  76 | (: Insert a sibling before the node :)
  77 | declare function mem-op:insert-before(
  78 |   $sibling as node()+,
  79 |   $new-nodes as node()*)
  80 | as node()?
  81 | {
  82 |   mem-op:process($sibling, $new-nodes, "insert-before")
  83 | };
  84 | 
  85 | (: Queue insert a sibling before the node :)
  86 | declare function mem-op:insert-before(
  87 |   $transaction-id as xs:string,
  88 |   $sibling as node()*,
  89 |   $new-nodes as node()*)
  90 | as empty-sequence()
  91 | {
  92 |   mem-op:queue(
  93 |     $transaction-id, $sibling, $new-nodes, "insert-before")
  94 | };
  95 | 
  96 | (: Insert a sibling after the node :)
  97 | declare function mem-op:insert-after(
  98 |   $sibling as node()+,
  99 |   $new-nodes as node()*)
 100 | as node()?
 101 | {
 102 |   mem-op:process($sibling, $new-nodes, "insert-after")
 103 | };
 104 | 
 105 | (: Queue insert a sibling after the node :)
 106 | declare function mem-op:insert-after(
 107 |   $transaction-id as xs:string,
 108 |   $sibling as node()*,
 109 |   $new-nodes as node()*)
 110 | as empty-sequence()
 111 | {
 112 |   mem-op:queue(
 113 |     $transaction-id, $sibling, $new-nodes, "insert-after")
 114 | };
 115 | 
 116 | (: Replace the node :)
 117 | declare function mem-op:replace(
 118 |   $replace-nodes as node()+,
 119 |   $new-nodes as node()*)
 120 | as node()?
 121 | {
 122 |   mem-op:process(
 123 |     $replace-nodes except $replace-nodes/descendant::node(),
 124 |     $new-nodes,
 125 |     "replace")
 126 | };
 127 | 
 128 | (: Queue replace of the node :)
 129 | declare function mem-op:replace(
 130 |   $transaction-id as xs:string,
 131 |   $replace-nodes as node()*,
 132 |   $new-nodes as node()*)
 133 | as empty-sequence()
 134 | {
 135 |   mem-op:queue(
 136 |     $transaction-id,
 137 |     $replace-nodes except $replace-nodes/descendant::node(),
 138 |     $new-nodes,
 139 |     "replace")
 140 | };
 141 | 
 142 | (: Delete the node :)
 143 | declare function mem-op:delete($delete-nodes as node()+)
 144 | as node()?
 145 | {
 146 |   mem-op:process(
 147 |     $delete-nodes except $delete-nodes/descendant::node(),
 148 |     (),
 149 |     "replace")
 150 | };
 151 | 
 152 | (: Queue delete the node :)
 153 | declare function mem-op:delete(
 154 |   $transaction-id as xs:string,
 155 |   $delete-nodes as node()*)
 156 | as empty-sequence()
 157 | {
 158 |   mem-op:queue(
 159 |     $transaction-id,
 160 |     $delete-nodes except $delete-nodes/descendant::node(),
 161 |     (),
 162 |     "replace")
 163 | };
 164 | 
 165 | (: Rename a node :)
 166 | declare function mem-op:rename(
 167 |   $nodes-to-rename as node()+,
 168 |   $new-name as xs:QName)
 169 | as node()?
 170 | {
 171 |   mem-op:process(
 172 |     $nodes-to-rename, element { $new-name } { }, "rename")
 173 | };
 174 | 
 175 | (: Queue renaming of node :)
 176 | declare function mem-op:rename(
 177 |   $transaction-id as xs:string,
 178 |   $nodes-to-rename as node()*,
 179 |   $new-name as xs:QName)
 180 | as empty-sequence()
 181 | {
 182 |   mem-op:queue(
 183 |     $transaction-id,
 184 |     $nodes-to-rename,
 185 |     element { $new-name } { },
 186 |     "rename")
 187 | };
 188 | 
 189 | (: Replaces a value of an element or attribute :)
 190 | declare function mem-op:replace-value(
 191 |   $nodes-to-change as node()+,
 192 |   $value as xs:anyAtomicType?)
 193 | as node()?
 194 | {
 195 |   mem-op:process(
 196 |     $nodes-to-change, text { $value }, "replace-value")
 197 | };
 198 | 
 199 | (: Queue replacement of a value of an element or attribute :)
 200 | declare function mem-op:replace-value(
 201 |   $transaction-id as xs:string,
 202 |   $nodes-to-change as node()*,
 203 |   $value as xs:anyAtomicType?)
 204 | as empty-sequence()
 205 | {
 206 |   mem-op:queue(
 207 |     $transaction-id,
 208 |     $nodes-to-change,
 209 |     text { $value },
 210 |     "replace-value")
 211 | };
 212 | 
 213 | (: Replaces contents of an element :)
 214 | declare function mem-op:replace-contents(
 215 |   $nodes-to-change as node()+,
 216 |   $contents as node()*)
 217 | as node()?
 218 | {
 219 |   mem-op:process(
 220 |     $nodes-to-change, $contents, "replace-value")
 221 | };
 222 | 
 223 | (: Queue replacement of contents of an element :)
 224 | declare function mem-op:replace-contents(
 225 |   $transaction-id as xs:string,
 226 |   $nodes-to-change as node()*,
 227 |   $contents as node()*)
 228 | as empty-sequence()
 229 | {
 230 |   mem-op:queue(
 231 |     $transaction-id,
 232 |     $nodes-to-change,
 233 |     $contents,
 234 |     "replace-value")
 235 | };
 236 | 
 237 | (: Replaces with the result of the passed function :)
 238 | declare function mem-op:transform(
 239 |   $nodes-to-change as node()+,
 240 |   $transform-function as function(node()) as node()*)
 241 | as node()?
 242 | {
 243 |    let $function-key as xs:string := mem-op:function-key($transform-function)
 244 |    return
 245 |   (map:put($transform-functions, $function-key, $transform-function),
 246 |    mem-op:process($nodes-to-change, text { $function-key }, "transform"),
 247 |    map:delete($transform-functions, $function-key))
 248 | };
 249 | 
 250 | (: Queues the replacement of the node with the result of the passed function :)
 251 | declare function mem-op:transform(
 252 |   $transaction-id as xs:string,
 253 |   $nodes-to-change as node()*,
 254 |   $transform-function as function(node()) as node()*)
 255 | as empty-sequence()
 256 | {
 257 |    let $function-key as xs:string := mem-op:function-key($transform-function)
 258 |    return
 259 |   (map:put(
 260 |      map:get($queue, $transaction-id), $function-key, $transform-function),
 261 |    mem-op:queue(
 262 |      $transaction-id,
 263 |      $nodes-to-change,
 264 |      text { $function-key },
 265 |      "transform"))
 266 | };
 267 | 
 268 | (: Select the root to return after transaction :)
 269 | declare function mem-op:copy($node-to-copy as node())
 270 | as xs:string
 271 | {
 272 |   let $transaction-id as xs:string := concat(mem-op:generate-id($node-to-copy), current-dateTime())
 273 |   let $transaction-map as map:map := map:map()
 274 |   let $_add-copy-to-transaction-map as empty-sequence() := map:put($transaction-map, "copy", $node-to-copy)
 275 |   let $_add-transaction-map-to-queue as empty-sequence() := map:put(
 276 |                                                             $queue,
 277 |                                                             $transaction-id,
 278 |                                                             $transaction-map
 279 |                                                            )
 280 |   return $transaction-id
 281 | };
 282 | 
 283 | (: Execute transaction :)
 284 | declare function mem-op:execute($transaction-id as xs:string)
 285 | as node()*
 286 | {
 287 |   let $transaction-map as map:map := map:get($queue, $transaction-id)
 288 |   return
 289 |   (
 290 |   if (exists(map:get($transaction-map, "nodes-to-modify")))
 291 |   then
 292 |      mem-op:safe-copy(mem-op:process(
 293 |        $transaction-map,
 294 |        (: Ensure nodes to modify are in document order by using union :)
 295 |        map:get($transaction-map, "nodes-to-modify") | (),
 296 |        map:get($transaction-map, "modifier-nodes"),
 297 |        map:get($transaction-map, "operation"),
 298 |        map:get($transaction-map, "copy")
 299 |      ))
 300 |   else
 301 |     mem-op:safe-copy(map:get($transaction-map, "copy"))
 302 |   ,
 303 |     map:clear($transaction-map)
 304 |   ),
 305 |   map:delete($queue, $transaction-id)
 306 | };
 307 | 
 308 | (: Execute transaction :)
 309 | declare function mem-op:execute-section($transaction-id as xs:string, $section-root as node())
 310 | as node()*
 311 | {
 312 |   let $transaction-map as map:map := map:get($queue, $transaction-id),
 313 |       $nodes-to-mod as node()* := map:get($transaction-map, "nodes-to-modify") intersect ($section-root/descendant-or-self::node(),$section-root/descendant-or-self::*/@*)
 314 |   return
 315 |   (
 316 |    if (exists($nodes-to-mod))
 317 |    then
 318 |      (mem-op:safe-copy(
 319 |        mem-op:process(
 320 |          $transaction-map,
 321 |          $nodes-to-mod,
 322 |          map:get($transaction-map, "modifier-nodes"),
 323 |          map:get($transaction-map, "operation"),
 324 |          $section-root
 325 |        ) except $section-root/../(@*|node()))
 326 |      ,
 327 |       map:put($transaction-map, "nodes-to-modify",map:get($transaction-map, "nodes-to-modify") except $nodes-to-mod)
 328 |     )
 329 |    else
 330 |      mem-op:safe-copy($section-root)
 331 |   )
 332 | };
 333 | 
 334 | (: Begin private functions! :)
 335 | 
 336 | (: Queue actions for later execution :)
 337 | declare %private
 338 | function mem-op:queue(
 339 |   $transaction-id as xs:string,
 340 |   $nodes-to-modify as node()*,
 341 |   $modifier-nodes as node()*,
 342 |   $operation as xs:string?)
 343 | as empty-sequence()
 344 | {
 345 |   if (exists($nodes-to-modify))
 346 |   then
 347 |     let $transaction-map as map:map := map:get($queue, $transaction-id)
 348 |     (: Creates elements based off of generate-id (i.e., node is 12439f8e4a3, then we get back <mem-op:_12439f8e4a3/>) :)
 349 |     let $modified-node-ids as element()* := mem-op:id-wrapper($nodes-to-modify) (: This line uses function mapping :)
 350 |     return
 351 |     (
 352 |     mem-op:all-nodes-from-same-doc($nodes-to-modify,map:get($transaction-map,"copy")),
 353 |     map:put(
 354 |         $transaction-map,
 355 |         "operation",
 356 |         (<mem-op:operation>{
 357 |              attribute operation { $operation },
 358 |              $modified-node-ids
 359 |            }</mem-op:operation>,
 360 |          (: Ensure operations are accummulated :)
 361 |          map:get($transaction-map, "operation"))),
 362 |     map:put(
 363 |         $transaction-map,
 364 |         "nodes-to-modify",
 365 |         ($nodes-to-modify,
 366 |          (: Ensure nodes to modify are accummulated :)
 367 |          map:get($transaction-map, "nodes-to-modify"))),
 368 |     map:put(
 369 |         $transaction-map,
 370 |         "modifier-nodes",
 371 |         (<mem-op:modifier-nodes>{
 372 |              attribute mem-op:operation { $operation },
 373 |              $modifier-nodes[self::attribute()],
 374 |              $modified-node-ids,
 375 |              $modifier-nodes[not(self::attribute())]
 376 |            }</mem-op:modifier-nodes>,
 377 |          (: Ensure nodes to modifier nodes are accummulated :)
 378 |          map:get($transaction-map, "modifier-nodes")))
 379 |     )
 380 |   else ()
 381 | };
 382 | 
 383 | declare function mem-op:all-nodes-from-same-doc($nodes as node()*,$parent-node as node()) as empty-sequence() {
 384 |   (: NOTE: must use every in satisfies to account for multiple outermost nodes :)
 385 |   if (every $n in node-op:outermost(($parent-node,$nodes)) satisfies $n is $parent-node)
 386 |   then ()
 387 |   else
 388 |     error(xs:QName("mem-op:MIXEDSOURCES"), "The nodes to change are coming from multiple sources",$nodes)
 389 | };
 390 | 
 391 | (: The process functions handle the core logic for handling forked paths that
 392 |     need to be altered :)
 393 | declare
 394 | function mem-op:process(
 395 |   $nodes-to-modify as node()+,
 396 |   $new-nodes as node()*,
 397 |   $operation)
 398 | as node()*
 399 | {
 400 |   mem-op:all-nodes-from-same-doc($nodes-to-modify,root($nodes-to-modify[1])),
 401 |   mem-op:safe-copy(mem-op:process((), $nodes-to-modify, $new-nodes, $operation, ()))
 402 | };
 403 | 
 404 | declare
 405 | function mem-op:process(
 406 |   $transaction-map as map:map?,
 407 |   $nodes-to-modify as node()+,
 408 |   $new-nodes as node()*,
 409 |   $operation,
 410 |   $root-node as node()?)
 411 | as node()*
 412 | {
 413 |   mem-op:process(
 414 |     $transaction-map,
 415 |     $nodes-to-modify,
 416 |     node-op:outermost($nodes-to-modify),
 417 |     $new-nodes,
 418 |     $operation,
 419 |     $root-node
 420 |   )
 421 | };
 422 | 
 423 | declare
 424 | function mem-op:process(
 425 |   $transaction-map as map:map?,
 426 |   $nodes-to-modify as node()+,
 427 |   $outermost-nodes-to-modify as node()+,
 428 |   $new-nodes as node()*,
 429 |   $operation,
 430 |   $root-node as node()?)
 431 | as node()*
 432 | {
 433 |   mem-op:process(
 434 |     $transaction-map,
 435 |     $nodes-to-modify,
 436 |     $outermost-nodes-to-modify,
 437 |     $nodes-to-modify,
 438 |     $new-nodes,
 439 |     $operation,
 440 |     mem-op:find-ancestor-intersect($outermost-nodes-to-modify, 1, ())
 441 |         except
 442 |     (if (exists($root-node))
 443 |      then $root-node/ancestor::node()
 444 |      else ())
 445 |   )
 446 | };
 447 | 
 448 | declare %private
 449 | function mem-op:process(
 450 |   $transaction-map as map:map?,
 451 |   $nodes-to-modify as node()+,
 452 |   $outermost-nodes-to-modify as node()+,
 453 |   $all-nodes-to-modify as node()*,
 454 |   $new-nodes as node()*,
 455 |   $operation,
 456 |   $common-ancestors as node()*)
 457 | as node()*
 458 | {
 459 |   mem-op:process(
 460 |     $transaction-map,
 461 |     $nodes-to-modify,
 462 |     $outermost-nodes-to-modify,
 463 |     $all-nodes-to-modify,
 464 |     $new-nodes,
 465 |     $operation,
 466 |     $common-ancestors,
 467 |     (: get the first common parent of all the items to modify
 468 |       (First going up the tree. Last in document order.) :)
 469 |     $common-ancestors[last()])
 470 | };
 471 | 
 472 | declare %private
 473 | function mem-op:process(
 474 |   $transaction-map as map:map?,
 475 |   $nodes-to-modify as node()+,
 476 |   $outermost-nodes-to-modify as node()+,
 477 |   $all-nodes-to-modify as node()*,
 478 |   $new-nodes as node()*,
 479 |   $operation,
 480 |   $common-ancestors as node()*,
 481 |   $common-parent as node()?)
 482 | as node()*
 483 | {
 484 |   mem-op:process(
 485 |     $transaction-map,
 486 |     $nodes-to-modify,
 487 |     $outermost-nodes-to-modify,
 488 |     $all-nodes-to-modify,
 489 |     $new-nodes,
 490 |     $operation,
 491 |     $common-ancestors,
 492 |     $common-parent,
 493 |     ($common-parent/node(), $common-parent/@node()) intersect
 494 |      $outermost-nodes-to-modify/ancestor-or-self::node())
 495 | };
 496 | 
 497 | declare %private
 498 | function mem-op:process(
 499 |   $transaction-map as map:map?,
 500 |   $nodes-to-modify as node()+,
 501 |   $outermost-nodes-to-modify as node()+,
 502 |   $all-nodes-to-modify as node()*,
 503 |   $new-nodes as node()*,
 504 |   $operation,
 505 |   $common-ancestors as node()*,
 506 |   $common-parent as node()?,
 507 |   $merging-nodes as node()*)
 508 | as node()*
 509 | {
 510 |   mem-op:process(
 511 |     $transaction-map,
 512 |     $nodes-to-modify,
 513 |     $outermost-nodes-to-modify,
 514 |     $all-nodes-to-modify,
 515 |     $new-nodes,
 516 |     $operation,
 517 |     $common-ancestors,
 518 |     $common-parent,
 519 |     $merging-nodes,
 520 |     (: create new XML trees for all the unique paths to
 521 |         the items to modify :)
 522 |     <mem-op:trees>{
 523 |         if (exists($common-parent))
 524 |         then
 525 |         mem-op:build-subtree(
 526 |           $transaction-map,
 527 |           $merging-nodes,
 528 |           $nodes-to-modify,
 529 |           $new-nodes,
 530 |           $operation,
 531 |           (: get all of the ancestors :)
 532 |           $common-parent/ancestor-or-self::node())
 533 |         else (
 534 |             let $reference-node as node()? := $nodes-to-modify[1]/..
 535 |             return
 536 |                 mem-op:build-subtree(
 537 |                     $transaction-map,
 538 |                     if (exists($reference-node))
 539 |                     then ($reference-node/@node(),$reference-node/node()) intersect $nodes-to-modify/ancestor-or-self::node()
 540 |                     else $outermost-nodes-to-modify,
 541 |                     $nodes-to-modify,
 542 |                     $new-nodes,
 543 |                     $operation,
 544 |                     (: get all of the ancestors :)
 545 |                     $nodes-to-modify[1]/ancestor::node())
 546 |         )
 547 |       }</mem-op:trees>)
 548 | };
 549 | 
 550 | declare %private
 551 | function mem-op:process(
 552 |   $transaction-map as map:map?,
 553 |   $nodes-to-modify as node()+,
 554 |   $outermost-nodes-to-modify as node()+,
 555 |   $all-nodes-to-modify as node()*,
 556 |   $new-nodes as node()*,
 557 |   $operation,
 558 |   $common-ancestors as node()*,
 559 |   $common-parent as node()?,
 560 |   $merging-nodes as node()*,
 561 |   $trees as element(mem-op:trees))
 562 | as node()*
 563 | {
 564 |   if (exists($common-parent))
 565 |   then
 566 |     mem-op:process-ancestors(
 567 |       $transaction-map,
 568 |       (: Ancestors of the common parent which will be used to walk up the XML tree. :)
 569 |       reverse($common-ancestors except $common-parent),
 570 |       $common-parent,
 571 |       $operation,
 572 |       $all-nodes-to-modify,
 573 |       (: Nodes to modify that are part of the common ancestors :)
 574 |       $all-nodes-to-modify intersect $common-ancestors,
 575 |       $new-nodes,
 576 |       mem-op:reconstruct-node-with-additional-modifications(
 577 |         $transaction-map,
 578 |         $common-parent,
 579 |         mem-op:place-trees(
 580 |           (: Reduce iterations by using outermost nodes :)
 581 |           $outermost-nodes-to-modify except $common-parent,
 582 |           (: Pass attributes and child nodes excluding ancestors of nodes to modify. :)
 583 |           ($common-parent/node(), $common-parent/@node())
 584 |             except
 585 |           $merging-nodes,
 586 |           (: New sub trees to put in place. :)
 587 |           $trees),
 588 |         $new-nodes,
 589 |         (),
 590 |         $all-nodes-to-modify,
 591 |         $operation,
 592 |         fn:false()
 593 |       )
 594 |     )
 595 |   else
 596 |     mem-op:place-trees(
 597 |       (: Reduce iterations by using outermost nodes :)
 598 |       $outermost-nodes-to-modify,
 599 |       (: Pass attributes and child nodes excluding ancestors of nodes to modify. :)
 600 |       let $copy-node as node()? :=
 601 |           if (fn:exists($transaction-map))
 602 |           then map:get($transaction-map,'copy')
 603 |           else ()
 604 |       let $reference-node as node()? := $nodes-to-modify[1]/..
 605 |       return
 606 |         (if (fn:empty($transaction-map) or ($copy-node << $reference-node or $reference-node is $copy-node))
 607 |         then($reference-node/(@node()|node()))
 608 |         else ())
 609 |         except
 610 |       $nodes-to-modify/ancestor-or-self::node(),
 611 |       (: New sub trees to put in place. :)
 612 |       $trees)
 613 | };
 614 | 
 615 | declare %private
 616 | function mem-op:build-subtree(
 617 |   $transaction-map as map:map?,
 618 |   $mod-node as node(),
 619 |   $nodes-to-modify as node()*,
 620 |   $new-nodes as node()*,
 621 |   $operations,
 622 |   $all-ancestors as node()*)
 623 | as node()*
 624 | {
 625 |   mem-op:subtree(
 626 |     $transaction-map,
 627 |     $mod-node,
 628 |     $nodes-to-modify intersect
 629 |     ($mod-node/descendant-or-self::node(),
 630 |      $mod-node/descendant-or-self::node()/@node()),
 631 |     $new-nodes,
 632 |     $operations,
 633 |     $all-ancestors)
 634 | };
 635 | 
 636 | declare %private
 637 | function mem-op:subtree(
 638 |   $transaction-map as map:map?,
 639 |   $mod-node as node(),
 640 |   $nodes-to-modify as node()*,
 641 |   $new-nodes as node()*,
 642 |   $operations,
 643 |   $all-ancestors as node()*)
 644 | as node()*
 645 | {
 646 |   let $mod-node-id-qn := mem-op:generate-id-qn($nodes-to-modify[1])
 647 |   let $descendant-nodes-to-mod := $nodes-to-modify except $mod-node
 648 |   return
 649 |     mem-op:wrap-subtree(
 650 |       $mod-node-id-qn,
 651 |       if (empty($descendant-nodes-to-mod))
 652 |       then
 653 |         mem-op:process-subtree(
 654 |           $transaction-map,
 655 |           $mod-node/ancestor::node() except $all-ancestors,
 656 |           $mod-node,
 657 |           $mod-node-id-qn,
 658 |           $new-nodes,
 659 |           $operations,
 660 |           ())
 661 |       else
 662 |         let $outermost-nodes-to-mod as node()+ := node-op:outermost($descendant-nodes-to-mod)
 663 |         return
 664 |           mem-op:process(
 665 |             $transaction-map,
 666 |             $descendant-nodes-to-mod,
 667 |             $outermost-nodes-to-mod,
 668 |             $nodes-to-modify,
 669 |             $new-nodes,
 670 |             $operations,
 671 |             (: find the ancestors that all nodes to modify have in common :)
 672 |             mem-op:find-ancestor-intersect(
 673 |               $outermost-nodes-to-mod,
 674 |               1,
 675 |               ()
 676 |             )
 677 |               except
 678 |             $all-ancestors)
 679 |     )
 680 | };
 681 | 
 682 | declare %private
 683 | function mem-op:wrap-subtree(
 684 |   $mod-node-id-qn as xs:QName,
 685 |   $results as node()*
 686 | )as node()*
 687 | {
 688 |   if ($results)
 689 |   then
 690 |     element { $mod-node-id-qn } {
 691 |       $results
 692 |     }
 693 |   else ()
 694 | };
 695 | (: Creates a new subtree with the changes made based off of the operation.  :)
 696 | declare %private
 697 | function mem-op:process-subtree(
 698 |   $transaction-map as map:map?,
 699 |   $ancestors as node()*,
 700 |   $node-to-modify as node(),
 701 |   $node-to-modify-id-qn as xs:QName,
 702 |   $new-node as node()*,
 703 |   $operations,
 704 |   $ancestor-nodes-to-modify as node()*)
 705 | as node()*
 706 | {
 707 |   mem-op:process-ancestors(
 708 |     $transaction-map,
 709 |     reverse($ancestors),
 710 |     (),
 711 |     $operations,
 712 |     $node-to-modify,
 713 |     $ancestor-nodes-to-modify,
 714 |     $new-node,
 715 |     mem-op:build-new-xml(
 716 |       $transaction-map,
 717 |       $node-to-modify,
 718 |       typeswitch ($operations)
 719 |        case xs:string return $operations
 720 |        default return
 721 |          $operations[*[node-name(.) eq $node-to-modify-id-qn]]/
 722 |          @operation,
 723 |       typeswitch ($new-node)
 724 |        case element(mem-op:modifier-nodes)* return $new-node[*[node-name(.) eq $node-to-modify-id-qn]]
 725 |        default return
 726 |          <mem-op:modifier-nodes>{
 727 |              attribute mem-op:operation { $operations },
 728 |              $new-node
 729 |            }</mem-op:modifier-nodes>))
 730 | };
 731 | 
 732 | (: Find all of the common ancestors of a given set of nodes  :)
 733 | declare %private
 734 | function mem-op:find-ancestor-intersect(
 735 |   $items as node()*,
 736 |   $current-position as xs:integer,
 737 |   $ancestor-intersect as node()*)
 738 | as node()*
 739 | {
 740 |   if (empty($items))
 741 |   then $ancestor-intersect
 742 |   else if ($current-position gt 1)
 743 |   (: if ancestor-intersect already exists intersect with the current item's ancestors :)
 744 |   then
 745 |     if (empty($ancestor-intersect))
 746 |     (: short circuit if intersect is empty :)
 747 |     then ()
 748 |     else
 749 |       $ancestor-intersect intersect head($items)/ancestor::node() intersect $items[fn:last()]/ancestor::node()
 750 |   (: otherwise just use the current item's ancestors :)
 751 |   else
 752 |     mem-op:find-ancestor-intersect(
 753 |       tail($items),
 754 |       $current-position + 1,
 755 |       head($items)/ancestor::node())
 756 | };
 757 | 
 758 | (: Place newly created trees in proper order :)
 759 | declare %private
 760 | function mem-op:place-trees(
 761 |   $nodes-to-modify as node()*,
 762 |   $merging-nodes as node()*,
 763 |   $trees as element(mem-op:trees)?)
 764 | as node()*
 765 | {
 766 |   if (empty($nodes-to-modify) or empty($trees[*]))
 767 |   then $merging-nodes
 768 |   else (
 769 |     let $tree-ids := $trees/* ! substring-after(local-name(.),'_')
 770 |     let $count-of-trees := count($tree-ids)
 771 |     for $tree at $pos in $trees/*
 772 |     let $previous-tree-pos := $pos - 1
 773 |     let $previous-tree-id := $tree-ids[position() eq $previous-tree-pos]
 774 |     let $current-tree-id := $tree-ids[position() eq $pos]
 775 |     let $previous-node-to-modify :=
 776 |                            if (exists($previous-tree-id))
 777 |                            then $nodes-to-modify[generate-id() eq $previous-tree-id][1]
 778 |                            else ()
 779 |     let $node-to-modify := $nodes-to-modify[generate-id() eq $current-tree-id][1]
 780 |     return
 781 |       (
 782 |         node-op:inbetween($merging-nodes, $previous-node-to-modify, $node-to-modify),
 783 |         $tree/(attribute::node()|child::node()),
 784 |         if ($pos eq $count-of-trees)
 785 |         then
 786 |           node-op:inbetween($merging-nodes, $node-to-modify, ())
 787 |         else ()
 788 |       )
 789 |   )
 790 | };
 791 | 
 792 | (: Go up the tree to build new XML using tail recursion. This is used when there are no side
 793 |   steps to merge in, only a direct path up the tree. $ancestors is expected to be passed in
 794 |   REVERSE document order. :)
 795 | declare %private
 796 | function mem-op:process-ancestors(
 797 |   $transaction-map as map:map?,
 798 |   $ancestors as node()*,
 799 |   $last-ancestor as node()?,
 800 |   $operations,
 801 |   $nodes-to-modify as node()*,
 802 |   $ancestor-nodes-to-modify as node()*,
 803 |   $new-node as node()*,
 804 |   $base as node()*)
 805 | as node()*
 806 | {
 807 |   if (exists($ancestors))
 808 |   then
 809 |     mem-op:process-ancestors(
 810 |       $transaction-map,
 811 |       tail($ancestors),
 812 |       head($ancestors),
 813 |       $operations,
 814 |       $nodes-to-modify,
 815 |       $ancestor-nodes-to-modify,
 816 |       $new-node,
 817 |       mem-op:reconstruct-node-with-additional-modifications(
 818 |         $transaction-map,
 819 |         head($ancestors),
 820 |         ($last-ancestor/preceding-sibling::node(),$base,$last-ancestor/following-sibling::node()),
 821 |         $new-node,
 822 |         $nodes-to-modify,
 823 |         $ancestor-nodes-to-modify,
 824 |         $operations,
 825 |         fn:true()
 826 |       )
 827 |     )
 828 |   else
 829 |     $base
 830 | };
 831 | 
 832 | (: Generic logic for rebuilding document/element nodes and passing in for  :)
 833 | declare %private
 834 | function mem-op:reconstruct-node-with-additional-modifications(
 835 |   $transaction-map as map:map?,
 836 |   $node as node(),
 837 |   $ordered-content as node()*,
 838 |   $new-node as node()*,
 839 |   $nodes-to-modify as node()*,
 840 |   $ancestor-nodes-to-modify as node()*,
 841 |   $operations,
 842 |   $carry-over-attributes as xs:boolean)
 843 | {
 844 |   if (some $n in $ancestor-nodes-to-modify
 845 |       satisfies $n is $node)
 846 |   then
 847 |     mem-op:process-subtree(
 848 |       $transaction-map,
 849 |       (),
 850 |       mem-op:reconstruct-node($node,$ordered-content,$nodes-to-modify,$carry-over-attributes),
 851 |       mem-op:generate-id-qn($node),
 852 |       $new-node,
 853 |       $operations,
 854 |       ()
 855 |     )
 856 |   else
 857 |     mem-op:reconstruct-node($node,$ordered-content,$nodes-to-modify,$carry-over-attributes)
 858 | };
 859 | 
 860 | (: Generic logic for rebuilding document/element nodes :)
 861 | declare %private
 862 | function mem-op:reconstruct-node(
 863 |   $node as node(),
 864 |   $ordered-content as node()*,
 865 |   $nodes-to-modify as node()*,
 866 |   $carry-over-attributes as xs:boolean)
 867 | {
 868 |   typeswitch ($node)
 869 |   case element() return
 870 |        element { node-name($node) } {
 871 |          if ($carry-over-attributes)
 872 |          then $node/@attribute() except $nodes-to-modify
 873 |          else (),
 874 |          $node/namespace::*,
 875 |          $ordered-content
 876 |        }
 877 |   case document-node() return
 878 |        document {
 879 |          $ordered-content
 880 |        }
 881 |   default return ()
 882 | };
 883 | 
 884 | (: Generate an id unique to a node in memory. Right now using fn:generate-id. :)
 885 | declare
 886 | function mem-op:id-wrapper($node as node())
 887 | {
 888 |   element {mem-op:generate-id-qn($node)} {()}
 889 | };
 890 | 
 891 | (: Generate QName from node :)
 892 | declare %private
 893 | function mem-op:generate-id-qn($node as node())
 894 | {
 895 |   QName(
 896 |       "http://maxdewpoint.blogspot.com/memory-operations",
 897 |       concat("_", mem-op:generate-id($node)))
 898 | };
 899 | 
 900 | (: Generate an id unique to a node in memory. Right now using fn:generate-id. :)
 901 | declare %private
 902 | function mem-op:generate-id($node as node())
 903 | {
 904 |   generate-id($node)
 905 | };
 906 | 
 907 | (: Create a key to uniquely identify a function :)
 908 | declare
 909 | function mem-op:function-key($function as function(*))
 910 | {
 911 |     xdmp:key-from-QName(
 912 |       (function-name($function),
 913 |        xs:QName("_" || string(xdmp:random())))[1]) ||
 914 |     "#" ||
 915 |     string(function-arity($function))
 916 | };
 917 | 
 918 | (: This is where the transformations to the XML take place and this module can be extended. :)
 919 | declare %private
 920 | function mem-op:build-new-xml(
 921 |   $transaction-map as map:map?,
 922 |   $node as node(),
 923 |   $operations as xs:string*,
 924 |   $modifier-nodes as element(mem-op:modifier-nodes)*)
 925 | {
 926 |   mem-op:build-new-xml(
 927 |     $transaction-map,
 928 |     $node,
 929 |     mem-op:weighed-operations(distinct-values($operations)),
 930 |     $modifier-nodes,
 931 |     ()
 932 |   )
 933 | };
 934 | 
 935 | (: This function contains the logic for each of the operations is is going to be the most
 936 |   likely place extensions will be made. :)
 937 | declare %private
 938 | function mem-op:build-new-xml(
 939 |   $transaction-map as map:map?,
 940 |   $nodes as node()*,
 941 |   $operations as xs:string*,
 942 |   $modifier-nodes as element(mem-op:modifier-nodes)*,
 943 |   $modifying-node as node()?)
 944 | {
 945 |   if (empty($operations) or empty($nodes))
 946 |   then $nodes
 947 |   else
 948 |     let $node as node()? := if (count($nodes) eq 1) then $nodes else $modifying-node
 949 |     let $pivot-pos as xs:integer? := $nodes ! (if (. is $node) then position() else ())
 950 |     let $operation as xs:string := head($operations)
 951 |     let $last-in-wins as xs:boolean := $operation = ('replace-value')
 952 |     let $reverse-mod-nodes as xs:boolean := $operation = ('insert-child')
 953 |     let $mod-nodes as node()* :=
 954 |       let $modifier-nodes :=
 955 |             if ($last-in-wins)
 956 |             then ($modifier-nodes[@mem-op:operation eq $operation])[1]
 957 |             else if ($reverse-mod-nodes) 
 958 |             then reverse($modifier-nodes[@mem-op:operation eq $operation])
 959 |             else $modifier-nodes[@mem-op:operation eq $operation]      
 960 |       return
 961 |         ($modifier-nodes ! @node()[empty(self::attribute(mem-op:operation))],
 962 |          $modifier-nodes ! node()[empty(self::mem-op:*)])
 963 | 
 964 |     let $new-nodes :=
 965 |       switch ($operation)
 966 |       case "replace" return $mod-nodes
 967 |       case "insert-child" return
 968 |           element { node-name($node) } {
 969 |             let $attributes-to-insert := $mod-nodes[self::attribute()],
 970 |                 $attributes-to-insert-qns := $attributes-to-insert/node-name(.)
 971 |             return
 972 |               ($node/@*[not(node-name(.) = $attributes-to-insert-qns)],
 973 |                $attributes-to-insert,
 974 |                $node/namespace::*,
 975 |                $node/node(),
 976 |                $mod-nodes[exists(. except $attributes-to-insert)])
 977 |           }
 978 |         case "insert-child-first" return
 979 |           element { node-name($node) } {
 980 |             let $attributes-to-insert := $mod-nodes[self::attribute()],
 981 |                 $attributes-to-insert-qns := $attributes-to-insert/node-name(.)
 982 |             return
 983 |               ($attributes-to-insert,
 984 |                $node/@*[not(node-name(.) = $attributes-to-insert-qns)],
 985 |                $node/namespace::*,
 986 |                $mod-nodes[exists(. except $attributes-to-insert)],
 987 |                $node/node())
 988 |           }
 989 |         case "insert-after" return ($node, $mod-nodes)
 990 |         case "insert-before" return ($mod-nodes, $node)
 991 |         case "rename" return
 992 |           element { node-name(($mod-nodes[self::element()])[1]) } { $node/@*, $node/namespace::*, $node/node() }
 993 |         case "replace-value" return
 994 |           typeswitch ($node)
 995 |            case attribute() return attribute { node-name($node) } { $mod-nodes }
 996 |            case element() return
 997 |              element { node-name($node) } { $node/@*, $node/namespace::*, $mod-nodes }
 998 |            case processing-instruction() return
 999 |              processing-instruction {
1000 |                node-name($node)
1001 |              } {
1002 |                $mod-nodes
1003 |              }
1004 |            case comment() return
1005 |              comment {
1006 |                $mod-nodes
1007 |              }
1008 |            case text() return $mod-nodes
1009 |            default return ()
1010 |         case "transform" return
1011 |           if (exists($transaction-map))
1012 |           then
1013 |             map:get(
1014 |               $transaction-map,
1015 |               string($mod-nodes))(
1016 |               $node)
1017 |           else
1018 |             map:get($transform-functions, string($mod-nodes))(
1019 |               $node)
1020 |         default return ()
1021 |     return
1022 |       mem-op:build-new-xml(
1023 |         $transaction-map,
1024 |         unordered {
1025 |             $nodes[position() lt $pivot-pos],
1026 |             $new-nodes,
1027 |             $nodes[position() gt $pivot-pos]
1028 |         },
1029 |         tail($operations),
1030 |         $modifier-nodes,
1031 |         if ($operation = ('insert-after','insert-before'))
1032 |         then $node
1033 |         else $new-nodes[1]
1034 |       )
1035 | };
1036 | 
1037 | (: Order the operations in such a way that the least amount of stomping on eachother occurs :)
1038 | declare %private
1039 | function mem-op:weighed-operations(
1040 |   $operations as xs:string*) as xs:string*
1041 | {
1042 |   $operations[. eq "replace"],
1043 |   $operations[. eq "replace-value"],
1044 |   $operations[not(. = ("replace","replace-value","transform"))],
1045 |   $operations[. eq "transform"]
1046 | };
1047 | 
1048 | declare %private
1049 | function mem-op:safe-copy(
1050 |   $node as node())
1051 | as node()? {
1052 |   try {
1053 |     validate lax {
1054 |       $node
1055 |     }
1056 |   } catch * {
1057 |     mem-op:reconstruct-node($node,$node/*,(),fn:true())
1058 |   }
1059 | };
1060 | 


--------------------------------------------------------------------------------
/mlpm.json:
--------------------------------------------------------------------------------
1 | {
2 |   "name": "XQuery-XML-Memory-Operations",
3 |   "version": "1.0.7",
4 |   "description": "XQuery library module for updating XML in memory",
5 |   "repository": "https://github.com/ryanjdew/XQuery-XML-Memory-Operations.git"
6 | }
7 | 


--------------------------------------------------------------------------------
/node-operations.xqy:
--------------------------------------------------------------------------------
 1 | xquery version "3.0";
 2 | (:~
 3 | Copyright (c) 2013 Ryan Dew
 4 | 
 5 | Licensed under the Apache License, Version 2.0 (the "License");
 6 | you may not use this file except in compliance with the License.
 7 | You may obtain a copy of the License at
 8 | 
 9 |        http://www.apache.org/licenses/LICENSE-2.0
10 | 
11 | Unless required by applicable law or agreed to in writing, software
12 | distributed under the License is distributed on an "AS IS" BASIS,
13 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14 | See the License for the specific language governing permissions and
15 | limitations under the License.
16 | 
17 | @author Ryan Dew (ryan.j.dew@gmail.com)
18 | @version 0.7
19 | @description This is a module with function changing XML in memory by creating subtrees using the ancestor, preceding-sibling, and following-sibling axes
20 | 				and intersect/except expressions. Requires MarkLogic 6+.
21 | :)
22 | 
23 | module namespace node-op = "http://maxdewpoint.blogspot.com/node-operations";
24 | declare default function namespace "http://www.w3.org/2005/xpath-functions";
25 | 
26 | 
27 | declare function node-op:innermost($nodes as node()*) {
28 | 	(: node-op:function-select((
29 | 		function-lookup(QName('http://www.w3.org/2005/xpath-functions','innermost'), 1),
30 | 		function ($nodes as node()*) { :)
31 | 			$nodes except $nodes/ancestor::node()
32 | 	(:	}
33 | 	))($nodes) :)
34 | };
35 | 
36 | declare function node-op:outermost($nodes as node()*) {
37 | 	(:node-op:function-select((
38 | 		function-lookup(QName('http://www.w3.org/2005/xpath-functions','outermost'), 1),
39 | 		function ($nodes as node()*) { :)
40 | 			$nodes except $nodes[ancestor::node() intersect $nodes]
41 | 	(:	}
42 | 	))($nodes) :)
43 | };
44 | 
45 | declare function node-op:inbetween($nodes as node()*, $start as node()?, $end as node()?) {
46 | 	node-op:inbetween($nodes, $start, $end, ())
47 | };
48 | 
49 | declare function node-op:inbetween-inclusive($nodes as node()*, $start as node()?, $end as node()?) {
50 | 	node-op:inbetween($nodes, $start, $end, ('start','end'))
51 | };
52 | 
53 | declare function node-op:inbetween-inclusive-start($nodes as node()*, $start as node()?, $end as node()?) {
54 | 	node-op:inbetween($nodes, $start, $end, ('start'))
55 | };
56 | 
57 | declare function node-op:inbetween-inclusive-end($nodes as node()*, $start as node()?, $end as node()?) {
58 | 	node-op:inbetween($nodes, $start, $end, ('end'))
59 | };
60 | 
61 | declare %private function node-op:inbetween($nodes as node()*, $start as node()?, $end as node()?, $inclusion as xs:string*) {
62 |   if (fn:exists($nodes))
63 |   then
64 |     (
65 |       if ($inclusion = 'start')
66 |       then $nodes intersect $start
67 |       else ()
68 |     ) union (
69 |       if (exists($start) and exists($end))
70 |       then $nodes[. >> $start][. << $end]
71 |       else if (exists($start))
72 |       then $nodes[. >> $start]
73 |       else if (exists($end))
74 |       then $nodes[. << $end]
75 |       else ()
76 |     ) union (
77 |       if ($inclusion = 'end')
78 |       then $nodes intersect $end
79 |       else ()
80 |     )
81 |   else ()
82 | };
83 | 
84 | 
85 | 
86 | declare %private function node-op:function-select($functions as function(*)+) as function(*) {
87 | 	$functions[1]
88 | };
89 | 


--------------------------------------------------------------------------------
/test/memory-operations-functional-test.xqy:
--------------------------------------------------------------------------------
  1 | xquery version "1.0-ml";
  2 | module namespace test = "http://github.com/robwhitby/xray/test";
  3 | import module namespace assert = "http://github.com/robwhitby/xray/assertions" at "/xray/src/assertions.xqy";
  4 | 
  5 | import module namespace mem = "http://maxdewpoint.blogspot.com/memory-operations/functional" at "/memory-operations-functional.xqy";
  6 | 
  7 | declare variable $test-xml := <html>
  8 | 								<head>
  9 | 									<title>This is a title</title>
 10 | 								</head>
 11 | 								<!-- old comment -->
 12 | 								<body>
 13 | 									<div id="div1">
 14 | 										<p class="p1"><!-- old comment -->This is a paragraph.</p>
 15 | 										<p class="p2">This is a paragraph.</p>
 16 | 										<p class="p3">This is a paragraph.</p>
 17 | 										<p class="p4">This is a paragraph.</p>
 18 | 										<p class="p5">This is a paragraph.</p>
 19 | 									</div>
 20 | 									<div id="div2">
 21 | 										<p class="p1">This is a paragraph.</p>
 22 | 										<p class="p2">This is a paragraph.</p>
 23 | 										<p class="p3">This is a paragraph.<!-- old comment --></p>
 24 | 										<p class="p4">This is a paragraph.</p>
 25 | 										<p class="p5">This is a paragraph.</p>
 26 | 									</div>
 27 | 								</body>
 28 | 							</html>;
 29 | 
 30 | declare %test:case function insert-before-and-insert-attribute()
 31 | as item()*
 32 | {
 33 | 	let $new-xml := 
 34 | 	        mem:execute(mem:insert-child(mem:insert-before(mem:copy($test-xml),
 35 | 						$test-xml/body/div/p[@class eq "p3"],
 36 | 						element p { attribute class {"testing"}}
 37 | 					),
 38 | 					$test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"})
 39 | 				)
 40 | 	return (
 41 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
 42 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
 43 | 	   return (
 44 | 		  assert:equal(fn:string(($p/preceding-sibling::node())[fn:last()]/@class), 'testing'),
 45 | 		  assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
 46 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
 47 | 	   )
 48 | 	)
 49 | };
 50 | 
 51 | declare %test:case function insert-after-and-insert-attribute()
 52 | as item()*
 53 | {
 54 | 	let $new-xml := 
 55 | 	        mem:execute(mem:insert-child(mem:insert-after(mem:copy($test-xml),
 56 | 						$test-xml/body/div/p[@class eq "p3"],
 57 | 						element p { attribute class {"testing"}}
 58 | 					),
 59 | 					$test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"})
 60 | 				)
 61 | 	return (
 62 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
 63 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
 64 | 	   return (
 65 | 		  assert:equal(fn:string($p/following-sibling::node()[1]/@class), 'testing'),
 66 | 		  assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
 67 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
 68 | 	   )
 69 | 	)
 70 | };
 71 | 
 72 | declare %test:case function advanced-operation()
 73 | as item()*
 74 | {
 75 | 	let $new-xml := 
 76 | 	        mem:execute(mem:insert-child(mem:replace(mem:copy($test-xml),
 77 | 						$test-xml/head/title,element title {"This is so awesome!"}
 78 | 					),
 79 | 					$test-xml/body/div/p, attribute data-info {"This is also awesome!"})
 80 | 				)
 81 | 				
 82 |   return (assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
 83 | 			for $p in $new-xml/body/div/p
 84 | 			return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
 85 | };
 86 | 
 87 | declare %test:case function copy()
 88 | as item()*
 89 | {
 90 |   let $test-xml := document { $test-xml }/html
 91 | 	let $new-xml := 
 92 | 	        mem:execute(mem:insert-child(mem:replace(mem:copy($test-xml),
 93 | 						$test-xml/head/title,element title {"This is so awesome!"}
 94 | 					),
 95 | 					$test-xml/body/div/p, attribute data-info {"This is also awesome!"})
 96 | 				)
 97 |   return (assert:equal($new-xml instance of element(html), fn:true()),
 98 | 			assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
 99 | 			for $p in $new-xml/body/div/p
100 | 			return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
101 | };
102 | 
103 | declare %test:case function multiple-operations-on-one-node()
104 | as item()*
105 | {
106 |   let $title := $test-xml/head/title
107 | 	let $new-xml := 
108 | 	        mem:execute(mem:replace-value(mem:rename(mem:copy($title),
109 | 						$title,fn:QName("","new-title")
110 | 					),
111 | 					$title,"This is so awesome!")
112 | 				)
113 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
114 | 			assert:equal(fn:string($new-xml), "This is so awesome!"))
115 | };
116 | 
117 | declare %test:case function transform-function-transaction()
118 | as item()*
119 | {
120 |   let $title := $test-xml/head/title
121 | 	let $new-xml := 
122 | 	        mem:execute(mem:transform(mem:copy($title),
123 | 						$title,function($node as node()) as node()* {element new-title {"This is so awesome!"}}
124 | 					))
125 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
126 | 			assert:equal(fn:string($new-xml), "This is so awesome!"))
127 | };
128 | 


--------------------------------------------------------------------------------
/test/memory-operations-pure-xquery-test.xqy:
--------------------------------------------------------------------------------
  1 | xquery version "1.0-ml";
  2 | module namespace test = "http://github.com/robwhitby/xray/test";
  3 | import module namespace assert = "http://github.com/robwhitby/xray/assertions" at "/xray/src/assertions.xqy";
  4 | 
  5 | import module namespace mem = "http://maxdewpoint.blogspot.com/memory-operations" at "/memory-operations-pure-xquery.xqy";
  6 | 
  7 | declare variable $test-xml := <html>
  8 |                 <head>
  9 |                   <title>This is a title</title>
 10 |                 </head>
 11 |                 <!-- old comment -->
 12 |                 <body>
 13 |                   <div id="div1">
 14 |                     <p class="p1"><!-- old comment -->This is a paragraph.</p>
 15 |                     <p class="p2">This is a paragraph.</p>
 16 |                     <p class="p3">This is a paragraph.</p>
 17 |                     <p class="p4">This is a paragraph.</p>
 18 |                     <p class="p5">This is a paragraph.</p>
 19 |                   </div>
 20 |                   <div id="div2">
 21 |                     <p class="p1">This is a paragraph.</p>
 22 |                     <p class="p2">This is a paragraph.</p>
 23 |                     <p class="p3">This is a paragraph.<!-- old comment --></p>
 24 |                     <p class="p4">This is a paragraph.</p>
 25 |                     <p class="p5">This is a paragraph.</p>
 26 |                   </div>
 27 |                 </body>
 28 |               </html>;
 29 | 
 30 | declare %test:case function insert-before-and-insert-attribute()
 31 | as item()*
 32 | {
 33 |   let $new-xml := 
 34 |           mem:execute(mem:insert-child(mem:insert-before(mem:copy($test-xml),
 35 |             $test-xml/body/div/p[@class eq "p3"],
 36 |             element p { attribute class {"testing"}}
 37 |           ),
 38 |           $test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"})
 39 |         )
 40 |   return (
 41 |      assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
 42 |      for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
 43 |      return (
 44 |       assert:equal(fn:string(($p/preceding-sibling::node())[fn:last()]/@class), 'testing'),
 45 |       assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
 46 |       assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
 47 |      )
 48 |   )
 49 | };
 50 | 
 51 | declare %test:case function insert-after-and-insert-attribute()
 52 | as item()*
 53 | {
 54 |   let $new-xml := 
 55 |           mem:execute(mem:insert-child(mem:insert-after(mem:copy($test-xml),
 56 |             $test-xml/body/div/p[@class eq "p3"],
 57 |             element p { attribute class {"testing"}}
 58 |           ),
 59 |           $test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"})
 60 |         )
 61 |   return (
 62 |      assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
 63 |      for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
 64 |      return (
 65 |       assert:equal(fn:string($p/following-sibling::node()[1]/@class), 'testing'),
 66 |       assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
 67 |       assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
 68 |      )
 69 |   )
 70 | };
 71 | 
 72 | declare %test:case function advanced-operation()
 73 | as item()*
 74 | {
 75 |   let $new-xml := 
 76 |           mem:execute(mem:insert-child(mem:replace(mem:copy($test-xml),
 77 |             $test-xml/head/title,element title {"This is so awesome!"}
 78 |           ),
 79 |           $test-xml/body/div/p, attribute data-info {"This is also awesome!"})
 80 |         )
 81 |         
 82 |   return (assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
 83 |       for $p in $new-xml/body/div/p
 84 |       return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
 85 | };
 86 | 
 87 | declare %test:case function copy()
 88 | as item()*
 89 | {
 90 |   let $test-xml := document { $test-xml }/html
 91 |   let $new-xml := 
 92 |           mem:execute(mem:insert-child(mem:replace(mem:copy($test-xml),
 93 |             $test-xml/head/title,element title {"This is so awesome!"}
 94 |           ),
 95 |           $test-xml/body/div/p, attribute data-info {"This is also awesome!"})
 96 |         )
 97 |   return (assert:equal($new-xml instance of element(html), fn:true()),
 98 |       assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
 99 |       for $p in $new-xml/body/div/p
100 |       return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
101 | };
102 | 
103 | declare %test:case function multiple-operations-on-one-node()
104 | as item()*
105 | {
106 |   let $title := $test-xml/head/title
107 |   let $new-xml := 
108 |           mem:execute(mem:replace-value(mem:rename(mem:copy($title),
109 |             $title,fn:QName("","new-title")
110 |           ),
111 |           $title,"This is so awesome!")
112 |         )
113 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
114 |       assert:equal(fn:string($new-xml), "This is so awesome!"))
115 | };
116 | 
117 | declare %test:case function transform-function-transaction()
118 | as item()*
119 | {
120 |   let $title := $test-xml/head/title
121 |   let $new-xml := 
122 |           mem:execute(mem:transform(mem:copy($title),
123 |             $title,function($node as node()) as node()* {element new-title {"This is so awesome!"}}
124 |           ))
125 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
126 |       assert:equal(fn:string($new-xml), "This is so awesome!"))
127 | };
128 | 


--------------------------------------------------------------------------------
/test/memory-operations-test.xqy:
--------------------------------------------------------------------------------
  1 | xquery version "1.0-ml";
  2 | module namespace test = "http://github.com/robwhitby/xray/test";
  3 | import module namespace assert = "http://github.com/robwhitby/xray/assertions" at "/xray/src/assertions.xqy";
  4 | 
  5 | import module namespace mem = "http://maxdewpoint.blogspot.com/memory-operations" at "/memory-operations.xqy";
  6 | 
  7 | declare variable $test-xml := <html>
  8 | 								<head>
  9 | 									<title>This is a title</title>
 10 | 								</head>
 11 | 								<!-- old comment -->
 12 | 								<body>
 13 | 									<div id="div1">
 14 | 										<p class="p1"><!-- old comment -->This is a paragraph.</p>
 15 | 										<p class="p2">This is a paragraph.</p>
 16 | 										<p class="p3">This is a paragraph.</p>
 17 | 										<p class="p4">This is a paragraph.</p>
 18 | 										<p class="p5">This is a paragraph.</p>
 19 | 									</div>
 20 | 									<div id="div2">
 21 | 										<p class="p1">This is a paragraph.</p>
 22 | 										<p class="p2">This is a paragraph.</p>
 23 | 										<p class="p3">This is a paragraph.<!-- old comment --></p>
 24 | 										<p class="p4">This is a paragraph.</p>
 25 | 										<p class="p5">This is a paragraph.</p>
 26 | 									</div>
 27 | 								</body>
 28 | 							</html>;
 29 | 
 30 | 
 31 | 
 32 | declare %test:case function insert-child-into-root-attribute()
 33 | as item()*
 34 | {
 35 | 	let $new-xml := mem:insert-child(
 36 | 						$test-xml,
 37 | 						attribute test {"testing"}
 38 | 					)
 39 | 	return assert:equal(fn:string($new-xml/@test), 'testing')	
 40 | };
 41 | 
 42 | declare %test:case function insert-child-into-many-items-attribute()
 43 | as item()*
 44 | {
 45 | 	let $new-xml := mem:insert-child(
 46 | 						($test-xml,$test-xml/body/div[@id eq "div1"],
 47 | 						$test-xml/body/div/p),
 48 | 						attribute test {"testing"}
 49 | 					)
 50 | 	for $i in ($new-xml,$new-xml/body/div[@id eq "div1"],
 51 | 						$new-xml/body/div/p)
 52 | 	return assert:equal(fn:string($i/@test), 'testing')	
 53 | };
 54 | 
 55 | declare %test:case function insert-child-into-root-element()
 56 | as item()*
 57 | {
 58 | 	let $new-xml := mem:insert-child(
 59 | 						$test-xml,
 60 | 						element test {"testing"}
 61 | 					)
 62 | 	return assert:equal(fn:string($new-xml/test), 'testing')	
 63 | };
 64 | 
 65 | declare  %test:case function insert-child-into-many-items-element()
 66 | as item()*
 67 | {
 68 | 	let $new-xml := mem:insert-child(
 69 | 						($test-xml,$test-xml/body/div[@id eq "div1"],
 70 | 						$test-xml/body/div/p),
 71 | 						element test {"testing"}
 72 | 					)
 73 | 	for $i in ($new-xml,$new-xml/body/div[@id eq "div1"],
 74 | 						$new-xml/body/div/p)
 75 | 	return assert:equal(fn:string($i/test), 'testing')	
 76 | };
 77 | 
 78 | declare %test:case function insert-before()
 79 | as item()*
 80 | {
 81 | 	let $new-xml := mem:insert-before(
 82 | 						$test-xml/body/div/p[@class eq "p3"],
 83 | 						element p { attribute class {"testing"}}
 84 | 					)
 85 | 	return (
 86 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
 87 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
 88 | 	   return (
 89 | 		  assert:equal(fn:string(($p/preceding-sibling::node())[fn:last()]/@class), 'testing'),
 90 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
 91 | 	   )
 92 | 	)
 93 | };
 94 | 
 95 | declare %test:case function insert-before-and-insert-attribute()
 96 | as item()*
 97 | {
 98 | 	let $new-xml := 
 99 | 	           let $id := mem:copy($test-xml) 
100 | 			   return (
101 | 	               mem:insert-before($id,
102 | 						$test-xml/body/div/p[@class eq "p3"],
103 | 						element p { attribute class {"testing"}}
104 | 					),
105 | 					mem:insert-child($id, $test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"}),
106 | 					mem:execute($id)
107 | 				)
108 | 	return (
109 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
110 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
111 | 	   return (
112 | 		  assert:equal(fn:string(($p/preceding-sibling::node())[fn:last()]/@class), 'testing'),
113 | 		  assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
114 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
115 | 	   )
116 | 	)
117 | };
118 | 
119 | declare %test:case function insert-after()
120 | as item()*
121 | {
122 | 	let $new-xml := mem:insert-after(
123 | 						$test-xml/body/div/p[@class eq "p3"],
124 | 						element p { attribute class {"testing"}}
125 | 					)
126 | 	return (
127 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
128 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
129 | 	   return (
130 | 		  assert:equal(fn:string($p/following-sibling::node()[1]/@class), 'testing'),
131 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
132 | 	   )
133 | 	)
134 | };
135 | 
136 | declare %test:case function insert-after-and-insert-attribute()
137 | as item()*
138 | {
139 | 	let $new-xml := 
140 | 	           let $id := mem:copy($test-xml) 
141 | 			   return (
142 | 				    mem:insert-after($id,
143 | 						$test-xml/body/div/p[@class eq "p3"],
144 | 						element p { attribute class {"testing"}}
145 | 					),
146 | 					mem:insert-child($id, $test-xml/body/div/p[@class eq "p3"], attribute data-testing {"this-is-a-test"}),
147 | 					mem:execute($id)
148 | 				)
149 | 	return (
150 | 	   assert:equal(fn:count($new-xml/body/div/p[@class eq "p3"]), 2),
151 | 	   for $p at $pos in $new-xml/body/div/p[@class eq "p3"]
152 | 	   return (
153 | 		  assert:equal(fn:string($p/following-sibling::node()[1]/@class), 'testing'),
154 | 		  assert:equal(fn:string($p/@data-testing), 'this-is-a-test'),
155 | 		  assert:equal(fn:string($p/parent::node()/@id), fn:concat('div',$pos))
156 | 	   )
157 | 	)
158 | };
159 | declare %test:case function remove-items()
160 | as item()*
161 | {
162 |    let $new-xml := mem:delete(
163 | 						$test-xml//comment()
164 | 					)
165 | 	return (assert:equal(fn:count($test-xml//comment()) gt 0, fn:true()),
166 | 			assert:equal(fn:count($new-xml//comment()), 0))
167 | };
168 | 
169 | declare %test:case function replace-items()
170 | as item()*
171 | {
172 |    let $new-xml := mem:replace(
173 | 						$test-xml//comment(),
174 | 						<!--this new comment-->
175 | 					)
176 | 	return (assert:equal(fn:count($new-xml//comment()), fn:count($test-xml//comment())),
177 | 			for $c in $new-xml//comment()
178 | 			return assert:equal(fn:string($c), 'this new comment'))
179 | };
180 | 
181 | declare %test:case function replace-item-values()
182 | as item()*
183 | {
184 |    let $new-xml := mem:replace-value(
185 | 						$test-xml//comment(),
186 | 						"this new comment"
187 | 					)
188 | 	return (assert:equal(fn:count($new-xml//comment()), fn:count($test-xml//comment())),
189 | 			for $c in $new-xml//comment()
190 | 			return assert:equal(fn:string($c), 'this new comment'))
191 | };
192 | 
193 | declare %test:case function replace-attributes()
194 | as item()*
195 | {
196 |    let $new-xml := mem:replace(
197 | 						$test-xml//p/@class,
198 | 						attribute class {"new-class"}
199 | 					)
200 | 	return (assert:equal(fn:count($new-xml//p/@class), fn:count($test-xml//p/@class)),
201 | 			for $c in $new-xml//p/@class
202 | 			return assert:equal(fn:string($c), 'new-class'))
203 | };
204 | 
205 | declare %test:case function replace-value-attributes()
206 | as item()*
207 | {
208 |    let $new-xml := mem:replace-value(
209 | 						$test-xml//p/@class,
210 | 						"new-class"
211 | 					)
212 | 	return (assert:equal(fn:count($new-xml//p/@class), fn:count($test-xml//p/@class)),
213 | 			for $c in $new-xml//p/@class
214 | 			return assert:equal(fn:string($c), 'new-class'))
215 | };
216 | 
217 | declare %test:case function rename()
218 | as item()*
219 | {
220 |   let $new-xml-blocks := mem:rename($test-xml//p,fn:QName("","block"))/body/div/block
221 |   return (for $p at $pos in $test-xml/body/div/p
222 | 		  return assert:equal($p/(@*|node()), $new-xml-blocks[$pos]/(@*|node())))
223 | };
224 | 
225 | declare %test:case function advanced-operation()
226 | as item()*
227 | {
228 |   let $new-xml := 
229 | 				let $id := mem:copy($test-xml) 
230 | 				return
231 | 				(
232 | 				mem:replace($id,$test-xml/head/title,element title {"This is so awesome!"}),
233 | 				mem:insert-child($id,$test-xml/body/div/p,attribute data-info {"This is also awesome!"}),
234 | 				mem:execute($id)	
235 | 				)
236 | 				
237 |   return (assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
238 | 			for $p in $new-xml/body/div/p
239 | 			return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
240 | };
241 | 
242 | declare %test:case function copy()
243 | as item()*
244 | {
245 |   let $test-xml := document { $test-xml }/html
246 |   let $new-xml := 
247 | 				let $id := mem:copy($test-xml) 
248 | 				return
249 | 				(
250 | 				mem:replace($id,$test-xml/head/title,element title {"This is so awesome!"}),
251 | 				mem:insert-child($id,$test-xml/body/div/p,attribute data-info {"This is also awesome!"}),
252 | 				mem:execute($id)	
253 | 				)
254 |   return (assert:equal($new-xml instance of element(html), fn:true()),
255 | 			assert:equal(fn:string($new-xml/head/title), "This is so awesome!"),
256 | 			for $p in $new-xml/body/div/p
257 | 			return assert:equal(fn:string($p/@data-info), "This is also awesome!"))
258 | };
259 | 
260 | declare %test:case function multiple-operations-on-one-node()
261 | as item()*
262 | {
263 |   let $title := $test-xml/head/title
264 |   let $new-xml := 
265 | 				let $id := mem:copy($title) 
266 | 				return
267 | 				(
268 | 				mem:rename($id,$title,fn:QName("","new-title")),
269 | 				mem:replace-value($id,$title,"This is so awesome!"),
270 | 				mem:execute($id)	
271 | 				)
272 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
273 | 			assert:equal(fn:string($new-xml), "This is so awesome!"))
274 | };
275 | 
276 | declare %test:case function transform-function-transaction()
277 | as item()*
278 | {
279 |   let $title := $test-xml/head/title
280 |   let $new-xml := 
281 | 				let $id := mem:copy($title) 
282 | 				return
283 | 				(
284 | 				mem:transform($id,$title,function($node as node()) as node()* {element new-title {"This is so awesome!"}}),
285 | 				mem:execute($id)	
286 | 				)
287 |   return (assert:equal($new-xml instance of element(new-title), fn:true()),
288 | 			assert:equal(fn:string($new-xml), "This is so awesome!"))
289 | };
290 | 
291 | declare %test:case function transform-function()
292 | as item()*
293 | {
294 |   let $title := $test-xml/head/title
295 |   let $new-xml :=  mem:transform($title,function($node as node()) as node()* {element new-title {"This is so awesome!"}})
296 |   return assert:equal(fn:string($new-xml/head/new-title), "This is so awesome!")
297 | };
298 | 
299 | declare %test:case function execute-section()
300 | as item()*
301 | {
302 |   let $div1 := $test-xml//div[@id = "div1"]
303 |   let $new-xml := 
304 | 				let $id := mem:copy($test-xml)[1]
305 | 				return
306 | 				(
307 | 				mem:insert-child($id,$div1,attribute class {"added-class"}),
308 | 				mem:replace($id,$div1,
309 | 				    let $copy := mem:execute-section($id, $div1)
310 | 				    for $i in (1 to 10)
311 | 				    let $cid := mem:copy($copy)
312 | 				    return 
313 | 				        (
314 | 				            mem:insert-child($cid,$copy,attribute data-position {$i}),
315 | 				            mem:execute($cid)
316 | 				        )
317 | 				),
318 | 				mem:execute($id)	
319 | 				)
320 |   return (assert:equal(fn:count($new-xml//div[@id = "div1"]), 10),
321 |             for $div at $pos in $new-xml//div[@id = "div1"]
322 | 			return (
323 | 			 assert:equal(fn:number($div/@data-position), $pos),
324 | 			 assert:equal(fn:string($div/@class), "added-class")
325 | 			)
326 | 		)
327 | };
328 | 
329 | declare %test:case function throws-error-on-mixed-sources()
330 | as item()*
331 | {
332 |   let $other-doc := <doc><p>my paragraph</p></doc>
333 |   return
334 |     assert:true(
335 |       try {
336 |         mem:replace(($test-xml,$other-doc)//p, <PARA/>)
337 |       } catch mem:MIXEDSOURCES {
338 |         fn:true()
339 |       }
340 |     )
341 | };
342 | 
343 | declare %test:case function removes-mem-op-namespace()
344 | as item()*
345 | {
346 |   let $title := $test-xml/head/title
347 |   let $new-xml := 
348 | 				let $id := mem:copy($test-xml) 
349 | 				return
350 | 				(
351 | 				mem:insert-child($id,$test-xml,attribute test {"testing"}),
352 |         		mem:transform($id,$title,function($node as node()) as node()* {element new-title {"This is so awesome!"}}),
353 | 				mem:execute($id)	
354 | 				)
355 |   return 
356 |   	assert:true(fn:empty($new-xml/namespace::mem-op), 'namespace not removed on queued run'),
357 |   let $title := $test-xml/head/title
358 |   let $new-xml := mem:insert-child($test-xml,attribute test {"testing"})
359 |   return 
360 |   	assert:true(fn:empty($new-xml/namespace::mem-op), 'namespace not removed on direct run')
361 | };


--------------------------------------------------------------------------------