xqdoc fix

xqdoc fix

xquery version "3.0";

(:
 : Copyright 2006-2009 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
:)

(:~
 : This module defines a set of functions to probe and refresh indexes which are
 : declared in the prolog of a module.
 :
 :
This module is part of Zorba's XQuery Data
 : Definition Facility. All the indexes managed by this module
 : have to be pre-declared in the prolog of a library module. Please refer to the
 : general documentation
 : for more information and examples.

 :
 : @see Data Lifecycle
 : @see XQuery Data Definition Facility
 : @see http://www.zorba-xquery.com/modules/store/static/indexes/ddl
 : @see http://www.zorba-xquery.com/modules/store/static/collections/dml
 : @see http://www.zorba-xquery.com/modules/store/static/collections/ddl
 : @see http://www.zorba-xquery.com/modules/store/static/integrity_constraints/ddl
 : @see http://www.zorba-xquery.com/modules/store/static/integrity_constraints/dml
 : @see http://www.zorba-xquery.com/errors
 :
 : @author Zorba Team
 :
 : @project store/indexes/static
 :
 :)
module namespace idml = "http://www.zorba-xquery.com/modules/store/static/indexes/dml";

declare namespace zerr = "http://www.zorba-xquery.com/errors";
declare namespace an = "http://www.zorba-xquery.com/annotations";

declare namespace ver = "http://www.zorba-xquery.com/options/versioning";

declare option ver:module-version "2.0";

(:~
 :
The probe-index-point-value function retrieves from an index the domain
 : nodes associated by value equality with a given search tuple.
 : The search tuple consists of a number of search keys, where
 : each search key is either an atomic item or the empty sequence.  The number
 : of search keys given must be equal to the number of keys declared for the
 : index. Since the number of keys differs from one index to another, this
 : function is variadic.

 :
 :
The result of the function is either an error or the set of domain nodes for
 : which the following xquery expression returns true:

 :
 :

 : $key1 eq $node/keyExpr1 and ... and $keyM eq $node/keyExprM
 :

 : where keyExpri is the expression specified in the i-th keyspec
 : of the index.
 :
 : @param $name The QName of the index to probe
 : @param $key_i the search keys used to probe the index with. The i-th search
 :        key corresponds to the i-th key expression in the index declaration.
 : @return The set of domain nodes that satisfy the search condition.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0025 if the number of search keys passed as arguments is not
 :        the same as the number of keys declared for the index.
 : @error err:XPTY0004 if a non-empty seach key is given, whose type does not match
 :        the sequence type specified in the corresponding keyspec.
 :
 :)
declare %an:variadic function idml:probe-index-point-value(
  $name as xs:QName,
  $key_i as xs:anyAtomicType?) as node()*  external;

(:~
 :
The probe-index-point-value-skip function is an extension of the
 : probe-index-point-value function. Additionally, it allows to skip index
 : items.

 :
 : @param $name The QName of the index to probe
 : @param $skip The number of index items to skip.
 : @param $key_i the search keys used to probe the index with. The i-th search
 :        key corresponds to the i-th key expression in the index declaration.
 : @return The set of domain nodes that satisfy the search condition.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0025 if the number of search keys passed as arguments is not
 :        the same as the number of keys declared for the index.
 : @error err:XPTY0004 if a non-empty seach key is given, whose type does not match
 :        the sequence type specified in the corresponding keyspec.
 :
 :)
declare %an:variadic function idml:probe-index-point-value-skip(
  $name as xs:QName,
  $skip as xs:integer,
  $key_i as xs:anyAtomicType?) as node()*  external;

(:~
 :
The probe-index-point-general function retrieves from an index the domain
 : nodes associated by general equality with a given search sequence
 : . The search sequence consists of an arbitrary number of
 : search keys, where each search key is an atomic item. The function
 : is supported by general indexes only. Its result is either an error or the
 : set of domain nodes for which the following xquery expression returns true:

 :

 : $keys = $node/keyExpr
 :

 : where keyExpr is the expression specified in the keyspec of the index (remember
 : that for general indexes, there can be only one keyspec).
 :
 : @param $name The QName of the index to probe.
 : @param $key The search sequence.
 : @return The set of domain nodes that satisfy the search condition.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0029 if the index is not general.
 : @error err:XPTY0004  if the search sequence contains a search key, whose
 :        type does not match the sequence type specified in the keyspec of
 :        the index.
 :)
declare function idml:probe-index-point-general(
  $name as xs:QName,
  $key  as xs:anyAtomicType*) as node()*  external;

(:~
 :
The probe-index-range-value function retrieves the domain nodes associated
 : by value order-comparison (operators le, lt, ge, gt) with a given search
 : box. The search box is specified as a number M of rangespecs
 : , where each rangespec consists of six values. The number M must be
 : greater than 0 and less than or equal to the number N of keyspecs found in the
 : index declaration. If M is less than N, then the "missing" rangespecs are
 : assumed to have the following value: [(), (), false, false, false, false].
 : As a result, we can assume that M is equal to N (Remember that for general
 : indexes, there can be only one IndexKeySpec, and as a result, for general
 : indexes, M = N = 1). Since the number of keys differs from one index to
 : another, this function is variadic.

 :
 :
The ith rangespec corresponds to the ith keyspec, and
 : specifies a search condition on the key values that are produced by evaluating
 : that keyspec for every domain node. Specifically, we define the ith
 : rangespec result as the set of domain nodes for which the
 : following xquery expression returns true:

 :
 :

 : if ($haveLowerBound-i and $haveUpperBound-i) then
 :   $lowerBound-i lop $node/keyExpr-i and $node/keyExpr-i uop $upperBound-i
 : else if ($haveLowerBound-i) then
 :   $lowerBound-i lop $node/keyExpr-i
 : else if ($haveUpperBound-i) then
 :   $node/keyExpr-i uop $upperBound-i
 : else
 :   fn:true()
 :

 :
 :
where keyExpr-i is the expression specified by the ith keyspec
 : of the index, lop is either the le or the lt operator depending on whether
 : $lowerBoundsIncluded-i is true or false, and uop is either the le or the
 : lt operator depending on whether $upperBoundsIncluded-i is true or false.

 :
 :
The result of the probe-index-range-value function is either an error,
 : or the intersection of all the rangespec results.

 :
 : @param $name The QName of the index to probe
 : @param $lowerBound-i The lower bound in a range of key values.
 : @param $upperBound-i The upper bound in a range of key values.
 : @param $haveLowerBound-i If false, then there is no lower bound, or
 :        equivalently, the lower bound is -INFINITY. Otherwise, the lower
 :        bound is the one given by the lowerBound-i value.
 : @param $haveUpperBound-i If false, then there is no upper bound, or
 :        equivalently, the upper bound is +INFINITY. Otherwise, the upper
 :        bound is the one given by the upperBound-i value.
 : @param $lowerBoundIncluded-i If false, then the range is open from below,
 :        i.e., the lowerBound-i value is not considered part of the
 :        range. Otherwise, the range is closed from below, i.e., the
 :        lowerBound-i value is part of the range.
 : @param $upperBoundIncluded-i If false, then the range is open from above,
 :        i.e., the upperBound-i value is not considered part of the
 :        range. Otherwise, the range is closed from above, i.e., the
 :        upperBound-i value is part of the range.
 : @return The set of domain nodes that satisfy the search condition.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0025 if the number of rangespecs passed as arguments
 :        is zero or greater than the number of keys declared for the index.
 : @error zerr:ZDDY0026 if the index is not a range index.
 : @error err:XPTY0004  if $haveLowerBound-i is true and $lowerBound-i is an
 :        atomic item whose type does not match the sequence type specified
 :        by the ith keyspec, or $haveUpperBound-i is true and
 :        $upperBound-i is an atomic item whose type does not match the
 :        sequence type specified by the ith keyspec.
 : @error zerr:ZDDY0034 if (a) the index is general (in which case there is
 :        only one rangespac), (b) the index is untyped, (c) there is both a
 :        lower and an upper bound, and (d) if T1 and T2 are the types of the
 :        lower and upper bound, neither T1 is a subtype of T2 nor T2 is a
 :        subtype of T1.
 :)
declare %an:variadic function idml:probe-index-range-value(
  $name                 as xs:QName,
  $lowerBound-i         as xs:anyAtomicType?,
  $upperBound-i         as xs:anyAtomicType?,
  $haveLowerBound-i     as xs:boolean,
  $haveUpperBound-i     as xs:boolean,
  $lowerBoundIncluded-i as xs:boolean,
  $upperBoundIncluded-i as xs:boolean) as node()*  external;

