├── doc ├── node-search-article.pdf ├── node-search-presentation.pdf ├── gettingStartedWithTopicTools.pdf ├── gettingStartedWithPcollections.pdf └── node-search-presentation-notes.pdf ├── README.md └── bin ├── tt ├── _log.xqm ├── _processorSpecific_saxonee.xqm ├── _processorSpecific_saxonpe.xqm ├── _processorSpecific.xqm ├── _processorSpecific_saxonhe.xqm ├── _processorSpecific_unknown.xqm ├── _extensions.xqm ├── _request_setters.xqm ├── _foxpath-processorDependent.xqm ├── _mongoExecutor.xqm ├── _request_parser.xqm ├── zzz._request_parser.hide.xqm ├── _resourceAccess.xqm ├── _constants.xqm ├── _pfilter.xqm ├── _reportAssistent.xqm ├── _help.xqm ├── _foxpath-uri-operations-github.xqm ├── _docs.xqm ├── _csvParser.xqm ├── _pcollection_xml.xqm ├── _foxpath-uri-operations-rdf.xqm ├── _foxpath-util.xqm ├── _pfilter_parser.xqm ├── _sqlExecutor.xqm ├── _foxpath-resourceTreeTypeDependent.xqm └── mongodb.xqm ├── ttoolsConstants.xqm ├── builder_extensions.xqm ├── prototypeWriter.xqm ├── toolSchemeParser.xqm ├── ttools.xq ├── builder_main.xqm └── example.xqm /doc/node-search-article.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hrennau/TopicTools/HEAD/doc/node-search-article.pdf -------------------------------------------------------------------------------- /doc/node-search-presentation.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hrennau/TopicTools/HEAD/doc/node-search-presentation.pdf -------------------------------------------------------------------------------- /doc/gettingStartedWithTopicTools.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hrennau/TopicTools/HEAD/doc/gettingStartedWithTopicTools.pdf -------------------------------------------------------------------------------- /doc/gettingStartedWithPcollections.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hrennau/TopicTools/HEAD/doc/gettingStartedWithPcollections.pdf -------------------------------------------------------------------------------- /doc/node-search-presentation-notes.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hrennau/TopicTools/HEAD/doc/node-search-presentation-notes.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TopicTools 2 | A lightweight framework for developing powerful command-line tools with XQuery. The ttools framework enables you to write XQuery programs which are topic tools. The term “topic tool” summarizes a simple idea: a tool which offers various operations related to a particular topic. Reserving the term for command-line tools, the idea can be evolved into a generic model of invocation syntax and basic behavioural rules. A conformant topic tool can accomplish many different tasks and is easy to use. Using the ttools framework, topic tools are also easy to write. ttools thus promises benefits to both, the tool user and the tool developer. 3 | 4 | Maintenance of topic tools requires the use of the BaseX processor ( http://basex.org ). The topic tools themselves can be used with any standards conformant XQuery processor offering a command-line interface, as for example the Saxon processor ( http://www.saxonica.com ). 5 | 6 | A comprehensive user manual is under construction and will be added soon. Until then, you may consider looking at the tutorials found in the doc folder - hopefully they suffice to get you started. 7 | -------------------------------------------------------------------------------- /bin/tt/_log.xqm: -------------------------------------------------------------------------------- 1 | (: log.xqm - provides a function for conditional logging of items 2 | : 3 | : @version 20141220 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace m="http://www.ttools.org/xquery-functions"; 8 | 9 | declare variable $m:LOG_LEVEL as xs:integer := 0; 10 | 11 | (: 12 | : ============================================================================ 13 | : 14 | : p u b l i c f u n c t i o n s 15 | : 16 | : ============================================================================ 17 | :) 18 | 19 | (:~ 20 | : Returns the items received, logging the value if the specified log level 21 | : is greater or equal the global constant $m:LOG_LEVEL. 22 | : 23 | : @param items the items to be logged 24 | : @param logLevel the log level of the log message 25 | : @param msg trace message, used if items are traced 26 | : @return the items received 27 | :) 28 | declare function m:log($items as item()*, $logLevel as xs:integer, $msg as xs:string) 29 | as item()* { 30 | if ($logLevel le $m:LOG_LEVEL) then trace($items, $msg) else $items 31 | }; -------------------------------------------------------------------------------- /bin/tt/_processorSpecific_saxonee.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : processorSpecific.xqm - processor specific extension functions 6 | : 7 | : Edition for processor: Saxon 8 | : 9 | :*************************************************************************** 10 | :) 11 | 12 | module namespace f="http://www.ttools.org/xquery-functions"; 13 | import module namespace tt="http://www.ttools.org/xquery-functions" at 14 | "_constants.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | declare namespace saxon="http://saxon.sf.net/"; 18 | 19 | (: 20 | : ============================================================================ 21 | : 22 | : p r i v a t e f u n c t i o n s 23 | : 24 | : ============================================================================ 25 | :) 26 | 27 | (:~ 28 | : Executes an XQuery expression. 29 | : 30 | : @param query an XQuery expression 31 | : @param ctxt an item to be used as context item 32 | : @return the result of evaluating the expression 33 | :) 34 | declare function f:evaluate($query as xs:string, $context as item()?) 35 | as item()* { 36 | $context ! saxon:evaluate($query) 37 | }; 38 | -------------------------------------------------------------------------------- /bin/tt/_processorSpecific_saxonpe.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : processorSpecific.xqm - processor specific extension functions 6 | : 7 | : Edition for processor: Saxon 8 | : 9 | :*************************************************************************** 10 | :) 11 | 12 | module namespace f="http://www.ttools.org/xquery-functions"; 13 | import module namespace tt="http://www.ttools.org/xquery-functions" at 14 | "_constants.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | declare namespace saxon="http://saxon.sf.net/"; 18 | 19 | (: 20 | : ============================================================================ 21 | : 22 | : p r i v a t e f u n c t i o n s 23 | : 24 | : ============================================================================ 25 | :) 26 | 27 | (:~ 28 | : Executes an XQuery expression. 29 | : 30 | : @param query an XQuery expression 31 | : @param ctxt an item to be used as context item 32 | : @return the result of evaluating the expression 33 | :) 34 | declare function f:evaluate($query as xs:string, $context as item()?) 35 | as item()* { 36 | $context ! saxon:evaluate($query) 37 | }; 38 | -------------------------------------------------------------------------------- /bin/tt/_processorSpecific.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : processorSpecific.xqm - processor specific extension functions 6 | : 7 | : Edition for processor: BaseX 8 | : 9 | :*************************************************************************** 10 | :) 11 | 12 | module namespace f="http://www.ttools.org/xquery-functions"; 13 | import module namespace tt="http://www.ttools.org/xquery-functions" at 14 | "_constants.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | 18 | (: 19 | : ============================================================================ 20 | : 21 | : p r i v a t e f u n c t i o n s 22 | : 23 | : ============================================================================ 24 | :) 25 | 26 | (:~ 27 | : Executes an XQuery expression. 28 | : 29 | : @param query an XQuery expression 30 | : @param ctxt an item to be used as context item 31 | : @return the result of evaluating the expression 32 | :) 33 | declare function f:evaluate($query as xs:string, $context as item()?) 34 | as item()* { 35 | 36 | let $context := map {'' : $context } 37 | return 38 | xquery:eval($query, $context) 39 | }; 40 | -------------------------------------------------------------------------------- /bin/tt/_processorSpecific_saxonhe.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : processorSpecific.xqm - processor specific extension functions 6 | : 7 | : Edition for processor: Saxon 8 | : 9 | :*************************************************************************** 10 | :) 11 | 12 | module namespace f="http://www.ttools.org/xquery-functions"; 13 | import module namespace tt="http://www.ttools.org/xquery-functions" at 14 | "_constants.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | declare namespace saxon="http://saxon.sf.net/"; 18 | 19 | (: 20 | : ============================================================================ 21 | : 22 | : p r i v a t e f u n c t i o n s 23 | : 24 | : ============================================================================ 25 | :) 26 | 27 | (:~ 28 | : Executes an XQuery expression. 29 | : 30 | : @param query an XQuery expression 31 | : @param ctxt an item to be used as context item 32 | : @return the result of evaluating the expression 33 | :) 34 | declare function f:evaluate($query as xs:string, $context as item()?) 35 | as item()* { 36 | error(QName($tt:URI_ERROR, 'INVALID_CALL'), 37 | 'With SaxonHE, this function should never be called, as the ', 38 | 'SaxonHE processor allows only for a dummy implementation.') 39 | }; 40 | -------------------------------------------------------------------------------- /bin/tt/_processorSpecific_unknown.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : processorSpecific.xqm - processor specific extension functions 6 | : 7 | : Edition for processor: unknown processor (without any known capabilitities) 8 | : 9 | :*************************************************************************** 10 | :) 11 | 12 | module namespace f="http://www.ttools.org/xquery-functions"; 13 | import module namespace tt="http://www.ttools.org/xquery-functions" at 14 | "_constants.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | declare namespace saxon="http://saxon.sf.net/"; 18 | 19 | (: 20 | : ============================================================================ 21 | : 22 | : p r i v a t e f u n c t i o n s 23 | : 24 | : ============================================================================ 25 | :) 26 | 27 | (:~ 28 | : Executes an XQuery expression. 29 | : 30 | : @param query an XQuery expression 31 | : @param ctxt an item to be used as context item 32 | : @return the result of evaluating the expression 33 | :) 34 | declare function f:evaluate($query as xs:string, $context as item()?) 35 | as item()* { 36 | error(QName($tt:URI_ERROR, 'INVALID_CALL'), 37 | 'With SaxonHE, this function should never be called, as the ', 38 | 'SaxonHE processor allows only for a dummy implementation.') 39 | }; 40 | -------------------------------------------------------------------------------- /bin/tt/_extensions.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : _extensions.xqm - generated functions invoking application specific extensions. 3 | : 4 | : @version 20140402-1 first version 5 | : =================================================================================== 6 | :) 7 | 8 | module namespace m="http://www.ttools.org/xquery-functions"; 9 | 10 | 11 | declare namespace z="http://www.ttools.org/structure"; 12 | 13 | declare variable $m:NON_STANDARD_TYPES := ''; 14 | 15 | (: 16 | : ============================================================================ 17 | : 18 | : o p e r a t i o n s 19 | : 20 | : ============================================================================ 21 | :) 22 | 23 | (:~ 24 | : Parses a request string into a data type item. The function delegates the 25 | : parsing to the appropriate function identified by pseudo annotations. 26 | : 27 | : @param paramName the parameter name 28 | : @param itemType the item type 29 | : @param itemText a string providing a single parameter item 30 | : @return the parsed item, or an z:errors element 31 | :) 32 | declare function m:parseNonStandardItemType($paramName as xs:string, $itemType as xs:string, $itemText as xs:string) 33 | as item() { 34 | 35 | 38 | }; 39 | 40 | declare function m:adaptItemTypeOfNonStandardItemType($itemType as xs:string) 41 | as xs:string { 42 | $itemType 43 | }; 44 | 45 | declare function m:checkNonStandardFacets($itemText as xs:string, $typedItem as item(), $paramConfig as element()) 46 | as element()* { 47 | () 48 | }; 49 | -------------------------------------------------------------------------------- /bin/tt/_request_setters.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : _request_setters.xqm - setter functions setting parameter values 3 | : 4 | : Supported parameter item types: 5 | : 6 | : xs:boolean 7 | : ... 8 | : 9 | : @version 20140908-1 first version 10 | : =================================================================================== 11 | :) 12 | 13 | module namespace m="http://www.ttools.org/xquery-functions"; 14 | 15 | import module namespace tt="http://www.ttools.org/xquery-functions" at 16 | "_constants.xqm", 17 | "_reportAssistent.xqm"; 18 | 19 | (:~ 20 | : Sets a parameter. If a request is supplied, the function 21 | : creates a copy extended by the desired parameter; otherwise, 22 | : the function creates a new request element. 23 | : 24 | : @param request the request element 25 | : @return the operation name 26 | :) 27 | declare function m:setParam($request as element()?, 28 | $name as xs:string, 29 | $value as xs:anyAtomicType*, 30 | $type as xs:string) 31 | as item()* { 32 | 33 | if (not(tt:itemsCastable($value, $type))) then 34 | error(QName($tt:URI_ERROR, 'INVALID_ARG'), concat('Invalid arguments supplied ', 35 | 'to ''setParam'' - item type: ', $type, '; items=', string-join($value, '; '))) else 36 | 37 | let $paramItem := 38 | element {$name} { 39 | attribute itemType {$type}, 40 | if (count($value) eq 1) then $value else 41 | for $item in $value return {$item} 42 | } 43 | return 44 | if ($request) then 45 | element {node-name($request)} { 46 | $request/@*, 47 | $request/(node() except *[local-name(.) eq $name]), 48 | $paramItem 49 | } 50 | else <_request>{$paramItem} 51 | }; 52 | 53 | -------------------------------------------------------------------------------- /bin/tt/_foxpath-processorDependent.xqm: -------------------------------------------------------------------------------- 1 | module namespace f="http://www.ttools.org/xquery-functions"; 2 | 3 | (:~ 4 | : Evaluates the an XQuery expression supplied as a string. 5 | : 6 | : @param xquery the XQuery expression 7 | : @param context bindings of variables to names; a binding to the zero-length 8 | : string is interpreted as context item 9 | :) 10 | declare function f:xquery($xquery as xs:string?, $context as map(*)?) 11 | as item()* { 12 | if (exists($context)) then xquery:eval($xquery, $context) 13 | else xquery:eval($xquery) 14 | }; 15 | 16 | (:~ 17 | : Returns the current directory. The directory is represented 18 | : in a normalized format: using forward slashes and without 19 | : a trailing slash. 20 | :) 21 | declare function f:currentDirectory() as xs:string? { 22 | replace(replace(file:current-dir(), '\\', '/'), '/$', '') 23 | }; 24 | 25 | (: 26 | (:~ 27 | : Tests if $path points to a directory. 28 | : 29 | : Note. For the time being, if $path is a http(s)::// URI the 30 | : function returns the empty sequence. 31 | : 32 | : @param path the path to be checked 33 | :) 34 | declare function f:isDirectory($path as xs:string) as xs:boolean? { 35 | if (matches($path, '^https?://')) then () 36 | else file:is-dir($path) 37 | }; 38 | 39 | (:~ 40 | : Tests if $path points to a file. 41 | : 42 | : Note. For the time being, if $path is a http(s)::// URI the 43 | : function returns the empty sequence. 44 | : 45 | : @param path the path to be checked 46 | :) 47 | declare function f:isFile($path as xs:string, $options as map(*)?) as xs:boolean? { 48 | if (matches($path, '^https?://')) then 49 | let $rtrees := 50 | if (empty($options)) then () 51 | else map:get($options, 'URI_TREES') 52 | return 53 | $path = ( 54 | for $rtree in $rtrees 55 | [starts-with($path, @uriPrefix)] 56 | /tree[starts-with($path, @baseURI)] 57 | let $baseUri := $rtree/@baseURI 58 | for $file in $rtree//file 59 | return concat($baseUri, $file/@path) 60 | ) 61 | else file:is-file($path) 62 | }; 63 | :) 64 | 65 | (: 66 | (:~ 67 | : Returns the last modification time of a file or directory. 68 | : 69 | : @param path the path of the file or directory 70 | :) 71 | declare function f:fileLastModified($path as xs:string) as xs:dateTime? { 72 | $path ! file:last-modified($path) 73 | }; 74 | :) 75 | 76 | (: 77 | (:~ 78 | : Returns the byte size of a file, or the value 0 for a directory. 79 | : 80 | : @param path the path of the file or directory 81 | :) 82 | declare function f:fileSize($path as xs:string?) as xs:integer? { 83 | $path ! file:size($path) 84 | }; 85 | :) -------------------------------------------------------------------------------- /bin/tt/_mongoExecutor.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | :*************************************************************************** 3 | : 4 | : mongoExecutor.xqm - functions for executing MongoDB commands 5 | : 6 | :*************************************************************************** 7 | :) 8 | 9 | module namespace f="http://www.ttools.org/xquery-functions"; 10 | 11 | (: import module namespace mongodb="http://expath.org/ns/mongodb" at "/projects/infospace/mongodb/mongodb.xqm"; :) 12 | import module namespace mongodb="http://expath.org/ns/mongodb" at "mongodb.xqm"; 13 | 14 | import module namespace tt="http://www.ttools.org/xquery-functions" at 15 | "_request.xqm", 16 | "_reportAssistent.xqm", 17 | "_errorAssistent.xqm", 18 | "_nameFilter.xqm", 19 | "_sqlWriter.xqm"; 20 | 21 | declare namespace z="http://www.ttools.org/structure"; 22 | 23 | (: 24 | : ============================================================================ 25 | : 26 | : p u b l i c f u n c t i o n s 27 | : 28 | : ============================================================================ 29 | :) 30 | 31 | (:~ 32 | : Creates a connection to server $server. 33 | : 34 | : @param server the server name (e.g. 'localhost') 35 | : @return the connection handle 36 | :) 37 | declare function f:mongoConnect($server as xs:string) 38 | as xs:string { 39 | let $uri := concat('mongodb://', $server) 40 | return mongodb:connect($uri) 41 | 42 | }; 43 | 44 | (:~ 45 | : Creates a new collection. If the collection already exists, 46 | : the existence is reported. 47 | : 48 | : @param cid MongoDB client id 49 | : @param db the database name 50 | : @param collection the collection name 51 | : @return a report describing the operation result 52 | :) 53 | declare function f:createCollection($conn as xs:string, 54 | $db as xs:string, 55 | $collection as xs:string) 56 | as element(z:createCollection) { 57 | let $collections := mongodb:list-collections($conn, $db) 58 | return 59 | if ($collections = $collection) then 60 | let $size := mongodb:count($conn, $db, $collection) 61 | return 62 | else 63 | 64 | let $r_insert := mongodb:insert($conn, $db, $collection, map{"INITIALIZED" : "true"}) 65 | let $r_remove := mongodb:remove($conn, $db, $collection, map{}) 66 | let $size := mongodb:count($conn, $db, $collection) 67 | return 68 | 69 | }; 70 | 71 | (:~ 72 | : Creates a database. 73 | : 74 | : @param conn the connection handle 75 | : @return nothing 76 | :) 77 | declare function f:mongoCreateDb($conn as xs:string, $db as xs:string) 78 | as empty-sequence() { 79 | error() 80 | }; 81 | 82 | (:~ 83 | : Deletes a database. 84 | : 85 | : @param conn the connection handle 86 | : @return nothing 87 | :) 88 | declare function f:mongoDropDb($conn as xs:string, $db as xs:string) 89 | as empty-sequence() { 90 | error() 91 | }; 92 | 93 | (:~ 94 | : Returns a 'dbs' element reporting the accessible databases. 95 | : 96 | : @param conn the connection handle 97 | : @return a report of the accessible databases 98 | :) 99 | declare function f:mongoShowDatabases($conn as xs:string) 100 | as element() { 101 | error() 102 | }; 103 | -------------------------------------------------------------------------------- /bin/tt/_request_parser.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : _request_parser.xqm - parses a request string into a data structure 3 | : 4 | : @version 20131025-1 first version 5 | : =================================================================================== 6 | :) 7 | 8 | module namespace m="http://www.ttools.org/xquery-functions"; 9 | 10 | import module namespace i="http://www.ttools.org/xquery-functions" at 11 | "_constants.xqm", 12 | "_stringTools.xqm"; 13 | 14 | (:~ 15 | : Parses a request string into a data structure. 16 | : 17 | : @param request the request string 18 | : @return an element representing the request 19 | :) 20 | declare function m:_parseRequest($request as xs:string) 21 | as element() { 22 | let $request := 23 | let $req := replace($request, '^\s+|\s+$', '') 24 | return 25 | if (starts-with($req, '?')) then 26 | concat('_help', $req[string-length(.) gt 1]) 27 | else $req 28 | 29 | let $operation := replace($request, '\s*\?.*', '', 's') 30 | let $params := 31 | if (not(contains($request, '?'))) then () else 32 | replace($request, '^.*?\?\s*', '', 's') 33 | let $storeq := starts-with($params, '?') 34 | let $params := if ($storeq) then replace($params, '^\?\s*', '') else $params 35 | let $storeqAtt := if (not($storeq)) then () else attribute storeq {true()} 36 | (: let $items := m:_getParamItemRC($params) :) 37 | let $items := m:_splitString($params, ',', ()) 38 | let $items := 39 | for $item in $items return 40 | if (not(contains($item, '='))) then 41 | if (starts-with($item, '~')) then 42 | else 43 | else 44 | let $name := replace($item, '^(.*?)\s*=.*', '$1', 's') 45 | let $value := replace($item, '^.*?=\s*', '', 's') 46 | return 47 | 48 | 49 | return 50 | {$storeqAtt, $items} 51 | }; 52 | 53 | (: 54 | (:~ 55 | : Recursive helper function of _parseRequest. Extracts the next 56 | : item, transforms it into an element representing item name 57 | : and value, and recursively calls itself for processing the 58 | : remainder of the parameter string, if there is a remainder. 59 | : 60 | : @param params the parameter string 61 | : @return the items, represented by "item" elements with a "name" and a 62 | : "value" attribute providing item name and value 63 | :) 64 | declare function m:_getParamItemRCXXX($params as xs:string?) 65 | as element()* { 66 | if (empty($params)) then () else 67 | 68 | (: the next item preceding a comma or the string end :) 69 | let $item := replace($params, '^(.*?[^\\](\\\\)*)?,($|[^,].*)', '$1', 's') 70 | return if (not(normalize-space($item))) then () else 71 | 72 | let $next := if ($item eq $params) then () else 73 | replace(substring($params, string-length($item) + 2), '^\s+', '') 74 | let $itemElem := 75 | if (not(contains($item, '='))) then 76 | if (starts-with($item, '~')) then 77 | else 78 | else 79 | let $name := replace($item, '^(.*?)\s*=.*', '$1', 's') 80 | let $value := replace($item, '^.*?=\s*', '', 's') 81 | return 82 | 83 | return ( 84 | $itemElem, 85 | if (empty($next)) then () else m:_getParamItemRCXXX($next) 86 | ) 87 | }; 88 | :) -------------------------------------------------------------------------------- /bin/tt/zzz._request_parser.hide.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : _request_parser.xqm - parses a request string into a data structure 3 | : 4 | : @version 20131025-1 first version 5 | : =================================================================================== 6 | :) 7 | 8 | module namespace m="http://www.ttools.org/xquery-functions"; 9 | 10 | import module namespace i="http://www.ttools.org/xquery-functions" at 11 | "_constants.xqm", 12 | "_stringTools.xqm"; 13 | 14 | (:~ 15 | : Parses a request string into a data structure. 16 | : 17 | : @param request the request string 18 | : @return an element representing the request 19 | :) 20 | declare function m:_parseRequest($request as xs:string) 21 | as element() { 22 | let $request := 23 | let $req := replace($request, '^\s+|\s+$', '') 24 | return 25 | if (starts-with($req, '?')) then 26 | concat('_help', $req[string-length(.) gt 1]) 27 | else $req 28 | 29 | let $operation := replace($request, '\s*\?.*', '', 's') 30 | let $params := 31 | if (not(contains($request, '?'))) then () else 32 | replace($request, '^.*?\?\s*', '', 's') 33 | let $storeq := starts-with($params, '?') 34 | let $params := if ($storeq) then replace($params, '^\?\s*', '') else $params 35 | let $storeqAtt := if (not($storeq)) then () else attribute storeq {true()} 36 | (: let $items := m:_getParamItemRC($params) :) 37 | let $items := m:_splitString($params, ',', ()) 38 | let $items := 39 | for $item in $items return 40 | if (not(contains($item, '='))) then 41 | if (starts-with($item, '~')) then 42 | else 43 | else 44 | let $name := replace($item, '^(.*?)\s*=.*', '$1', 's') 45 | let $value := replace($item, '^.*?=\s*', '', 's') 46 | return 47 | 48 | 49 | return 50 | {$storeqAtt, $items} 51 | }; 52 | 53 | (: 54 | (:~ 55 | : Recursive helper function of _parseRequest. Extracts the next 56 | : item, transforms it into an element representing item name 57 | : and value, and recursively calls itself for processing the 58 | : remainder of the parameter string, if there is a remainder. 59 | : 60 | : @param params the parameter string 61 | : @return the items, represented by "item" elements with a "name" and a 62 | : "value" attribute providing item name and value 63 | :) 64 | declare function m:_getParamItemRCXXX($params as xs:string?) 65 | as element()* { 66 | if (empty($params)) then () else 67 | 68 | (: the next item preceding a comma or the string end :) 69 | let $item := replace($params, '^(.*?[^\\](\\\\)*)?,($|[^,].*)', '$1', 's') 70 | return if (not(normalize-space($item))) then () else 71 | 72 | let $next := if ($item eq $params) then () else 73 | replace(substring($params, string-length($item) + 2), '^\s+', '') 74 | let $itemElem := 75 | if (not(contains($item, '='))) then 76 | if (starts-with($item, '~')) then 77 | else 78 | else 79 | let $name := replace($item, '^(.*?)\s*=.*', '$1', 's') 80 | let $value := replace($item, '^.*?=\s*', '', 's') 81 | return 82 | 83 | return ( 84 | $itemElem, 85 | if (empty($next)) then () else m:_getParamItemRCXXX($next) 86 | ) 87 | }; 88 | :) -------------------------------------------------------------------------------- /bin/tt/_resourceAccess.xqm: -------------------------------------------------------------------------------- 1 | (: resourceAccess.xqm - functions for accessing resources 2 | : 3 | : @version 20141205-1 first version 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace m="http://www.ttools.org/xquery-functions"; 8 | 9 | declare base-uri ".."; 10 | 11 | (:#file#:) 12 | declare variable $m:BASE_URI := file:current-dir() ! file:path-to-uri(.); 13 | (:##:) 14 | 15 | (: 16 | : ============================================================================ 17 | : 18 | : p u b l i c f u n c t i o n s 19 | : 20 | : ============================================================================ 21 | :) 22 | 23 | declare function m:resolve-uri($uri as xs:string?) 24 | as xs:anyURI? { 25 | (:#file#:) 26 | let $uri := file:resolve-path($uri, $m:BASE_URI) ! file:path-to-uri(.) return 27 | (:##:) 28 | resolve-uri($uri) 29 | }; 30 | 31 | declare function m:static-base-uri() 32 | as xs:anyURI? { 33 | (: add a trailing /, if missing, to patch BaseX bug :) 34 | let $value := static-base-uri() 35 | return xs:anyURI(replace($value, '[^/]$', '$0/')) 36 | }; 37 | 38 | declare function m:doc($uri as xs:string?) 39 | as document-node()? { 40 | (:#file#:) 41 | let $uri := file:resolve-path($uri, $m:BASE_URI) ! file:path-to-uri(.) return 42 | (:##:) 43 | doc($uri) 44 | }; 45 | 46 | declare function m:doc-available($uri as xs:string?) 47 | as xs:boolean { 48 | (:#file#:) 49 | let $uri := file:resolve-path($uri, $m:BASE_URI) ! file:path-to-uri(.) return 50 | (:##:) 51 | try { 52 | doc-available($uri) 53 | } catch * { 54 | let $encoded := encode-for-uri($uri) 55 | return 56 | doc-available($encoded) 57 | } 58 | }; 59 | 60 | declare function m:unparsed-text($href as xs:string?) 61 | as xs:string? { 62 | (:#file#:) 63 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 64 | (:##:) 65 | unparsed-text($href) 66 | }; 67 | 68 | declare function m:unparsed-text($href as xs:string?, $encoding as xs:string) 69 | as xs:string? { 70 | (:#file#:) 71 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 72 | (:##:) 73 | unparsed-text($href, $encoding) 74 | }; 75 | 76 | declare function m:unparsed-text-lines($href as xs:string?) 77 | as xs:string* { 78 | (:#file#:) 79 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 80 | (:##:) 81 | unparsed-text-lines($href) 82 | }; 83 | 84 | declare function m:unparsed-text-lines($href as xs:string?, $encoding as xs:string) 85 | as xs:string* { 86 | (:#file#:) 87 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 88 | (:##:) 89 | unparsed-text-lines($href, $encoding) 90 | }; 91 | 92 | declare function m:unparsed-text-available($href as xs:string?) 93 | as xs:boolean { 94 | (:#file#:) 95 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 96 | (:##:) 97 | unparsed-text-available($href) 98 | }; 99 | 100 | declare function m:unparsed-text-available($href as xs:string?, $encoding as xs:string) 101 | as xs:boolean { 102 | (:#file#:) 103 | let $href := file:resolve-path($href, $m:BASE_URI) ! file:path-to-uri(.) return 104 | (:##:) 105 | unparsed-text-available($href, $encoding) 106 | }; 107 | 108 | declare function m:uri-collection($uri as xs:string?) 109 | as xs:anyURI* { 110 | (:#file#:) 111 | let $uri := file:resolve-path($uri, $m:BASE_URI) ! file:path-to-uri(.) return 112 | (:##:) 113 | uri-collection($uri) 114 | }; 115 | -------------------------------------------------------------------------------- /bin/ttoolsConstants.xqm: -------------------------------------------------------------------------------- 1 | (: ttoolsConstants.xqm - provides constants used by topic tool 'ttools' 2 | : 3 | : @version 20140124-1 first version 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace c="http://www.ttools.org/ttools/xquery-functions"; 8 | 9 | declare variable $c:cfg := 10 | 11 | tt 12 | 13 | 14 | _constants.xqm 15 | _csvParser.xqm 16 | _docs.xqm 17 | _foxpath.xqm 18 | _foxpath-functions.xqm 19 | _foxpath-fox-functions.xqm 20 | _foxpath-parser.xqm 21 | _foxpath-util.xqm 22 | _foxpath-processorDependent.xqm 23 | _foxpath-uri-operations.xqm 24 | _foxpath-uri-operations-basex.xqm 25 | _foxpath-uri-operations-svn.xqm 26 | _foxpath-uri-operations-rdf.xqm 27 | _foxpath-uri-operations-utree.xqm 28 | _foxpath-uri-operations-github.xqm 29 | _foxpath-uri-operations-archive.xqm 30 | _help.xqm 31 | _log.xqm 32 | _nameFilter.xqm 33 | _nameFilter_parser.xqm 34 | _namespaceTools.xqm 35 | _reportAssistent.xqm 36 | _errorAssistent.xqm 37 | _pcollection.xqm 38 | _pcollection_sql.xqm 39 | _pcollection_mongo.xqm 40 | _pcollection_utils.xqm 41 | _pcollection_xml.xqm 42 | _pfilter.xqm 43 | _pfilter_parser.xqm 44 | _processorSpecific.xqm 45 | _processorSpecific.xqm 46 | _processorSpecific.xqm 47 | _processorSpecific.xqm 48 | _rcat.xqm 49 | _request.xqm 50 | _request_facets.xqm 51 | _request_getters.xqm 52 | 53 | _request_setters.xqm 54 | _request_valueParser.xqm 55 | _resourceAccess.xqm 56 | _sqlExecutor.xqm 57 | _sqlWriter.xqm 58 | _mongoExecutor.xqm 59 | mongodb.xqm 60 | _stringTools.xqm 61 | 62 | 63 | 64 | 65 | 66 | ; 67 | 68 | declare variable $c:serParamsText := 69 | 70 | 71 | ; 72 | 73 | declare variable $c:serParamsXml := 74 | 75 | 76 | 77 | ; 78 | 79 | 80 | -------------------------------------------------------------------------------- /bin/tt/_constants.xqm: -------------------------------------------------------------------------------- 1 | (: constants.xqm - provides constants used by xquery topic tool applications 2 | : 3 | : @version 20140124-1 first version 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace m="http://www.ttools.org/xquery-functions"; 8 | 9 | declare variable $m:URI_ERROR := "http://www.ttools.org/errors"; 10 | declare variable $m:URI_XSD := "http://www.w3.org/2001/XMLSchema"; 11 | declare variable $m:URI_PCOLLECTION := "http://www.infospace.org/pcollection"; 12 | 13 | (: 14 | declare variable $m:MODIFIERS_CSV := ('encoding', 'delim', 'sep', 'header', 'names', 'fromRec', 'toRec'); 15 | :) 16 | 17 | declare variable $m:NODE_SER_PARAMS := 18 | 19 | 20 | 21 | 22 | ; 23 | 24 | declare variable $m:PARAM_MODIFIER_SCHEMES := 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | ; 89 | 90 | 91 | -------------------------------------------------------------------------------- /bin/tt/_pfilter.xqm: -------------------------------------------------------------------------------- 1 | (: pfilterParser.xqm - parses a pfilter into a structured representation (pfilter element) 2 | : 3 | : @version 20141205-1 first version 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace m="http://www.ttools.org/xquery-functions"; 8 | 9 | import module namespace tt="http://www.ttools.org/xquery-functions" at 10 | "_constants.xqm", 11 | "_errorAssistent.xqm", 12 | "_pcollection_utils.xqm"; 13 | 14 | declare namespace z="http://www.ttools.org/structure"; 15 | declare namespace is="http://www.infospace.org/pcollection"; 16 | 17 | (: 18 | : ============================================================================ 19 | : 20 | : p u b l i c f u n c t i o n s 21 | : 22 | : ============================================================================ 23 | :) 24 | 25 | (:~ 26 | : Determines whether a node descriptor contained by an XML RCAT 27 | : matches a pfilter. 28 | : 29 | : @param node a node descriptor 30 | : @param pfilter a pfilter 31 | : @return true if the node descriptor matches the pfilter or no pfilter has 32 | : been specified, false otherwise 33 | :) 34 | declare function m:matchesPfilter($pnode as element(is:pnode), $pfilter as element(is:pfilter)?) 35 | as xs:boolean { 36 | if (not($pfilter)) then true() else 37 | 38 | m:_matchesPfilterRC($pnode, $pfilter/*) 39 | }; 40 | 41 | (:~ 42 | : Transforms a pfilter into a where clause expressing it. 43 | : 44 | : @param node a node descriptor 45 | : @param pfilter a pfilter 46 | : @return the text of the where clause 47 | :) 48 | declare function m:pfilterWhereClause($pfilter as element(is:pfilter)?) 49 | as xs:string? { 50 | if (not($pfilter)) then () else 51 | 52 | m:_pfilterWhereClauseRC($pfilter/*) 53 | }; 54 | 55 | (: 56 | : ============================================================================ 57 | : 58 | : p r i v a t e f u n c t i o n s 59 | : 60 | : ============================================================================ 61 | :) 62 | 63 | (:~ 64 | : Determines whether a node descriptor contained by an XML RCAT 65 | : matches a pfilter node. 66 | : 67 | : @param node a node descriptor 68 | : @param pfn a pfilter node 69 | : @return true if the node descriptor matches the pfilter node, false otherwise 70 | :) 71 | declare function m:_matchesPfilterRC($pnode as element(is:pnode), $pfn as element()) 72 | as xs:boolean { 73 | typeswitch ($pfn) 74 | case element(is:and) return 75 | every $c in $pfn/* satisfies m:_matchesPfilterRC($pnode, $c) 76 | case element(is:or) return 77 | some $c in $pfn/* satisfies m:_matchesPfilterRC($pnode, $c) 78 | case element(is:not) return 79 | not(m:_matchesPfilterRC($pnode, $pfn/*)) 80 | case $p as element(is:p) return 81 | let $pname := $p/@name 82 | let $op := $p/@op 83 | let $pvalue := tt:_pnodeProperty($pnode, $pname) 84 | (:( 85 | $pnode/@*[local-name(.) eq $pname], 86 | $pnode/*[not(*)][local-name(.) eq $pname]/string(), 87 | $pnode/*[*][local-name(.) eq $pname]/is:item/string() 88 | ) :) 89 | let $tvalue := if ($p/is:value/is:item) then $p/is:value/is:item/string() else $p/is:value/string() 90 | let $tvalue := 91 | if ($op eq '~') then 92 | for $v in $tvalue return concat('^', replace($v, '\*', '.*'), '$') 93 | else $tvalue 94 | return 95 | if ($op eq '~') then 96 | some $pv in $pvalue satisfies ( 97 | some $tv in $tvalue satisfies matches($pv, $tv, 'i') 98 | ) 99 | else if ($op eq '=') then $pvalue = $tvalue 100 | else if ($op eq '<') then $pvalue < $tvalue 101 | else if ($op eq '<=') then $pvalue <= $tvalue 102 | else if ($op eq '>') then $pvalue > $tvalue 103 | else if ($op eq '>=') then $pvalue >= $tvalue 104 | else 105 | error(QName($tt:URI_ERROR, 'INVALID_PFILTER'), 106 | concat('Unexpected operator: ', $op)) 107 | default return 108 | error(QName($tt:URI_ERROR, 'INVALID_PFILTER'), concat('Unexpected element, local name: ', local-name($pfn))) 109 | }; 110 | 111 | (:~ 112 | : Transforms a pfilter into a where clause expressing it. 113 | : 114 | : @param pfn a pfilter node 115 | : @return the fragment of the where clause corresponding to the given pfilter node 116 | :) 117 | declare function m:_pfilterWhereClauseRC($pfn as element()) 118 | as xs:string { 119 | typeswitch ($pfn) 120 | case element(is:and) return 121 | string-join(for $child in $pfn/* return m:_pfilterWhereClauseRC($child), ' and ') 122 | case element(is:or) return 123 | let $chain := 124 | string-join(for $child in $pfn/* return m:_pfilterWhereClauseRC($child), ' or ') 125 | return 126 | if ($pfn/parent::is:pfilter) then $chain else concat('(', $chain, ')') 127 | case element(is:not) return 128 | concat('not(', m:_pfilterWhereClauseRC($pfn/*), ')') 129 | case $p as element(is:p) return 130 | let $pname := $p/@name 131 | let $op := $p/@op 132 | let $tvalue := if ($p/is:value/is:item) then $p/is:value/is:item/string() else $p/is:value/string() 133 | let $useOp := 134 | if ($op eq '~') then 'like' 135 | else if ($op eq '=' and count($tvalue) gt 1) then 'in' 136 | else $op 137 | let $useTvalue := 138 | let $edited := 139 | if (not($op eq '~')) then $tvalue else 140 | for $v in $tvalue return replace($v, '\*', '%') 141 | let $edited := 142 | for $item in $edited return 143 | concat("'", replace($item, '[,)]', '\\$0'), "'") 144 | return 145 | if (count($edited) le 1) then $edited else 146 | concat('(', string-join($edited, ', '), ')') 147 | return 148 | concat('`', $pname, '` ', $useOp, ' ', $useTvalue) 149 | default return 150 | error(QName($tt:URI_ERROR, 'INVALID_PFILTER'), concat('Unexpected element, local name: ', local-name($pfn))) 151 | }; 152 | 153 | -------------------------------------------------------------------------------- /bin/builder_extensions.xqm: -------------------------------------------------------------------------------- 1 | (: builder_extensions.xqm - builds a topic tool 2 | : 3 | : @version 20140628-1 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace f="http://www.ttools.org/ttools/xquery-functions"; 8 | 9 | import module namespace tt="http://www.ttools.org/xquery-functions" at 10 | "tt/_constants.xqm", 11 | "tt/_request.xqm", 12 | "tt/_request_setters.xqm", 13 | "tt/_reportAssistent.xqm", 14 | "tt/_nameFilter.xqm"; 15 | 16 | import module namespace i="http://www.ttools.org/ttools/xquery-functions" at 17 | "util.xqm"; 18 | 19 | declare namespace z="http://www.ttools.org/ttools/structure"; 20 | declare namespace soap="http://schemas.xmlsoap.org/soap/envelope/"; 21 | 22 | (:~ 23 | : Generates the source code of the types module. 24 | :) 25 | declare function f:makeExtensionsModule($toolScheme as element(), $toolNamespace as element()) 26 | as xs:string { 27 | let $ttname := $toolScheme/@name/string(.) 28 | let $mods := distinct-values($toolScheme//(type, facet)/@mod[not(starts-with(., '_'))]) 29 | let $modules := 30 | if (empty($mods)) then ' ' else 31 | concat( 32 | string-join( 33 | for $m in $mods 34 | order by $m return concat('"../', $m, '"') 35 | , ', '), 36 | '; ') 37 | 38 | let $types := 39 | for $t in distinct-values($toolScheme//type/@name) 40 | order by lower-case($t) return $t 41 | let $facets := 42 | for $f in distinct-values($toolScheme//facet/@name) 43 | order by lower-case($f) return $f 44 | 45 | let $itemTypeMappings := 46 | for $t in $toolScheme//type/@itemType return 47 | let $text := 48 | (:~ 49 | : _extensions.xqm - generated functions invoking application specific extensions. 50 | : 51 | : @version 20140402-1 first version 52 | : =================================================================================== 53 | :) 54 | 55 | module namespace m="http://www.ttools.org/xquery-functions"; 56 | 57 | {if (not(normalize-space($modules))) then () else 58 | import module namespace app="{$toolNamespace/@func/string()}" at 59 | {$modules} 60 | /string()} 61 | declare namespace z="http://www.ttools.org/structure"; 62 | 63 | declare variable $m:NON_STANDARD_TYPES := '{$types}'; 64 | 65 | (:~ 66 | : Parses a request string into a data type item. The function delegates the 67 | : parsing to the appropriate function identified by pseudo annotations. 68 | : 69 | : @param paramName the parameter name 70 | : @param itemType the item type 71 | : @param itemText a string providing a single parameter item 72 | : @return the parsed item, or an z:errors element 73 | :) 74 | declare function m:parseNonStandardItemType($paramName as xs:string, $itemType as xs:string, $itemText as xs:string) 75 | as item()+ {{ 76 | { 77 | if (empty($toolScheme//type)) then 81 | };]]>/string() 82 | else 83 | let $result := 84 | {for $type at $pos in $toolScheme//type 85 | let $name := $type/@name/string() 86 | let $func := $type/@func/string() 87 | let $if := concat('else '[$pos ne 1], 'if') 88 | return 89 | {' '}{$if} ($itemType eq '{$name}') then 90 | let $value := app:{$func}($itemText) return 91 | if ($value instance of xs:anyAtomicType+) then $value 92 | else if (not($value/descendant-or-self::z:error)) then $value 93 | else 94 | let $parserMsg := string-join($value/descendant-or-self::z:error/@msg, '; ') 95 | let $msg := concat("Parameter '", $paramName, "': ", lower-case(substring($parserMsg, 1, 1)), substring($parserMsg, 2)) 96 | return 97 | <z:error type="PARAMETER_TYPE_ERROR" paramName="{{$paramName}}" 98 | itemType="{{$itemType}}" itemValue="{{$itemText}}" msg="{{$msg}}"/> 99 | 100 | } 101 | else 102 | <z:error type="SYSTEM_ERROR_UNKNOWN_ITEMTYPE" paramName="{{$paramName}}" itemType="{{$itemType}}" 103 | itemValue="{{$itemText}}" 104 | msg="{{concat('Parameter ''', $paramName, ''' has unknown item type: ', $itemType, 105 | '; this error would not occur if the tool scheme validation worked correctly')}}"/> 106 | return 107 | if ($result instance of element(z:error)) then <z:errors>{{$result}}</z:errors> 108 | else $result 109 | }}; 110 | 111 | } 112 | 113 | (:~ 114 | : Non-standard types resulting in atomic item types require a mapping of the 115 | : non-standard item type name to the atomic item type name in order to enable 116 | : correct delivery from the param element. The atomic item type name is 117 | : retrieved from the @itemType attribute on the type annotations' 118 | : <type> element. 119 | : 120 | : @param itemType the item type name as communicated to the user 121 | : @return the item type of delivered value items 122 | :) 123 | declare function m:adaptItemTypeOfNonStandardItemType($itemType as xs:string) 124 | as xs:string {{ 125 | {if (not($itemTypeMappings)) then ' $itemType' else 126 | string-join(( 127 | for $mapping at $pos in $itemTypeMappings 128 | let $else := if ($pos eq 1) then () else 'else ' 129 | return 130 | concat(' ', $else, 'if ($itemType eq "', $mapping/@from, '") then "', $mapping/@to, '"') 131 | , 132 | ' else $itemType'), 133 | ' ') 134 | } 135 | }}; 136 | 137 | declare function m:checkNonStandardFacets($itemText as xs:string, $typedItem as item()+, $paramConfig as element()?) 138 | as element()* {{ 139 | let $itemType := $paramConfig/@itemType 140 | let $name := $paramConfig/@name 141 | let $errors := ( 142 | {string-join( 143 | for $facet at $pos in $toolScheme//facet 144 | let $name := $facet/@name/string() 145 | let $func := $facet/@func/string() 146 | return 147 | (: *** check @{$name} :) 148 | if (not($paramConfig/@fct_{$name})) then () else 149 | let $facetValue := $paramConfig/@fct_{$name}/string() 150 | let $check := app:{$func}($typedItem, $facetValue) 151 | return 152 | if ($check) then () else 153 | <z:error type="PARAMETER_FACET_ERROR" paramName="{{$name}}" itemType="{{$itemType}}" 154 | itemValue="{{$itemText}}" facet="maxTodayPlus" facetValue="{{$facetValue}}" 155 | msg="{{concat('Parameter ''', $name, ''': item value (', $typedItem, ') not facet-valid; ', 156 | 'facet={$name}, facetValue=', $paramConfig/@fct_{$name})}}"/> 157 | , 158 | /replace(., '^ ', '') 159 | , '')} 160 | () 161 | ) 162 | return 163 | $errors 164 | }}; 165 | 166 | return replace($text, '^\s+', '') 167 | }; -------------------------------------------------------------------------------- /bin/tt/_reportAssistent.xqm: -------------------------------------------------------------------------------- 1 | (: reportAssistent.xqm - provides report utilities 2 | : 3 | : @version 20130926-1 first version 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace m="http://www.ttools.org/xquery-functions"; 8 | 9 | import module namespace i="http://www.ttools.org/xquery-functions" at 10 | "_request.xqm", 11 | "_constants.xqm", 12 | "_request_getters.xqm"; 13 | 14 | declare namespace z="http://www.ttools.org/structure"; 15 | 16 | (:~ 17 | : Returns standard items to be added to a report. These are a timestamp and 18 | : an optional repetition of the request element. 19 | : 20 | : @param request the request string 21 | : @return the standard items 22 | :) 23 | declare function m:getStandardItems($request as element()) 24 | as node()* { 25 | attribute t {current-dateTime()}, 26 | if (not(i:getParam($request, 'echo'))) then () else 27 | {$request} 28 | }; 29 | 30 | declare function m:finalEdit($report as element()?) 31 | as element()? { 32 | if (not($report)) then () else m:prettyPrint($report) 33 | }; 34 | 35 | declare function m:_padRight($s as xs:string?, $width as xs:integer) 36 | as xs:string? { 37 | substring(concat($s, string-join(for $i in 1 to $width return ' ', '')), 1, $width) 38 | }; 39 | 40 | declare function m:_foldText($text as xs:string?, $width as xs:integer, $initialCol as xs:integer, $indent as xs:integer) 41 | as xs:string? { 42 | if (not($text)) then () else 43 | 44 | let $sep := concat(' ', string-join(for $i in 1 to $indent return ' ', '')) 45 | let $len1 := $width - $initialCol 46 | let $len := string-length($text) 47 | return 48 | if ($len le $len1) then $text else 49 | 50 | let $lineRaw := substring($text, 1, $len1) 51 | let $line := replace($lineRaw, '^(.*\s).*', '$1') 52 | 53 | let $next := concat(replace(substring($lineRaw, 1 + string-length($line)), '^\s+', ''), substring($text, 1 + string-length($lineRaw))) 54 | return 55 | string-join(($line, m:_foldText($next, $width, $initialCol, $indent)), $sep) 56 | }; 57 | 58 | (: 59 | : Creates a copy of the input node with all element namespaces 60 | : removed. 61 | : 62 | : @param n the node to be transformed 63 | : @return a copy with element namespaces removed 64 | :) 65 | declare function m:rmElemNamespaces($n as node()) 66 | as node() { 67 | typeswitch($n) 68 | case document-node() return 69 | document {for $c in $n/node() return m:rmElemNamespaces($c)} 70 | case element() return 71 | element {local-name($n)} { 72 | for $a in $n/@* return m:rmElemNamespaces($a), 73 | for $c in $n/node() return m:rmElemNamespaces($c) 74 | } 75 | default return $n 76 | }; 77 | 78 | declare function m:prettyPrint($n as node()) 79 | as node()? { 80 | typeswitch($n) 81 | case document-node() return 82 | for $c in $n/node() return document {m:prettyPrint($c)} 83 | case element() return 84 | let $elem := 85 | element {node-name($n)} { 86 | for $a in $n/@* return m:prettyPrint($a), 87 | for $c in $n/node() return m:prettyPrint($c) 88 | } 89 | return 90 | if ($n/parent::*) then $elem 91 | else <_ xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">{$elem}/* 92 | 93 | case text() return 94 | if ($n/../* and not(matches($n, '\S'))) then () else $n 95 | default return $n 96 | }; 97 | 98 | (:~ 99 | : Checks if all items of an item sequence are castable to a given type. 100 | : 101 | : @param items the items to be checked 102 | : $type the type against which to check 103 | : @return true if all items are castable to $type 104 | :) 105 | declare function m:itemsCastable($items as item()*, $type as xs:string) 106 | as xs:boolean { 107 | every $item in $items satisfies 108 | if ($type eq 'xs:string') then true() 109 | else if ($type eq 'xs:normalizedString') then $item castable as xs:normalizedString 110 | else if ($type eq 'xs:token') then $item castable as xs:token 111 | else if ($type eq 'xs:language') then $item castable as xs:language 112 | else if ($type eq 'xs:NMTOKEN') then $item castable as xs:NMTOKEN 113 | else if ($type eq 'xs:Name') then $item castable as xs:Name 114 | else if ($type eq 'xs:NCName') then $item castable as xs:NCName 115 | else if ($type eq 'xs:ID') then $item castable as xs:ID 116 | else if ($type eq 'xs:IDREF') then $item castable as xs:IDREF 117 | else if ($type eq 'xs:dateTime') then $item castable as xs:dateTime 118 | else if ($type eq 'xs:date') then $item castable as xs:date 119 | else if ($type eq 'xs:time') then $item castable as xs:time 120 | else if ($type eq 'xs:duration') then $item castable as xs:duration 121 | else if ($type eq 'xs:yearMonthDuration') then $item castable as xs:yearMonthDuration 122 | else if ($type eq 'xs:dayTimeDuration') then $item castable as xs:dayTimeDuration 123 | else if ($type eq 'xs:float') then $item castable as xs:float 124 | else if ($type eq 'xs:double') then $item castable as xs:double 125 | else if ($type eq 'xs:decimal') then $item castable as xs:decimal 126 | else if ($type eq 'xs:integer') then $item castable as xs:integer 127 | else if ($type eq 'xs:nonPositiveInteger') then $item castable as xs:nonPositiveInteger 128 | else if ($type eq 'xs:negativeInteger') then $item castable as xs:negativeInteger 129 | else if ($type eq 'xs:long') then $item castable as xs:long 130 | else if ($type eq 'xs:int') then $item castable as xs:int 131 | else if ($type eq 'xs:short') then $item castable as xs:short 132 | else if ($type eq 'xs:byte') then $item castable as xs:byte 133 | else if ($type eq 'xs:nonNegativeInteger') then $item castable as xs:nonNegativeInteger 134 | else if ($type eq 'xs:unsignedLong') then $item castable as xs:unsignedLong 135 | else if ($type eq 'xs:unsignedInt') then $item castable as xs:unsignedInt 136 | else if ($type eq 'xs:unsignedShort') then $item castable as xs:unsignedShort 137 | else if ($type eq 'xs:unsignedByte') then $item castable as xs:unsignedByte 138 | else if ($type eq 'xs:positiveInteger') then $item castable as xs:positiveInteger 139 | else if ($type eq 'xs:gYearMonth') then $item castable as xs:gYearMonth 140 | else if ($type eq 'xs:gYear') then $item castable as xs:gYear 141 | else if ($type eq 'xs:gMonthDay') then $item castable as xs:gMonthDay 142 | else if ($type eq 'xs:gDay') then $item castable as xs:gDay 143 | else if ($type eq 'xs:gMonth') then $item castable as xs:gMonth 144 | else if ($type eq 'xs:boolean') then $item castable as xs:boolean 145 | else if ($type eq 'xs:base64Binary') then $item castable as xs:base64Binary 146 | else if ($type eq 'xs:hexBinary') then $item castable as xs:hexBinary 147 | else if ($type eq 'xs:anyURI') then $item castable as xs:anyURI 148 | 149 | else if ($type eq 'directory') then true() 150 | else if ($type eq 'docURI') then true() 151 | else 152 | false() 153 | }; 154 | 155 | 156 | -------------------------------------------------------------------------------- /bin/prototypeWriter.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | : ============================================================================ 3 | : prototypeWrite.xqm - functions for creating a module prototype 4 | : 5 | : @version 20150126-1 6 | : ============================================================================ 7 | :) 8 | 9 | (: 10 | :***************************************************************************** 11 | : 12 | : i n t e r f a c e 13 | : 14 | :***************************************************************************** 15 | :) 16 | 17 | (:~@operations 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | :) 28 | 29 | module namespace f="http://www.ttools.org/ttools/xquery-functions"; 30 | import module namespace tt="http://www.ttools.org/xquery-functions" at 31 | "tt/_constants.xqm", 32 | "tt/_request.xqm", 33 | "tt/_reportAssistent.xqm", 34 | "tt/_nameFilter.xqm"; 35 | 36 | import module namespace i="http://www.ttools.org/ttools/xquery-functions" at 37 | "ttoolsConstants.xqm", 38 | "util.xqm"; 39 | 40 | declare namespace z="http://www.ttools.org/ttools/structure"; 41 | declare namespace soap="http://schemas.xmlsoap.org/soap/envelope/"; 42 | 43 | (:~ 44 | : Installs or updates a topic tool application. 45 | : 46 | : @param request the operation request 47 | : @return no return value, side effect is the installation / an update 48 | : of the topic tool application. 49 | :) 50 | declare function f:addModule($request as element()) 51 | as node()* { 52 | let $dir as xs:string := tt:getParam($request, 'dir') 53 | let $useDir := resolve-uri($dir, static-base-uri()) 54 | let $mod as xs:NCName := tt:getParam($request, 'mod') 55 | let $useMod := concat($useDir, '/', $mod) 56 | return 57 | (: check that module does not already exist :) 58 | if (file:exists($useMod)) then 59 | 61 | 62 | else 63 | 64 | let $name as xs:NCName := 65 | let $nameParam as xs:NCName? := tt:getParam($request, 'name') 66 | return i:getToolName($dir, $nameParam) 67 | let $settings := i:getToolSettings($dir, $name) 68 | let $flavor as xs:string := trace( i:getToolFlavor($request, $settings) , 'FLAVOR: ') 69 | let $namespace as element(namespace) := i:getToolNamespace($request, $name, $settings) 70 | let $features as xs:string* := f:featuresFromFlavor($flavor) 71 | 72 | 73 | 74 | let $ops as xs:string+ := tt:getParam($request, 'ops') 75 | let $moduleText := f:writeModule($name, $namespace, $mod, $ops, $features) 76 | 77 | let $ttoolsUri := replace(replace(static-base-uri(), '^file:/+(.:)?', ''), '^(.*)/.*', '$1/ttools.xq') 78 | let $moduleFname := concat($mod, '.xqm') 79 | let $toolUri as xs:string := 80 | let $raw := concat($dir, $name, '.xq') 81 | return 82 | replace(replace(replace($raw, '^file:/+', ''), '^.:', ''), '\\', '/') 83 | let $dirInfo := replace(replace(replace(replace($dir, '^file:/+', ''), '^.:', ''), '\\', '/'), '/$', '') 84 | 85 | return ( 86 | f:deploy($dir, $mod, $moduleText), 87 | 88 | let $requestBuild := tt:setParam((), 'dir', $dir, 'directory') 89 | let $requestBuild:= tt:setParam($requestBuild, 'name', $name, 'xs:NCName') 90 | let $requestBuild:= tt:setParam($requestBuild, 'upgrade', 'false', 'xs:boolean') 91 | return 92 | f:build($requestBuild) 93 | , 94 | <_> 95 | =============================================================== 96 | XQuery module created: {$moduleFname} 97 | Operations: {$ops} 98 | 99 | Directory: {$dirInfo} 100 | Topic tool: {$name} 101 | 102 | The new operations are available. Example: 103 | 104 | basex -b "request={$ops[1]}?doc=doc1.xml doc2.xml doc3.xml" {$toolUri} 105 | 106 | To implement them, edit these functions: {$ops} 107 | =============================================================== 108 | /text() 109 | ) 110 | }; 111 | 112 | (:~ 113 | : Writes the prototype of an application module. 114 | :) 115 | declare function f:writeModule($ttname as xs:string, 116 | $namespace as element(namespace), 117 | $moduleName as xs:string, 118 | $ops as xs:string+, 119 | $features as xs:string*) 120 | as xs:string { 121 | let $rawText := 122 | 123 | 124 | (: 125 | : ------------------------------------------------------------------------- 126 | : 127 | : {$moduleName}.xqm - Document me! 128 | : 129 | : ------------------------------------------------------------------------- 130 | :) 131 | 132 | (:~@operations 133 | <operations>{ 134 | for $op in $ops return 135 | 136 | <operation name="{$op}" type="node()" func="{$op}"> 137 | <param name="doc" type="docURI*" sep="WS" pgroup="input"/> 138 | (:#file#:) 139 | <param name="docs" type="docDFD*" sep="SC" pgroup="input"/> 140 | <param name="dox" type="docFOX*" sep="SC" pgroup="input"/> 141 | (:##:) 142 | <param name="dcat" type="docCAT*" sep="WS" pgroup="input"/> 143 | <param name="fdocs" type="docSEARCH*" sep="SC" pgroup="input"/> 144 | <pgroup name="input" minOccurs="1"/> 145 | </operation> 146 | /replace(., '\s+$', '', 's') } 147 | </operations> 148 | :) 149 | 150 | module namespace f="{$namespace/@func/string()}"; 151 | import module namespace tt="http://www.ttools.org/xquery-functions" at 152 | "tt/_request.xqm", 153 | "tt/_reportAssistent.xqm", 154 | "tt/_errorAssistent.xqm", 155 | "tt/_log.xqm", 156 | "tt/_nameFilter.xqm", 157 | "tt/_pcollection.xqm"; 158 | 159 | declare namespace z="{$namespace/@struct/string()}"; 160 | { 161 | for $op in $ops return 162 | 163 | (:~ 164 | : Document me! 165 | : 166 | : @param request the operation request 167 | : @return a report describing ... 168 | :) 169 | declare function f:{$op}($request as element()) 170 | as element() {{ 171 | (:#file#:) 172 | let $docs := tt:getParams($request, 'doc docs dox dcat fdocs') 173 | (:#file-#:) 174 | let $docs := tt:getParams($request, 'doc dcat fdocs') 175 | (:##:) 176 | return 177 | <z:{$op} countDocs="{{count($docs)}}">{{ 178 | () 179 | }}</z:{$op}> 180 | }}; 181 | /string() 182 | } 183 | 184 | /replace(., '^\s+', '', 's') 185 | 186 | return 187 | f:filterTextByFeatures($rawText, $features) 188 | }; 189 | 190 | (:~ 191 | : Deploys the topic tool and its extensions module. 192 | :) 193 | declare function f:deploy($dir as xs:string, 194 | $moduleName as xs:string, 195 | $moduleText as xs:string) 196 | as element(z:error)? { 197 | 198 | let $useDir := trace( replace(replace(resolve-uri($dir, static-base-uri()), '\\', '/'), '([^/])$', '$1/') , 'USEDIR: ') 199 | let $moduleURI := string-join(($useDir, concat($moduleName, '.xqm')), '') 200 | return 201 | if (file:exists($moduleURI)) then 202 | 206 | else 207 | file:write($moduleURI, $moduleText, $i:serParamsText) 208 | }; 209 | -------------------------------------------------------------------------------- /bin/toolSchemeParser.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : toolSchemeParser.xqm - parses a directory and constructs a tool scheme 3 | : 4 | : @version 20150211-1 5 | : 6 | : ############################################################################ 7 | :) 8 | 9 | module namespace f="http://www.ttools.org/ttools/xquery-functions"; 10 | 11 | import module namespace tt="http://www.ttools.org/xquery-functions" at 12 | "tt/_constants.xqm", 13 | "tt/_reportAssistent.xqm", 14 | "tt/_nameFilter.xqm"; 15 | 16 | import module namespace i="http://www.ttools.org/ttools/xquery-functions" at 17 | "builder_main.xqm", 18 | "builder_extensions.xqm", 19 | "ttoolsConstants.xqm", 20 | "toolSchemeValidator.xqm", 21 | "util.xqm"; 22 | 23 | declare namespace z="http://www.ttools.org/ttools/structure"; 24 | declare namespace ztt="http://www.ttools.org/structure"; 25 | 26 | (:~ 27 | : Parses a tool directory and generates the tool scheme, assembling and augmenting 28 | : the contents of module annotations. 29 | : 30 | : @param dir the directory in which to build/install the topic tool 31 | : @param ttname the topic tool name 32 | : @param features the features of the current tool flavor 33 | : @return the extensions model 34 | :) 35 | declare function f:getToolScheme($dir as xs:string, $ttname as xs:string, $features as xs:string*) 36 | as item()* { 37 | let $helpOperation := 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | let $fileNames := '^.*.xqm?$' 46 | let $useDir := 47 | let $staticBaseUri := tt:static-base-uri() 48 | let $value := resolve-uri($dir, $staticBaseUri) 49 | let $value := replace($value, '/$', '') 50 | return replace($value, '\\', '/') 51 | let $useDirTt := string-join(($useDir, $i:cfg/ttSubDir), '/') 52 | let $files := 53 | file:list($useDir, true(), '*')[matches(., $fileNames)] ! replace(., '\\', '/') 54 | let $annotations := 55 | for $file in $files 56 | let $uri := string-join(($useDir, $file), '/') 57 | let $text := tt:unparsed-text($uri) 58 | let $ns := f:getModuleNamespace($text) 59 | 60 | (: collect annotations :) 61 | let $operationsElems := f:getAnnotations($text, 'operations') 62 | let $operationElems := f:getAnnotations($text, 'operation') 63 | let $typesElems := f:getAnnotations($text, 'types') 64 | let $typeElems := f:getAnnotations($text, 'type') 65 | let $facetsElems := f:getAnnotations($text, 'facets') 66 | let $facetElems := f:getAnnotations($text, 'facet') 67 | return ( 68 | {$operationsElems}, 69 | {$operationElems}, 70 | {$typesElems}, 71 | {$typeElems}, 72 | {$facetsElems}, 73 | {$facetElems} 74 | ) 75 | let $annotationItems := 76 | for $ai in $annotations/* 77 | let $mod := $ai/root()/@mod/string() 78 | let $ns := $ai/root()/@namespace/string() 79 | let $kind := $ai/parent::*/local-name() 80 | let $childElems := 81 | if ($kind eq 'operations') then 'operation' 82 | else if ($kind eq 'types') then 'type' 83 | else if ($kind eq 'facets') then 'facet' 84 | else () 85 | return 86 | if ($ai/self::_unparsed) then 87 | tt:createError('ANNOTATION_ERROR', 'Invalid annotation - not well-formed XML', 88 | <_ module="{$mod}"/>) 89 | else if (not(local-name($ai) eq $kind)) then 90 | tt:createError('ANNOTATION_ERROR', concat('@', $kind, ' annotation must be ''', 91 | $kind, ''' element, but found ''', local-name($ai), ''''), 92 | <_ module="{$mod}"/>) 93 | else if ($childElems and empty($ai/*)) then 94 | tt:createError('ANNOTATION_ERROR', concat('@', $kind, ' annotation must be ''', 95 | $kind, ''' element with ''', $childElems, ''' child elements, ', 96 | 'but the element is empty'), 97 | <_ module="{$mod}"/>) 98 | else if ($childElems and exists($ai/*[local-name(.) ne $childElems])) then 99 | let $invalidChildren := $ai/*[local-name(.) ne $childElems] 100 | return 101 | tt:createError('ANNOTATION_ERROR', concat('@', $kind, ' annotation must be ''', 102 | $kind, ''' element with ''', $childElems, ''' child elements, but the element ', 103 | 'contains non-', $childElems, ' children (', string-join( 104 | $invalidChildren/local-name(.), ', '), ')'), 105 | <_ module="{$mod}"/>) 106 | else if ($childElems) then 107 | for $child in $ai/* return 108 | element {node-name($child)} { 109 | $child/@*, 110 | attribute mod {$mod}, 111 | attribute namespace {$ns}, 112 | $child/node() 113 | } 114 | else 115 | element {node-name($ai)} { 116 | $ai/@*, 117 | attribute mod {$mod}, 118 | attribute namespace {$ns}, 119 | $ai/node() 120 | } 121 | let $errors := $annotationItems/self::ztt:error 122 | return 123 | if ($errors) then tt:wrapErrors($errors) 124 | else 125 | let $scheme := 126 | { 127 | { 128 | $annotationItems/self::operation, 129 | $helpOperation 130 | }, 131 | { 132 | $annotationItems/self::type 133 | }, 134 | { 135 | $annotationItems/self::facet 136 | } 137 | } 138 | let $errors := i:validateToolScheme($scheme, $features) 139 | return 140 | if ($errors) then tt:wrapErrors($errors) 141 | else 142 | f:pretty($scheme) 143 | }; 144 | 145 | (:~ 146 | : Extracts the annotations from a module 147 | : 148 | : @param text the module text 149 | : @param annoName the name of the annotations to be extracted 150 | : @return the extracted annotation contents (XML elements) 151 | :) 152 | declare function f:getAnnotations($text as xs:string, $annoName as xs:string) 153 | as element()* { 154 | let $annoText := 155 | replace($text, concat('^(.*? \s*)\(:~@', $annoName, '\s(.*?):\).*'), '$2', 's') 156 | [. ne $text] 157 | return 158 | if (not($annoText)) then () else 159 | let $tail := replace($text, concat('^(.*? \s*)\(:~@', $annoName, '\s(.*?):\)(.*)'), '$3', 's') 160 | (: let $annoTextCore := replace(replace($annoText, '\{', '{{'), '\}', '}}') :) 161 | return ( 162 | try {parse-xml($annoText)/*} catch * {<_unparsed>{$annoText}} 163 | , 164 | f:getAnnotations($tail, $annoName) 165 | ) 166 | }; 167 | 168 | (:~ 169 | : Extracts from the text of a library module the module namespace. 170 | : 171 | : @param text the module text 172 | : @return the module namespace 173 | :) 174 | declare function f:getModuleNamespace($text as xs:string) 175 | as xs:string { 176 | let $noctext := f:removeModuleComments($text) 177 | let $ns := replace($noctext, '.*?module\s+namespace\s+\S+\s*=\s*(''|")(.*?)\1.*', '$2', 's') 178 | return $ns 179 | }; 180 | 181 | (:~ 182 | : Removes comments from an XQuery code text. 183 | : 184 | : @param text XQuery code 185 | : @return the code with all comments removed 186 | :) 187 | declare function f:removeModuleComments($text as xs:string) 188 | as xs:string { 189 | $text 190 | }; 191 | 192 | -------------------------------------------------------------------------------- /bin/tt/_help.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | : _help - topic tool help 3 | : 4 | : @version 2014-02-08T22:22:35+01:00 5 | :) 6 | module namespace m="http://www.ttools.org/xquery-functions"; 7 | declare namespace z="http://www.ttools.org/structure"; 8 | 9 | import module namespace tt="http://www.ttools.org/xquery-functions" at 10 | "_nameFilter.xqm", 11 | "_request.xqm", 12 | "_stringTools.xqm"; 13 | 14 | (: 15 | : ============================================================================ 16 | : 17 | : p u b l i c f u n c t i o n s 18 | : 19 | : ============================================================================ 20 | :) 21 | 22 | (: 23 | : ============================================================================ 24 | : 25 | : p r i v a t e f u n c t i o n s 26 | : 27 | : ============================================================================ 28 | :) 29 | 30 | declare function m:_help($request as element(), 31 | $toolScheme as element()) 32 | as item() { 33 | let $mode as xs:string := tt:getParam($request, 'mode') 34 | return 35 | if ($mode eq 'overview') then m:_helpOverview($request, $toolScheme) 36 | else if ($mode eq 'scheme') then m:_helpScheme($request, $toolScheme) 37 | else m:_helpOverview($request, $toolScheme) 38 | }; 39 | 40 | (:~ 41 | : Returns a view of the tool scheme (complete or filtered, according 42 | : to request parameters. 43 | :) 44 | declare function m:_helpScheme($request as element(), 45 | $toolScheme as element()) 46 | as element() { 47 | let $nf as element(nameFilter)? := tt:getParam($request, 'ops') 48 | let $ops := $toolScheme/operations/operation 49 | [not($nf) or tt:matchesNameFilter(@name, $nf)] 50 | return 51 | element {node-name($toolScheme)} { 52 | $toolScheme/@*, 53 | $ops 54 | } 55 | }; 56 | 57 | (:~ 58 | : Returns an overview of the topic tool operations. 59 | :) 60 | declare function m:_helpOverview($request as element(), 61 | $toolScheme as element()) 62 | as element() { 63 | let $default as xs:boolean := tt:getParam($request, 'default') 64 | let $type as xs:boolean := tt:getParam($request, 'type') 65 | let $nf as element(nameFilter)? := tt:getParam($request, 'ops') 66 | let $fill := ' ' 67 | let $ops := 68 | for $op in $toolScheme//operation[not($nf) or m:matchesNameFilter(@name, $nf)] 69 | order by $op/@name/lower-case(.) 70 | return $op 71 | let $opsCount := count($ops) 72 | let $opColWidth := 2 + max((10, $ops/@name/string-length(.))) 73 | let $opColBlanks := string-join(for $i in 1 to (1 + $opColWidth) return ' ', '') 74 | 75 | let $oplines := 76 | for $op at $pos in $ops 77 | let $name := $op/@name 78 | let $paramsInfo := 79 | for $p in $op/param 80 | let $itemTypeCardMinMax := m:_getParamItemTypeCardMinMax($p/@type) 81 | let $facets := 82 | let $items := 83 | $p/@*[starts-with(local-name(.), 'fct_')]/concat(replace(local-name(.), '^fct_', ''), '=', .) 84 | return 85 | if (empty($items)) then () else 86 | attribute facets {concat('facets: ', string-join($items, '; '))} 87 | let $sep := 88 | if ($p/@sep) then $p/@sep 89 | else if ($itemTypeCardMinMax[4] lt 0 or $itemTypeCardMinMax[4] gt 1) then attribute sep {'WS'} 90 | else () 91 | order by lower-case($p/@name) 92 | return 93 | { 98 | $sep, 99 | $facets, 100 | $p/@default 101 | } 102 | 103 | let $footnotes := 104 | if (not($op/pgroup)) then () else string-join( 105 | for $g in $op/pgroup 106 | let $gname := $g/@name 107 | let $memberNames := 108 | string-join( 109 | for $p in $op/param[@pgroup eq $gname] 110 | let $name := $p/@name 111 | order by lower-case($name) 112 | return $name 113 | , ', ') 114 | return 115 | if ($g/@minOccurs/xs:integer(.) eq $g/@maxOccurs/xs:integer(.)) then 116 | concat('Exactly ', $g/@minOccurs, ' of these parameters must be set: ', $memberNames) 117 | else ( 118 | if (not($g/@minOccurs)) then () else 119 | concat('At least ', $g/@minOccurs, ' of these parameters must be set: ', $memberNames), 120 | if (not($g/@maxOccurs)) then () else 121 | concat('At most ', $g/@maxOccurs, ' of these parameters must be set: ', $memberNames) 122 | ) 123 | , ' ') 124 | 125 | let $params := 126 | if (not($type)) then 127 | string-join($paramsInfo/concat(@name, @card, @default[$default]/concat('=', .)), ', ') 128 | else 129 | let $paramDescriptors := 130 | for $p in $paramsInfo 131 | let $sep := $p/@sep/concat(' (sep=', ., ')') 132 | return 133 | concat( 134 | tt:padRight($p/concat(@name, @default[$default]/concat('=', .)), 20, '.'), ' : ', 135 | $p/@type, $sep, $p/@facets/concat('; ', .)) 136 | 137 | let $lineSep := concat(' ', $opColBlanks) 138 | return 139 | concat( 140 | string-join(( 141 | $paramDescriptors, 142 | if (empty($footnotes)) then () else concat(' ', $footnotes)) 143 | , $lineSep), 144 | if ($pos eq $opsCount) then () else ' ' 145 | ) 146 | 147 | (: 148 | concat( 149 | string-join(($paramsInfo/concat( 150 | m:rpad(concat(@name, @default[$default]/concat('=', .)), 20, '.'), ' : ', @type, @facets/concat('; ', .)), 151 | if (empty($footnotes)) then () else concat(' ', $footnotes)), 152 | concat(' ', $opColBlanks)), 153 | if ($pos eq $opsCount) then () else ' ' 154 | ) 155 | :) 156 | return 157 | concat(tt:padRight($name, $opColWidth, $fill), ' ', $params) 158 | let $sepLine := 159 | string-join( 160 | for $i in 1 to max(for $o in $oplines, $l in tokenize($o, ' ') return string-length($l)) return '=' 161 | , '') 162 | let $headlines := ( 163 | '', 164 | concat('TOOL: ', $toolScheme/@name), 165 | '', 166 | concat(tt:padRight('OPERATIONS', $opColWidth, $fill), ' PARAMS'), 167 | $sepLine 168 | ) 169 | let $footlines := ($sepLine, '', '') 170 | 171 | let $text := string-join(('',$headlines, $oplines, $footlines), ' ') 172 | return 173 | { 174 | $text 175 | } 176 | }; 177 | 178 | (:~ 179 | : Returns for a given type descriptor four items, providing the 180 | : item type, the cardinality descriptor, the minOccurs value and 181 | : the maxOccurs value. Note that 'unbounded' is represented by 182 | : -1. 183 | :) 184 | declare function m:_getParamItemTypeCardMinMax($type as xs:string?) 185 | as item()+ { 186 | if (not($type)) then ("", "", "", "") else 187 | 188 | let $itemType := replace($type, '^([\i\c()]+).*', '$1') 189 | let $card := substring-after($type, $itemType) 190 | let $minMax := 191 | if ($card eq '?') then (0, 1) 192 | else if (not($card)) then (1, 1) 193 | else if ($card eq '*') then (0, -1) 194 | else if ($card eq '+') then (1, -1) 195 | else 196 | let $cardItems := tokenize(replace($card, '[{}]', ''), '\s*,\s*')[position() le 2] 197 | return 198 | for $cardItem in $cardItems return xs:integer($cardItem) 199 | return 200 | ($itemType, $card, $minMax) 201 | }; 202 | -------------------------------------------------------------------------------- /bin/tt/_foxpath-uri-operations-github.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | foxpath-uri-operation.xqm - library of functions operating on URIs 3 | 4 | Overview: 5 | 6 | Group: resource properties 7 | uriDomain 8 | fox-is-file 9 | fox-is-dir 10 | fox-file-size 11 | fox-file-date 12 | fox-file-sdate 13 | 14 | Group: resource retrieval 15 | fox-unparsed-text 16 | fox-unparsed-text-lines 17 | 18 | :) 19 | module namespace f="http://www.ttools.org/xquery-functions"; 20 | 21 | import module namespace i="http://www.ttools.org/xquery-functions" 22 | at "_foxpath-processorDependent.xqm"; 23 | 24 | import module namespace util="http://www.ttools.org/xquery-functions/util" 25 | at "_foxpath-util.xqm"; 26 | 27 | 28 | (: 29 | : =============================================================================== 30 | : 31 | : r e s o u r c e p r o p e r t i e s 32 | : 33 | : =============================================================================== 34 | :) 35 | 36 | (: 37 | : =============================================================================== 38 | : 39 | : r e s o u r c e r e t r i e v a l 40 | : 41 | : =============================================================================== 42 | :) 43 | 44 | (:~ 45 | : Returns an XML document identified by a github URI. 46 | : 47 | : @param uri the URI 48 | : @param options options controlling the evaluation 49 | : @return the document, or the empty sequence if retrieval or parsing fails 50 | :) 51 | declare function f:fox-doc_github($uri as xs:string, $options as map(*)?) 52 | as document-node()? { 53 | let $useUri := replace($uri, '^github-', '') 54 | let $binary := f:get-request_github($useUri, $f:TOKEN) 55 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 56 | return 57 | try {parse-xml($text)} catch * {()} 58 | }; 59 | 60 | (:~ 61 | : Returns true if a given github URI points to a well-formed XML document. 62 | : 63 | : @param uri the URI or file path of the resource 64 | : @param options options controlling the evaluation 65 | : @return true if the URI points to a well-formed XML document 66 | :) 67 | declare function f:fox-doc-available_github($uri as xs:string, $options as map(*)?) 68 | as xs:boolean { 69 | let $useUri := replace($uri, '^github-', '') 70 | let $binary := f:get-request_github($useUri, $f:TOKEN) 71 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 72 | return 73 | try { 74 | (: bug? exists(parse-xml($text)) does not work ! :) 75 | let $doc := parse-xml($text) 76 | let $count := count($doc//*) 77 | return 78 | $count > 0 79 | } catch * {false()} 80 | }; 81 | 82 | (:~ 83 | : Returns the string representation of a github resource. 84 | : 85 | : @param uri the URI or file path of the resource 86 | : @param options options controlling the evaluation 87 | : @return the text of the resource, or the empty sequence if retrieval fails 88 | :) 89 | declare function f:fox-unparsed-text_github($uri as xs:string, 90 | $encoding as xs:string?, 91 | $options as map(*)?) 92 | as xs:string? { 93 | let $useUri := replace($uri, '^github-', '') 94 | let $binary := f:get-request_github($useUri, $f:TOKEN) 95 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 96 | return 97 | $text 98 | }; 99 | 100 | (:~ 101 | : Returns the lines of the string representation of a resource identified 102 | : by a github URI. 103 | : 104 | : @param uri the URI or file path of the resource 105 | : @param options options controlling the evaluation 106 | : @return the text lines, or the empty sequence if retrieval fails 107 | :) 108 | declare function f:fox-unparsed-text-lines_github($uri as xs:string, 109 | $encoding as xs:string?, 110 | $options as map(*)?) 111 | as xs:string* { 112 | let $useUri := replace($uri, '^github-', '') 113 | let $binary := f:get-request_github($useUri, $f:TOKEN) 114 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 115 | return 116 | tokenize($text, ' ') 117 | }; 118 | 119 | (:~ 120 | : Returns an XML representation of the JSON record identified by a github URI. 121 | : 122 | : @param uri the URI or file path of the resource 123 | : @param options options controlling the evaluation 124 | : @return an XML document representing JSON data, or the empty sequence if 125 | : retrieval or parsing fails 126 | :) 127 | declare function f:fox-json-doc_github($uri as xs:string, 128 | $options as map(*)?) 129 | as document-node()? { 130 | let $useUri := replace($uri, '^github-', '') 131 | let $binary := f:get-request_github($useUri, $f:TOKEN) 132 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 133 | return 134 | try {json:parse($text)} catch * {()} 135 | }; 136 | 137 | (:~ 138 | : Returns true if a given github URI points to a valid JSON record. 139 | : 140 | : @param uri the URI or file path of the resource 141 | : @param options options controlling the evaluation 142 | : @return true if a JSON record can be retrieved 143 | :) 144 | declare function f:fox-json-doc-available_github($uri as xs:string, 145 | $options as map(*)?) 146 | as xs:boolean { 147 | let $useUri := replace($uri, '^github-', '') 148 | let $binary := f:get-request_github($useUri, $f:TOKEN) 149 | let $text := $binary//content/convert:binary-to-string(xs:base64Binary(.)) 150 | return 151 | try { 152 | json:parse($text) ! exists(.) 153 | } catch * {false()} 154 | }; 155 | 156 | (:~ 157 | : Returns the content of a file as the Base64 representation of its bytes. 158 | : 159 | : @param uri the URI or file path of the resource 160 | : @return the Base64 representation, if available, the empty sequence otherwise 161 | :) 162 | declare function f:fox-binary_github($uri as xs:string, 163 | $options as map(*)?) 164 | as xs:base64Binary? { 165 | let $useUri := replace($uri, '^github-', '') 166 | let $restResponse := f:get-request_github($useUri, $f:TOKEN) 167 | let $binary := $restResponse//content/xs:base64Binary(.) 168 | return 169 | $binary 170 | }; 171 | 172 | 173 | (: 174 | : =============================================================================== 175 | : 176 | : u t i l i t i e s 177 | : 178 | : =============================================================================== 179 | :) 180 | (:~ 181 | : Sends a github API - GET request and returns the response. Returns the response body, 182 | : if there is one, otherwise the response header. 183 | 184 | : @param uri the URI 185 | : @param token if specified, used for authorization 186 | : @return the response 187 | :) 188 | declare function f:get-request_github($uri as xs:string, $token as xs:string?) 189 | as node()* { 190 | if (not($token)) then () else 191 | 192 | let $DUMMY := trace(substring($uri, 1, 80), 'GITHUB RETRIEVAL, URI: ') 193 | let $rq := 194 | { 195 | [$token] 196 | } 197 | let $rs := try {http:send-request($rq)} catch * {trace((), 'EXCEPTION_IN_SEND_REQUEST: ')} 198 | let $rsHeader := $rs[1] 199 | let $body := $rs[position() gt 1] 200 | return 201 | ($body, $rsHeader)[1] 202 | }; 203 | 204 | 205 | (:~ 206 | : Retrieves the text of a resource identified by a github navigation URI. 207 | : 208 | : @param uri the URI 209 | : @param options options controlling the evaluation 210 | : @return the domain 211 | :) 212 | declare function f:fox-navURI-to-text_github($uri as xs:string, 213 | $encoding as xs:string?, 214 | $options as map(*)?) 215 | as xs:string? { 216 | let $redirect := 217 | if (not(f:uriDomain($uri, $options) eq 'REDIRECTING_URI_TREE')) then () 218 | else if (empty($options)) then () 219 | else 220 | for $buri in map:get($options, 'URI_TREES_BASE_URIS')[starts-with($uri, .)] return 221 | $buri/..//file[$uri eq concat($buri, @path)]/@uri 222 | 223 | return 224 | try { 225 | if ($redirect) then 226 | let $response := f:get-request_github($redirect, $f:TOKEN) 227 | return $response//content/convert:binary-to-string(xs:base64Binary(.)) 228 | else () 229 | } catch * {()} 230 | }; 231 | 232 | 233 | -------------------------------------------------------------------------------- /bin/ttools.xq: -------------------------------------------------------------------------------- 1 | (: 2 | : ttools - A tool for creating topic tools 3 | : 4 | : @version 2014-04-07T23:24:01.156+02:00 5 | :) 6 | 7 | import module namespace tt="http://www.ttools.org/xquery-functions" at 8 | "tt/_rcat.xqm", 9 | "tt/_request.xqm", 10 | "tt/_help.xqm"; 11 | 12 | 13 | import module namespace i="http://www.ttools.org/ttools/xquery-functions" at 14 | "example.xqm", 15 | "prototypeWriter.xqm", 16 | "builder.xqm", 17 | "util.xqm"; 18 | 19 | declare namespace m="http://www.ttools.org/ttools/xquery-functions"; 20 | declare namespace z="http://www.ttools.org/ttools/structure"; 21 | declare namespace ztt="http://www.ttools.org/structure"; 22 | 23 | declare variable $request as xs:string external; 24 | 25 | (: Service configuration. 26 | ====================== 27 | :) 28 | declare variable $toolScheme := 29 | 30 | 31 | 32 | 33 | 34 | 35 | doc dcat 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | ; 89 | 90 | declare variable $req as element() := tt:loadRequest($request, $toolScheme); 91 | 92 | (:~ 93 | : Executes operation '_help'. 94 | : 95 | : @param request the request element 96 | : @return the operation result 97 | :) 98 | declare function m:execOperation__help($request as element()) 99 | as node() { 100 | tt:_help($request, $toolScheme) 101 | }; 102 | 103 | 104 | (:~ 105 | : Executes pseudo operation '_storeq'. The request is stored in 106 | : simplified form, in which every parameter is represented by a 107 | : parameter element whose name captures the parameter value 108 | : and whose text content captures the (unitemized) parameter 109 | : value. 110 | : 111 | : @param request the request element 112 | : @return the operation result 113 | :) 114 | declare function m:execOperation__storeq($request as element()) 115 | as node() { 116 | element {node-name($request)} { 117 | attribute crTime {current-dateTime()}, 118 | 119 | for $c in $request/* return 120 | let $value := replace($c/@paramText, '^\s+|\s+$', '', 's') 121 | return 122 | element {node-name($c)} {$value} 123 | } 124 | }; 125 | 126 | 127 | (:~ 128 | : Executes operation 'counts'. 129 | : 130 | : @param request the request element 131 | : @return the operation result 132 | :) 133 | declare function m:execOperation_counts($request as element()) 134 | as node() { 135 | i:getCounts($request) 136 | }; 137 | 138 | (:~ 139 | : Executes operation 'items'. 140 | : 141 | : @param request the request element 142 | : @return the operation result 143 | :) 144 | declare function m:execOperation_items($request as element()) 145 | as node() { 146 | i:getItemReport($request) 147 | }; 148 | 149 | (:~ 150 | : Executes operation 'proto'. 151 | : 152 | : @param request the request element 153 | : @return the operation result 154 | :) 155 | declare function m:execOperation_add($request as element()) 156 | as node()* { 157 | let $result := i:addModule($request) 158 | let $errors := $result/descendant-or-self::*:error 159 | return 160 | if ($errors) then tt:_getErrorReport($errors, ()) else $result 161 | }; 162 | 163 | (:~ 164 | : Executes operation 'new'. 165 | : 166 | : @param request the request element 167 | : @return the operation result 168 | :) 169 | declare function m:execOperation_new($request as element()) 170 | as node() { 171 | let $result := i:new($request) 172 | return 173 | if ($result/self::ztt:errors) then 174 | tt:_getErrorReport($result, 'Annotation errors', 'module', ()) 175 | else $result 176 | }; 177 | 178 | (:~ 179 | : Executes operation 'build'. 180 | : 181 | : @param request the request element 182 | : @return the operation result 183 | :) 184 | declare function m:execOperation_build($request as element()) 185 | as element()? { 186 | let $errors := i:build($request) 187 | return 188 | if ($errors) then tt:_getErrorReport($errors, 'Annotation errors', 'module', ()) else () 189 | }; 190 | 191 | (: 192 | (:~ 193 | : Executes operation 'dcat'. 194 | : 195 | : @param request the request element 196 | : @return the operation result 197 | :) 198 | declare function m:execOperation_dcat($request as element()) 199 | as node() { 200 | tt:getDocumentCat($request) 201 | }; 202 | 203 | (:~ 204 | : Executes operation 'docs'. 205 | : 206 | : @param request the request element 207 | : @return the operation result 208 | :) 209 | declare function m:execOperation_docs($request as element()) 210 | as node() { 211 | tt:getDocuments($request) 212 | }; 213 | :) 214 | 215 | (:~ 216 | : Executes an operation. 217 | : 218 | : @param req the operation request 219 | : @return the result of the operation 220 | :) 221 | declare function m:execOperation($req as element()) 222 | as item()* { 223 | if ($req/self::ztt:errors) then tt:_getErrorReport($req, 'Invalid call', 'code', ()) else 224 | if ($req/@storeq eq 'true') then m:execOperation__storeq($req) else 225 | 226 | let $opName := tt:getOperationName($req) 227 | let $result := 228 | if ($opName eq '_help') then m:execOperation__help($req) 229 | else if ($opName eq 'counts') then m:execOperation_counts($req) 230 | else if ($opName eq 'items') then m:execOperation_items($req) 231 | else if ($opName eq 'add') then m:execOperation_add($req) 232 | else if ($opName eq 'new') then m:execOperation_new($req) 233 | else if ($opName eq 'build') then m:execOperation_build($req) 234 | else 235 | tt:createError('UNKNOWN_OPERATION', concat('No such operation: ', $opName), 236 | ) 237 | let $errors := tt:extractErrors($result) 238 | return 239 | if ($errors) then tt:_getErrorReport($errors, 'System error', 'code', ()) 240 | else $result 241 | }; 242 | 243 | m:execOperation($req) 244 | -------------------------------------------------------------------------------- /bin/builder_main.xqm: -------------------------------------------------------------------------------- 1 | (: builder_main.xqm - generates a topic tool main module 2 | : 3 | : @version 20140628-1 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace f="http://www.ttools.org/ttools/xquery-functions"; 8 | 9 | import module namespace tt="http://www.ttools.org/xquery-functions" at 10 | "tt/_constants.xqm", 11 | "tt/_request.xqm", 12 | "tt/_request_setters.xqm", 13 | "tt/_reportAssistent.xqm", 14 | "tt/_nameFilter.xqm"; 15 | 16 | import module namespace i="http://www.ttools.org/ttools/xquery-functions" at 17 | "builder_extensions.xqm", 18 | "ttoolsConstants.xqm", 19 | "util.xqm"; 20 | 21 | declare namespace z="http://www.ttools.org/ttools/structure"; 22 | 23 | (:~ 24 | : Generates the source code of the topic tool main module. 25 | :) 26 | declare function f:makeMainModule($toolScheme as element(), 27 | $explain as xs:string?, 28 | $namespace as element(namespace)) 29 | as xs:string { 30 | (: file:write('/projects/tt-intro/toolScheme.xml', $toolScheme), :) 31 | let $tsReport := f:evalToolScheme4MainModule($toolScheme) 32 | 33 | let $ttname := $toolScheme/@name/string(.) 34 | let $toolSchemeText := replace(string-join(serialize($toolScheme), ''), ' ', '') 35 | let $toolSchemeText := replace($toolSchemeText, '\{', '{{') 36 | let $toolSchemeText := replace($toolSchemeText, '\}', '}}') 37 | let $ops := $toolScheme//operation 38 | let $op1 := $ops[1] 39 | let $ttPrefix := string-join(($i:cfg/ttSubDir, '_'), '/') 40 | 41 | let $moduleImports := 42 | for $ns in $tsReport//namespace[not(@builtin eq 'true')] 43 | let $mods := $ns/modules/module/@uri 44 | return 45 | concat( 46 | 'import module namespace ', $ns/@prefix, '="', $ns/@uri, '" at', 47 | ' ', 48 | string-join( 49 | for $m in $mods 50 | order by $m return concat('"', $m, '"') 51 | , ', '), 52 | ';') 53 | 54 | let $moduleImportBuiltin := 55 | let $ns := $tsReport//namespace[@builtin eq 'true'] 56 | let $mods := $ns/modules/module/@uri 57 | return 58 | concat( 59 | 'import module namespace ', $ns/@prefix, '="', $ns/@uri, '" at', 60 | ' ', 61 | string-join( 62 | for $m in $mods 63 | order by $m return concat('"', $m, '"') 64 | , ', '), 65 | ';', 66 | ' ', 67 | ' ') 68 | (: 69 | let $modules := 70 | let $mods := distinct-values($toolScheme//@mod[not(starts-with(., $ttPrefix))]) 71 | return 72 | if (empty($mods)) then () else 73 | concat( 74 | string-join( 75 | for $m in $mods 76 | order by $m return concat('"', $m, '"') 77 | , ', '), 78 | ';') 79 | let $modulesBuiltin := 80 | concat( 81 | string-join( 82 | for $m in distinct-values($toolScheme//@mod[starts-with(., $ttPrefix)]) 83 | order by $m return concat('"', $m, '"') 84 | , ', '), 85 | ',') 86 | :) 87 | let $toolText := 88 | (: 89 | : {$ttname} - {$explain} 90 | : 91 | : @version {current-dateTime()} 92 | :) 93 | 94 | {string-join($moduleImportBuiltin, ' ')} 95 | 96 | {string-join($moduleImports, ' ')} 97 | 98 | declare namespace m="{$namespace/@func/string()}"; 99 | declare namespace z="{$namespace/@struct/string()}"; 100 | declare namespace zz="http://www.ttools.org/structure"; 101 | 102 | declare variable $request as xs:string external; 103 | 104 | (: tool scheme 105 | =========== 106 | :) 107 | declare variable $toolScheme := 108 | {$toolSchemeText}; 109 | 110 | declare variable $req as element() := tt:loadRequest($request, $toolScheme); 111 | 112 | 135 | { 136 | for $op in $ops 137 | let $func := ($op/@func, $op/@name)[1]/string() 138 | let $prefix := $tsReport//operations/operation[@name eq $op/@name]/ancestor::namespace/@prefix/string() 139 | let $resultType := ($op/@type/string(), 'node()')[1] 140 | return 141 | (:~ 142 | : Executes operation '{$op/@name/string()}'. 143 | : 144 | : @param request the request element 145 | : @return the operation result 146 | :) 147 | declare function m:execOperation_{$op/@name/string()}($request as element()) 148 | as {$resultType} {{ 149 | {('tt'[$op/@mod/starts-with(., $ttPrefix)], $prefix)[1]}:{$func}($request{if ($func eq '_help') then ', $toolScheme' else ()}) 150 | }}; 151 | /string() 152 | } 153 | (:~ 154 | : Executes an operation. 155 | : 156 | : @param req the operation request 157 | : @return the result of the operation 158 | :) 159 | declare function m:execOperation($req as element()) 160 | as item()* {{ 161 | if ($req/self::zz:errors) then tt:_getErrorReport($req, 'Invalid call', 'code', ()) else 162 | if ($req/@storeq eq 'true') then m:execOperation__storeq($req) else 163 | 164 | let $opName := tt:getOperationName($req) 165 | let $result := 166 | {string-join(( 167 | " if ($opName eq '_help') then m:execOperation__help($req)", 168 | for $op at $pos in $ops 169 | let $if := if ($pos eq 1) then 'else if' else 'else if' 170 | return 171 | concat(' ', $if, ' ($opName eq ''', $op/@name/string(), ''') then m:execOperation_', $op/@name/string(), '($req)'), 172 | " else", 173 | " tt:createError('UNKNOWN_OPERATION', concat('No such operation: ', $opName), ", 174 | " )" 175 | ), ' ')} 176 | let $errors := if ($result instance of node()+) then tt:extractErrors($result) else () 177 | return 178 | if ($errors) then tt:_getErrorReport($errors, 'System error', 'code', ()) 179 | else $result 180 | }}; 181 | 182 | m:execOperation($req) 183 | /replace(., '^\s+', '') 184 | return 185 | $toolText 186 | }; 187 | 188 | (:~ 189 | : Evaluates a toolScheme and creates a report supporting the 190 | : generation of the application main module. 191 | : 192 | : @param toolScheme the tool scheme 193 | : @return the namespaces etc. report 194 | :) 195 | declare function f:evalToolScheme4MainModule($toolScheme as element()) 196 | as element() { 197 | let $ttNamespace := 'http://www.ttools.org/xquery-functions' 198 | let $namespaces := distinct-values($toolScheme//operation/@namespace)[not(. eq $ttNamespace)] 199 | let $operations := $toolScheme//operation 200 | let $ttOperations := $operations[@namespace eq $ttNamespace]/@name 201 | let $ttModules := distinct-values($ttOperations/../@mod) 202 | let $nsElem := 203 | { 204 | { 205 | { 206 | for $m in $ttModules return , 207 | , 208 | 209 | }, 210 | { 211 | for $o in $ttOperations return 212 | 213 | } 214 | }, 215 | for $ns at $pos in $namespaces 216 | let $prefix := concat('a', $pos) 217 | let $myOperations := $operations[@namespace eq $ns]/@name 218 | let $myModules := distinct-values($myOperations/../@mod) 219 | order by $ns 220 | return 221 | { 222 | { 223 | for $m in $myModules order by $m return 224 | 225 | }, 226 | { 227 | for $o in $myOperations return 228 | 229 | } 230 | } 231 | } 232 | return 233 | $nsElem 234 | }; 235 | -------------------------------------------------------------------------------- /bin/tt/_docs.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | : ------------------------------------------------------------------------- 3 | : 4 | : docs.xqm - Document me! 5 | : 6 | : ------------------------------------------------------------------------- 7 | :) 8 | 9 | (: 10 | :*************************************************************************** 11 | : 12 | : i n t e r f a c e 13 | : 14 | :*************************************************************************** 15 | :) 16 | 17 | (:~@operations 18 | 19 | (:#file#:) 20 | 21 | 22 | 23 | 24 | 25 | (:##:) 26 | 27 | 28 | 29 | (:#file#:) 30 | 31 | 32 | (:##:) 33 | 34 | 35 | 36 | 37 | 38 | 39 | (:#file#:) 40 | 41 | 42 | (:##:) 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | :) 51 | 52 | module namespace f="http://www.ttools.org/xquery-functions"; 53 | import module namespace tt="http://www.ttools.org/xquery-functions" at 54 | "_request.xqm", 55 | "_reportAssistent.xqm", 56 | "_nameFilter.xqm"; 57 | 58 | declare namespace z="http://www.ttools.org/structure"; 59 | 60 | (: 61 | : ============================================================================ 62 | : 63 | : o p e r a t i o n s 64 | : 65 | : ============================================================================ 66 | :) 67 | 68 | (:~ 69 | : Document me! 70 | : 71 | : @param request the operation request 72 | : @return a report describing ... 73 | :) 74 | declare function f:getRcat($request as element()) 75 | as element() { 76 | let $rcats := tt:getParams($request, 'docs dox') 77 | return 78 | if (count($rcats) eq 1) then $rcats else 79 | 80 | (: merge rcats :) 81 | let $hrefs := distinct-values($rcats//@href) 82 | let $count := count($hrefs) 83 | let $dirs := string-join(for $rcat in $rcats return $rcat/@dirs, ' ; ') 84 | let $files := string-join(for $rcat in $rcats return $rcat/@files, ' ; ') 85 | let $subDirs := string-join(for $rcat in $rcats return $rcat/@subDirs, ' ; ') 86 | return 87 | element {$rcats[1]/node-name(.)} { 88 | attribute count {$count}, 89 | attribute dirs {$dirs}, 90 | attribute files {$files}, 91 | attribute subDirs {$subDirs}, 92 | for $href in $hrefs 93 | order by lower-case($href) 94 | return 95 | } 96 | }; 97 | 98 | (:~ 99 | : Document me! 100 | : 101 | : @param request the operation request 102 | : @return a report describing ... 103 | :) 104 | declare function f:getDocs($request as element()) 105 | as element() { 106 | let $docs := tt:getParams($request, ('doc', 'docs', 'dox', 'dcat', 'fdocs')) 107 | let $count := count($docs) 108 | return 109 | { 110 | for $doc in $docs return 111 | element {node-name($doc/*)} { 112 | attribute z:documentURI {document-uri($doc)}, 113 | $doc/*/(@*, node()) 114 | } 115 | } 116 | }; 117 | 118 | (:~ 119 | : Document me! 120 | : 121 | : @param request the operation request 122 | : @return a report describing ... 123 | :) 124 | declare function f:getDoctypes($request as element()) 125 | as element() { 126 | let $docs := tt:getParams($request, ('doc', 'docs', 'dox', 'dcat', 'fdocs')) 127 | let $sortBy := tt:getParams($request, 'sortBy') 128 | let $withAttNames as xs:boolean := tt:getParams($request, 'attNames') 129 | let $withElemNames as xs:boolean := tt:getParams($request, 'elemNames') 130 | (:#xq30ge#:) 131 | let $doctypes := 132 | for $doc in $docs 133 | let $root := $doc/* 134 | let $lname := local-name($root) 135 | let $ns := namespace-uri($root) 136 | let $doctype := concat($lname, '@', $ns) 137 | group by $doctype 138 | let $docRefs := 139 | let $uris := $doc/document-uri(.) 140 | return 141 | for $uri in $uris order by lower-case($uri) return 142 | let $attNames := 143 | if (not($withAttNames)) then () else 144 | let $names := 145 | for $name in distinct-values($doc//@*/local-name()) order by lower-case($name) return $name 146 | return 147 | {$names} 148 | let $elemNames := 149 | if (not($withElemNames)) then () else 150 | let $names := 151 | for $name in distinct-values($doc//*/local-name()) order by lower-case($name) return $name 152 | return 153 | {$names} 154 | return 155 | { 156 | $attNames, 157 | $elemNames, 158 | $docRefs 159 | } 160 | (:#xq10#:) 161 | let $doctypes := 162 | let $doctypeValues := distinct-values($docs/*/concat(local-name(.), '@', namespace-uri(.))) 163 | for $dtype in $doctypeValues 164 | let $myDocs := $docs[*/concat(local-name(.), '@', namespace-uri(.)) eq $dtype] 165 | let $docRefs := 166 | let $uris := $myDocs/document-uri(.) 167 | return 168 | for $uri in $uris order by lower-case($uri) return 169 | let $attNames := 170 | if (not($withAttNames)) then () else 171 | let $names := 172 | for $name in distinct-values($myDocs//@*/local-name()) order by lower-case($name) return $name 173 | return 174 | {$names} 175 | let $elemNames := 176 | if (not($withElemNames)) then () else 177 | let $names := 178 | for $name in distinct-values($myDocs//*/local-name()) order by lower-case($name) return $name 179 | return 180 | {$names} 181 | return 182 | { 183 | $attNames, 184 | $elemNames, 185 | $docRefs 186 | } 187 | (:##:) 188 | let $sortedDoctypes := 189 | if ($sortBy eq 'namespace') then 190 | for $d in $doctypes 191 | let $dt := $d/lower-case(@name) 192 | let $name := substring-before($dt, '@') 193 | let $namespace := substring-after($dt, '@') 194 | order by $namespace, $name 195 | return $d 196 | else 197 | for $d in $doctypes 198 | let $dt := $d/lower-case(@name) 199 | let $name := substring-before($dt, '@') 200 | let $namespace := substring-after($dt, '@') 201 | order by $name, $namespace 202 | return $d 203 | 204 | return 205 | { 206 | $sortedDoctypes 207 | } 208 | }; 209 | 210 | (: 211 | : ============================================================================ 212 | : 213 | : p u b l i c f u n c t i o n s 214 | : 215 | : ============================================================================ 216 | :) 217 | 218 | (: 219 | : ============================================================================ 220 | : 221 | : p r i v a t e f u n c t i o n s 222 | : 223 | : ============================================================================ 224 | :) 225 | 226 | -------------------------------------------------------------------------------- /bin/tt/_csvParser.xqm: -------------------------------------------------------------------------------- 1 | (: csvParser.xqm - parses csv and turns it into xml 2 | : 3 | : @version 20140110-1 4 | : =================================================================================== 5 | :) 6 | 7 | module namespace f="http://www.ttools.org/xquery-functions"; 8 | import module namespace tt="http://www.ttools.org/xquery-functions" at 9 | "_constants.xqm", 10 | "_request.xqm", 11 | "_resourceAccess.xqm" 12 | ; 13 | 14 | (: 15 | : ============================================================================ 16 | : 17 | : p u b l i c f u n c t i o n s 18 | : 19 | : ============================================================================ 20 | :) 21 | 22 | (:~ 23 | : Parses a text file as CSV document and transforms it into 24 | : an XML representation. 25 | :) 26 | declare function f:parseCsv($uri as xs:string, 27 | $encoding as xs:string?, 28 | $sep as xs:string?, 29 | $delim as xs:string?, 30 | $header as xs:boolean?, 31 | $names as xs:string*, 32 | $fromRec as xs:integer?, 33 | $toRec as xs:integer?) 34 | as element() { 35 | let $sep := ($sep, ',')[1] 36 | let $encoding := ($encoding, 'ISO-8859-1')[1] 37 | 38 | let $defaultNames := ('table', 'row', 'cell') 39 | let $useNames := 40 | if (count($names) ge 3) then $names 41 | else 42 | ($names, subsequence($defaultNames, 1 + count($names))) 43 | let $namesString := string-join($useNames, $sep) 44 | 45 | let $control := 46 | 54 | let $lines := tt:unparsed-text-lines($uri, $encoding)[string(.)] 55 | return 56 | element {$useNames[1]} { 57 | f:_getCsvRecordsRC(1, 1, $lines, $control, ()) 58 | } 59 | }; 60 | 61 | (: 62 | : ============================================================================ 63 | : 64 | : p r i v a t e f u n c t i o n s 65 | : 66 | : ============================================================================ 67 | :) 68 | 69 | (:~ 70 | : csvParser.xqm - parses csv and turns it into xml 71 | : 72 | : The csv items are separated by $sep and may be delimited 73 | : by $delimit. If delimited, the item may contain character 74 | : $sep, and any occurrences of $delim are doubled. 75 | : 76 | : Note. The query does not support the use of end of line characters 77 | : within data items. 78 | : 79 | : @param uri uri of the csv file 80 | : @param sep separator used (default: ;) 81 | : @param delim delimiter used if an item contains the separator or the delimiter itself 82 | : (default: ") 83 | : @param names the names of wrapper elem, row elem, column elems 84 | : 85 | : @version 2014-01-09-a 86 | :) 87 | 88 | declare function f:_getCsvRecordsRC($recordNr as xs:integer, 89 | $lineNr as xs:integer, 90 | $lines as xs:string*, 91 | $control as element(control), 92 | $accum as element()*) 93 | as element()* { 94 | let $toRec as xs:integer := $control/@toRec/xs:integer(.) return 95 | if ($toRec gt 0 and $recordNr gt $toRec) then $accum 96 | else if ($lineNr gt count($lines)) then $accum else 97 | 98 | let $sep := $control/@sep 99 | let $delim := $control/@delim 100 | let $names := tokenize($control/@names, concat($sep, '\s*')) 101 | let $fromRec as xs:integer := $control/@fromRec/xs:integer(.) 102 | let $recNrAtt as xs:string? := $control/@recNrAtt/string() 103 | let $rowElem := ($names[2], 'row')[1] 104 | let $colElem := 'col' 105 | 106 | let $recordText := $lines[$lineNr] 107 | let $itemsAndUpdatedLineNr := f:_getCsvItems($recordText, $lines, $lineNr, $sep, $delim) 108 | let $items := $itemsAndUpdatedLineNr[position() lt last()] 109 | let $updatedLineNr := $itemsAndUpdatedLineNr[last()] 110 | let $control := 111 | if ($recordNr ne 1 or not($control/@header eq 'true')) then $control 112 | else trace( 113 | let $useNames := for $item in $items return replace($item, '\s', '_') 114 | return 115 | { 116 | attribute names {string-join((subsequence($names, 1, 2), $useNames), $sep)}, 117 | $control/(@* except @names) 118 | } , 'NEW_CONTROL: ') 119 | let $record := 120 | if ($fromRec gt 0 and $recordNr lt $fromRec) then () 121 | else if ($recordNr eq 1 and $control/@header eq 'true') then () 122 | else 123 | element {$rowElem} { 124 | if (not($recNrAtt)) then () else attribute {$recNrAtt} {$recordNr}, 125 | for $cell at $nr in $items return 126 | element {($names[2 + $nr], $colElem)[1]} {$cell} 127 | } 128 | return 129 | f:_getCsvRecordsRC($recordNr + 1, $updatedLineNr + 1, $lines, $control, ($accum, $record)) 130 | }; 131 | 132 | declare function f:_getCsvItems($recordText as xs:string, 133 | $lines as xs:string+, 134 | $lineNr as xs:integer, 135 | $sep as xs:string, 136 | $delim as xs:string) 137 | as item()* { 138 | let $delimited := substring($recordText, 1, 1) eq $delim 139 | let $rawItem := 140 | if (not($delimited)) then replace($recordText, concat($sep, '.*'), '') 141 | else 142 | let $notDelim := concat('[^', $delim, ']') 143 | let $value := 144 | replace($recordText, concat('^(', $delim, '(|.*?', $notDelim, ')', 145 | '(', $delim, $delim, ')*', $delim, ')($|', $notDelim, '.*)'), '$1') 146 | return 147 | if ($value ne $recordText) then $value 148 | else 149 | (: either no match, or recordText = single item -> check! :) 150 | if (matches($recordText, concat('^', $delim, '(|.*?[^', $delim, '])(', $delim, $delim, ')*', $delim, '$'))) 151 | then $value 152 | else 153 | let $updatedRecordTextAndLineNr := 154 | f:_expandRecordText($recordText, $lines, $lineNr, $delim) 155 | let $updatedRecordText := $updatedRecordTextAndLineNr[1] 156 | let $updatedLineNr := $updatedRecordTextAndLineNr[2] 157 | let $value := 158 | replace($updatedRecordText, concat('(', $delim, '(.*?[^', $delim, ']|)', 159 | '(', $delim, $delim, ')*', $delim, ')[^', $delim, '].*'), '$1', 's') 160 | return 161 | ($value, $updatedRecordText, $updatedLineNr) 162 | 163 | let $recordText := ($rawItem[2], $recordText)[1] 164 | let $lineNr := ($rawItem[3], $lineNr)[1] 165 | let $rawItem := $rawItem[1] 166 | let $rawItemLength := string-length($rawItem) 167 | let $remainder := substring($recordText, 2 + $rawItemLength) 168 | let $item := 169 | if (not($delimited)) then $rawItem else 170 | replace(substring($rawItem, 2, string-length($rawItem) - 2), concat($delim, $delim), $delim) 171 | return ( 172 | $item, 173 | 174 | if (not($remainder)) then $lineNr (: end of record text -> return updated lineNr :) 175 | else if ($delimited and not(substring($recordText, 1 + $rawItemLength, 1) = $sep)) then 176 | error(QName((), 'INVALID_CSV'), concat('Invalid data encountered; closing delimiter ''', $delim, 177 | ''' must be followed by separater ''', $sep, '''; found: ', $recordText)) 178 | else (: next item within line :) 179 | f:_getCsvItems($remainder, $lines, $lineNr, $sep, $delim) 180 | ) 181 | }; 182 | 183 | (:~ 184 | : Expands the record text by as many lines as necessary in order to find the end of the current 185 | : item which is expected to be delimited, starting within the current value of $recordText 186 | : and ending in the next line or a later line. The line in which the current item ends is 187 | : the first line after the current line, which contains a substring consisting of an uneven 188 | : number of delimiter characters which is neither preceded nor followed by the delimiter 189 | : character. 190 | : 191 | : @recordText the incomplete record text within which a delimited item begins, but is not 192 | : completed 193 | : @lines the lines of the csv text 194 | : @lineNr the number of the last line which has been incorporated into $recordText 195 | : @delim the delimiter character 196 | : @returns two items, the first being the new $recordText and the second the number of the line 197 | : following the last line used to expand the current $record Text (in other words: the 198 | : new value of $lineNr) 199 | :) 200 | declare function f:_expandRecordText($recordText as xs:string, $lines as xs:string+, $lineNr as xs:integer, 201 | $delim as xs:string) 202 | as item()+ { 203 | let $nextLineNr := $lineNr + 1 204 | let $nextLine := $lines[$nextLineNr] 205 | let $recordText := concat($recordText, ' ', $nextLine) 206 | let $notDelim := concat('[^', $delim, ']') 207 | let $matches := matches($recordText, 208 | concat('(^|', $notDelim, ')(', $delim, $delim, ')*', $delim, '($|', $notDelim, ')')) 209 | return 210 | if ($matches) then ($recordText, $nextLineNr) else 211 | f:_expandRecordText($recordText, $lines, $nextLineNr, $delim) 212 | }; 213 | -------------------------------------------------------------------------------- /bin/tt/_pcollection_xml.xqm: -------------------------------------------------------------------------------- 1 | xquery version "3.0"; 2 | (: 3 | :*************************************************************************** 4 | : 5 | : _pcollection_xml.xqm - functions for managing and searching XML based pollections 6 | : 7 | :*************************************************************************** 8 | :) 9 | 10 | module namespace f="http://www.ttools.org/xquery-functions"; 11 | import module namespace tt="http://www.ttools.org/xquery-functions" at 12 | "_errorAssistent.xqm", 13 | "_nameFilter.xqm", 14 | "_pcollection_utils.xqm", 15 | "_pfilter.xqm", 16 | "_pfilter_parser.xqm", 17 | "_processorSpecific.xqm", 18 | "_request.xqm", 19 | "_reportAssistent.xqm", 20 | "_pfilter.xqm"; 21 | 22 | declare namespace z="http://www.ttools.org/structure"; 23 | declare namespace pc="http://www.infospace.org/pcollection"; 24 | declare namespace file="http://expath.org/ns/file"; 25 | 26 | (: 27 | : ============================================================================ 28 | : 29 | : p r i v a t e f u n c t i o n s 30 | : 31 | : ============================================================================ 32 | :) 33 | 34 | (:~ 35 | : Returns a filtered pcollection which is implemented by an XML based ncat. 36 | : If no query is specified, the complete collection is returned, otherwise only 37 | : those collection members whose external properties match the query. 38 | : 39 | : @param enodl the extended NODL document describing the collection 40 | : @param pfilter a pfilter against which the external properties of the collection 41 | : members are matched 42 | : @return all collection members whose external properties match the specified 43 | : pfilter, or all collection members if no pfilter has been specified 44 | :) 45 | declare function f:_filteredCollection_xml($enodl as element(pc:enodl), $pfilter as element(pc:pfilter)?) 46 | as node()* { 47 | let $ncatUri := $enodl//pc:xmlNcat/@documentURI 48 | let $ncat := 49 | if (tt:doc-available($ncatUri)) then tt:doc($ncatUri)/* else () 50 | return if (not($ncat)) then 51 | let $msg := 52 | if (not($ncatUri)) then 'The xml NCAT model does not specify a node URI.' 53 | else 54 | concat('The specified NCAT document cannot be opened; URI: ''', $ncatUri, '''.') 55 | return tt:createError('INVALID_NODL', $msg, ()) 56 | else 57 | 58 | for $pnode in $ncat//pc:pnode 59 | where not($pfilter) or tt:matchesPfilter($pnode, $pfilter) 60 | return 61 | let $uri := $pnode/@_node_uri/resolve-uri(., base-uri(..)) 62 | return 63 | if (not(tt:doc-available($uri))) then () else tt:doc($uri) 64 | }; 65 | 66 | (:#file eval#:) 67 | (:~ 68 | : Creates a new xml based ncat. 69 | : 70 | : @param request the operation request 71 | : @return a report describing ... 72 | :) 73 | declare function f:_createXmlNcat($enodl as element(pc:enodl), $request as element()) 74 | as element()? { 75 | let $xmlNcat := $enodl//pc:ncatModel/pc:xmlNcat 76 | let $docUri := $xmlNcat/@documentURI/resolve-uri(., base-uri(..)) 77 | 78 | return 79 | if (file:exists($docUri)) then 80 | tt:createError('INVALID_ARG', concat('Cannot create NCAT ', 81 | 'at this URI: ', $docUri, ' - file exists'), ()) 82 | else 83 | let $ncat := 84 | { 85 | $enodl//pc:collection/@*, 86 | attribute nodeConstructorKind {$enodl//pc:nodeConstructor/@kind}, 87 | attribute countNodes {'0'} 88 | } 89 | return ( 90 | file:write($docUri, $ncat), 91 | 92 | ) 93 | }; 94 | (:##:) 95 | 96 | (:#file#:) 97 | (:~ 98 | : Deletes an XML based ncat. 99 | : 100 | : @param request the operation request 101 | : @return a report describing ... 102 | :) 103 | declare function f:_deleteXmlNcat($enodl as element(pc:enodl), $request as element()) 104 | as element()? { 105 | let $xmlNcat := $enodl//pc:ncatModel/pc:xmlNcat 106 | let $docUri := $xmlNcat/@documentURI/resolve-uri(., base-uri(..)) 107 | 108 | return 109 | if (not(file:exists($docUri))) then 110 | tt:createError('INVALID_ARG', concat('No NCAT found at this URI: ', $docUri), ()) 111 | else ( 112 | file:delete($docUri), 113 | 114 | ) 115 | }; 116 | (:##:) 117 | 118 | (:#file eval#:) 119 | (:~ 120 | : Feeds an ncat with pnodes created for a set of XML documents. 121 | : 122 | : @param an extended NODL element 123 | : @request the operation request 124 | : @return an element providing some counts concerning the feed operation 125 | :) 126 | declare function f:_feedXmlNcat($enodl as element(pc:enodl), $request as element()) 127 | as element() { 128 | let $ncatUri := $enodl//pc:xmlNcat/@documentURI 129 | let $ncat := 130 | if (tt:doc-available($ncatUri)) then tt:doc($ncatUri)/* 131 | else f:_createXmlNcat($enodl, $request) 132 | let $dcat := tt:getParams($request, 'docs dox') 133 | 134 | let $pnodes := 135 | let $pmodel := $enodl/pc:pmodel 136 | let $nodeConstructor := $enodl/pc:nodeConstructor 137 | for $href in $dcat//@href 138 | let $uri := $href/resolve-uri(., base-uri(..)) 139 | let $doc := tt:doc($uri) 140 | return 141 | tt:_pnode($doc, $uri, $pmodel, $nodeConstructor) 142 | 143 | let $uris := $pnodes/@_node_uri 144 | let $newNcat := 145 | let $newPnodes := ( 146 | $ncat/pc:pnode[not(@_node_uri = $uris)], 147 | $pnodes 148 | ) 149 | return 150 | element {node-name($ncat)} { 151 | $ncat/(@* except @countNodes), 152 | attribute countNodes {count($newPnodes)}, 153 | $ncat/(* except pc:pnode), 154 | $newPnodes 155 | } 156 | let $oldNcatSize := count($ncat//pc:pnode) 157 | let $newNcatSize := count($newNcat//pc:pnode) 158 | return ( 159 | file:write($ncatUri, $newNcat), 160 | 164 | ) 165 | }; 166 | 167 | (:##:) 168 | (:~ 169 | : Retrieves pnodes from an XML based ncat. 170 | : 171 | : @param enodl the extended NODL document describing the ncat 172 | : @param query only pnodes matching this pfilter are exported 173 | : @return a sequence of pnodes 174 | :) 175 | declare function f:_getPnodes_xml($enodl as element(pc:enodl), $pfilter as element(pc:pfilter)?) 176 | as node()* { 177 | let $ncatUri := f:_getNcatURI_xml($enodl) 178 | let $ncat := f:_getNcat_xml($enodl) 179 | return if (not($ncat)) then 180 | let $msg := 181 | if (not($ncatUri)) then 'The xml NCAT model does not specify a document URI.' 182 | else 183 | concat('The specified NCAT document cannot be opened; URI: ''', $ncatUri, '''.') 184 | return tt:createError('INVALID_NODL', $msg, ()) 185 | else 186 | 187 | if (not($pfilter)) then $ncat//pc:pnode 188 | else 189 | for $pnode in $ncat//pc:pnode 190 | where tt:matchesPfilter($pnode, $pfilter) 191 | return 192 | $pnode 193 | }; 194 | 195 | (:#file#:) 196 | (:~ 197 | : Inserts pnodes into an XML based ncat. Any existing pnodes with 198 | : a node URI found among the new pnodes is replaced. 199 | : 200 | : @param request the operation request 201 | : @return a report describing ... 202 | :) 203 | declare function f:_insertPnodes_xml($enodl as element(pc:enodl), 204 | $pnodes as element()*) 205 | as element()? { 206 | let $ncat := f:_getNcat_xml($enodl) 207 | return if (not($ncat)) then () else 208 | 209 | let $asElemNames := 210 | for $item in $enodl/pc:ncatModel/pc:xmlNcat/@asElement/tokenize(normalize-space(.), ' ') return 211 | concat('^', replace($item, '\*', '.*'), '$') 212 | 213 | (: the inserted pnodes are edited so as to conform to the @asElement configuration :) 214 | let $pnodesInserted := 215 | if (empty($asElemNames)) then $pnodes 216 | else 217 | for $pnode in $pnodes 218 | let $atts := 219 | for $a in $pnode/@* 220 | let $name := local-name($a) 221 | return 222 | if ($name = '_node_uri') then $a 223 | else if (some $n in $asElemNames satisfies matches($name, $n)) then 224 | element {$name} {string($a)} 225 | else $a 226 | return 227 | element {node-name($pnode)} { 228 | $atts[self::attribute()], 229 | $atts[self::*], 230 | $pnode/node() 231 | } 232 | let $ncatUri := f:_getNcatURI_xml($enodl) 233 | let $nodeUris := distinct-values($pnodes/@_node_uri) 234 | let $newNcat := 235 | element {node-name($ncat)} { 236 | $ncat/@*, 237 | $ncat/pc:pnode[not(@_node_uri = $nodeUris)], 238 | $pnodesInserted 239 | } 240 | let $ncatSizeBefore := count($ncat/pc:pnode) 241 | let $ncatSizeNew := count($newNcat/pc:pnode) 242 | return ( 243 | file:write($ncatUri, $newNcat), 244 | 248 | ) 249 | }; 250 | 251 | (:##:) 252 | (:~ 253 | : Returns the URI of an xml ncat described by a NODL document. 254 | : 255 | : @param enodl extended NODL document 256 | : @return the ncat 257 | :) 258 | declare function f:_getNcatURI_xml($enodl as element(pc:enodl)) 259 | as xs:string? { 260 | $enodl//pc:xmlNcat/@documentURI 261 | }; 262 | 263 | (:~ 264 | : Returns the xml ncat described by a NODL document. 265 | : 266 | : @param enodl extended NODL document 267 | : @return the ncat 268 | :) 269 | declare function f:_getNcat_xml($enodl as element(pc:enodl)) 270 | as element()? { 271 | let $ncatUri := f:_getNcatURI_xml($enodl) 272 | return 273 | if (tt:doc-available($ncatUri)) then tt:doc($ncatUri)/* else () 274 | }; 275 | -------------------------------------------------------------------------------- /bin/tt/_foxpath-uri-operations-rdf.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | foxpath-uri-operation.xqm - library of functions operating on URIs 3 | 4 | Overview: 5 | 6 | Group: resource properties 7 | uriDomain 8 | fox-is-file 9 | fox-is-dir 10 | fox-file-size 11 | fox-file-date 12 | fox-file-sdate 13 | 14 | Group: resource retrieval 15 | fox-unparsed-text 16 | fox-unparsed-text-lines 17 | 18 | :) 19 | module namespace f="http://www.ttools.org/xquery-functions"; 20 | import module namespace i="http://www.ttools.org/xquery-functions" 21 | at "_foxpath-processorDependent.xqm"; 22 | 23 | import module namespace util="http://www.ttools.org/xquery-functions/util" 24 | at "_foxpath-util.xqm"; 25 | 26 | 27 | (: 28 | : =============================================================================== 29 | : 30 | : r e s o u r c e p r o p e r t i e s 31 | : 32 | : =============================================================================== 33 | :) 34 | 35 | (:~ 36 | : Returns true if a resource exists. 37 | : 38 | : @param uri the URI or file path of the resource 39 | : @param options options controlling the evaluation 40 | : @return true if the resource exists and is a file 41 | :) 42 | declare function f:fox-file-exists_rdf($uri as xs:string?, $options as map(*)?) 43 | as xs:boolean? { 44 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 45 | let $query := ``[ 46 | PREFIX fs: 47 | 48 | SELECT ?exists 49 | WHERE 50 | { 51 | OPTIONAL {?res fs:navURI "`{$uri}`"} 52 | BIND( IF(BOUND(?res), true, false ) as ?exists) 53 | }]`` 54 | let $response := f:sparql2strings($query, $endpoint, ()) 55 | return 56 | $response ! xs:boolean(.) 57 | }; 58 | 59 | (:~ 60 | : Returns true if a resource is a file, rather than a directory. 61 | : 62 | : @param uri the URI or file path of the resource 63 | : @param options options controlling the evaluation 64 | : @return true if the resource exists and is a file 65 | :) 66 | declare function f:fox-is-file_rdf($uri as xs:string?, $options as map(*)?) 67 | as xs:boolean? { 68 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 69 | let $uriString := concat('"', $uri, '"') 70 | let $query := ``[ 71 | PREFIX fs: 72 | 73 | SELECT ?isFile 74 | WHERE 75 | { 76 | ?res fs:navURI "`{$uri}`" . 77 | OPTIONAL {?res a fs:file . BIND(true as ?isFile)} 78 | OPTIONAL {?res a fs:dir . BIND(false as ?isFile)} 79 | }]`` 80 | let $response := f:sparql2strings($query, $endpoint, ()) 81 | return 82 | $response ! xs:boolean(.) 83 | }; 84 | 85 | (:~ 86 | : Returns true if a resource is a directory, rather than a file. 87 | : 88 | : @param uri the URI or file path of the resource 89 | : @param options options controlling the evaluation 90 | : @return true if the resource exists and is a file 91 | :) 92 | declare function f:fox-is-dir_rdf($uri as xs:string?, $options as map(*)?) 93 | as xs:boolean? { 94 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 95 | let $uriString := concat('"', $uri, '"') 96 | let $query := ``[ 97 | PREFIX fs: 98 | 99 | SELECT ?isDir 100 | WHERE 101 | { 102 | ?res fs:navURI "`{$uri}`" . 103 | OPTIONAL {?res a fs:dir . BIND(true as ?isDir)} 104 | OPTIONAL {?res a fs:file . BIND(false as ?isDir)} 105 | }]`` 106 | let $response := f:sparql2strings($query, $endpoint, ()) 107 | return 108 | $response ! xs:boolean(.) 109 | }; 110 | 111 | (:~ 112 | : Returns the last modification date of a resource. 113 | : 114 | : @param uri the URI or file path of the resource 115 | : @param options options controlling the evaluation 116 | : @return the last update date of the resource 117 | :) 118 | declare function f:fox-file-date_rdf($uri as xs:string?, $options as map(*)?) 119 | as xs:dateTime? { 120 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 121 | let $uriString := concat('"', $uri, '"') 122 | let $query := ``[ 123 | PREFIX fs: 124 | 125 | SELECT DISTINCT ?date 126 | WHERE 127 | { 128 | ?res fs:navURI `{$uriString}` . 129 | ?res fs:lastModified ?date . 130 | }]`` 131 | let $response := f:sparql2strings($query, $endpoint, ()) 132 | return 133 | $response ! xs:dateTime(.) 134 | }; 135 | 136 | declare function f:fox-file-size_rdf($uri as xs:string?, $options as map(*)?) 137 | as xs:integer? { 138 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 139 | let $uriString := concat('"', $uri, '"') 140 | let $query := ``[ 141 | PREFIX fs: 142 | 143 | SELECT DISTINCT ?size 144 | WHERE 145 | { 146 | ?res fs:navURI `{$uriString}` . 147 | ?res fs:fileSize ?size . 148 | }]`` 149 | let $response := f:sparql2strings($query, $endpoint, ()) 150 | return 151 | $response ! xs:integer(.) 152 | }; 153 | 154 | (: 155 | : =============================================================================== 156 | : 157 | : r e s o u r c e r e t r i e v a l 158 | : 159 | : =============================================================================== 160 | :) 161 | 162 | (:~ 163 | : Returns the access URI associated with a given navigation URI. 164 | :) 165 | declare function f:fox-get-access-uri_rdf($uri as xs:string?, $options as map(*)?) 166 | as xs:string? { 167 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 168 | let $query := ``[ 169 | PREFIX fs: 170 | 171 | SELECT ?accessURI 172 | WHERE 173 | { 174 | ?file fs:navURI "`{$uri}`" . 175 | ?file fs:accessURI ?accessURI 176 | }]`` 177 | let $response := f:sparql2strings($query, $endpoint, ()) 178 | return 179 | $response ! xs:string(.) 180 | }; 181 | (: 182 | : =============================================================================== 183 | : 184 | : r e s o u r c e t r e e n a v i g a t i o n 185 | : 186 | : =============================================================================== 187 | :) 188 | 189 | (: 190 | : =============================================================================== 191 | : 192 | : r e s o u r c e t r e e n a v i g a t i o n / r d f 193 | : 194 | : =============================================================================== 195 | :) 196 | declare function f:childUriCollection_rdf($uri as xs:string, 197 | $name as xs:string?, 198 | $stepDescriptor as element()?, 199 | $options as map(*)?) { 200 | f:childOrDescendantUriCollection_rdf('child', $uri, $name, $stepDescriptor, $options) 201 | }; 202 | 203 | declare function f:descendantUriCollection_rdf($uri as xs:string, 204 | $name as xs:string?, 205 | $stepDescriptor as element()?, 206 | $options as map(*)?) { 207 | f:childOrDescendantUriCollection_rdf('descendant', $uri, $name, $stepDescriptor, $options) 208 | }; 209 | 210 | declare function f:childOrDescendantUriCollection_rdf($axis as xs:string, 211 | $uri as xs:string, 212 | $name as xs:string?, 213 | $stepDescriptor as element()?, 214 | $options as map(*)?) { 215 | (: let $DUMMY := trace($uri, concat('axis=', $axis, ' ; URI: ')) :) 216 | let $endpoint := $options ! map:get(., 'UGRAPH_ENDPOINTS') 217 | let $pattern := 218 | if (not($name)) then () 219 | else concat('^', replace($name, '\*', '.*'), '$') 220 | let $kindFilter := $stepDescriptor/@kindFilter 221 | 222 | let $sparql_up_navigator := 223 | if ($axis eq 'child') then 'fs:parentDir' 224 | else 'fs:parentDir+' 225 | let $sparql_filter_name := 226 | if (not($pattern)) then () 227 | else "?res fs:name ?name . " || "FILTER (regex(?name, '" || $pattern || "', 'i'))" 228 | let $sparql_filter_kind := 229 | if ($kindFilter eq 'file') then '?res a fs:file .' 230 | else if ($kindFilter eq 'dir') then '?res a fs:dir .' 231 | else () 232 | let $query := ``[ 233 | PREFIX fs: 234 | 235 | SELECT DISTINCT ?navURI 236 | WHERE 237 | { 238 | ?dir fs:navURI "`{$uri}`" . 239 | ?res `{$sparql_up_navigator}` ?dir . 240 | `{$sparql_filter_kind}` 241 | `{$sparql_filter_name}` 242 | ?res fs:navURI ?navURI 243 | }]`` ! replace(., ' ', '') 244 | let $DUMMY := file:write('/projects/foxbug/foxbug.txt', $query, map{'method':'text'}) 245 | let $response := f:sparql2strings($query, $endpoint, ()) 246 | let $uriWithTrailingSlash := replace($uri, '([^/])$', '$1/') 247 | return 248 | $response ! substring-after(., $uriWithTrailingSlash) 249 | }; 250 | 251 | (: 252 | : =============================================================================== 253 | : 254 | : u t i l i t i e s 255 | : 256 | : =============================================================================== 257 | :) 258 | 259 | (:~ 260 | : Executes a SPARQL query and returns the result as a sequence of strings. 261 | :) 262 | declare function f:sparql2strings($query as xs:string, 263 | $endpoint as xs:string?, 264 | $encoding as xs:string?) 265 | as xs:string* { 266 | let $endpoint := ($endpoint, 'http://localhost:3030/moly')[1] 267 | let $encoding := ($encoding, 'iso-8859-1')[1] 268 | let $sparql := replace($query, ' ', '') 269 | 270 | let $request := 271 | 273 | {$sparql} 276 | (: , 'REQUEST: ') :) 277 | let $rs := http:send-request($request)[2] 278 | return 279 | convert:binary-to-string($rs) ! json:parse(.)//value/string() 280 | }; 281 | 282 | (:~ 283 | : Returns the URI prefixes covered by a UGRAPH endpoint. 284 | :) 285 | declare function f:get-ugraph-uri-prefixes($endpoint as xs:string, $options as map(*)?) 286 | as xs:string? { 287 | let $query := ``[ 288 | PREFIX fs: 289 | 290 | SELECT ?navURI 291 | WHERE 292 | { 293 | ?dir a fs:dir . 294 | FILTER NOT EXISTS {?dir fs:parentDir ?pdir} 295 | ?dir fs:navURI ?navURI . 296 | }]`` 297 | let $response := f:sparql2strings($query, $endpoint, ()) 298 | return 299 | $response ! xs:string(.) 300 | }; 301 | 302 | -------------------------------------------------------------------------------- /bin/tt/_foxpath-util.xqm: -------------------------------------------------------------------------------- 1 | module namespace f="http://www.ttools.org/xquery-functions/util"; 2 | 3 | declare namespace fox="http://www.foxpath.org/ns/annotations"; 4 | 5 | declare variable $f:DEBUG := ''; 6 | declare variable $f:DG := 7 | for $item in tokenize(normalize-space($f:DEBUG), ' ') 8 | return concat('^', replace($item, '\*', '.*'), '$'); 9 | declare variable $f:ARCHIVE_TOKEN external := '#archive#'; 10 | declare variable $f:PREDECLARED_NAMESPACES := ( 11 | , 12 | , 13 | , 14 | , 15 | , 16 | , 17 | , 18 | , 19 | 20 | ); 21 | 22 | (:~ 23 | : Translates a whitespace-separated list of string patterns 24 | : into a list of regular expressions and a list of literal strings. 25 | : 26 | : @param patterns a list of names and/or patterns, whitespace concatenated 27 | : @param ignoreCase if true, the filter ignores case 28 | : @return a map with entries 'names', 'regexes' and 'flags' 29 | :) 30 | declare function f:compileNameFilter($patterns as xs:string*, 31 | $ignoreCase as xs:boolean?) 32 | as map(xs:string, item()*)? { 33 | if (empty($patterns)) then () else 34 | 35 | let $items := $patterns ! normalize-space(.) ! tokenize(.) 36 | let $names := 37 | let $raw := $items[not(contains(., '*')) and not(contains(., '?'))] 38 | return 39 | if (not($ignoreCase)) then $raw else $raw ! lower-case(.) 40 | let $regexes := $items[contains(., '*') or contains(., '?')] 41 | ! replace(., '[{}()\[\]]', '\\$0') 42 | ! replace(., '\*', '.*') 43 | ! replace(., '\?', '.') 44 | ! concat('^', ., '$') 45 | let $flags := if ($ignoreCase) then 'i' else '' 46 | return 47 | map{'names': $names, 'regexes': $regexes, 'empty': empty(($names, $regexes)), 'ignoreCase': $ignoreCase} 48 | }; 49 | 50 | (:~ 51 | : Matches a string against a name filter constructed by `patternsToNameFilter()`. 52 | : 53 | : @param string the string to match 54 | : @param nameFilter the name filter 55 | : @return true if the name filter is matched, false otherwise 56 | :) 57 | declare function f:matchesNameFilter($string as xs:string, 58 | $nameFilter as map(xs:string, item()*)?) 59 | as xs:boolean { 60 | let $flags := if ($nameFilter?ignoreCase) then 'i' else '' 61 | let $string := if ($nameFilter?ignoreCase) then lower-case($string) else $string 62 | return 63 | $nameFilter?empty 64 | or exists($nameFilter?names) and $string = $nameFilter?names 65 | or exists($nameFilter?regexes) and (some $r in $nameFilter?regexes satisfies matches($string, $r, $flags)) 66 | }; 67 | 68 | (:~ 69 | : Matches a string against an optional inclusive name filter and an optional 70 | : exclusive name filter. 71 | : 72 | : @param string the string to match 73 | : @param nameFilter inclusive name filter - matching requires matching this filter 74 | : @param nameFilterExclude exclusive name filter - matching requires not matching this filter 75 | : @return true if the string matches nameFilter and does not not match nameFilterExclude, false otherwise 76 | :) 77 | declare function f:matchesPlusMinusNameFilters( 78 | $string as xs:string, 79 | $nameFilter as map(xs:string, item()*)?, 80 | $nameFilterExclude as map(xs:string, item()*)?) 81 | as xs:boolean { 82 | (empty($nameFilter) or f:matchesNameFilter($string, $nameFilter)) and 83 | (empty($nameFilterExclude) or not(f:matchesNameFilter($string, $nameFilterExclude))) 84 | }; 85 | 86 | (:~ 87 | : Returns all items contained in every array in a given 88 | : sequence of arrays. Array members are evaluated and 89 | : returned in atomized form. 90 | : 91 | : @param sequences a sequence of arrays 92 | : @return the items contained by all arrays 93 | :) 94 | declare function f:atomIntersection($sequences as array(item()*)*) 95 | as item()* { 96 | let $seq1 := head($sequences) 97 | let $seq2 := tail($sequences) 98 | return fold-left($seq2, array:flatten($seq1), 99 | function($sofar, $new) { 100 | let $t1 := prof:current-ms() 101 | let $newItems := array:flatten($new) 102 | let $t2 := prof:current-ms() 103 | let $newAccum := $sofar[. = $newItems] 104 | 105 | let $t3 := prof:current-ms() 106 | let $_DEBUG := trace(concat('_NEXT_INTERSECTION; #OLD_ITEMS: ', count($sofar), ' ; #NEW_ITEMS: ', count($newItems))) 107 | let $_DEBUG := trace($t2 - $t1, 't(flatten): ') 108 | let $_DEBUG := trace($t3 - $t2, 't(filter) : ') 109 | 110 | return $newAccum}) 111 | }; 112 | 113 | (: 114 | declare variable $f:STDLIB := map{ 115 | 'lower-case#1' : map{'funcItem' : lower-case#1, 'args' : ['xs:string?'], 'result' : 'xs:string'} 116 | }; 117 | :) 118 | declare variable $f:STD-FUNC-ITEMS := map{ 119 | 'lower-case#1' : lower-case#1, 120 | 'number#1' : number#1, 121 | 'upper-case#1' : upper-case#1, 122 | 'xs:integer#1' : xs:integer#1 123 | }; 124 | 125 | (:~ 126 | : Resolves the text of a function item to a function item. 127 | : Examples: 128 | : lower-case#1 129 | : bslash#1 130 | :) 131 | declare function f:resolveFuncItemText($itemText as xs:string) 132 | as function(*)? { 133 | let $item := f:resolveStandardFuncItemText($itemText) 134 | return 135 | if (exists($item)) then $item 136 | else 137 | f:resolveFoxFuncItemText($itemText) 138 | (: 139 | if ($itemText eq 'bslash#1') then f:foxfunc_bslash#1 140 | else () 141 | :) 142 | }; 143 | 144 | (:~ 145 | : Resolves the text of a standard function item to a function item. 146 | : If the text does not reference a standard function, the empty 147 | : sequence is returned. 148 | : 149 | : Examples: 150 | : lower-case#1 151 | :) 152 | declare function f:resolveStandardFuncItemText($itemText as xs:string) 153 | as function(*)? { 154 | try { 155 | xquery:eval($itemText) treat as function(*) 156 | } catch * { 157 | () 158 | } 159 | }; 160 | 161 | (:~ 162 | : Resolves the text of a foxpath function item to a function item. 163 | : If the text does not reference a foxpath function, the empty 164 | : sequence is returned. 165 | : 166 | : Examples: 167 | : lower-case#1 168 | :) 169 | declare function f:resolveFoxFuncItemText($itemText as xs:string) 170 | as function(*)? { 171 | let $query := 172 | 'import module namespace f="http://www.ttools.org/xquery-functions" ' 173 | || ' at "_foxpath-fox-functions.xqm"; ' 174 | || 'f:foxfunc_' || $itemText 175 | let $funcItem := 176 | try {xquery:eval($query)} catch * {()} 177 | return 178 | $funcItem 179 | }; 180 | 181 | (:~ 182 | : Constructs an error element conveying an error code and an 183 | : error message. 184 | :) 185 | declare function f:createFoxpathError($code as xs:string, $msg as xs:string) 186 | as element() { 187 | 188 | }; 189 | 190 | (:~ 191 | : Constructs an error list containing a single error element. 192 | :) 193 | declare function f:createFoxpathErrors($code as xs:string, $msg as xs:string) 194 | as element(errors) { 195 | {f:createFoxpathError($code, $msg)} 196 | }; 197 | 198 | (:~ 199 | : Wraps a sequence of `error` elements in an `errors` element. 200 | :) 201 | declare function f:finalizeFoxpathErrors($errors as element()*) 202 | as element(errors)? { 203 | if (not($errors)) then () else {$errors} 204 | }; 205 | 206 | 207 | declare function f:trace($items as item()*, 208 | $logFilter as xs:string, 209 | $logLabel as xs:string) 210 | as item()* { 211 | if (exists($f:DG) and 212 | (some $d in $f:DG satisfies matches($logFilter, $d))) 213 | then trace($items, $logLabel) 214 | else $items 215 | }; 216 | 217 | (:~ 218 | : Applies the function conversion rules to a value given a sequence type specificationb. 219 | : @TODO - shift call of `xquery:eval` into _foxpath-processorDependent.xqm. 220 | :) 221 | declare function f:applyFunctionConversionRules( 222 | $value as item()*, 223 | $seqType as element(sequenceType)?) 224 | as item()* { 225 | if (not($seqType)) then $value else 226 | 227 | let $funcText := 'function($value as ' || $seqType/@text || '){$value}' 228 | let $func := xquery:eval($funcText, map{'value': $value}) 229 | return $func($value) 230 | }; 231 | 232 | (:~ 233 | : Returns the prefix of a URI identifying the root of an SVN repository. 234 | : 235 | : Example: Assume that URI "file:///c:/foo/bar" identifies the root of an 236 | : SVN repository; various values of $path produce a return value 237 | : as follows: 238 | : file:///c: -> () 239 | : file:///c:/foo -> () 240 | : file:///c:/foo/bar -> file:///c:/foo/bar 241 | : file:///c:/foo/bar/foobar -> file:///c:/foo/bar 242 | : 243 | : @param uri an URI supposed to address an SVN repository or some resource within it 244 | : @return a report describing ... 245 | :) 246 | declare function f:getSvnRootUri($uri as xs:string) 247 | as xs:string? { 248 | let $prefix := replace($uri, '(^(file|https?):/+).*', '$1') 249 | let $steps := substring($uri, 1 + string-length($prefix)) 250 | return 251 | f:getSvnRootUriRC($prefix, $steps) 252 | }; 253 | 254 | declare function f:getSvnRootUriRC($prefix as xs:string, $steps as xs:string) 255 | as xs:string? { 256 | if (not($steps)) then () else 257 | let $step1 := replace($steps, '^(.*?)/.*', '$1') 258 | let $tryPath := $prefix || $step1 259 | return 260 | if (proc:execute('svn', ('list', $tryPath))/code = '0') then $tryPath 261 | else f:getSvnRootUriRC($tryPath || '/', substring($steps, 2 + string-length($step1))) 262 | }; 263 | 264 | (:~ 265 | : Maps an atomic value to a boolean value. Intended for convenient 266 | : entry of boolean parameters. 267 | :) 268 | declare function f:booleanValue($s as xs:anyAtomicType?, $default as xs:boolean?) as xs:boolean { 269 | if (empty($s)) then boolean($default) 270 | else if ($s instance of xs:boolean) then $s 271 | else if ($s instance of xs:decimal) then $s ne 0 272 | else string($s) = ('true', 'y', '1') 273 | }; 274 | 275 | (:~ 276 | : Transforms a glob pattern into a regex. 277 | : 278 | : @param pattern a glob pattern 279 | : @return the equivalent regex 280 | :) 281 | declare function f:glob2regex($pattern as xs:string) 282 | as xs:string { 283 | replace($pattern, '\.', '\\.') 284 | ! replace(., '\*', '.*') 285 | ! replace(., '\?', '.') 286 | ! replace(., '[()\[\]{}^$]', '\\$0') 287 | ! concat('^', ., '$') 288 | }; 289 | 290 | (:~ 291 | : Creates a copy of a node with all "whitespace only" text nodes 292 | : which are element siblings removed. 293 | :) 294 | declare function f:prettyFoxPrint($n as node()) 295 | as node()? { 296 | copy $n_ := $n 297 | modify delete nodes $n_//text()[not(matches(., '\S'))][../*] 298 | return $n_ 299 | }; -------------------------------------------------------------------------------- /bin/tt/_pfilter_parser.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | :*************************************************************************** 3 | : 4 | : pfilter_parser.xqm - parses a pfilter into a structured representation (pfilter element) 5 | : 6 | : @version 20141205-1 first version 7 | :*************************************************************************** 8 | :) 9 | 10 | module namespace m="http://www.ttools.org/xquery-functions"; 11 | 12 | import module namespace i="http://www.ttools.org/xquery-functions" at 13 | "_constants.xqm", 14 | "_errorAssistent.xqm"; 15 | 16 | declare namespace z="http://www.ttools.org/structure"; 17 | 18 | (: 19 | : ============================================================================ 20 | : 21 | : p u b l i c f u n c t i o n s 22 | : 23 | : ============================================================================ 24 | :) 25 | 26 | (:~ 27 | : Parses a pfilter. 28 | : 29 | : @param text the text to be parsed 30 | : @return a structured representation of the pfilter 31 | :) 32 | declare function m:parsePfilter($text as xs:string?) 33 | as element()? { 34 | if (not($text)) then () else 35 | 36 | let $pfilterEtc := m:_parseOrExpr($text) 37 | let $pfilter := $pfilterEtc[. instance of node()] 38 | let $textAfter := $pfilterEtc[not(. instance of node())][string()] 39 | return 40 | if ($textAfter) then 41 | i:createError('INVALID_PFILTER', 42 | concat('Unexpected trailing text: ', $textAfter), ()) 43 | else 44 | element {QName($i:URI_PCOLLECTION, 'pfilter')} {$pfilter} 45 | }; 46 | 47 | (: 48 | : ============================================================================ 49 | : 50 | : p r i v a t e f u n c t i o n s 51 | : 52 | : ============================================================================ 53 | :) 54 | 55 | (:~ 56 | : Parses an OrExpr. 57 | : 58 | : @param text the text to be parsed 59 | : @return a structured representation of the Or expression, 60 | : followed by the text not yet parsed. 61 | :) 62 | declare function m:_parseOrExpr($text as xs:string) 63 | as item()+ { 64 | let $orEtc := m:_parseOrExprRC($text) 65 | let $orNodes := $orEtc[. instance of node()] 66 | let $textAfter := $orEtc[not(. instance of node())] 67 | return ( 68 | if (count($orNodes) lt 2) then $orNodes else 69 | element {QName($i:URI_PCOLLECTION, 'or')} {$orNodes}, 70 | $textAfter 71 | ) 72 | }; 73 | 74 | (:~ 75 | : Recursive helper function of '_parseOrExpr'. 76 | : 77 | : @param text the text to be parsed 78 | : @return a structured representation the remaining items of 79 | : the and expression, followed by the text not yet parsed 80 | :) 81 | declare function m:_parseOrExprRC($text as xs:string) 82 | as item()+ { 83 | let $andEtc := m:_parseAndExpr($text) 84 | let $and := $andEtc[. instance of node()] 85 | let $textAfter := replace($andEtc[not(. instance of node())], '^\s+', '') 86 | return ( 87 | $and, 88 | if (not(starts-with($textAfter, '||'))) then $textAfter else 89 | m:_parseOrExprRC(substring($textAfter, 3)) 90 | ) 91 | }; 92 | 93 | (:~ 94 | : Parses an AndExpr. 95 | : 96 | : @param text the text to be parsed 97 | : @return a structured representation of the And expression, 98 | : followed by the text not yet parsed. 99 | :) 100 | declare function m:_parseAndExpr($text as xs:string) 101 | as item()+ { 102 | let $andEtc := m:_parseAndExprRC($text) 103 | let $andNodes := $andEtc[. instance of node()] 104 | let $textAfter := $andEtc[not(. instance of node())] 105 | return ( 106 | if (count($andNodes) lt 2) then $andNodes else 107 | element {QName($i:URI_PCOLLECTION, 'and')} {$andNodes}, 108 | $textAfter 109 | ) 110 | }; 111 | 112 | (:~ 113 | : Recursive helper function of '_parseAndExpr'. 114 | : 115 | : @param text the text to be parsed 116 | : @return a structured representation the remaining items of 117 | : the and expression, followed by the text not yet parsed 118 | :) 119 | declare function m:_parseAndExprRC($text as xs:string) 120 | as item()+ { 121 | let $particleEtc := m:_parseParticle($text) 122 | let $particle := $particleEtc[. instance of node()] 123 | let $textAfter := replace($particleEtc[not(. instance of node())], '^\s+', '') 124 | return ( 125 | $particle, 126 | if (not(starts-with($textAfter, '&&'))) then $textAfter 127 | else m:_parseAndExprRC(substring($textAfter, 3)) 128 | ) 129 | }; 130 | 131 | (:~ 132 | : Parses a particle, which is either a parenthesized expression, or 133 | : a not expression, or a ptest. 134 | : 135 | : @param text the text to be parsed 136 | : @return a structured representation of the particule, followed 137 | : by the text not yet parsed 138 | :) 139 | declare function m:_parseParticle($text as xs:string) 140 | as item()+ { 141 | let $useText := replace($text, '^\s+', '') 142 | return 143 | if (starts-with($useText, '(')) then m:_parseParenthesizedExpr($useText) 144 | else if (matches($useText, '^not\s*\(')) then m:_parseNotExpr($useText) 145 | else m:_parsePtest($useText) 146 | }; 147 | 148 | (:~ 149 | : Parses a parenthesized expression. 150 | : 151 | : @param text the text to be parsed 152 | : @return a structured representation of the parenthesized expression, 153 | : followed by the text not yet parsed 154 | :) 155 | declare function m:_parseParenthesizedExpr($text as xs:string) 156 | as item()+ { 157 | let $useText := replace($text, '^\s*\(', '') 158 | let $orEtc := m:_parseOrExpr($useText) 159 | let $or := $orEtc[. instance of node()] 160 | let $textAfter := replace($orEtc[not(. instance of node())], '^\s+', '') 161 | return 162 | if (not(starts-with($textAfter, ')'))) then 163 | i:createError('PFILTER_SYNTAX_ERROR', 'Unbalanced parentheses', ()) 164 | else ( 165 | $or, 166 | substring($textAfter, 2) 167 | ) 168 | }; 169 | 170 | (:~ 171 | : Parses a not expression. 172 | : 173 | : @param text the text to be parsed 174 | : @return a structured representation of the not expression, 175 | : followed by the text not yet parsed 176 | :) 177 | declare function m:_parseNotExpr($text as xs:string) 178 | as item()+ { 179 | let $useText := replace($text, '^\s*not\s*\(', '') 180 | let $orEtc := m:_parseOrExpr($useText) 181 | let $or := $orEtc[. instance of node()] 182 | let $textAfter := replace($orEtc[not(. instance of node())], '^\s+', '') 183 | return 184 | if (not(starts-with($textAfter, ')'))) then 185 | i:createError('PFILTER_SYNTAX_ERROR', 'Unbalanced parentheses', ()) 186 | else ( 187 | element {QName($i:URI_PCOLLECTION, 'not')} {$or}, 188 | substring($textAfter, 2) 189 | ) 190 | }; 191 | 192 | (:~ 193 | : Parses a p-test consisting of a property name, an operator and a 194 | : test value which may be a single item or a list of one or more items. 195 | : A list of items is comma-separated and delimited by parentheses. 196 | : 197 | : Precondition: the received text starts with the first character of 198 | : the property name (optionally preceded by whitespace). 199 | : 200 | : @param text the text to be parsed 201 | : @return structured representation of the p-test, followed by the 202 | : remaining text not yet parsed 203 | :) 204 | declare function m:_parsePtest($text as xs:string) 205 | as item()+ { 206 | let $pname := replace($text, '^(\s*\i\c*).*', '$1') 207 | let $op := replace(substring($text, 1 + string-length($pname)), '^(\s*[=~><]+).*', '$1') 208 | let $valueEtc := 209 | let $text := substring($text, 1 + string-length($pname) + string-length($op)) 210 | return 211 | m:_parseValue($text) 212 | return ( 213 | element {QName($i:URI_PCOLLECTION, 'p')} { 214 | attribute name {replace($pname, '^\s+', '')}, 215 | attribute op {replace($op, '^\s+', '')}, 216 | $valueEtc[. instance of node()] 217 | }, 218 | $valueEtc[not(. instance of node())] 219 | ) 220 | }; 221 | 222 | (:~ 223 | : Parses a test value which may by a single item or a list of one or more 224 | : items. A list of items is comma-separated and delimited by parentheses. 225 | : 226 | : @param text the text to be parsed 227 | : @return a structured representation of the value, followed by 228 | : the remaining text not yet parsed 229 | :) 230 | declare function m:_parseValue($text as xs:string) 231 | as item()+ { 232 | let $useText := replace($text, '^\s+', '') 233 | return 234 | if (starts-with($useText, '(')) then m:_parseValueItemList($useText) 235 | else m:_parseSimpleValue($useText) 236 | }; 237 | 238 | (:~ 239 | : Parses a test value consisting of (possibly) multiple items. The value 240 | : is a comma-separated list of value items, delimited by parentheses. 241 | : 242 | : Precondition: the received text starts with ( 243 | : 244 | : @param text the text to be parsed 245 | : @return structured representation of the value list (items element 246 | : with item child elements), followed by the remaining text not yet 247 | : parsed 248 | :) 249 | declare function m:_parseValueItemList($text as xs:string) 250 | as item()+ { 251 | let $itemsEtc := m:_parseValueItemListRC(substring($text, 2)) 252 | return ( 253 | element {QName($i:URI_PCOLLECTION, 'value')} 254 | {$itemsEtc[. instance of node()]}, 255 | $itemsEtc[not(. instance of node())] 256 | ) 257 | }; 258 | 259 | (:~ 260 | : Recursive helper function of '_parseValueItemList'. 261 | : 262 | : @param text the text to be parsed 263 | : @return an 'item' element containing the next value item, 264 | : and the remainder of the input string not yet parsed 265 | :) 266 | declare function m:_parseValueItemListRC($text as xs:string) 267 | as item()+ { 268 | let $item := replace($text, concat( 269 | '^(', 270 | '( [^,)\\] | \\[,)\\] )+', (: all chars except ,)\, or escaped ,)\ :) 271 | ').*'), '$1', 'x') 272 | let $textAfter := substring($text, 1 + string-length($item)) 273 | let $useItem := replace(replace($item, '^\s+|\s+$', ''), '\\([,)\\])', '$1') 274 | return ( 275 | element {QName($i:URI_PCOLLECTION, 'item')} {$useItem}, 276 | if (starts-with($textAfter, ')')) then substring($textAfter, 2) 277 | else if (starts-with($textAfter, ',')) then 278 | m:_parseValueItemListRC(substring($textAfter, 2)) 279 | else i:createError('INVALID_PFILTER_STRING', 'Invalid value list', ()) 280 | ) 281 | }; 282 | 283 | (:~ 284 | : Parses a test value consisting of a single item. Such a value 285 | : is distinguished from test values which may containn multiple items 286 | : by not starting with an opening parenthesis. 287 | : 288 | : Precondition: the input string starts with the test value to be 289 | : parsed. 290 | : 291 | : @param text the text to be parsed 292 | : @return a 'value' element containing the value and a string containing 293 | : the remainder of the input text not yet parsed 294 | :) 295 | declare function m:_parseSimpleValue($text as xs:string) 296 | as item()+ { 297 | let $item := replace($text, concat( 298 | '^(', 299 | '( [^&|)\\] | \\[&|)\\] )+', (: all chars except &|§\, or escaped &|§\ :) 300 | ').*'), '$1', 'x') 301 | let $textAfter := substring($text, 1 + string-length($item)) 302 | let $useItem := replace(replace($item, '^\s+|\s+$', ''), '\\([&|)\\])', '$1') 303 | return ( 304 | element {QName($i:URI_PCOLLECTION, 'value')} {$useItem}, 305 | $textAfter 306 | ) 307 | }; 308 | -------------------------------------------------------------------------------- /bin/tt/_sqlExecutor.xqm: -------------------------------------------------------------------------------- 1 | (: 2 | :*************************************************************************** 3 | : 4 | : sqlExecutor.xqm - functions for executing SQL commands 5 | : 6 | :*************************************************************************** 7 | :) 8 | 9 | module namespace f="http://www.ttools.org/xquery-functions"; 10 | import module namespace tt="http://www.ttools.org/xquery-functions" at 11 | "_request.xqm", 12 | "_reportAssistent.xqm", 13 | "_errorAssistent.xqm", 14 | "_nameFilter.xqm", 15 | "_sqlWriter.xqm"; 16 | 17 | declare namespace z="http://www.ttools.org/structure"; 18 | 19 | (: 20 | : ============================================================================ 21 | : 22 | : p u b l i c f u n c t i o n s 23 | : 24 | : ============================================================================ 25 | :) 26 | 27 | declare function f:execute($conn as xs:integer, $sql as xs:string) 28 | as item()* { 29 | sql:execute($conn, $sql) 30 | }; 31 | 32 | (:~ 33 | : Creates a connection to server $server, with user $user and password $pw. 34 | : 35 | : @param server the server name (e.g. 'localhost') 36 | : @param user the user name 37 | : @param pw the password 38 | : @return the connection handle 39 | :) 40 | declare function f:connect($server as xs:string, $user as xs:string, $pw as xs:string?) 41 | as xs:integer { 42 | let $uri := concat('jdbc:mysql://', $server) 43 | return 44 | sql:connect($uri, $user, $pw) 45 | 46 | }; 47 | 48 | (:~ 49 | : Creates a database. 50 | : 51 | : @param conn the connection handle 52 | : @return nothing 53 | :) 54 | declare function f:sqlCreateDb($conn as xs:integer, $createDb as element(createDb)) 55 | as empty-sequence() { 56 | let $sql := tt:writeSql($createDb) 57 | return 58 | f:execute($conn, $sql) 59 | }; 60 | 61 | (:~ 62 | : Deletes a database. 63 | : 64 | : @param conn the connection handle 65 | : @return nothing 66 | :) 67 | declare function f:sqlDropDb($conn as xs:integer, $dropDb as element(dropDb)) 68 | as empty-sequence() { 69 | let $sql := tt:writeSql($dropDb) 70 | return 71 | f:execute($conn, $sql) 72 | }; 73 | 74 | (:~ 75 | : Creates a database. 76 | : 77 | : @param conn the connection handle 78 | : @return a report of the accessible databases 79 | :) 80 | declare function f:createDb($conn as xs:integer, $db as xs:string) 81 | as empty-sequence() { 82 | let $cmd := concat('CREATE DATABASE IF NOT EXISTS ', $db, ' CHARACTER SET utf8;') 83 | return 84 | f:execute($conn, $cmd) 85 | }; 86 | 87 | (:~ 88 | : Returns a 'dbs' element reporting the accessible databases. 89 | : 90 | : @param conn the connection handle 91 | : @return a report of the accessible databases 92 | :) 93 | declare function f:sqlShowDatabases($conn as xs:integer) 94 | as element() { 95 | let $cmd := 'SHOW DATABASES;' 96 | let $dbsRaw := f:execute($conn, $cmd) 97 | let $dbs := 98 | for $db in $dbsRaw/sql:column[@name eq 'Database']/string() 99 | return {$db} 100 | return 101 | {$dbs} 102 | }; 103 | 104 | (:~ 105 | : Returns a 'tables' element reporting the tables of a given database. 106 | : 107 | : @param conn the connection handle 108 | : @param db the database name 109 | : @return a report of the accessible databases 110 | :) 111 | declare function f:sqlInfoTables($conn as xs:integer, $db as xs:string) 112 | as element() { 113 | let $cmdUseDb := 'USE INFORMATION_SCHEMA' 114 | let $cmdSelect := concat('SELECT TABLE_NAME FROM TABLES WHERE TABLE_SCHEMA=''', $db, '''') 115 | let $retUse := f:execute($conn, $cmdUseDb) 116 | let $tablesRaw := f:execute($conn, $cmdSelect) 117 | let $tables := 118 | for $table in $tablesRaw/sql:column[@name eq 'TABLE_NAME']/string() 119 | order by lower-case($table) 120 | return {$table}
121 | return 122 | { 123 | $tables 124 | } 125 | }; 126 | 127 | (:~ 128 | : Returns a 'tables' element reporting the tables of a given database. 129 | : 130 | : @param conn the connection handle 131 | : @param db the database name 132 | : @return a report of the accessible databases 133 | :) 134 | declare function f:sqlInfoColumns($conn as xs:integer, 135 | $db as xs:string, 136 | $tableFilters as element(nameFilter)*, 137 | $columnFilters as element(nameFilter)*, 138 | $typeFilters as element(nameFilter)*) 139 | as element() { 140 | let $cmdUseDb := concat('USE ', $db) 141 | let $tables := f:sqlInfoTables($conn, $db) 142 | let $infoAtts := ( 143 | if (empty($tableFilters)) then () else attribute tableFilter {string-join($tableFilters/@text, '; ')}, 144 | if (empty($columnFilters)) then () else attribute columnFilter {string-join($columnFilters/@text, '; ')}, 145 | if (empty($typeFilters)) then () else attribute dtypeFilter {string-join($typeFilters/@text, '; ')}, 146 | () 147 | ) 148 | let $tableCols := 149 | let $colNames := ('COLUMN_NAME', 'COLUMN_TYPE', 'COLUMN_DEFAULT') 150 | let $colNamesDesc := string-join(for $n in $colNames return concat('`', $n, '`'), ', ') 151 | for $table in $tables/* 152 | let $cmdSelect := concat('SELECT ', $colNamesDesc, ' FROM `COLUMNS` WHERE TABLE_SCHEMA=''', $db, ''' and TABLE_NAME=''', $table, '''') 153 | let $tableColumnsRaw := f:execute($conn, $cmdSelect) 154 | where not($tableFilters) or (some $tf in $tableFilters satisfies tt:matchesNameFilter($table, $tf)) 155 | return 156 | { 157 | for $record in $tableColumnsRaw 158 | let $name := $record/sql:column[lower-case(@name) eq 'column_name']/string() 159 | let $type := $record/sql:column[lower-case(@name) eq 'column_type']/string() 160 | let $default := $record/sql:column[lower-case(@name) eq 'column_default']/string() 161 | order by lower-case($name) 162 | where (not($columnFilters) or (some $cf in $columnFilters satisfies tt:matchesNameFilter($name, $cf))) 163 | and 164 | (not($typeFilters) or (some $df in $typeFilters satisfies tt:matchesNameFilter($type, $df))) 165 | return 166 | { 167 | if (not($type)) then () else attribute type {$type}, 168 | if (not($default)) then () else attribute default {$default} 169 | } 170 | }
171 | let $countCols := sum($tableCols/@coundColumns/xs:integer) 172 | return 173 | { 174 | $infoAtts, 175 | $tableCols 176 | } 177 | }; 178 | 179 | (:~ 180 | : Creates a data base table. 181 | : 182 | : @param conn the connection handle 183 | : @param db the database name 184 | : @param tableDesc an XML descriptor of the 'createTable' command 185 | : @return a report of the accessible databases 186 | :) 187 | declare function f:sqlCreateTable($conn as xs:integer, 188 | $db as xs:string?, 189 | $tableDesc as element(createTable)) 190 | as element() { 191 | let $sqlUseDb := concat('USE ', $db) 192 | let $sqlCreateTable := tt:writeSql($tableDesc) 193 | let $retCmeUseDb := f:execute($conn, $sqlUseDb) 194 | let $retCreateTable := f:execute($conn, $sqlCreateTable) 195 | return 196 | { 197 | {$tableDesc}, 198 | {$sqlCreateTable} 199 | } 200 | }; 201 | 202 | (:~ 203 | : Executes a 'DROP TABLE' command supplied as a command descriptor. 204 | : 205 | : @param conn the connection handle 206 | : @param db the database name 207 | : @param table the table name 208 | : @return 1, if the table was dropped, 0, if it does not exist 209 | :) 210 | declare function f:sqlDropTable($conn as xs:integer, 211 | $db as xs:string?, 212 | $table as xs:string) 213 | as xs:integer { 214 | if (not(f:sqlTableExists($conn, $db, $table))) then 0 else 215 | 216 | let $retUseDb := 217 | if (not($db)) then () else 218 | f:execute($conn, concat('USE `', $db, '`')) 219 | 220 | let $sqlDropTable := concat('DROP TABLE IF EXISTS `', $table, '`') 221 | let $retDropTable := f:execute($conn, $sqlDropTable) 222 | return 223 | 1 224 | }; 225 | 226 | (:~ 227 | : Returns true if the specified table exists, false otherwise. 228 | : 229 | : @param conn connection handle 230 | : @param db specifies the database 231 | : @param table the table name 232 | : @return true if the table exists, false otherwise 233 | :) 234 | declare function f:sqlTableExists($conn as xs:integer, 235 | $db as xs:string?, 236 | $table as xs:string) 237 | as xs:boolean { 238 | let $fromClause := if (not($db)) then () else concat("FROM `", $db, "` ") 239 | let $sqlCheckExists := concat("SHOW TABLES ", $fromClause, "LIKE '", $table, "'") 240 | let $retCheckExists := f:execute($conn, $sqlCheckExists) 241 | return 242 | exists($retCheckExists) 243 | }; 244 | 245 | (:~ 246 | : Executes an 'INSERT' command supplied as a command descriptor. 247 | : 248 | : @param conn the connection handle 249 | : @param db the database name 250 | : @param tableDesc an XML descriptor of the 'createTable' command 251 | : @return a report of the accessible databases 252 | :) 253 | declare function f:execInsert($conn as xs:integer, 254 | $db as xs:string?, 255 | $insert as element(insert)) 256 | as element() { 257 | let $retUseDb := 258 | let $db := ($db, $insert/@db)[1] 259 | return 260 | if (not($db)) then () else 261 | let $sqlUse := concat('USE ', $db) 262 | return f:execute($conn, $sqlUse) 263 | 264 | 265 | let $sqlInsert := tt:writeSql($insert) 266 | let $retInsert := f:execute($conn, $sqlInsert) 267 | return 268 | { 269 | {$insert}, 270 | {$sqlInsert} 271 | } 272 | }; 273 | 274 | (:~ 275 | : Executes a 'SELECT' command supplied as a command descriptor. 276 | : 277 | : @param conn the connection handle 278 | : @param db the database name 279 | : @param tableDesc an XML descriptor of the 'createTable' command 280 | : @return a report of the accessible databases 281 | :) 282 | declare function f:execSelect($conn as xs:integer, 283 | $db as xs:string?, 284 | $select as element(select)) 285 | as element() { 286 | let $retUseDb := 287 | let $db := ($db, $select/@db)[1] 288 | return 289 | if (not($db)) then () else 290 | let $sqlUse := concat('USE ', $db) 291 | return f:execute($conn, $sqlUse) 292 | 293 | 294 | let $sqlSelect := tt:writeSql($select) 295 | let $retSelect := f:execute($conn, $sqlSelect) 296 | return 297 | 308 | }; 309 | -------------------------------------------------------------------------------- /bin/example.xqm: -------------------------------------------------------------------------------- 1 | (: logOperations.xqm - reports the service operations observed in a JMeter log 2 | : 3 | : @version 20140124-1 4 | : =================================================================================== 5 | :) 6 | 7 | (:~@interface 8 | 9 | 10 | 11 | 12 | doc docs 13 | 14 | 15 | 16 | 17 | 18 | 19 | doc docs 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | doc dcat 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | :) 45 | 46 | module namespace f="http://www.ttools.org/ttools/xquery-functions"; 47 | import module namespace tt="http://www.ttools.org/xquery-functions" at 48 | "tt/_request.xqm", 49 | "tt/_reportAssistent.xqm", 50 | "tt/_nameFilter.xqm"; 51 | 52 | declare namespace z="http://www.ttools.org/ttools/structure"; 53 | declare namespace soap="http://schemas.xmlsoap.org/soap/envelope/"; 54 | 55 | (:~ 56 | : Demo operation 'count'. Note how the code relies on the 57 | : binding of a document node to the parameter 'doc'. This is 58 | : possible because the parameter is configured to have 59 | : type 'docUri' and to be required. 60 | : 61 | : @param request the operation request 62 | : @return a report yielding various counts 63 | :) 64 | 65 | declare function f:getCounts($request as element()) 66 | as element() { 67 | let $doc1 as document-node()* := tt:getParam($request, 'doc') 68 | let $doc2 as document-node()* := tt:getParam($request, 'docs') 69 | let $docs := ($doc1, $doc2) 70 | 71 | let $countElems := count($docs//*) 72 | let $countAtts := count($docs//@*) 73 | let $countNodes := count($docs//(node(), @*)) 74 | return 75 | { 76 | {$countElems}, 77 | {$countAtts}, 78 | {$countNodes} 79 | } 80 | }; 81 | 82 | (:~ 83 | : Demo operation 'count'. Note how the code relies on the 84 | : binding of a document node to the parameter 'doc'. This is 85 | : possible because the parameter is configured to have 86 | : type 'docUri' and to be required. 87 | : 88 | : @param request the operation request 89 | : @return a report yielding various counts 90 | :) 91 | 92 | declare function f:getPaths($request as element()) 93 | as element() { 94 | let $scope as xs:string := tt:getParam($request, 'scope') 95 | let $skipRoot as xs:boolean := tt:getParam($request, 'skipRoot') 96 | 97 | let $doc1 as document-node()* := tt:getParam($request, 'doc') 98 | let $doc2 as document-node()* := tt:getParam($request, 'docs') 99 | let $docs := ($doc1, $doc2) 100 | 101 | let $attPaths := 102 | if (not($scope = ('all', 'atts'))) then () else 103 | for $p in distinct-values($docs//@*/f:getPath(., $skipRoot)) 104 | order by lower-case($p) return 105 | let $elemPaths := 106 | let $elems := 107 | if ($scope = ('all', 'elems')) then $docs//* 108 | else if ($scope = 'leaves') then $docs//*[not(*)] 109 | else () 110 | for $p in distinct-values($elems/f:getPath(., $skipRoot)) 111 | order by lower-case($p) return 112 | return 113 | { 114 | $attPaths, 115 | $elemPaths 116 | } 117 | }; 118 | 119 | declare function f:getPath($n as node(), $skipRoot as xs:boolean) 120 | as xs:string { 121 | let $root := $n/ancestor-or-self::*[last()] return 122 | string-join($n/ancestor-or-self::node()[not($skipRoot) or . >> $root]/ 123 | concat(self::attribute()/'@', local-name()), '/') 124 | }; 125 | 126 | (:~ 127 | : Demo operation 'getItemReport'. Note the name filter retrieved 128 | : from the request. 129 | : 130 | : @param request the operation request 131 | : @return a report yielding various counts 132 | :) 133 | declare function f:getItemReport($request as element()) 134 | as item() { 135 | let $doc as document-node()* := ( 136 | tt:getParam($request, 'doc'), 137 | tt:getParam($request, 'dcat') 138 | ) 139 | let $nameFilter as element(nameFilter) := tt:getParam($request, 'names') 140 | let $count as xs:boolean := tt:getParam($request, 'count') 141 | let $scope as xs:string := tt:getParam($request, 'scope') 142 | let $path as xs:boolean := tt:getParam($request, 'path') 143 | let $simple as xs:boolean := tt:getParam($request, 'simple') 144 | let $nval as xs:integer := tt:getParam($request, 'nval') 145 | let $nvalues as element(nameFilterMap)? := tt:getParam($request, 'nvalues') 146 | let $npvalues as element(nameFilterMap)? := tt:getParam($request, 'npvalues') 147 | let $path := if ($npvalues) then true() else $path 148 | 149 | let $elemNameInfos := if ($scope eq 'atts') then () else 150 | let $elems := $doc//*[not($simple) or not(*)] 151 | let $elemNames := tt:filterNames(distinct-values($elems/local-name(.)), $nameFilter) 152 | for $n in $elemNames 153 | let $myItems := $elems[local-name(.) eq $n] 154 | let $countInfo := if (not($count)) then () else attribute count {count($myItems)} 155 | let $pathInfo := if (not($path)) then () else 156 | let $paths := distinct-values($myItems/f:_getPath(.)) 157 | return 158 | if (count($paths) eq 1) then ( 159 | attribute path {$paths}, 160 | if (not($npvalues)) then () else 161 | f:_getValues($n, $npvalues, $myItems) 162 | ) else 163 | { 164 | for $p in $paths order by lower-case($p) return 165 | { 166 | if (not($npvalues)) then () else 167 | let $pathItems := $myItems[f:_getPath(.) eq $p] return 168 | f:_getValues($n, $npvalues, $pathItems) 169 | } 170 | } 171 | let $valueInfo := 172 | if (not($nvalues)) then () 173 | else if (empty($myItems[not(*)])) then () 174 | else f:_getValues($n, $nvalues, $myItems) 175 | return 176 | { 177 | ($countInfo, $pathInfo, $valueInfo)/self::attribute(), 178 | ($countInfo, $pathInfo, $valueInfo)/self::element() 179 | } 180 | 181 | let $attNameInfos := if ($scope eq 'elems') then () else 182 | let $atts := $doc//@* 183 | let $attNames := tt:filterNames(distinct-values($atts/local-name()), $nameFilter) 184 | for $n in $attNames 185 | let $myItems := $atts[local-name(.) eq $n] 186 | let $countInfo := if (not($count)) then () else attribute count {count($myItems)} 187 | let $pathInfo := if (not($path)) then () else 188 | let $paths := distinct-values($myItems/f:_getPath(.)) 189 | return 190 | if (count($paths) eq 1) then ( 191 | attribute path {$paths}, 192 | if (not($npvalues)) then () else 193 | f:_getValues($n, $npvalues, $myItems) 194 | ) else 195 | { 196 | for $p in $paths order by lower-case($p) return 197 | { 198 | if (not($npvalues)) then () else 199 | let $pathItems := $myItems[f:_getPath(.) eq $p] return 200 | f:_getValues($n, $npvalues, $pathItems) 201 | } 202 | } 203 | (: 204 | if (count($paths) eq 1) then attribute path {$paths} 205 | else 206 | { 207 | for $p in $paths order by lower-case($p) return 208 | } 209 | :) 210 | let $valueInfo := 211 | if (not($nvalues)) then () 212 | else f:_getValues($n, $nvalues, $myItems) 213 | return 214 | { 215 | ($countInfo, $pathInfo, $valueInfo)/self::attribute(), 216 | ($countInfo, $pathInfo, $valueInfo)/self::element() 217 | } 218 | return 219 | { 220 | for $item in ($elemNameInfos, $attNameInfos) 221 | order by lower-case($item/@name) 222 | return $item 223 | } 224 | }; 225 | 226 | declare function f:_getPath($n as node()) 227 | as xs:string { 228 | string-join($n/ancestor-or-self::node() 229 | [not(self::document-node())][not(parent::document-node())]/concat(self::attribute()/'@', local-name(.)), '/') 230 | }; 231 | 232 | declare function f:_getValueCount($name as xs:string, $nvalues as element(nameFilterMap)?) 233 | as xs:integer? { 234 | let $value := tt:nameFilterMapValue($name, $nvalues, "10") 235 | return 236 | if ($value eq '*') then -1 else xs:integer($value) 237 | }; 238 | 239 | (:~ 240 | : Returns a sample of text values found in a set of items. 241 | : 242 | : @param name the name of the items 243 | : @param nvalues a name filter map specifying the number of items 244 | : dependent on the name 245 | : @param items the items 246 | : @return an element containing the values 247 | :) 248 | declare function f:_getValues($name as xs:string, 249 | $nvalues as element(nameFilterMap), 250 | $items as node()*) 251 | as element(z:values)? { 252 | if ($items[1]/self::element() and empty($items[not(*)])) then () else 253 | 254 | let $values := distinct-values($items[not(*)]) 255 | let $valueCount := f:_getValueCount($name, $nvalues) 256 | return 257 | if (not($valueCount)) then () else 258 | { 259 | for $v in $values[$valueCount lt 0 or position() le $valueCount] 260 | order by $v return 261 | } 262 | }; -------------------------------------------------------------------------------- /bin/tt/_foxpath-resourceTreeTypeDependent.xqm: -------------------------------------------------------------------------------- 1 | module namespace f="http://www.ttools.org/xquery-functions"; 2 | import module namespace i="http://www.ttools.org/xquery-functions" at 3 | "_foxpath-processorDependent.xqm", 4 | "_foxpath-util.xqm"; 5 | 6 | declare variable $f:UNAME external := 'hrennau'; 7 | declare variable $f:TOKEN external := try {unparsed-text('/git/token')} catch * {()}; 8 | 9 | declare function f:getResponse($path as xs:string, $uname as xs:string?, $token as xs:string) 10 | as node()+ { 11 | let $rq := 12 | { 13 | $uname ! , 14 | 15 | } 16 | let $rs := http:send-request($rq) 17 | let $rsHeader := $rs[1] 18 | let $body := $rs[position() gt 1] 19 | return 20 | ($body, $rsHeader)[1] 21 | }; 22 | 23 | declare function f:fox-unparsed-text($uri as xs:string, $options as map(*)?) 24 | as xs:string? { 25 | let $text := f:redirectedRetrieval($uri, $options) 26 | return 27 | try {if ($text) then $text else unparsed-text($uri)} 28 | catch * {()} 29 | }; 30 | 31 | declare function f:fox-unparsed-text-lines($uri as xs:string, $options as map(*)?) 32 | as xs:string* { 33 | let $text := f:redirectedRetrieval($uri, $options) 34 | return 35 | try {if ($text) then tokenize($text, ' ?') else unparsed-text-lines($uri)} 36 | catch * {()} 37 | }; 38 | 39 | declare function f:fox-doc($uri as xs:string, $options as map(*)?) 40 | as document-node()? { 41 | let $text := f:redirectedRetrieval($uri, $options) 42 | return 43 | try {if ($text) then parse-xml($text) else doc($uri)} 44 | catch * {()} 45 | }; 46 | 47 | declare function f:fox-doc-available($uri as xs:string, $options as map(*)?) 48 | as xs:boolean { 49 | let $text := f:redirectedRetrieval($uri, $options) 50 | return 51 | try {if ($text) then exists(parse-xml($text)) else doc-available($uri)} 52 | catch * {false()} 53 | }; 54 | 55 | declare function f:fox-file-lines($uri as xs:string, $options as map(*)?) 56 | as xs:string* { 57 | let $text := f:redirectedRetrieval($uri, $options) 58 | return 59 | try {if ($text) then tokenize($text, ' ') else unparsed-text-lines($uri)} 60 | catch * {()} 61 | }; 62 | 63 | declare function f:redirectedRetrieval($uri as xs:string, $options as map(*)?) 64 | as xs:string? { 65 | let $rtrees := 66 | if (empty($options)) then () 67 | else map:get($options, 'URI_TREES') 68 | let $redirect := $rtrees//file[$uri eq concat(ancestor::tree/@baseURI, @path)]/@uri 69 | return 70 | try { 71 | if ($redirect) then 72 | let $doc := f:getResponse($redirect, $f:UNAME, $f:TOKEN) 73 | return $doc//content/convert:binary-to-string(xs:base64Binary(.)) 74 | else () 75 | } catch * {()} 76 | }; 77 | 78 | declare function f:childUriCollection($uri as xs:string, 79 | $name as xs:string?, 80 | $stepDescriptor as element()?, 81 | $options as map(*)?) { 82 | (: let $DUMMY := trace($uri, 'CHILD_URI_COLLECTION; URI: ') return :) 83 | if (matches($uri, '^https://')) then 84 | f:childUriCollection_uriTree($uri, $name, $stepDescriptor, $options) else 85 | 86 | let $kindFilter := $stepDescriptor/@kindFilter 87 | let $ignKindTest := 88 | try {file:list($uri, false(), $name) 89 | ! replace(., '\\', '/') 90 | ! replace(., '/$', '') 91 | } catch * {()} 92 | return 93 | if (not($kindFilter)) then $ignKindTest 94 | else 95 | let $useUri := replace($uri, '/$', '') 96 | return 97 | if ($kindFilter eq 'file') then 98 | $ignKindTest[file:is-file(concat($useUri, '/', .))] 99 | else if ($kindFilter eq 'dir') then 100 | $ignKindTest[file:is-dir(concat($useUri, '/', .))] 101 | else 102 | error(QName((), 'PROGRAM_ERROR'), concat('Unexpected kind filter: ', $kindFilter)) 103 | }; 104 | 105 | (:~ 106 | : Returns the descendants of an input URI. If the $stopDescriptor specifies 107 | : a kind test (is-dir or is-file), this test is evaluted. 108 | :) 109 | declare function f:descendantUriCollection($uri as xs:string, 110 | $name as xs:string?, 111 | $stepDescriptor as element()?, 112 | $options as map(*)?) { 113 | if (matches($uri, '^https://')) then 114 | f:descendantUriCollection_uriTree($uri, $name, $stepDescriptor, $options) else 115 | 116 | let $kindFilter := $stepDescriptor/@kindFilter 117 | let $ignKindTest := 118 | try { 119 | file:list($uri, true(), $name) 120 | ! replace(., '\\', '/') 121 | ! replace(., '/$', '') 122 | } catch * {()} 123 | return 124 | if (not($kindFilter)) then $ignKindTest 125 | else 126 | let $useUri := replace($uri, '/$', '') 127 | return 128 | if ($kindFilter eq 'file') then 129 | $ignKindTest[file:is-file(concat($useUri, '/', .))] 130 | else if ($kindFilter eq 'dir') then 131 | $ignKindTest[file:is-dir(concat($useUri, '/', .))] 132 | else 133 | error(QName((), 'PROGRAM_ERROR'), concat('Unexpected kind filter: ', $kindFilter)) 134 | }; 135 | 136 | declare function f:childUriCollection_uriTree($uri as xs:string, 137 | $name as xs:string?, 138 | $stepDescriptor as element()?, 139 | $options as map(*)?) { 140 | (: let $DUMMY := trace($uri, 'CHILD_FROM_URI_TREE, URI: ') :) 141 | let $rtrees := 142 | if (empty($options)) then () 143 | else map:get($options, 'URI_TREES') 144 | return if (empty($rtrees)) then () else 145 | (: let $DUMMY := trace(count($rtrees), 'COUNT_RTREES: ') :) 146 | 147 | let $kindFilter := $stepDescriptor/@kindFilter 148 | let $baseUris := $rtrees/tree/@baseURI 149 | 150 | let $ignNameTest := distinct-values( 151 | let $uri_ := 152 | if (ends-with($uri, '/')) then $uri else concat($uri, '/') 153 | let $precedingTreeBaseUris := $baseUris[starts-with($uri_, .)] 154 | return 155 | (: case 1: URI starts with base uris :) 156 | if ($precedingTreeBaseUris) then 157 | for $bu in $precedingTreeBaseUris 158 | let $tree := $bu/.. 159 | 160 | (: the matching elements :) 161 | let $matchElems := 162 | if ($bu eq $uri_) then 163 | if ($kindFilter eq 'file') then $tree/file 164 | else if ($kindFilter eq 'dir') then $tree/dir 165 | else $tree/* 166 | else 167 | let $match := $tree//*[concat($bu, @path) eq $uri] 168 | return 169 | if (not($match)) then () else 170 | if ($kindFilter eq 'file') then $match/file 171 | else if ($kindFilter eq 'dir') then $match/dir 172 | else $match/* 173 | return 174 | $matchElems/@name 175 | (: case 2: URI is the prefix of base uris :) 176 | else 177 | let $continuingTreeBaseUris := $baseUris[starts-with(., $uri_)][not(. eq $uri_)] 178 | return 179 | if (not($continuingTreeBaseUris)) then () 180 | else if ($kindFilter eq 'dir') then () 181 | else 182 | $continuingTreeBaseUris 183 | ! substring-after(., $uri_) 184 | ! replace(., '/.*', '') 185 | ) 186 | return 187 | if (not($name) or empty($ignNameTest)) then $ignNameTest 188 | else 189 | let $regex := concat('^', replace(replace($name, '\*', '.*', 's'), '\?', '.'), '$') 190 | return $ignNameTest[matches(., $regex, 'is')] 191 | }; 192 | 193 | declare function f:descendantUriCollection_uriTree($uri as xs:string, 194 | $name as xs:string?, 195 | $stepDescriptor as element()?, 196 | $options as map(*)?) { 197 | (: let $DUMMY := trace($uri, 'DESCENDANT_FROM_URI_TREE, URI: ') :) 198 | 199 | let $rtrees := 200 | if (empty($options)) then () 201 | else map:get($options, 'URI_TREES') 202 | return if (empty($rtrees)) then () else 203 | 204 | let $kindFilter := $stepDescriptor/@kindFilter 205 | let $baseUris := $rtrees/tree/@baseURI 206 | 207 | let $ignNameTest := distinct-values( 208 | let $uri_ := if (ends-with($uri, '/')) then $uri else concat($uri, '/') 209 | let $precedingTreeBaseUris := $baseUris[starts-with($uri_, .)] 210 | return 211 | (: case 1: URI starts with base uris :) 212 | if ($precedingTreeBaseUris) then 213 | for $bu in $precedingTreeBaseUris 214 | let $tree := $bu/.. 215 | 216 | (: potentially matching elements :) 217 | let $candidates := 218 | if ($kindFilter eq 'file') then $tree/descendant::file 219 | else if ($kindFilter eq 'dir') then $tree/descendant::dir 220 | else $tree/descendant::* 221 | 222 | (: the matching elements :) 223 | let $matchElems := 224 | if ($bu eq $uri_) then $candidates 225 | else 226 | let $match := $tree//*[concat($bu, @path) eq $uri] 227 | return 228 | if (not($match)) then () else 229 | $candidates[not(. << $match)] 230 | let $fullUris := 231 | $matchElems/concat($bu, @path) 232 | 233 | (: return the paths as postfix of input URI :) 234 | let $fromPos := string-length($uri) + 2 235 | return 236 | $fullUris ! substring(., $fromPos) 237 | 238 | (: case 2: URI is the prefix of base uris :) 239 | else 240 | let $continuingTreeBaseUris := $baseUris[starts-with(., $uri_)][not(. eq $uri_)] 241 | return 242 | if (not($continuingTreeBaseUris)) then () 243 | else 244 | for $bu in $continuingTreeBaseUris 245 | let $tree := $bu/.. 246 | let $suffix := substring-after($bu, $uri_) 247 | let $suffixSteps := tokenize($suffix, '/')[string()] 248 | return ( 249 | if ($kindFilter eq 'file') then () else 250 | for $i in 1 to count($suffixSteps) 251 | return 252 | string-join($suffixSteps[position() le $i], '/'), 253 | let $matchElems := 254 | if ($kindFilter eq 'file') then $tree/descendant::file 255 | else if ($kindFilter eq 'dir') then $tree/descendant-or-self::dir 256 | else $tree/descendant-or-self::* 257 | return 258 | $matchElems/@path ! concat($suffix, .) 259 | (: return the paths as postfix of input URI :) 260 | ) 261 | ) 262 | (: process name test :) 263 | return 264 | if (not($name) or empty($ignNameTest)) then $ignNameTest 265 | else 266 | let $regex := concat('^', replace(replace($name, '\*', '.*', 's'), '\?', '.'), '$') 267 | return 268 | if ($regex eq '^.*$') then $ignNameTest 269 | else 270 | $ignNameTest[matches(replace(., '^.*/', ''), $regex, 'is')] 271 | }; 272 | -------------------------------------------------------------------------------- /bin/tt/mongodb.xqm: -------------------------------------------------------------------------------- 1 | (:~ 2 | : This is a wrapper for the MongoDB driver implementation in Java. 3 | : 4 | : @author BaseX Team 2005-15, BSD License 5 | : @author Christian Gruen 6 | :) 7 | module namespace mongodb = "http://expath.org/ns/mongodb"; 8 | 9 | import module namespace m = "java:org.expath.ns.mongodb.MongoDB"; 10 | 11 | (:~ 12 | : Creates a new MongoDB client for the specified URL. 13 | : Example: {@code mongodb://root:root@localhost}. 14 | : @param $uri connection URI 15 | : @return client id 16 | :) 17 | declare function mongodb:connect($uri as xs:string) as xs:string { 18 | m:connect($uri) 19 | }; 20 | 21 | (:~ 22 | : Returns all client ids. 23 | : @return collections 24 | :) 25 | declare function mongodb:list-client-ids() as xs:string* { 26 | m:list-client-ids() 27 | }; 28 | 29 | (:~ 30 | : Returns the names of all databases. 31 | : @param $id client id 32 | : @return databases 33 | :) 34 | declare function mongodb:list-databases($id as xs:string) as xs:string* { 35 | m:list-databases($id) 36 | }; 37 | 38 | (:~ 39 | : Returns the names of all collections of a database. 40 | : @param $id client id 41 | : @param $database database 42 | : @return collections 43 | :) 44 | declare function mongodb:list-collections($id as xs:string, $database as xs:string) 45 | as xs:string* { 46 | m:list-collections($id, $database) 47 | }; 48 | 49 | (:~ 50 | : Finds documents. 51 | : @param $id client id 52 | : @param $database database 53 | : @param $collection collection 54 | : @return documents 55 | :) 56 | declare function mongodb:find($id as xs:string, $database as xs:string, 57 | $collection as xs:string) as map(*)* { 58 | m:find($id, $database, $collection) 59 | }; 60 | 61 | (:~ 62 | : Finds documents. 63 | : @param $id client id 64 | : @param $database database 65 | : @param $collection collection 66 | : @param $query query 67 | : @return documents 68 | :) 69 | declare function mongodb:find($id as xs:string, $database as xs:string, 70 | $collection as xs:string, $query as item()) as map(*)* { 71 | m:find($id, $database, $collection, $query) 72 | }; 73 | 74 | (:~ 75 | : Finds documents. 76 | : @param $id client id 77 | : @param $database database 78 | : @param $collection collection 79 | : @param $query query 80 | : @param $fields fields to return 81 | : @return documents 82 | :) 83 | declare function mongodb:find($id as xs:string, $database as xs:string, 84 | $collection as xs:string, $query as item(), $fields as map(*)) as map(*)* { 85 | m:find($id, $database, $collection, $query, $fields) 86 | }; 87 | 88 | (:~ 89 | : Finds and modifies documents. 90 | : @param $id client id 91 | : @param $database database 92 | : @param $collection collection 93 | : @param $query query 94 | : @param $update update operation 95 | : @return old document, if found 96 | :) 97 | declare function mongodb:find-and-modify($id as xs:string, $database as xs:string, 98 | $collection as xs:string, $query as map(*), $update as map(*)) as map(*)? { 99 | m:find-and-modify($id, $database, $collection, $query, $update) 100 | }; 101 | 102 | (:~ 103 | : Finds and modifies documents. 104 | : @param $id client id 105 | : @param $database database 106 | : @param $collection collection 107 | : @param $query query 108 | : @param $update update operation 109 | : @param $options options 110 | : @return old document, if found 111 | :) 112 | declare function mongodb:find-and-modify($id as xs:string, $database as xs:string, 113 | $collection as xs:string, $query as map(*), $update as map(*), $options as map(*)) 114 | as map(*)? { 115 | m:find-and-modify($id, $database, $collection, $query, $update, $options) 116 | }; 117 | 118 | (:~ 119 | : Finds and removed documents. 120 | : @param $id client id 121 | : @param $database database 122 | : @param $collection collection 123 | : @param $query query 124 | : @return old document, if found 125 | :) 126 | declare function mongodb:find-and-remove($id as xs:string, $database as xs:string, 127 | $collection as xs:string, $query as map(*)) as map(*)? { 128 | m:find-and-remove($id, $database, $collection, $query) 129 | }; 130 | 131 | (:~ 132 | : Finds a single document. 133 | : @param $id client id 134 | : @param $database database 135 | : @param $collection collection 136 | : @return document, if found 137 | :) 138 | declare function mongodb:find-one($id as xs:string, $database as xs:string, 139 | $collection as xs:string) as map(*)? { 140 | m:find-one($id, $database, $collection) 141 | }; 142 | 143 | (:~ 144 | : Finds a single document. 145 | : @param $id client id 146 | : @param $database database 147 | : @param $collection collection 148 | : @param $query query 149 | : @return document, if found 150 | :) 151 | declare function mongodb:find-one($id as xs:string, $database as xs:string, 152 | $collection as xs:string, $query as map(*)) as map(*)? { 153 | m:find-one($id, $database, $collection, $query) 154 | }; 155 | 156 | (:~ 157 | : Finds a single document. 158 | : @param $id client id 159 | : @param $database database 160 | : @param $collection collection 161 | : @param $query query 162 | : @param $options options 163 | : @return document, if found 164 | :) 165 | declare function mongodb:find-one($id as xs:string, $database as xs:string, 166 | $collection as xs:string, $query as map(*), $options as map(*)) as map(*)? { 167 | m:find-one($id, $database, $collection, $query, $options) 168 | }; 169 | 170 | (:~ 171 | : Count documents. 172 | : @param $id client id 173 | : @param $database database 174 | : @param $collection collection 175 | : @return number of documents 176 | :) 177 | declare function mongodb:count($id as xs:string, $database as xs:string, 178 | $collection as xs:string) as xs:integer { 179 | m:count($id, $database, $collection) 180 | }; 181 | 182 | (:~ 183 | : Counts documents. 184 | : @param $id client id 185 | : @param $database database 186 | : @param $collection collection 187 | : @param $query query 188 | : @return number of results 189 | :) 190 | declare function mongodb:count($id as xs:string, $database as xs:string, 191 | $collection as xs:string, $query as map(*)) as xs:integer { 192 | m:count($id, $database, $collection, $query) 193 | }; 194 | 195 | (:~ 196 | : Inserts new documents into a collection. 197 | : @param $id client id 198 | : @param $database database 199 | : @param $collection collection 200 | : @param $documents documents 201 | :) 202 | declare function mongodb:insert($id as xs:string, $database as xs:string, 203 | $collection as xs:string, $documents as map(*)*) as empty-sequence() { 204 | m:insert($id, $database, $collection, $documents) 205 | }; 206 | 207 | (:~ 208 | : Aggregates documents. 209 | : @param $id client id 210 | : @param $database database 211 | : @param $collection collection 212 | : @param $pipeline pipeline 213 | : @return result 214 | :) 215 | declare function mongodb:aggregate($id as xs:string, $database as xs:string, 216 | $collection as xs:string, $pipeline as map(*)*) as map(*)* { 217 | m:aggregate($id, $database, $collection, $pipeline) 218 | }; 219 | 220 | (:~ 221 | : Saves a document. 222 | : @param $id client id 223 | : @param $database database 224 | : @param $collection collection 225 | : @param $document document 226 | :) 227 | declare function mongodb:save($id as xs:string, $database as xs:string, 228 | $collection as xs:string, $document as map(*)) as empty-sequence() { 229 | m:save($id, $database, $collection, $document) 230 | }; 231 | 232 | (:~ 233 | : Updates documents. 234 | : @param $id client id 235 | : @param $database database 236 | : @param $collection collection 237 | : @param $query selection criteria 238 | : @param $update update operation 239 | :) 240 | declare function mongodb:update($id as xs:string, $database as xs:string, 241 | $collection as xs:string, $query as map(*), $update as map(*)) 242 | as empty-sequence() { 243 | m:update($id, $database, $collection, $query, $update) 244 | }; 245 | 246 | (:~ 247 | : Updates documents. 248 | : @param $id client id 249 | : @param $database database 250 | : @param $collection collection 251 | : @param $query selection criteria 252 | : @param $update update operation 253 | : @param $options options 254 | :) 255 | declare function mongodb:update($id as xs:string, $database as xs:string, 256 | $collection as xs:string, $query as map(*), $update as map(*), 257 | $options as map(*)) as empty-sequence() { 258 | m:update($id, $database, $collection, $query, $update, $options) 259 | }; 260 | 261 | (:~ 262 | : Removes documents. 263 | : @param $id client id 264 | : @param $database database 265 | : @param $collection collection 266 | : @param $query query 267 | :) 268 | declare function mongodb:remove($id as xs:string, $database as xs:string, 269 | $collection as xs:string, $query as map(*)) as empty-sequence() { 270 | m:remove($id, $database, $collection, $query) 271 | }; 272 | 273 | (:~ 274 | : Grouping query. 275 | : @param $id client id 276 | : @param $database database 277 | : @param $collection collection 278 | : @param $fields fields to group by 279 | : @param $reduce reduce 280 | : @param $initial initial 281 | : @return results 282 | :) 283 | declare function mongodb:group($id as xs:string, $database as xs:string, 284 | $collection as xs:string, $fields as map(*), $reduce as xs:string, $initial as map(*)) 285 | as map(*)* { 286 | m:group($id, $database, $collection, $fields, $reduce, $initial) 287 | }; 288 | 289 | (:~ 290 | : Grouping query. 291 | : @param $id client id 292 | : @param $database database 293 | : @param $collection collection 294 | : @param $fields fields to group by 295 | : @param $reduce reduce 296 | : @param $initial initial 297 | : @param $options options 298 | : @return results 299 | :) 300 | declare function mongodb:group($id as xs:string, $database as xs:string, 301 | $collection as xs:string, $fields as map(*), $reduce as xs:string, $initial as map(*), 302 | $options as map(*)) as map(*)* { 303 | m:group($id, $database, $collection, $fields, $reduce, $initial, $options) 304 | }; 305 | 306 | (:~ 307 | : Evaluates a map-reduce query. 308 | : @param $id client id 309 | : @param $database database 310 | : @param $collection collection 311 | : @param $map map function 312 | : @param $reduce reduce function 313 | : @return results 314 | :) 315 | declare function mongodb:map-reduce($id as xs:string, $database as xs:string, 316 | $collection as xs:string, $map as xs:string, $reduce as xs:string) as map(*)* { 317 | m:map-reduce($id, $database, $collection, $map, $reduce) 318 | }; 319 | 320 | (:~ 321 | : Evaluates a map-reduce query. 322 | : @param $id client id 323 | : @param $database database 324 | : @param $collection collection 325 | : @param $map map function 326 | : @param $reduce reduce function 327 | : @param $options options 328 | : @return results 329 | :) 330 | declare function mongodb:map-reduce($id as xs:string, $database as xs:string, 331 | $collection as xs:string, $map as xs:string, $reduce as xs:string, 332 | $options as map(*)) as map(*)* { 333 | m:map-reduce($id, $database, $collection, $map, $reduce, $options) 334 | }; 335 | 336 | (:~ 337 | : Evaluates a server-side script. 338 | : @param $id client id 339 | : @param $database database 340 | : @param $code code 341 | : @return result 342 | :) 343 | declare function mongodb:eval($id as xs:string, $database as xs:string, 344 | $code as xs:string) as item()* { 345 | m:eval($id, $database, $code) 346 | }; 347 | 348 | (:~ 349 | : Evaluates a server-side script. 350 | : @param $id client id 351 | : @param $database database 352 | : @param $code code 353 | : @param $args arguments 354 | : @return result 355 | :) 356 | declare function mongodb:eval($id as xs:string, $database as xs:string, 357 | $code as xs:string, $args as item()*) as item()* { 358 | m:eval($id, $database, $code, $args) 359 | }; 360 | 361 | (:~ 362 | : Evaluates a server command. 363 | : @param $id client id 364 | : @param $database database 365 | : @param $command command 366 | : @return result 367 | :) 368 | declare function mongodb:command($id as xs:string, $database as xs:string, 369 | $command as map(*)) as map(*) { 370 | m:command($id, $database, $command) 371 | }; 372 | 373 | (:~ 374 | : Drops a database. 375 | : @param $id client id 376 | : @param $database database 377 | :) 378 | declare function mongodb:drop-database($id as xs:string, $database as xs:string) 379 | as empty-sequence() { 380 | m:drop-database($id, $database) 381 | }; 382 | 383 | (:~ 384 | : Drops a collection. 385 | : @param $id client id 386 | : @param $database database 387 | : @param $collection collection 388 | :) 389 | declare function mongodb:drop-collection($id as xs:string, $database as xs:string, 390 | $collection as xs:string) { 391 | m:drop-collection($id, $database, $collection) 392 | }; 393 | 394 | (:~ 395 | : Closes a client connection. 396 | : @param $id client id 397 | :) 398 | declare function mongodb:close($id as xs:string) as empty-sequence() { 399 | m:close($id) 400 | }; 401 | --------------------------------------------------------------------------------