(:~
 :
The probe-index-range-value-skip function is an extension of the
 : probe-index-range-value function. Additionally, it allows to skip index
 : items.

 :
 : @param $name The QName of the index to probe
 : @param $skip The number of index items to skip.
 : @param $lowerBound-i The lower bound in a range of key values.
 : @param $upperBound-i The upper bound in a range of key values.
 : @param $haveLowerBound-i If false, then there is no lower bound, or
 :        equivalently, the lower bound is -INFINITY. Otherwise, the lower
 :        bound is the one given by the lowerBound-i value.
 : @param $haveUpperBound-i If false, then there is no upper bound, or
 :        equivalently, the upper bound is +INFINITY. Otherwise, the upper
 :        bound is the one given by the upperBound-i value.
 : @param $lowerBoundIncluded-i If false, then the range is open from below,
 :        i.e., the lowerBound-i value is not considered part of the
 :        range. Otherwise, the range is closed from below, i.e., the
 :        lowerBound-i value is part of the range.
 : @param $upperBoundIncluded-i If false, then the range is open from above,
 :        i.e., the upperBound-i value is not considered part of the
 :        range. Otherwise, the range is closed from above, i.e., the
 :        upperBound-i value is part of the range.
 : @return The set of domain nodes that satisfy the search condition.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0025 if the number of rangespecs passed as arguments
 :        is zero or greater than the number of keys declared for the index.
 : @error zerr:ZDDY0026 if the index is not a range index.
 : @error err:XPTY0004  if $haveLowerBound-i is true and $lowerBound-i is an
 :        atomic item whose type does not match the sequence type specified
 :        by the ith keyspec, or $haveUpperBound-i is true and
 :        $upperBound-i is an atomic item whose type does not match the
 :        sequence type specified by the ith keyspec.
 : @error zerr:ZDDY0034 if (a) the index is general (in which case there is
 :        only one rangespac), (b) the index is untyped, (c) there is both a
 :        lower and an upper bound, and (d) if T1 and T2 are the types of the
 :        lower and upper bound, neither T1 is a subtype of T2 nor T2 is a
 :        subtype of T1.
 :)
declare %an:variadic function idml:probe-index-range-value-skip(
  $name                 as xs:QName,
  $skip                 as xs:integer,
  $lowerBound-i         as xs:anyAtomicType?,
  $upperBound-i         as xs:anyAtomicType?,
  $haveLowerBound-i     as xs:boolean,
  $haveUpperBound-i     as xs:boolean,
  $lowerBoundIncluded-i as xs:boolean,
  $upperBoundIncluded-i as xs:boolean) as node()*  external;

(:~
 :
The probe-index-range-general function retrieves the domain nodes associated
 : by general order-comparison (operators <=, <, >=, >) with one or two
 : search sequences. Each search sequence consists of an
 : arbitrary number of search keys, where each search key is
 : an atomic item. This method is supported by general range indexes only. Its
 : result is either an error or the set of domain nodes for which the following
 : xquery expression returns true:

 :
 :

 : if ($haveLowerBound and $haveUpperBound) then
 :   $lowerBoundKeys lop $node/keyExpr and $node/keyExpr uop $upperBoundKeys
 : else if ($haveLowerBound) then
 :   $lowerBoundKeys lop $node/keyExpr
 : else if ($haveUpperBound) then
 :   $node/keyExpr uop $upperBoundKeys
 : else
 :   fn:true()
 :

 :
 :
where keyExpr is the expression specified in the keyspec of the index,
 : lop is either the <= or the < operator depending on whether
 : $lowerBoundsIncluded is true or false, and uop is either the <= or the
 : < operator depending on whether $upperBoundsIncluded is true or false
.
 :
 : @param $name The QName of the index to probe.
 : @param $lowerBound The lower bound search sequence.
 : @param $upperBound The upper bound search sequence.
 : @param $haveLowerBound Whether a lower bound search sequence exists or not.
 : @param $haveUpperBound Whether an upper bound search sequence exists or not.
 : @param $lowerBoundIncluded Whether to use the <= or the < operator when
 :        comparing a search key from $lowerBound with an index key.
 : @param $upperBoundIncluded Whether to use the <= or the < operator when
 :        comparing an index key with a search key from $upperBound.
 : @return The set of domain nodes that satisfy the search condition
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 : @error zerr:ZDDY0030 if the index is not a general range index.
 : @error err:XPTY0004  if $haveLowerBound is true and $lowerBoundKeys constains
 : an atomic item whose type does not match the sequence type specified by the
 : index keyspec, or $haveUpperBound is true and $upperBoundKeys contains an
 : atomic item whose type does not match the sequence type specified by the
 : index keyspec.
 :)
declare function idml:probe-index-range-general(
  $name               as xs:QName,
  $lowerBound         as xs:anyAtomicType*,
  $upperBound         as xs:anyAtomicType*,
  $haveLowerBound     as xs:boolean,
  $haveUpperBound     as xs:boolean,
  $lowerBoundIncluded as xs:boolean,
  $upperBoundIncluded as xs:boolean) as node()*  external;

(:~
 : The refresh-index function is an updating function which updates
 : the index with the given name.
 : Note that if the maintenance property of the index is automatic,
 : this function is a NOP.
 :
 : @param $name The QName of the index to refresh.
 : @return The result of the function is an empty XDM instance and a
 :         pending update list which, when applied, refreshes the contents
 :         of the index.that consists of a
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 :)
declare updating function idml:refresh-index($name as xs:QName) external;

(:~
 : The keys function returns a sequence of all keys contained in the
 : index with the given name. Each element has the following structure:
 :

 :   <key xmlns="http://www.zorba-xquery.com/modules/store/static/indexes/dml">
 :     <attribute value="key1_value"/>
 :     <attribute value="key2_value"/>
 :     <attribute value="key3_value"/>
 :   </key>
 :

 :
 : @param $name The QName of the index
 : @return The result of the function is sequence of elements each representing
 :         one key contained in the index.
 :
 : Note that the order of the attribute elements reflects the order of
 : the keys in the index specification. Also note that the values in
 : these attributes have the type that is declared in the corresponding
 : index specification.
 :
 : @error zerr:ZDDY0021 if the index with name $name is not declared.
 : @error zerr:ZDDY0023 if the index with name $name does not exist.
 :)
declare function idml:keys($name as xs:QName) as node()* external;


svn path=/trunk/eXist/; revision=13457

xquery version "1.0" encoding "UTF-8";

(:NOTE - requires file module to be enabled :)
import module namespace file="http://exist-db.org/xquery/file";
import module namespace xproc = "http://xproc.net/xproc";
import module namespace u = "http://xproc.net/xproc/util" at "resource:net/xproc/xprocxq/src/xquery/util.xqm";

declare namespace p="http://www.w3.org/ns/xproc";
declare namespace t="http://xproc.org/ns/testsuite";
declare namespace c="http://www.w3.org/ns/xproc-step";

declare option exist:serialize "method=html media-type=text/html omit-xml-declaration=yes indent=yes";

declare function local:sequence-deep-equal
  ( $seq1 as item()* ,
    $seq2 as item()* )  as xs:boolean {

  every $i in 1 to max((count($seq1),count($seq2)))
  satisfies deep-equal($seq1[$i],$seq2[$i])
 } ;

let $runtime-debug := request:get-parameter("dbg", ())
let $format := request:get-parameter("format", ())
let $not :=  request:get-parameter("not", ())
let $type :=  request:get-parameter("type", ())
let $dir := concat('/Users/jimfuller/Source/Thirdparty/eXist/extensions/xprocxq/main/test/tests.xproc.org/',$type)
let $file :=  request:get-parameter("file", ())
let $files := file:directory-list($dir,$file)

let $result := for $file in $files/*:file[not(contains(@name,$not))]
let $path     := concat('file://',$dir,$file/@name)
let $test     := doc($path)
let $error    := fn:string($test/t:test/@error)

let $stdin    := for $item in util:catch("*",$test//t:input[@port='source']/*,"no input")
                return
                 document{$item}
let $bindings := for $item in util:catch("*",if ($test//t:input[fn:not(@port='source')]) then <bindings>{$test//t:input[fn:not(@port='source')]}</bindings> else (),())
                return
                 document{$item}
let $pipeline := util:catch("*",$test//t:pipeline,"no pipeline")
let $expected := if($error) then fn:true() else util:catch("*",$test//t:output/*,"no expected")
let $result   :=  util:catch("*",xproc:run($pipeline,$stdin,$runtime-debug,$bindings,()),("ERROR: ",$util:exception-message))
let $pass     := if ($error) then
    fn:contains($result,$error)
  else
    if (contains($result,"ERROR:")) then
      fn:false()
    else if (count($expected/*) eq 1 and count($result/*) eq 1 ) then
        fn:deep-equal(u:treewalker($expected),u:treewalker($result))
    else
       fn:deep-equal($expected,$result)
return

<test pass="{$pass}" uri="{$file/@name}" title="{$test//t:title/node()}">

{fn:deep-equal($expected,$result)} - {$test//t:title/node()} - {fn:string($test/t:test/@error)}

  <textarea rows="5" cols="25"><t/> {$stdin}</textarea>
  <textarea rows="5" cols="25"><t/> {$bindings}</textarea>
  <textarea rows="5" cols="30"><t/> {$pipeline/*}</textarea>
  <textarea rows="5" cols="30"><t/> {$result}</textarea>
  <textarea rows="5" cols="30"><t/> {$expected}</textarea>

</test>

return

if ($format eq 'w3c') then
      transform:transform(document{<tests>{$result}</tests>}, xs:anyURI("w3c-test-result.xsl"), ())
else
  $result

xquery version "1.0" encoding "UTF-8";

(:NOTE - requires file module to be enabled :)
import module namespace file="http://exist-db.org/xquery/file";
import module namespace xproc = "http://xproc.net/xproc";
import module namespace u = "http://xproc.net/xproc/util" at "resource:net/xproc/xprocxq/src/xquery/util.xqm";

declare namespace p="http://www.w3.org/ns/xproc";
declare namespace t="http://xproc.org/ns/testsuite";
declare namespace c="http://www.w3.org/ns/xproc-step";

declare option exist:serialize "method=html media-type=text/html omit-xml-declaration=yes indent=yes";

declare function local:sequence-deep-equal
  ( $seq1 as item()* ,
    $seq2 as item()* )  as xs:boolean {

  every $i in 1 to max((count($seq1),count($seq2)))
  satisfies deep-equal($seq1[$i],$seq2[$i])
 } ;

let $runtime-debug := request:get-parameter("dbg", ())
let $format := request:get-parameter("format", ())
let $not :=  request:get-parameter("not", ())
let $type :=  request:get-parameter("type", ())
let $dir := concat('/Users/jimfuller/Source/Thirdparty/eXist/extensions/xprocxq/main/test/tests.xproc.org/',$type)
let $file :=  request:get-parameter("file", ())
let $files := file:directory-list($dir,$file)

let $result := for $file in $files/*:file[not(contains(@name,$not))]
let $path     := concat('file://',$dir,$file/@name)
let $test     := doc($path)
let $error    := fn:string($test/t:test/@error)

let $stdin    := for $item in util:catch("*",$test//t:input[@port='source']/*,"no input")
                return
                 document{$item}
let $bindings := for $item in util:catch("*",if ($test//t:input[fn:not(@port='source')]) then <bindings>{$test//t:input[fn:not(@port='source')]}</bindings> else (),())
                return
                 document{$item}
let $pipeline := util:catch("*",$test//t:pipeline,"no pipeline")
let $expected := if($error) then fn:true() else util:catch("*",$test//t:output/*,"no expected")
let $result   :=  util:catch("*",xproc:run($pipeline,$stdin,$runtime-debug,$bindings,()),("ERROR: ",$util:exception-message))
let $pass     := if ($error) then
    fn:contains($result,$error)
  else
    if (count($expected) eq 1 and count($result) eq 1) then
        fn:deep-equal(normalize-space($expected),normalize-space($result))
    else
        fn:deep-equal($expected,$result)
return

<test pass="{$pass}" uri="{$file/@name}" title="{$test//t:title/node()}">

{fn:deep-equal($expected,$result)} - {$test//t:title/node()} - {fn:string($test/t:test/@error)}

  <textarea rows="5" cols="25"><t/> {$stdin}</textarea>
  <textarea rows="5" cols="25"><t/> {$bindings}</textarea>
  <textarea rows="5" cols="30"><t/> {$pipeline/*}</textarea>
  <textarea rows="5" cols="30"><t/> {$result}</textarea>
  <textarea rows="5" cols="30"><t/> {$expected}</textarea>

</test>

return

if ($format eq 'w3c') then
      transform:transform(document{<tests>{$result}</tests>}, xs:anyURI("w3c-test-result.xsl"), ())
else
  $result


[xproc.split-sequence] implemented split-sequence step

svn path=/trunk/eXist/; revision=9558

xquery version "1.0" encoding "UTF-8";
module namespace std = "http://xproc.net/xproc/std";
(: -------------------------------------------------------------------------------------

	std.xqm - Implements all standard xproc steps.

---------------------------------------------------------------------------------------- :)

(: XProc Namespace Declaration :)
declare namespace p="http://www.w3.org/ns/xproc";
declare namespace c="http://www.w3.org/ns/xproc-step";
declare namespace err="http://www.w3.org/ns/xproc-error";
declare namespace xsl="http://www.w3.org/1999/XSL/Transform";
declare namespace xproc = "http://xproc.net/xproc";

declare namespace t = "http://xproc.org/ns/testsuite";

(: Module Imports :)
import module namespace u = "http://xproc.net/xproc/util";
import module namespace const = "http://xproc.net/xproc/const";
import module namespace http = "http://www.expath.org/mod/http-client";

(: -------------------------------------------------------------------------- :)

(: Module Vars :)
declare variable $std:add-attribute :=util:function(xs:QName("std:add-attribute"), 3);
declare variable $std:add-xml-base :=util:function(xs:QName("std:add-xml-base"), 3);
declare variable $std:count :=util:function(xs:QName("std:count"), 3);
declare variable $std:compare :=util:function(xs:QName("std:compare"),3);
declare variable $std:delete :=util:function(xs:QName("std:delete"),3);
declare variable $std:error :=util:function(xs:QName("std:error"), 3);
declare variable $std:filter :=util:function(xs:QName("std:filter"), 3);
declare variable $std:directory-list :=util:function(xs:QName("std:directory-list"), 3);
declare variable $std:escape-markup :=util:function(xs:QName("std:escape-markup"), 3);
declare variable $std:http-request :=util:function(xs:QName("std:http-request"), 3);
declare variable $std:identity :=util:function(xs:QName("std:identity"), 3);
declare variable $std:insert :=util:function(xs:QName("std:insert"), 3);
declare variable $std:label-elements :=util:function(xs:QName("std:label-elements"), 3);
declare variable $std:load :=util:function(xs:QName("std:load"), 3);
declare variable $std:make-absolute-uris :=util:function(xs:QName("std:make-absolute-uris"), 3);
declare variable $std:namespace-rename :=util:function(xs:QName("std:namespace-rename"), 3);
declare variable $std:pack :=util:function(xs:QName("std:pack"), 3);
declare variable $std:parameters :=util:function(xs:QName("std:parameters"), 3);
declare variable $std:rename :=util:function(xs:QName("std:rename"), 3);
declare variable $std:replace :=util:function(xs:QName("std:replace"), 3);
declare variable $std:set-attributes :=util:function(xs:QName("std:set-attributes"), 3);
declare variable $std:sink :=util:function(xs:QName("std:sink"), 3);
declare variable $std:split-sequence :=util:function(xs:QName("std:split-sequence"), 3);
declare variable $std:store :=util:function(xs:QName("std:store"), 3);
declare variable $std:string-replace :=util:function(xs:QName("std:string-replace"), 3);
declare variable $std:unescape-markup :=util:function(xs:QName("std:unescape-markup"), 3);
declare variable $std:xinclude :=util:function(xs:QName("std:xinclude"), 3);
declare variable $std:wrap :=util:function(xs:QName("std:wrap"), 3);
declare variable $std:wrap-sequence :=util:function(xs:QName("std:wrap-sequence"), 3);
declare variable $std:unwrap :=util:function(xs:QName("std:unwrap"), 3);
declare variable $std:xslt :=util:function(xs:QName("std:xslt"), 3);

(: -------------------------------------------------------------------------- :)
declare function std:add-attribute($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (starts-with($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $attribute-name := u:get-option('attribute-name',$options,$v)
let $attribute-value := u:get-option('attribute-value',$options,$v)
return
	u:add-attribute-matching-elements($v/*,$matchresult,$attribute-name,$attribute-value)
};

(: -------------------------------------------------------------------------- :)
declare function std:add-xml-base($primary,$secondary,$options) {

(: TODO: need to refactor to pass in pipeline uri and any external input uri :)

let $v := u:get-primary($primary)
let $all := xs:boolean(u:get-option('all',$options,$v))
let $relative := xs:boolean(u:get-option('relative',$options,$v))
let $attrNames := xs:QName('xml:base')
let $attrValues := base-uri($v)

return
    if ($all) then
    for $element in $v/*
       return element { node-name($element)}
                      { for $attrName at $seq in $attrNames
                        return if ($element/@*[node-name(.) = $attrName])
                               then ()
                               else attribute {$attrName}
                                              {$attrValues[$seq]},
                        $element/@*,
                        $element/node() }
else
    for $element in $v/*
       return element { node-name($element)}
                      { for $attrName at $seq in $attrNames
                        return if ($element/@*[node-name(.) = $attrName])
                               then ()
                               else attribute {$attrName}
                                              {$attrValues[$seq]},
                        $element/@*,
                        $element/node() }
};

(: -------------------------------------------------------------------------- :)
declare function std:compare($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $alternate : = u:get-secondary('alternate',$secondary)
let $strict := xs:boolean(u:get-option('xproc:strict',$options,$v)) (: ext attribute xproc:strict:)
let $fail-if-not-equal := xs:boolean(u:get-option('fail-if-not-equal',$options,$v))

let $result :=  if ($strict and count($v/*) eq 1) then
		deep-equal($v,$alternate)

else if ($strict and count($v/*) gt 1) then
	u:deep-equal-seq($v,$alternate,'1')

else if (count($v/*) gt 1) then
	u:deep-equal-seq($v,$alternate,'0')

else
	deep-equal(u:treewalker($v/*),u:treewalker($alternate/*))

    return

       if($fail-if-not-equal) then
            if ($result) then
      			u:outputResultElement('true')
            else
                u:stepError('err:XC0019','p:compare fail-if-not-equal option is enabled and documents were not equal')
        else
            u:outputResultElement($result)
};

(: -------------------------------------------------------------------------- :)
declare function std:count($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $limit := xs:integer(u:get-option('limit',$options,$v))
let $count := count($v)
return
    if (empty($limit) or $limit eq 0 or $count lt $limit ) then
		u:outputResultElement($count)
    else
   		u:outputResultElement($limit)
};

(: -------------------------------------------------------------------------- :)
declare function std:delete($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:delete-matching-elements($v/*, $matchresult)
};

(: -------------------------------------------------------------------------- :)
declare function std:directory-list($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $path := u:get-option('path',$options,$v)
let $include-filter := u:get-option('include-filter',$options,$v)
let $exclude-filter := u:get-option('exclude-filter',$options,$v)
let $query := concat("util:directory-list('",$path,"','",$include-filter,"')")
let $directory-list := u:eval($query)
let $result := <c:directory name="{$directory-list/@name}">
					{for $file in $directory-list//*:file
					return
						<c:file name="{$file/@name}"/>
					}
				</c:directory>
return
		u:outputResultElement($result)
};

(: -------------------------------------------------------------------------- :)
declare function std:escape-markup($primary,$secondary,$options) {
(: TODO: test with sequences :)
let $v := u:get-primary($primary)
return
	element{name($v/*)}{
    	u:serialize($v/*/*,$const:ESCAPE_SERIALIZE)
	}
};

(: -------------------------------------------------------------------------- :)
declare function std:error($primary,$secondary,$options) {
(: TODO: this should be generated to the error port:)

let $v := u:get-primary($primary)
let $code := u:get-option('code',$options,$v)
let $err := <c:errors xmlns:c="http://www.w3.org/ns/xproc-step"
          xmlns:p="http://www.w3.org/ns/xproc"
          xmlns:my="http://www.example.org/error">
		<c:error href="" column="" offset=""
         	name="step-name" type="p:error"
         	code="{$code}">
    		<message>{$v}</message>
		</c:error>
</c:errors>
return
	u:dynamicError('err:XD0030',concat(": p:error throw custom error code - ",$code," ",u:serialize($err,$const:TRACE_SERIALIZE)))

};

(: -------------------------------------------------------------------------- :)
declare function std:filter($primary,$secondary,$options) {
(: TODO: is it an error for a empty match ? :)
u:assert(exists($options/p:with-option[@name='select']/@select),'p:with-option match is required'),
let $v := u:get-primary($primary)
let $select := string(u:get-option('select',$options,$v))
let $result := u:evalXPATH($select,$v)
    return
        if(exists($result)) then
        	$result
		else
            $select
};

(: -------------------------------------------------------------------------- :)
declare function std:http-request($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $href := $v/c:request/@href
let $method := $v/c:request/@method
let $content-type := $v/c:request/c:body/@content-type
let $body := $v/c:request/c:body
let $status-only := $v/c:request/@status-only
let $detailed := $v/c:request/@detailed
let $username := ''
let $password := ''
let $auth-method := ''
let $send-authorization := ''
let $override-content-type := ''
let $follow-redirect := ''
let $http-request := <http:request href="{$href}" method="{$method}">{

		for $header in $v/c:request/c:header
		return
			<http:header name="{$header/@name}" value="{$header/@value}"/>,

		if (empty($body)) then
		    ()
		else
	      <http:body content-type="{$content-type}">
	         {$body}
	      </http:body>
	}
	   </http:request>
let $raw-response := http:send-request( $http-request)
let $response-headers := for $header in $raw-response//http:header
        return
            <c:header name="{$header/@name}" value="{$header/@value}"/>

let $response-body := if ($status-only) then
        ()
     else if ($detailed) then
		<c:body>{$raw-response/*[not(name(.) eq 'http:body')][not(name(.) eq 'http:header')]}</c:body>
     else
		$raw-response/*[not(name(.) eq 'http:body')][not(name(.) eq 'http:header')]

return
    if (name($v/node()) ne 'c:request') then
            u:dynamicError('err:XC0040',"source port must contain c:request element")
    else if ($detailed) then
      <c:response status="{$raw-response/@status}">
        {$response-headers}
        {$response-body}
      </c:response>
    else
        $response-body

};

(: -------------------------------------------------------------------------- :)
declare function std:identity($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:insert($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $position := u:get-option('position',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $insertion := u:get-secondary('insertion',$secondary)
return
	u:insert-matching-elements($v/*,$matchresult,$insertion,$position)
};

(: -------------------------------------------------------------------------- :)
declare function std:label-elements($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $attribute := u:get-option('attribute',$options,$v)
let $label := u:get-option('label',$options,$v)
let $replace := u:get-option('replace',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:label-matching-elements($v/*,$matchresult,$attribute,$label,$replace)
};

(: -------------------------------------------------------------------------- :)
declare function std:load($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $href := u:get-option('href',$options,$v)
let $xproc:output-uri := u:get-option('xproc:output-uri',$options,$v)
return
if (empty($href)) then
	u:dynamicError('err:XC0026',"p:load option href is empty.")
else if(starts-with($href,'file://')) then
		let $test-exists := concat("file:exists('",
									 substring-after($href,'file://'),
									 "')")
		let $query := concat("file:read('",
									 $href,
									 "')")
		return
			if (u:eval($test-exists)) then
				u:parse-string(u:eval($query))
			else
				u:dynamicError('err:XC0026',"p:load could not access or find the file.")
else
	let $load := doc($href)
	return
		if ($xproc:output-uri eq 'true') then
			u:outputResultElement($href)
		else
			$load
};

(: -------------------------------------------------------------------------- :)
declare function std:make-absolute-uris($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:namespace-rename($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:pack($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $alternate := u:get-secondary('alternate',$secondary)
let $wrapper := u:get-option('wrapper',$options,$v)
return

    for $child at $count in $v
    return
	    element {$wrapper}{$child,$alternate[$count]}
};

(: -------------------------------------------------------------------------- :)
declare function std:parameters($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:rename($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $new-name := u:get-option('new-name',$options,$v)
return
	u:rename-matching-elements($v/*,$matchresult,$new-name)
};

(: -------------------------------------------------------------------------- :)
declare function std:replace($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $replacement := u:get-secondary('replacement',$secondary)
return
	u:replace-matching-elements($v/*,$matchresult,$replacement)
};

(: -------------------------------------------------------------------------- :)
declare function std:set-attributes($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $attributes := u:get-secondary('attributes',$secondary)
let $match := u:get-option('match',$options,$v)
let $matchresult := u:evalXPATH(string($match), $v)
return
	u:add-attributes-matching-elements($v/*,$matchresult,$attributes/*/@*)
};

(: -------------------------------------------------------------------------- :)
declare function std:sink($primary,$secondary,$options) {
    (string(''))
};

(: -------------------------------------------------------------------------- :)
declare function std:split-sequence($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $test := u:get-option('test',$options,$v)
let $match := u:evalXPATH($test, $v)
return
    for $child at $count in $match
    return
        if($child) then
            $v[$count]
        else
            ()
};

(: -------------------------------------------------------------------------- :)
declare function std:store($primary,$secondary,$options) {
(:TODO - check existence of collection path :)
let $v := u:get-primary($primary)
let $href-uri := u:get-option('href',$options,$v)
let $name := tokenize($href-uri, "/")[last()]
let $xproc:output-document := u:get-option('xproc:output-document',$options,$v)
let $path := substring-before($href-uri,$name)
let $serialized := u:serialize($v,$const:DEFAULT_SERIALIZE)
let $store := if(starts-with($path,'file://')) then
				let $query := concat("file:serialize(",
									 $serialized,
								 	 ",'",
									 substring-after($href-uri,'file://'),
									 "','method=xml')")
				return
					u:eval($query)
			  else
								xmldb:store($path,$name,$v)
return
if($xproc:output-document eq 'true') then
		$v
	else
		u:outputResultElement(concat($path,$name))
};

(: -------------------------------------------------------------------------- :)
declare function std:string-replace($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $replace := string(u:get-option('replace',$options,$v))

(:
let $replace := u:evalXPATH(string(u:get-option('replace',$options,$v)),$v)
:)
return
	u:string-replace-matching-elements($v/*,$matchresult,$replace)
};

(: -------------------------------------------------------------------------- :)
declare function std:unescape-markup($primary,$secondary,$options){
(: TODO: test with sequences :)
let $v := u:get-primary($primary)
return
    element{name($v/*)}{
		u:parse-string($v)
		}
};

(: -------------------------------------------------------------------------- :)
declare function std:xinclude($primary,$secondary,$options){
let $v := u:get-primary($primary)
return
	u:parse-string(u:serialize($v,'expand-xincludes=yes'))
};

(: -------------------------------------------------------------------------- :)
declare function std:wrap($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $wrapper := u:get-option('wrapper',$options,$v)
let $group-adjacent := u:get-option('group-adjacent',$options,$v)
return
	u:wrap-matching-elements($v/*,$matchresult,$wrapper)
};

(: -------------------------------------------------------------------------- :)
declare function std:wrap-sequence($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $wrapper := u:get-option('wrapper',$options,$v)
let $group-adjacent := u:get-option('group-adjacent',$options,$v)
return
	element {$wrapper}{
		$v
	}
};

(: -------------------------------------------------------------------------- :)
declare function std:unwrap($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:unwrap-matching-elements($v/*,$matchresult)
};

(: -------------------------------------------------------------------------- :)
declare function std:xslt($primary,$secondary,$options){

    u:assert(exists($secondary/xproc:input[@port='stylesheet']/*),'stylesheet is required'),
	let $v := u:get-primary($primary)
    let $stylesheet := u:get-secondary('stylesheet',$secondary)
    return
        u:xslt($stylesheet,$v)
};

(: -------------------------------------------------------------------------- :)

xquery version "1.0" encoding "UTF-8";
module namespace std = "http://xproc.net/xproc/std";
(: -------------------------------------------------------------------------------------

	std.xqm - Implements all standard xproc steps.

---------------------------------------------------------------------------------------- :)

(: XProc Namespace Declaration :)
declare namespace p="http://www.w3.org/ns/xproc";
declare namespace c="http://www.w3.org/ns/xproc-step";
declare namespace err="http://www.w3.org/ns/xproc-error";
declare namespace xsl="http://www.w3.org/1999/XSL/Transform";
declare namespace xproc = "http://xproc.net/xproc";

declare namespace t = "http://xproc.org/ns/testsuite";

(: Module Imports :)
import module namespace u = "http://xproc.net/xproc/util";
import module namespace const = "http://xproc.net/xproc/const";
import module namespace http = "http://www.expath.org/mod/http-client";

(: -------------------------------------------------------------------------- :)

(: Module Vars :)
declare variable $std:add-attribute :=util:function(xs:QName("std:add-attribute"), 3);
declare variable $std:add-xml-base :=util:function(xs:QName("std:add-xml-base"), 3);
declare variable $std:count :=util:function(xs:QName("std:count"), 3);
declare variable $std:compare :=util:function(xs:QName("std:compare"),3);
declare variable $std:delete :=util:function(xs:QName("std:delete"),3);
declare variable $std:error :=util:function(xs:QName("std:error"), 3);
declare variable $std:filter :=util:function(xs:QName("std:filter"), 3);
declare variable $std:directory-list :=util:function(xs:QName("std:directory-list"), 3);
declare variable $std:escape-markup :=util:function(xs:QName("std:escape-markup"), 3);
declare variable $std:http-request :=util:function(xs:QName("std:http-request"), 3);
declare variable $std:identity :=util:function(xs:QName("std:identity"), 3);
declare variable $std:insert :=util:function(xs:QName("std:insert"), 3);
declare variable $std:label-elements :=util:function(xs:QName("std:label-elements"), 3);
declare variable $std:load :=util:function(xs:QName("std:load"), 3);
declare variable $std:make-absolute-uris :=util:function(xs:QName("std:make-absolute-uris"), 3);
declare variable $std:namespace-rename :=util:function(xs:QName("std:namespace-rename"), 3);
declare variable $std:pack :=util:function(xs:QName("std:pack"), 3);
declare variable $std:parameters :=util:function(xs:QName("std:parameters"), 3);
declare variable $std:rename :=util:function(xs:QName("std:rename"), 3);
declare variable $std:replace :=util:function(xs:QName("std:replace"), 3);
declare variable $std:set-attributes :=util:function(xs:QName("std:set-attributes"), 3);
declare variable $std:sink :=util:function(xs:QName("std:sink"), 3);
declare variable $std:split-sequence :=util:function(xs:QName("std:split-sequence"), 3);
declare variable $std:store :=util:function(xs:QName("std:store"), 3);
declare variable $std:string-replace :=util:function(xs:QName("std:string-replace"), 3);
declare variable $std:unescape-markup :=util:function(xs:QName("std:unescape-markup"), 3);
declare variable $std:xinclude :=util:function(xs:QName("std:xinclude"), 3);
declare variable $std:wrap :=util:function(xs:QName("std:wrap"), 3);
declare variable $std:wrap-sequence :=util:function(xs:QName("std:wrap-sequence"), 3);
declare variable $std:unwrap :=util:function(xs:QName("std:unwrap"), 3);
declare variable $std:xslt :=util:function(xs:QName("std:xslt"), 3);

(: -------------------------------------------------------------------------- :)
declare function std:add-attribute($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (starts-with($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $attribute-name := u:get-option('attribute-name',$options,$v)
let $attribute-value := u:get-option('attribute-value',$options,$v)
return
	u:add-attribute-matching-elements($v/*,$matchresult,$attribute-name,$attribute-value)
};

(: -------------------------------------------------------------------------- :)
declare function std:add-xml-base($primary,$secondary,$options) {

(: TODO: need to refactor to pass in pipeline uri and any external input uri :)

let $v := u:get-primary($primary)
let $all := xs:boolean(u:get-option('all',$options,$v))
let $relative := xs:boolean(u:get-option('relative',$options,$v))
let $attrNames := xs:QName('xml:base')
let $attrValues := base-uri($v)

return
    if ($all) then
    for $element in $v/*
       return element { node-name($element)}
                      { for $attrName at $seq in $attrNames
                        return if ($element/@*[node-name(.) = $attrName])
                               then ()
                               else attribute {$attrName}
                                              {$attrValues[$seq]},
                        $element/@*,
                        $element/node() }
else
    for $element in $v/*
       return element { node-name($element)}
                      { for $attrName at $seq in $attrNames
                        return if ($element/@*[node-name(.) = $attrName])
                               then ()
                               else attribute {$attrName}
                                              {$attrValues[$seq]},
                        $element/@*,
                        $element/node() }
};

(: -------------------------------------------------------------------------- :)
declare function std:compare($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $alternate : = u:get-secondary('alternate',$secondary)
let $strict := xs:boolean(u:get-option('xproc:strict',$options,$v)) (: ext attribute xproc:strict:)
let $fail-if-not-equal := xs:boolean(u:get-option('fail-if-not-equal',$options,$v))

let $result :=  if ($strict and count($v/*) eq 1) then
		deep-equal($v,$alternate)

else if ($strict and count($v/*) gt 1) then
	u:deep-equal-seq($v,$alternate,'1')

else if (count($v/*) gt 1) then
	u:deep-equal-seq($v,$alternate,'0')

else
	deep-equal(u:treewalker($v/*),u:treewalker($alternate/*))

    return

       if($fail-if-not-equal) then
            if ($result) then
      			u:outputResultElement('true')
            else
                u:stepError('err:XC0019','p:compare fail-if-not-equal option is enabled and documents were not equal')
        else
            u:outputResultElement($result)
};

(: -------------------------------------------------------------------------- :)
declare function std:count($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $limit := xs:integer(u:get-option('limit',$options,$v))
let $count := count($v)
return
    if (empty($limit) or $limit eq 0 or $count lt $limit ) then
		u:outputResultElement($count)
    else
   		u:outputResultElement($limit)
};

(: -------------------------------------------------------------------------- :)
declare function std:delete($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:delete-matching-elements($v/*, $matchresult)
};

(: -------------------------------------------------------------------------- :)
declare function std:directory-list($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $path := u:get-option('path',$options,$v)
let $include-filter := u:get-option('include-filter',$options,$v)
let $exclude-filter := u:get-option('exclude-filter',$options,$v)
let $query := concat("util:directory-list('",$path,"','",$include-filter,"')")
let $directory-list := u:eval($query)
let $result := <c:directory name="{$directory-list/@name}">
					{for $file in $directory-list//*:file
					return
						<c:file name="{$file/@name}"/>
					}
				</c:directory>
return
		u:outputResultElement($result)
};

(: -------------------------------------------------------------------------- :)
declare function std:escape-markup($primary,$secondary,$options) {
(: TODO: test with sequences :)
let $v := u:get-primary($primary)
return
	element{name($v/*)}{
    	u:serialize($v/*/*,$const:ESCAPE_SERIALIZE)
	}
};

(: -------------------------------------------------------------------------- :)
declare function std:error($primary,$secondary,$options) {
(: TODO: this should be generated to the error port:)

let $v := u:get-primary($primary)
let $code := u:get-option('code',$options,$v)
let $err := <c:errors xmlns:c="http://www.w3.org/ns/xproc-step"
          xmlns:p="http://www.w3.org/ns/xproc"
          xmlns:my="http://www.example.org/error">
		<c:error href="" column="" offset=""
         	name="step-name" type="p:error"
         	code="{$code}">
    		<message>{$v}</message>
		</c:error>
</c:errors>
return
	u:dynamicError('err:XD0030',concat(": p:error throw custom error code - ",$code," ",u:serialize($err,$const:TRACE_SERIALIZE)))

};

(: -------------------------------------------------------------------------- :)
declare function std:filter($primary,$secondary,$options) {
(: TODO: is it an error for a empty match ? :)
u:assert(exists($options/p:with-option[@name='select']/@select),'p:with-option match is required'),
let $v := u:get-primary($primary)
let $select := string(u:get-option('select',$options,$v))
let $result := u:evalXPATH($select,$v)
    return
        if(exists($result)) then
        	$result
		else
            $select
};

(: -------------------------------------------------------------------------- :)
declare function std:http-request($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $href := $v/c:request/@href
let $method := $v/c:request/@method
let $content-type := $v/c:request/c:body/@content-type
let $body := $v/c:request/c:body
let $status-only := $v/c:request/@status-only
let $detailed := $v/c:request/@detailed
let $username := ''
let $password := ''
let $auth-method := ''
let $send-authorization := ''
let $override-content-type := ''
let $follow-redirect := ''
let $http-request := <http:request href="{$href}" method="{$method}">{

		for $header in $v/c:request/c:header
		return
			<http:header name="{$header/@name}" value="{$header/@value}"/>,

		if (empty($body)) then
		    ()
		else
	      <http:body content-type="{$content-type}">
	         {$body}
	      </http:body>
	}
	   </http:request>
let $raw-response := http:send-request( $http-request)
let $response-headers := for $header in $raw-response//http:header
        return
            <c:header name="{$header/@name}" value="{$header/@value}"/>

let $response-body := if ($status-only) then
        ()
     else if ($detailed) then
		<c:body>{$raw-response/*[not(name(.) eq 'http:body')][not(name(.) eq 'http:header')]}</c:body>
     else
		$raw-response/*[not(name(.) eq 'http:body')][not(name(.) eq 'http:header')]

return
    if (name($v/node()) ne 'c:request') then
            u:dynamicError('err:XC0040',"source port must contain c:request element")
    else if ($detailed) then
      <c:response status="{$raw-response/@status}">
        {$response-headers}
        {$response-body}
      </c:response>
    else
        $response-body

};

(: -------------------------------------------------------------------------- :)
declare function std:identity($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:insert($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $position := u:get-option('position',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $insertion := u:get-secondary('insertion',$secondary)
return
	u:insert-matching-elements($v/*,$matchresult,$insertion,$position)
};

(: -------------------------------------------------------------------------- :)
declare function std:label-elements($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $attribute := u:get-option('attribute',$options,$v)
let $label := u:get-option('label',$options,$v)
let $replace := u:get-option('replace',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:label-matching-elements($v/*,$matchresult,$attribute,$label,$replace)
};

(: -------------------------------------------------------------------------- :)
declare function std:load($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $href := u:get-option('href',$options,$v)
let $xproc:output-uri := u:get-option('xproc:output-uri',$options,$v)
return
if (empty($href)) then
	u:dynamicError('err:XC0026',"p:load option href is empty.")
else if(starts-with($href,'file://')) then
		let $test-exists := concat("file:exists('",
									 substring-after($href,'file://'),
									 "')")
		let $query := concat("file:read('",
									 $href,
									 "')")
		return
			if (u:eval($test-exists)) then
				u:parse-string(u:eval($query))
			else
				u:dynamicError('err:XC0026',"p:load could not access or find the file.")
else
	let $load := doc($href)
	return
		if ($xproc:output-uri eq 'true') then
			u:outputResultElement($href)
		else
			$load
};

(: -------------------------------------------------------------------------- :)
declare function std:make-absolute-uris($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:namespace-rename($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:pack($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $alternate := u:get-secondary('alternate',$secondary)
let $wrapper := u:get-option('wrapper',$options,$v)
return

    for $child at $count in $v
    return
	    element {$wrapper}{$child,$alternate[$count]}
};

(: -------------------------------------------------------------------------- :)
declare function std:parameters($primary,$secondary,$options) {
let $v := u:get-primary($primary)
return
	$v
};

(: -------------------------------------------------------------------------- :)
declare function std:rename($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $new-name := u:get-option('new-name',$options,$v)
return
	u:rename-matching-elements($v/*,$matchresult,$new-name)
};

(: -------------------------------------------------------------------------- :)
declare function std:replace($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $replacement := u:get-secondary('replacement',$secondary)
return
	u:replace-matching-elements($v/*,$matchresult,$replacement)
};

(: -------------------------------------------------------------------------- :)
declare function std:set-attributes($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $attributes := u:get-secondary('attributes',$secondary)
let $match := u:get-option('match',$options,$v)
let $matchresult := u:evalXPATH(string($match), $v)
return
	u:add-attributes-matching-elements($v/*,$matchresult,$attributes/*/@*)
};

(: -------------------------------------------------------------------------- :)
declare function std:sink($primary,$secondary,$options) {
    (string(''))
};

(: -------------------------------------------------------------------------- :)
declare function std:split-sequence($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $test := u:get-option('test',$options,$v)
return
	for $child in $v/*
	let $prove := u:evalXPATH($test, $child)
	return
	    if ($prove) then
	        <success/>
	    else
	        <failure/>
};

(: -------------------------------------------------------------------------- :)
declare function std:store($primary,$secondary,$options) {
(:TODO - check existence of collection path :)
let $v := u:get-primary($primary)
let $href-uri := u:get-option('href',$options,$v)
let $name := tokenize($href-uri, "/")[last()]
let $xproc:output-document := u:get-option('xproc:output-document',$options,$v)
let $path := substring-before($href-uri,$name)
let $serialized := u:serialize($v,$const:DEFAULT_SERIALIZE)
let $store := if(starts-with($path,'file://')) then
				let $query := concat("file:serialize(",
									 $serialized,
								 	 ",'",
									 substring-after($href-uri,'file://'),
									 "','method=xml')")
				return
					u:eval($query)
			  else
								xmldb:store($path,$name,$v)
return
if($xproc:output-document eq 'true') then
		$v
	else
		u:outputResultElement(concat($path,$name))
};

(: -------------------------------------------------------------------------- :)
declare function std:string-replace($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $replace := string(u:get-option('replace',$options,$v))

(:
let $replace := u:evalXPATH(string(u:get-option('replace',$options,$v)),$v)
:)
return
	u:string-replace-matching-elements($v/*,$matchresult,$replace)
};

(: -------------------------------------------------------------------------- :)
declare function std:unescape-markup($primary,$secondary,$options){
(: TODO: test with sequences :)
let $v := u:get-primary($primary)
return
    element{name($v/*)}{
		u:parse-string($v)
		}
};

(: -------------------------------------------------------------------------- :)
declare function std:xinclude($primary,$secondary,$options){
let $v := u:get-primary($primary)
return
	u:parse-string(u:serialize($v,'expand-xincludes=yes'))
};

(: -------------------------------------------------------------------------- :)
declare function std:wrap($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
let $wrapper := u:get-option('wrapper',$options,$v)
let $group-adjacent := u:get-option('group-adjacent',$options,$v)
return
	u:wrap-matching-elements($v/*,$matchresult,$wrapper)
};

(: -------------------------------------------------------------------------- :)
declare function std:wrap-sequence($primary,$secondary,$options){
let $v := u:get-primary($primary)
let $wrapper := u:get-option('wrapper',$options,$v)
let $group-adjacent := u:get-option('group-adjacent',$options,$v)
return
	element {$wrapper}{
		$v
	}
};

(: -------------------------------------------------------------------------- :)
declare function std:unwrap($primary,$secondary,$options) {
let $v := u:get-primary($primary)
let $match := u:get-option('match',$options,$v)
let $query := if (contains($match,'/')) then
				$match
			  else
				concat('//',$match)
let $matchresult := u:evalXPATH($query, $v)
return
	u:unwrap-matching-elements($v/*,$matchresult)
};

(: -------------------------------------------------------------------------- :)
declare function std:xslt($primary,$secondary,$options){

    u:assert(exists($secondary/xproc:input[@port='stylesheet']/*),'stylesheet is required'),
	let $v := u:get-primary($primary)
    let $stylesheet := u:get-secondary('stylesheet',$secondary)
    return
        u:xslt($stylesheet,$v)
};

(: -------------------------------------------------------------------------- :)


fixed a typo error

fixed a typo error

xquery version "1.0";

(: ~
 : Module Name:             new data element concept XQuery
 :
 : Module Version           1.0
 :
 : Date                     17th September 2007
 :
 : Copyright                The cancergrid consortium
 :
 : Module overview          Creates a DEC and optionally an object class and property
 :
 :)

(:~
 :    @author Steve Harris
 :    @version 0.1
~ :)

  import module namespace
  lib-forms="http://www.cagrid.org/xquery/library/forms"
  at "../edit/m-lib-forms.xquery";

  import module namespace
  lib-util="http://www.cagrid.org/xquery/library/util"
  at "../library/m-lib-util.xquery";

  import module namespace
  lib-rendering="http://www.cagrid.org/xquery/library/rendering"
  at "../web/m-lib-rendering.xquery";

  import module namespace
    lib-make-admin-item="http://www.cagrid.org/xquery/library/make-admin-item"
    at "../edit/m-lib-make-admin-item.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace exist = "http://exist.sourceforge.net/NS/exist";
declare namespace datetime = "http://exist-db.org/xquery/datetime";

declare function local:DataElementConcept(
   $reg-auth as xs:string,
   $administrative-note as xs:string,
   $administrative-status as xs:string,
   $administered-by as xs:string,
   $submitted-by as xs:string,
   $registered-by as xs:string,
   $context-ids as xs:string*,
   $country-identifiers as xs:string*,
   $language-identifiers as xs:string*,
   $names as xs:string*,
   $definitions as xs:string*,
   $sources as xs:string*,
   $preferred as xs:string?
   ) as xs:string
{
   let $version := '0.1'

   let $object_class_id := request:get-parameter('object_class_id','')
   let $property_id := request:get-parameter('property_id','')
   let $conceptual_domain_id := request:get-parameter('conceptual_domain_id','')
   let $object_class_uri := request:get-parameter('object_class_uri','')
   let $property_uri := request:get-parameter('property_uri','')

   let $data-identifier-oc := lib-forms:generate-id()
   let $data-identifier-pr := lib-forms:generate-id()

   let $full-identifier-oc := concat($reg-auth, '_', $data-identifier-oc, '_', $version)
   let $full-identifier-pr := concat($reg-auth, '_', $data-identifier-pr, '_', $version)

   let $data-identifier := lib-forms:generate-id()
   let $new-identifier := concat($reg-auth, '_', $data-identifier, '_', $version)

   let $content := (
            lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(), "MM-dd-yyyy '  ' HH:mm:ss"),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
                    element openMDR:data_element_concept_conceptual_domain {$conceptual_domain_id},
                    element openMDR:data_element_concept_object_class {
                      if ($object_class_id) then ($object_class_id) else ($full-identifier-oc)
                    },
                    element openMDR:data_element_concept_property {
                      if ($property_id) then ($property_id) else ($full-identifier-pr)
                    }
    )

let $object-class :=
   (
   element openMDR:Object_Class {
        lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier-oc,$version),
         lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(), "MM-dd-yyyy '  ' HH:mm:ss"),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
        element openMDR:reference_uri {$object_class_uri}
        }
   )

let $property :=
   (
    element openMDR:Property {
        lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier-pr,$version),
         lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(), "MM-dd-yyyy '  ' HH:mm:ss"),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
        element openMDR:reference_uri {$property_uri}
        }
   )

   (: compose the document :)
   let $document :=
      element openMDR:Data_Element_Concept {
            lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier,$version),
            $content
           }

   return
   if ((
      if ($object_class_id > '')
      then 'stored'
      else lib-forms:store-document($object-class))='stored'
      )
   then (
      if ((
         if ($property_id > '')
         then 'stored'
         else lib-forms:store-document($property))='stored')
      then (
          if(lib-forms:store-document($document)='stored')
          then 'stored'
          else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store data element concept"))) )
          )
      else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store property"))) )
   )
   else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store object class"))) )

};

declare function local:input-page(
   $message as xs:string?,
   $reg-auth as xs:string?,
   $administrative-note  as xs:string?,
   $administrative-status  as xs:string?,
   $administered-by  as xs:string?,
   $submitted-by  as xs:string?,
   $registered-by  as xs:string?,
   $context-ids as xs:string*,
   $country-identifiers as xs:string*,
   $language-identifiers as xs:string*,
   $names as xs:string*,
   $definitions as xs:string*,
   $sources as xs:string*,
   $action as xs:string?,
   $preferred as xs:string?
   ) {
   let $skip-name := substring-after($action,'delete naming entry')
   let $skip-name-index := if ($skip-name>'') then xs:int($skip-name) else 0

   return

                This form will allow you to create a new DataElementConcept in the metadata repository

          <form name="new_DataElementConcept" action="newDataElementConcept.xquery" method="post" class="cagridForm" enctype="multipart/form-data">

             {lib-forms:edit-admin-item($reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $preferred,
                     $action)}

                  Object Class URI

                     {lib-forms:find-concept-id('object_class_uri','get object class concept',request:get-parameter('object_class_uri',''))}

                   or select existing
                  {
                    if(request:get-parameter('object_class_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('object_class','object_class_id', session:get-attribute("object_class_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("object_class_id", "")
                    )
                    else if(request:get-parameter('object_class_id','') != "")  then (
                        session:set-attribute("object_class_id", request:get-parameter('object_class_id','')),
                        lib-forms:make-select-form-admin-item('object_class','object_class_id', request:get-parameter('object_class_id',''),'new_DataElementConcept', 'Change Relationship')
                    )
                    else(
                       lib-forms:make-select-form-admin-item('object_class','object_class_id', request:get-parameter('object_class_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

                  Property URI

                  {lib-forms:find-concept-id('property_uri','get property concept',request:get-parameter('property_uri',''))}

                   or select existing
                  {
                    if(request:get-parameter('property_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('property','property_id', session:get-attribute("property_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("property_id", "") )

                    else if(request:get-parameter('property_id','') != "")  then (
                        session:set-attribute("property_id", request:get-parameter('property_id','')),
                        lib-forms:make-select-form-admin-item('property','property_id', request:get-parameter('property_id',''),'new_DataElementConcept', 'Change Relationship'))

                    else(
                       lib-forms:make-select-form-admin-item('property','property_id', request:get-parameter('property_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

                  Conceptual Domain

                  {
                    if(request:get-parameter('conceptual_domain_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', session:get-attribute("conceptual_domain_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("conceptual_domain_id", "") )

                    else if(request:get-parameter('conceptual_domain_id','') != "")  then (
                        session:set-attribute("conceptual_domain_id", request:get-parameter('conceptual_domain_id','')),
                        lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', request:get-parameter('conceptual_domain_id',''),'new_DataElementConcept', 'Change Relationship'))

                    else(
                       lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', request:get-parameter('conceptual_domain_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

	<input type="submit" name="update" value="Store" onClick="return validate_adminItems ()"/>
                      <input type="button" name="update" value="Clear" onClick="this.form.reset()"/>

          </form>

{$message}

   };

declare function local:success-page()
{
   let $calling-page := request:get-parameter("calling-page","")
   return

DataElementConcept {request:get-parameter('names',())} class created

Return to Maintenance Menu

Create another DataElementConcept

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

   session:create(),
   let $title as xs:string := "Creating a New DataElementConcept"
   let $reg-auth := request:get-parameter('registration-authority','')
   let $administrative-note := request:get-parameter('administrative-note','')
   let $administrative-status := request:get-parameter('administrative-status','')
   let $administered-by := request:get-parameter('administered-by','')
   let $submitted-by := request:get-parameter('submitted-by','')
   let $registered-by := request:get-parameter('registered-by','')
   let $context-ids := request:get-parameter('context-ids',())
   let $country-identifiers := request:get-parameter('country-identifiers',())
   let $language-identifiers := request:get-parameter('language-identifiers',())
   let $names := request:get-parameter('names',())
   let $definitions := request:get-parameter('definitions',())
   let $sources := request:get-parameter('sources',())
   let $preferred := request:get-parameter('preferred','')
   let $action := request:get-parameter('update','')

   return

      lib-rendering:txfrm-webpage(
      $title,
      if ($action='Store')
      then
         (
         if (
               local:DataElementConcept
                  (
                     $reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $preferred
                  ) = 'stored'
            )
         then local:success-page()
         else (local:input-page(
            'could not store document',
                     $reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $action,
                     $preferred
                  )
               )
         )
      else local:input-page
               (
               '',
               $reg-auth,
               $administrative-note,
               $administrative-status,
               $administered-by,
               $submitted-by,
               $registered-by,
               $context-ids,
               $country-identifiers,
               $language-identifiers,
               $names,
               $definitions,
               $sources,
               $action,
               $preferred
               )
         )

xquery version "1.0";

(: ~
 : Module Name:             new data element concept XQuery
 :
 : Module Version           1.0
 :
 : Date                     17th September 2007
 :
 : Copyright                The cancergrid consortium
 :
 : Module overview          Creates a DEC and optionally an object class and property
 :
 :)

(:~
 :    @author Steve Harris
 :    @version 0.1
~ :)

  import module namespace
  lib-forms="http://www.cagrid.org/xquery/library/forms"
  at "../edit/m-lib-forms.xquery";

  import module namespace
  lib-util="http://www.cagrid.org/xquery/library/util"
  at "../library/m-lib-util.xquery";

  import module namespace
  lib-rendering="http://www.cagrid.org/xquery/library/rendering"
  at "../web/m-lib-rendering.xquery";

  import module namespace
    lib-make-admin-item="http://www.cagrid.org/xquery/library/make-admin-item"
    at "../edit/m-lib-make-admin-item.xquery";

declare namespace openMDR = "http://www.cagrid.org/schema/openMDR";
declare namespace ISO11179= "http://www.cagrid.org/schema/ISO11179";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace exist = "http://exist.sourceforge.net/NS/exist";
declare namespace datetime = "http://exist-db.org/xquery/datetime";

declare function local:DataElementConcept(
   $reg-auth as xs:string,
   $administrative-note as xs:string,
   $administrative-status as xs:string,
   $administered-by as xs:string,
   $submitted-by as xs:string,
   $registered-by as xs:string,
   $context-ids as xs:string*,
   $country-identifiers as xs:string*,
   $language-identifiers as xs:string*,
   $names as xs:string*,
   $definitions as xs:string*,
   $sources as xs:string*,
   $preferred as xs:string?
   ) as xs:string
{
   let $version := '0.1'

   let $object_class_id := request:get-parameter('object_class_id','')
   let $property_id := request:get-parameter('property_id','')
   let $conceptual_domain_id := request:get-parameter('conceptual_domain_id','')
   let $object_class_uri := request:get-parameter('object_class_uri','')
   let $property_uri := request:get-parameter('property_uri','')

   let $data-identifier-oc := lib-forms:generate-id()
   let $data-identifier-pr := lib-forms:generate-id()

   let $full-identifier-oc := concat($reg-auth, '_', $data-identifier-oc, '_', $version)
   let $full-identifier-pr := concat($reg-auth, '_', $data-identifier-pr, '_', $version)

   let $data-identifier := lib-forms:generate-id()
   let $new-identifier := concat($reg-auth, '_', $data-identifier, '_', $version)

   let $content := (
            lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(), "MM-dd-yyyy '  ' HH:mm:ss"),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
                    element openMDR:data_element_concept_conceptual_domain {$conceptual_domain_id},
                    element openMDR:data_element_concept_object_class {
                      if ($object_class_id) then ($object_class_id) else ($full-identifier-oc)
                    },
                    element openMDR:data_element_concept_property {
                      if ($property_id) then ($property_id) else ($full-identifier-pr)
                    }
    )

let $object-class :=
   (
   element openMDR:Object_Class {
        lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier-oc,$version),
         lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
        element openMDR:reference_uri {$object_class_uri}
        }
   )

let $property :=
   (
    element openMDR:Property {
        lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier-pr,$version),
         lib-make-admin-item:administration-record($administrative-note,$administrative-status,datetime:format-dateTime(current-dateTime(),'Recorded'),
            lib-make-admin-item:custodians($administered-by,$registered-by,$submitted-by),
            lib-make-admin-item:havings(
                    $context-ids,
                    $country-identifiers,
                    $language-identifiers,
                    $names,
                    $definitions,
                    $preferred,
                    $sources),
        element openMDR:reference_uri {$property_uri}
        }
   )

   (: compose the document :)
   let $document :=
      element openMDR:Data_Element_Concept {
            lib-make-admin-item:identifier-attributes($reg-auth,$data-identifier,$version),
            $content
           }

   return
   if ((
      if ($object_class_id > '')
      then 'stored'
      else lib-forms:store-document($object-class))='stored'
      )
   then (
      if ((
         if ($property_id > '')
         then 'stored'
         else lib-forms:store-document($property))='stored')
      then (
          if(lib-forms:store-document($document)='stored')
          then 'stored'
          else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store data element concept"))) )
          )
      else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store property"))) )
   )
   else ( response:redirect-to(xs:anyURI(concat("login.xquery?calling_page=newDataElementConcept.xquery&","Could not store object class"))) )

};

declare function local:input-page(
   $message as xs:string?,
   $reg-auth as xs:string?,
   $administrative-note  as xs:string?,
   $administrative-status  as xs:string?,
   $administered-by  as xs:string?,
   $submitted-by  as xs:string?,
   $registered-by  as xs:string?,
   $context-ids as xs:string*,
   $country-identifiers as xs:string*,
   $language-identifiers as xs:string*,
   $names as xs:string*,
   $definitions as xs:string*,
   $sources as xs:string*,
   $action as xs:string?,
   $preferred as xs:string?
   ) {
   let $skip-name := substring-after($action,'delete naming entry')
   let $skip-name-index := if ($skip-name>'') then xs:int($skip-name) else 0

   return

                This form will allow you to create a new DataElementConcept in the metadata repository

          <form name="new_DataElementConcept" action="newDataElementConcept.xquery" method="post" class="cagridForm" enctype="multipart/form-data">

             {lib-forms:edit-admin-item($reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $preferred,
                     $action)}

                  Object Class URI

                     {lib-forms:find-concept-id('object_class_uri','get object class concept',request:get-parameter('object_class_uri',''))}

                   or select existing
                  {
                    if(request:get-parameter('object_class_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('object_class','object_class_id', session:get-attribute("object_class_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("object_class_id", "")
                    )
                    else if(request:get-parameter('object_class_id','') != "")  then (
                        session:set-attribute("object_class_id", request:get-parameter('object_class_id','')),
                        lib-forms:make-select-form-admin-item('object_class','object_class_id', request:get-parameter('object_class_id',''),'new_DataElementConcept', 'Change Relationship')
                    )
                    else(
                       lib-forms:make-select-form-admin-item('object_class','object_class_id', request:get-parameter('object_class_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

                  Property URI

                  {lib-forms:find-concept-id('property_uri','get property concept',request:get-parameter('property_uri',''))}

                   or select existing
                  {
                    if(request:get-parameter('property_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('property','property_id', session:get-attribute("property_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("property_id", "") )

                    else if(request:get-parameter('property_id','') != "")  then (
                        session:set-attribute("property_id", request:get-parameter('property_id','')),
                        lib-forms:make-select-form-admin-item('property','property_id', request:get-parameter('property_id',''),'new_DataElementConcept', 'Change Relationship'))

                    else(
                       lib-forms:make-select-form-admin-item('property','property_id', request:get-parameter('property_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

                  Conceptual Domain

                  {
                    if(request:get-parameter('conceptual_domain_id','') eq "Cancel")  then (
                        lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', session:get-attribute("conceptual_domain_id"),'new_DataElementConcept', 'Change Relationship'),
                        session:set-attribute("conceptual_domain_id", "") )

                    else if(request:get-parameter('conceptual_domain_id','') != "")  then (
                        session:set-attribute("conceptual_domain_id", request:get-parameter('conceptual_domain_id','')),
                        lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', request:get-parameter('conceptual_domain_id',''),'new_DataElementConcept', 'Change Relationship'))

                    else(
                       lib-forms:make-select-form-admin-item('conceptual_domain','conceptual_domain_id', request:get-parameter('conceptual_domain_id',''),'new_DataElementConcept', 'Select Relationship')
                  )
                  }

	<input type="submit" name="update" value="Store" onClick="return validate_adminItems ()"/>
                      <input type="button" name="update" value="Clear" onClick="this.form.reset()"/>

          </form>

{$message}

   };

declare function local:success-page()
{
   let $calling-page := request:get-parameter("calling-page","")
   return

DataElementConcept {request:get-parameter('names',())} class created

Return to Maintenance Menu

Create another DataElementConcept

};

declare option exist:serialize "media-type=text/html method=xhtml doctype-public=-//W3C//DTD XHTML 1.0 Transitional//EN doctype-system=http://www.w3.org/TR/2002/REC-xhtml1-20020801/DTD/xhtml1-transitional.dtd";

   session:create(),
   let $title as xs:string := "Creating a New DataElementConcept"
   let $reg-auth := request:get-parameter('registration-authority','')
   let $administrative-note := request:get-parameter('administrative-note','')
   let $administrative-status := request:get-parameter('administrative-status','')
   let $administered-by := request:get-parameter('administered-by','')
   let $submitted-by := request:get-parameter('submitted-by','')
   let $registered-by := request:get-parameter('registered-by','')
   let $context-ids := request:get-parameter('context-ids',())
   let $country-identifiers := request:get-parameter('country-identifiers',())
   let $language-identifiers := request:get-parameter('language-identifiers',())
   let $names := request:get-parameter('names',())
   let $definitions := request:get-parameter('definitions',())
   let $sources := request:get-parameter('sources',())
   let $preferred := request:get-parameter('preferred','')
   let $action := request:get-parameter('update','')

   return

      lib-rendering:txfrm-webpage(
      $title,
      if ($action='Store')
      then
         (
         if (
               local:DataElementConcept
                  (
                     $reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $preferred
                  ) = 'stored'
            )
         then local:success-page()
         else (local:input-page(
            'could not store document',
                     $reg-auth,
                     $administrative-note,
                     $administrative-status,
                     $administered-by,
                     $submitted-by,
                     $registered-by,
                     $context-ids,
                     $country-identifiers,
                     $language-identifiers,
                     $names,
                     $definitions,
                     $sources,
                     $action,
                     $preferred
                  )
               )
         )
      else local:input-page
               (
               '',
               $reg-auth,
               $administrative-note,
               $administrative-status,
               $administered-by,
               $submitted-by,
               $registered-by,
               $context-ids,
               $country-identifiers,
               $language-identifiers,
               $names,
               $definitions,
               $sources,
               $action,
               $preferred
               )
         )