adding config-param; ns-handling

adding config-param; ns-handling

xquery version "1.0";
module namespace cmdcheck = "http://clarin.eu/cmd/check";
(: checking (trying to ensure) consistency of the IDs in CMD-records (MdSelfLink vs. ResourceProxies vs. IsPartOf)

TODO: check (and/or generate) the inverse links in IsPartOf (vs. ResourceProxies)
:)

(:import module namespace cmd  = "http://clarin.eu/cmd/collections" at "cmd-collections.xqm";:)
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";
import module namespace fcs = "http://clarin.eu/fcs/1.0" at "/db/cr/fcs.xqm";
import module namespace crday  = "http://aac.ac.at/content_repository/data-ay" at "/db/cr/crday.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace cmd = "http://www.clarin.eu/cmd/";

(:~ default namespace: cmd - declared statically, because dynamic ns-declaration did not work
cmd is the default namespace in (not) all the CMD records
:)
declare default element namespace "http://www.clarin.eu/cmd/";
(:~ default namespace - not declared explicitely, it is declared dynamically where necessary (function: addIsPartOf() :)
declare variable $cmdcheck:default-ns := "http://www.clarin.eu/cmd/";
declare variable $cmdcheck:root-coll := "root";

(:~ runs cmd.profile-scan for all contexts defined in the mappings :)

declare function cmdcheck:run-stats($config-path as xs:string) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings'))

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

      for $map in $mappings//map[@key]
                let $map-key := $map/xs:string(@key),
                    $map-dbcoll-path := $map/xs:string(@path),
                    $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config)
                return $scan-cmd-profile
};

(:~ currently not used -> DEPRECATE?
init-function meant to call individual functions actually doing something.
at least it resolves x-context to a nodeset
:)
declare function cmdcheck:check($x-context as xs:string+, $config as node() ) as item()* {

    let $log-file-name := concat('log_checks_', repo-utils:sanitize-name($x-context), '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')

    let $start-time := util:system-dateTime()

    let $stat-profiles := cmdcheck:scan-profiles($x-context, $config),
(:        $check-linking := cmdcheck:check-linking($data-collection),:)
        $duration := util:system-dateTime() - $start-time

    let $result-data := <checks context="{$x-context}" on="{$start-time}" duration="{$duration}" >
                    <profiles>{$stat-profiles}</profiles>
                    <check-linking>{$check-linking}</check-linking>
                  </checks>
     let $store := xmldb:store($log-path ,  $log-file-name, $result-data)
    return $store
};

(:~ extracts CMD-Profiles from given nodeset

TODO: match with cmd-terms and diagnostics
:)
declare function cmdcheck:scan-profiles($x-context as xs:string, $config as node()) as item()* {
      (: try- to handle namespace problem - primitively :)

    let $context := repo-utils:context-to-collection($x-context, $config),
        $ns-uri := namespace-uri($context[1]/*)
            (: dynamically declare a namespace for the next step, if one is defined in current context
       $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
       (: this is now trying to overcome the default-ns issue, by accepting with and without ns :)

let $profiles-summary :=
        if (not(exists($context))) then
            diag:diagnostics("general-error", concat("scan-profiles: no context: ", $x-context))
         else
            (:        $dummy := util:declare-namespace("",xs:anyURI(""))       :)
            (:    let $profiles := util:eval("$context//(MdProfile|cmd:MdProfile)/text()"):)
                    let $is-ns-cmd := ($ns-uri = xs:anyURI("http://www.clarin.eu/cmd/") )
                let $profiles :=
                                      if ($is-ns-cmd) then
                                            $context//cmd:CMD/concat(cmd:Header/cmd:MdProfile/text(), '#', cmd:Components/*[1]/local-name())
                                      else
                                            let $dummy := util:declare-namespace("",xs:anyURI($ns-uri))
                                            return util:eval("$context//CMD/concat(Header/MdProfile/text(), '#', Components/*[1]/local-name())")

            let $distinct-profiles := distinct-values($profiles)
           return for $profile in $distinct-profiles
(:                                let $profile-name := util:eval("$context[.//(MdProfile|cmd:MdProfile)/text() = $profile][1]//(Components|cmd:Components)/*/name()"):)
                                let $profile-name := substring-after($profile, '#')
                                let $profile-id := substring-before($profile, '#')
                                let $cnt := count($profiles[. eq $profile])
                                return <sru:term>
                                           <sru:value>{if ($profile-id ne '') then $profile-id else $profile-name}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                           { if ($profile-id eq '') then
                                                    <sru:extraTermData>
                                                        { (diag:diagnostics("profile-missing", $profile-name),
                                                           if (not($is-ns-cmd)) then diag:diagnostics("unknown-namespace", $ns-uri)
                                                                        else ()
                                                        )}
                                                    </sru:extraTermData>
                                                  else ()
                                                  }
                                         </sru:term>
    let $count-all := count($profiles-summary)
    return
                    <sru:scanResponse xmlns:sru="http://www.loc.gov/zing/srw/" xmlns:fcs="http://clarin.eu/fcs/1.0">
                          <sru:version>1.2</sru:version>
                          <sru:terms>
                            {$profiles-summary }
                           </sru:terms>
                           <sru:extraResponseData>
                                 <fcs:countTerms>{$count-all}</fcs:countTerms>
                             </sru:extraResponseData>
                             <sru:echoedScanRequest>
                                  <sru:scanClause>cmd.profile</sru:scanClause>
                              </sru:echoedScanRequest>
                       </sru:scanResponse>
};

declare function cmdcheck:display-overview($config-path as xs:string) as item()* {

   let $config := doc($config-path),
       $dummy := util:declare-namespace("",xs:anyURI("")),
       $mappings := doc(repo-utils:config-value($config, 'mappings'))
(:       $baseurl := repo-utils:config-value($config, 'base.url'),:)

   let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

   let $overview :=  crday:display-overview($config-path, 'raw')

   let $profiles-overview :=

collection	profiles

           { for $map in util:eval("$mappings//map[@key]")
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
                        $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config),
                        $scan-formatted := repo-utils:serialise-as( $scan-cmd-profile, 'htmldetail', 'scan', $config, ())
                    return

                        {$map-key}
                        { $scan-formatted }

                        }

            (: { for $profile in $scan-cmd-profile//sru:term
                            return ($profile/sru:value, $profile/sru:displayTerm, $profile/sru:numberOfRecords)
                        }:)

        return repo-utils:serialise-as(
{($overview, $profiles-overview)}
, 'htmlpage', 'html', $config, ())

};

(:~	WARNING - CHANGES DATA! adds IsPartOf to the CMDrecords (contained in the db-coll)
- expects CMD-records for collections in specific db-coll (with name of the db-coll matching the name of the collectionfile):
    ./_corpusstructure/collection_{db-coll-name}.cmdi
- logs the progress of the processing in a separate file
- can be applied repeatedly - deletes(!) old IsPartOfList, before inserting new

@param $x-context an identifier of a collection (as defined in mappings)
@param $config config-node - used to get log.path and collection-path

TODO: could also generate the CMD-records for collections (assuming db-colls as collections)
      (now done by the python script: dir2cmdicollection.py)
TODO: currently a hack: the collection-records also are marked as root elements - this has to be optional at least,
      and may even be dangerous (count(IsPartOf[@level=1])>1)!
TODO: not recursive yet!
:)
declare function cmdcheck:addIsPartOf-colls($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    (:let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),:)
    let $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

    let $coll-dbcoll := '_corpusstructure'

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    (: dynamic ns-declaration does not work for xpath
    let $declare-dummy := util:declare-namespace("",xs:anyURI($cmdcheck:default-ns))
    :)
    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                        coll-dbcoll="{$coll-dbcoll}" count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result
    (:if (exists($colls)) then:)
    for $coll_name in $colls[not(.=$coll-dbcoll)]
    (: let $coll_name := 'HomeFamilyManagement' :)
    let $files := collection(concat($root-dbcoll-path,$coll_name))
    (: let $files := xmldb:xcollection($root_coll) :)
	let $coll_file := concat($root-dbcoll-path, $coll-dbcoll, '/collection_', $coll_name, '.cmdi')
	let $coll_doc := doc($coll_file)
	let $coll_id := $coll_doc//MdSelfLink/text()

(:	let $cmdi_files := $files[ends-with(util:document-name(.),".cmdi")]:)

    let $pre_time := util:system-dateTime()
	let $duration := $pre_time - $start_time
 return	( update insert <edit coll="{$coll_name}" collid="{$coll_id}" coll_file="{$coll_file}" count="{count($files)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $files//IsPartOfList,
			update delete $coll_doc//IsPartOfList,
			update insert <IsPartOfList>
								<IsPartOf level="1">{$x-context}</IsPartOf>
								<IsPartOf level="1">{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
			  	into $coll_doc//Resources,
			update insert <IsPartOfList>
							<IsPartOf level="2">{$x-context}</IsPartOf>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList>
				into $files//Resources,
		update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )
    (:
    return	($coll_name, count($cmdi_files), $coll_file,  update insert <IsPartOfList>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList> into $cmdi_files//Resources ):)
};

(:~ recursive addIsPartOf
starts by finding "orphaned" mdrecords = expecting that to be the root records.
and continues  ?
:)
declare function cmdcheck:addIsPartOf($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),
        $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

(:    let $coll-dbcoll := '_corpusstructure':)

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                         count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result

    let $root := cmdcheck:addIsPartOf-root($root-dbcoll, $log-doc)
    let $updated := cmdcheck:addIsPartOf-r($root-dbcoll, $root, 1, $log-doc)

    return $log-doc
 };

 (:~ consider those, whose MdSelfLink isn't referenced anywhere (orphans) as the root-cmd-collections
 @returns the edited records :)
 declare function cmdcheck:addIsPartOf-root($context as node()*, $log-doc as node()*) as item()* {

    let $pre_time := util:system-dateTime()

    let $orphaned := $context//CMD[not(Header/MdSelfLink = $context//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)]

    let $update := ( update insert <edit collid="root" count="{count($orphaned)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $orphaned//IsPartOfList,
			update insert <IsPartOfList>
			                 <IsPartOf>{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
				into $orphaned//Resources,
		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )

    return $orphaned

 };

 declare function cmdcheck:addIsPartOf-r($context as node()*, $parents as node()*, $level as xs:integer, $log-doc as node()*) as item()* {

    let $start_time := util:system-dateTime()
    let $log-dummy := update insert <edit level="{$level}"
                        count-colls="{count($parents)}" time="{$start_time}" /> into $log-doc/result

  let $update := for $cmd-record in $parents
                    let $parent-id := $cmd-record//MdSelfLink/text()
                    let $children := $context//CMD[Header/MdSelfLink = $cmd-record//ResourceRef]
                	let $ispartoflist := <IsPartOfList>{($cmd-record//IsPartOfList/IsPartOf[not(text()=$cmdcheck:root-coll)],
                								<IsPartOf >{$parent-id}</IsPartOf>) }
                						  </IsPartOfList>

                    let $pre_time := util:system-dateTime()
                	let $duration := $pre_time - $start_time
                    return	( update insert <edit collid="{$parent-id}" count="{count($children)}" time="{$pre_time}" /> into $log-doc/result,
                			update delete $children//IsPartOfList,
                			update insert $ispartoflist
                				into $children//Resources,
                		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
                        )

    (: go next level - we dont have to recurse in the update-loop,
     but we can do whole next level in one call :)
    let $next-level := $context//CMD[Header/MdSelfLink = $parents//ResourceRef]
    let $updated := if (exists($next-level)) then  cmdcheck:addIsPartOf-r($context, $next-level ,($level+1),$log-doc)
                        else ()
    return $update
};

xquery version "1.0";
module namespace cmdcheck = "http://clarin.eu/cmd/check";
(: checking (trying to ensure) consistency of the IDs in CMD-records (MdSelfLink vs. ResourceProxies vs. IsPartOf)

TODO: check (and/or generate) the inverse links in IsPartOf (vs. ResourceProxies)
:)

(:import module namespace cmd  = "http://clarin.eu/cmd/collections" at "cmd-collections.xqm";:)
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "/db/cr/repo-utils.xqm";
import module namespace fcs = "http://clarin.eu/fcs/1.0" at "/db/cr/fcs.xqm";
import module namespace crday  = "http://aac.ac.at/content_repository/data-ay" at "/db/cr/crday.xqm";
import module namespace diag =  "http://www.loc.gov/zing/srw/diagnostic/" at  "modules/diagnostics/diagnostics.xqm";

declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace cmd = "http://www.clarin.eu/cmd/";

(:~ default namespace: cmd - declared statically, because dynamic ns-declaration did not work
cmd is the default namespace in (not) all the CMD records
:)
declare default element namespace "http://www.clarin.eu/cmd/";
(:~ default namespace - not declared explicitely, it is declared dynamically where necessary (function: addIsPartOf() :)
declare variable $cmdcheck:default-ns := "http://www.clarin.eu/cmd/";
declare variable $cmdcheck:root-coll := "root";

(:~ runs cmd.profile-scan for all contexts defined in the mappings :)

declare function cmdcheck:run-stats($config-path as xs:string) as item()* {

       let $config := doc($config-path),
           $mappings := doc(repo-utils:config-value($config, 'mappings'))

        let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

      for $map in $mappings//map[@key]
                let $map-key := $map/xs:string(@key),
                    $map-dbcoll-path := $map/xs:string(@path),
                    $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config)
                return $scan-cmd-profile
};

(:~ currently not used -> DEPRECATE?
init-function meant to call individual functions actually doing something.
at least it resolves x-context to a nodeset
:)
declare function cmdcheck:check($x-context as xs:string+, $config as node() ) as item()* {

    let $log-file-name := concat('log_checks_', repo-utils:sanitize-name($x-context), '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')

    let $start-time := util:system-dateTime()

    let $data-collection := repo-utils:context-to-collection($x-context, $config),
        $stat-profiles := cmdcheck:scan-profiles($data-collection),
(:        $check-linking := cmdcheck:check-linking($data-collection),:)
        $duration := util:system-dateTime() - $start-time

    let $result-data := <checks context="{$x-context}" on="{$start-time}" duration="{$duration}" >
                    <profiles>{$stat-profiles}</profiles>
                    <check-linking>{$check-linking}</check-linking>
                  </checks>
     let $store := xmldb:store($log-path ,  $log-file-name, $result-data)
    return $store
};

(:~ extracts CMD-Profiles from given nodeset

TODO: match with cmd-terms and diagnostics
:)
declare function cmdcheck:scan-profiles($context as node()*) as item()* {
      (: try- to handle namespace problem - primitively :)
    let $ns-uri := namespace-uri($context[1]/*)
            (: dynamically declare a namespace for the next step, if one is defined in current context
       $dummy := if (exists($ns-uri)) then util:declare-namespace("",$ns-uri) else () :)
       (: this is now trying to overcome the default-ns issue, by accepting with and without ns :)

(:        $dummy := util:declare-namespace("",xs:anyURI(""))       :)
(:    let $profiles := util:eval("$context//(MdProfile|cmd:MdProfile)/text()"):)
(: taking :)
    let $profiles := $context//cmd:CMD/concat(cmd:Header/cmd:MdProfile/text(), '#', cmd:Components/*[1]/local-name())
    let $distinct-profiles := distinct-values($profiles)
    let $profiles-summary := for $profile in $distinct-profiles
(:                                let $profile-name := util:eval("$context[.//(MdProfile|cmd:MdProfile)/text() = $profile][1]//(Components|cmd:Components)/*/name()"):)
                                let $profile-name := substring-after($profile, '#')
                                let $profile-id := substring-before($profile, '#')
                                let $cnt := count($profiles[. eq $profile])
                                return <sru:term>
                                           <sru:value>{if ($profile-id ne '') then $profile-id else $profile-name}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                           { if ($profile-id eq '') then
                                                    <sru:extraTermData>
                                                        { diag:diagnostics("profile-missing", $profile-name) }
                                                    </sru:extraTermData>
                                                  else ()
                                                  }
                                         </sru:term>
    let $count-all := count($distinct-profiles)
    return
        <sru:scanResponse xmlns:sru="http://www.loc.gov/zing/srw/" xmlns:fcs="http://clarin.eu/fcs/1.0">
              <sru:version>1.2</sru:version>
              <sru:terms>
                {$profiles-summary }
               </sru:terms>
               <sru:extraResponseData>
                     <fcs:countTerms>{$count-all}</fcs:countTerms>
                 </sru:extraResponseData>
                 <sru:echoedScanRequest>
                      <sru:scanClause>cmd.profile</sru:scanClause>
                  </sru:echoedScanRequest>
           </sru:scanResponse>
};

declare function cmdcheck:display-overview($config-path as xs:string) as item()* {

   let $config := doc($config-path),
       $dummy := util:declare-namespace("",xs:anyURI("")),
       $mappings := doc(repo-utils:config-value($config, 'mappings'))
(:       $baseurl := repo-utils:config-value($config, 'base.url'),:)

   let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")

   let $overview :=  crday:display-overview($config-path, 'raw')

   let $profiles-overview :=

collection	profiles

           { for $map in util:eval("$mappings//map[@key]")
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
                        $scan-cmd-profile := fcs:scan('cmd.profile', $map-key, 1, 50, 1, 1, "text", $config),
                        $scan-formatted := repo-utils:serialise-as( $scan-cmd-profile, 'htmldetail', 'scan', $config, ())
                    return

                        {$map-key}
                        { $scan-formatted }

                        }

            (: { for $profile in $scan-cmd-profile//sru:term
                            return ($profile/sru:value, $profile/sru:displayTerm, $profile/sru:numberOfRecords)
                        }:)

        return repo-utils:serialise-as(
{($overview, $profiles-overview)}
, 'htmlpage', 'html', $config, ())

};

(:~	WARNING - CHANGES DATA! adds IsPartOf to the CMDrecords (contained in the db-coll)
- expects CMD-records for collections in specific db-coll (with name of the db-coll matching the name of the collectionfile):
    ./_corpusstructure/collection_{db-coll-name}.cmdi
- logs the progress of the processing in a separate file
- can be applied repeatedly - deletes(!) old IsPartOfList, before inserting new

@param $x-context an identifier of a collection (as defined in mappings)
@param $config config-node - used to get log.path and collection-path

TODO: could also generate the CMD-records for collections (assuming db-colls as collections)
      (now done by the python script: dir2cmdicollection.py)
TODO: currently a hack: the collection-records also are marked as root elements - this has to be optional at least,
      and may even be dangerous (count(IsPartOf[@level=1])>1)!
TODO: not recursive yet!
:)
declare function cmdcheck:addIsPartOf-colls($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    (:let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),:)
    let $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

    let $coll-dbcoll := '_corpusstructure'

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    (: dynamic ns-declaration does not work for xpath
    let $declare-dummy := util:declare-namespace("",xs:anyURI($cmdcheck:default-ns))
    :)
    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                        coll-dbcoll="{$coll-dbcoll}" count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result
    (:if (exists($colls)) then:)
    for $coll_name in $colls[not(.=$coll-dbcoll)]
    (: let $coll_name := 'HomeFamilyManagement' :)
    let $files := collection(concat($root-dbcoll-path,$coll_name))
    (: let $files := xmldb:xcollection($root_coll) :)
	let $coll_file := concat($root-dbcoll-path, $coll-dbcoll, '/collection_', $coll_name, '.cmdi')
	let $coll_doc := doc($coll_file)
	let $coll_id := $coll_doc//MdSelfLink/text()

(:	let $cmdi_files := $files[ends-with(util:document-name(.),".cmdi")]:)

    let $pre_time := util:system-dateTime()
	let $duration := $pre_time - $start_time
 return	( update insert <edit coll="{$coll_name}" collid="{$coll_id}" coll_file="{$coll_file}" count="{count($files)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $files//IsPartOfList,
			update delete $coll_doc//IsPartOfList,
			update insert <IsPartOfList>
								<IsPartOf level="1">{$x-context}</IsPartOf>
								<IsPartOf level="1">{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
			  	into $coll_doc//Resources,
			update insert <IsPartOfList>
							<IsPartOf level="2">{$x-context}</IsPartOf>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList>
				into $files//Resources,
		update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )
    (:
    return	($coll_name, count($cmdi_files), $coll_file,  update insert <IsPartOfList>
							<IsPartOf level="1">{$coll_id}</IsPartOf>
						  </IsPartOfList> into $cmdi_files//Resources ):)
};

(:~ recursive addIsPartOf
starts by finding "orphaned" mdrecords = expecting that to be the root records.
and continues  ?
:)
declare function cmdcheck:addIsPartOf($x-context as xs:string, $config as node()*) as item()* {

let $log-file-name := concat('log_addIsPartOf_', $x-context, '.xml')
    let $log-path := repo-utils:config-value($config, 'log.path')
    let $log-doc-path := xmldb:store($log-path ,  $log-file-name, <result></result>)
    let $log-doc := doc($log-doc-path)

    let $root-dbcoll := repo-utils:context-to-collection($x-context, $config),
        $root-dbcoll-path := repo-utils:context-to-collection-path($x-context, $config)

(:    let $coll-dbcoll := '_corpusstructure':)

    (: beware empty path!! would return first-level collections and run over whole database :)
    let $colls := if ($root-dbcoll-path ne "") then xmldb:get-child-collections($root-dbcoll-path) else ()
    let $start_time := fn:current-dateTime()

    let $log-dummy := update insert <edit x-context="{$x-context}" root-dbcoll="{$root-dbcoll-path}"
                         count-colls="{count($colls)}" time="{$start_time}" /> into $log-doc/result

    let $root := cmdcheck:addIsPartOf-root($root-dbcoll, $log-doc)
    let $updated := cmdcheck:addIsPartOf-r($root-dbcoll, $root, 1, $log-doc)

    return $log-doc
 };

 (:~ consider those, whose MdSelfLink isn't referenced anywhere (orphans) as the root-cmd-collections
 @returns the edited records :)
 declare function cmdcheck:addIsPartOf-root($context as node()*, $log-doc as node()*) as item()* {

    let $pre_time := util:system-dateTime()

    let $orphaned := $context//CMD[not(Header/MdSelfLink = $context//ResourceProxy[ResourceType eq 'Metadata']/ResourceRef)]

    let $update := ( update insert <edit collid="root" count="{count($orphaned)}" time="{$pre_time}" /> into $log-doc/result,
			update delete $orphaned//IsPartOfList,
			update insert <IsPartOfList>
			                 <IsPartOf>{$cmdcheck:root-coll}</IsPartOf>
						  </IsPartOfList>
				into $orphaned//Resources,
		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
        )

    return $orphaned

 };

 declare function cmdcheck:addIsPartOf-r($context as node()*, $parents as node()*, $level as xs:integer, $log-doc as node()*) as item()* {

    let $start_time := util:system-dateTime()
    let $log-dummy := update insert <edit level="{$level}"
                        count-colls="{count($parents)}" time="{$start_time}" /> into $log-doc/result

  let $update := for $cmd-record in $parents
                    let $parent-id := $cmd-record//MdSelfLink/text()
                    let $children := $context//CMD[Header/MdSelfLink = $cmd-record//ResourceRef]
                	let $ispartoflist := <IsPartOfList>{($cmd-record//IsPartOfList/IsPartOf[not(text()=$cmdcheck:root-coll)],
                								<IsPartOf >{$parent-id}</IsPartOf>) }
                						  </IsPartOfList>

                    let $pre_time := util:system-dateTime()
                	let $duration := $pre_time - $start_time
                    return	( update insert <edit collid="{$parent-id}" count="{count($children)}" time="{$pre_time}" /> into $log-doc/result,
                			update delete $children//IsPartOfList,
                			update insert $ispartoflist
                				into $children//Resources,
                		  update value $log-doc/result/edit[last()] with (util:system-dateTime() - $pre_time)
                        )

    (: go next level - we dont have to recurse in the update-loop,
     but we can do whole next level in one call :)
    let $next-level := $context//CMD[Header/MdSelfLink = $parents//ResourceRef]
    let $updated := if (exists($next-level)) then  cmdcheck:addIsPartOf-r($context, $next-level ,($level+1),$log-doc)
                        else ()
    return $update
};


removed leading slash on getUpdatedServices page that was causing incorrect references to static files

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_qus = "https://github.com/his-interop/openinfoman/csd_qus" at "../repo/csd_query_updated_services.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";
import module namespace csd_webconf =  "https://github.com/his-interop/openinfoman/csd_webconf" at "../repo/csd_webapp_config.xqm";

import module namespace file = "http://expath.org/ns/file";
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/getUpdatedServices/{$name}/soap")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:updated_service_soap($name,$mtime)
{
 let $url := concat($csd_webconf:baseurl,"CSD/getUpdatedServices/" , $name , "/get")
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="text/xml; charset=utf-8"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   csd_qus:create_last_update_request($url,$mtime)
 )

};

declare
  %rest:path("/CSD/getUpdatedServices/{$name}/get")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$updatedServicesRequest}")
  function page:updated_services($name,$updatedServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
   csd_qus:get_updated_services_soap($updatedServicesRequest/soap:Envelope,csd_dm:open_document($csd_webconf:db,$name))
else
  ()
};

declare
  %rest:path("/CSD/getUpdatedServices")
  %rest:GET
  %output:method("xhtml")
  function page:updated_services_list()
{
let $response :=

Get Updated Services For Sample And Merged Directories

      {
	for $name in $page:csd_docs
	return

Service Directory:{$name}

	  {page:service_menu($name)}

      }

  return page:wrapper($response)
};

declare
  %rest:path("/CSD/getUpdatedServices/{$name}")
  %rest:GET
  %output:method("xhtml")
function page:show_service_menu($name) {
  page:wrapper(
{$name}
{page:service_menu($name)})
};

declare function page:service_menu($name)
{

    Query {$name} for Updated Services by time
    <form method='get' action="/CSD/getUpdatedServices/{$name}/get">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value=""/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="/CSD/getUpdatedServices/{$name}/soap">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value=""/>
      <input type='submit' />
    </form>

    Submit {$name} SOAP request to:

{$csd_webconf:baseurl}/CSD/getUpdatedServices/{$name}/get

};

declare function page:wrapper($response) {

    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="{$csd_webconf:baseurl}static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

    <link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>

          <button type="button" class="navbar-toggle" data-toggle="collapse" data-target=".navbar-collapse">

          </button>
          OpenInfoMan

  {$response}

};

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_qus = "https://github.com/his-interop/openinfoman/csd_qus" at "../repo/csd_query_updated_services.xqm";
import module namespace csd_dm = "https://github.com/his-interop/openinfoman/csd_dm" at "../repo/csd_document_manager.xqm";
import module namespace csd_webconf =  "https://github.com/his-interop/openinfoman/csd_webconf" at "../repo/csd_webapp_config.xqm";

import module namespace file = "http://expath.org/ns/file";
declare namespace soap = "http://www.w3.org/2003/05/soap-envelope";

declare variable $page:csd_docs := csd_dm:registered_documents($csd_webconf:db);

declare
  %rest:path("/CSD/getUpdatedServices/{$name}/soap")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:updated_service_soap($name,$mtime)
{
 let $url := concat($csd_webconf:baseurl,"CSD/getUpdatedServices/" , $name , "/get")
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="text/xml; charset=utf-8"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   csd_qus:create_last_update_request($url,$mtime)
 )

};

declare
  %rest:path("/CSD/getUpdatedServices/{$name}/get")
  %rest:consumes("application/xml", "text/xml", "multipart/form-data")
  %rest:POST("{$updatedServicesRequest}")
  function page:updated_services($name,$updatedServicesRequest)
{
if (csd_dm:document_source_exists($csd_webconf:db,$name)) then
   csd_qus:get_updated_services_soap($updatedServicesRequest/soap:Envelope,csd_dm:open_document($csd_webconf:db,$name))
else
  ()
};

declare
  %rest:path("/CSD/getUpdatedServices")
  %rest:GET
  %output:method("xhtml")
  function page:updated_services_list()
{
let $response :=

Get Updated Services For Sample And Merged Directories

      {
	for $name in $page:csd_docs
	return

Service Directory:{$name}

	  {page:service_menu($name)}

      }

  return page:wrapper($response)
};

declare
  %rest:path("/CSD/getUpdatedServices/{$name}")
  %rest:GET
  %output:method("xhtml")
function page:show_service_menu($name) {
  page:wrapper(
{$name}
{page:service_menu($name)})
};

declare function page:service_menu($name)
{

    Query {$name} for Updated Services by time
    <form method='get' action="/CSD/getUpdatedServices/{$name}/get">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value=""/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="/CSD/getUpdatedServices/{$name}/soap">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value=""/>
      <input type='submit' />
    </form>

    Submit {$name} SOAP request to:

{$csd_webconf:baseurl}/CSD/getUpdatedServices/{$name}/get

};

declare function page:wrapper($response) {

    <link href="{$csd_webconf:baseurl}/static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="{$csd_webconf:baseurl}/static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

    <link rel="stylesheet" type="text/css" media="screen"   href="{$csd_webconf:baseurl}/static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>

          <button type="button" class="navbar-toggle" data-toggle="collapse" data-target=".navbar-collapse">

          </button>
          OpenInfoMan

  {$response}

};


fixed minor typo

fixed minor typo

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_psd = "https://github.com/openhie/openinfoman/csd_psd";
import module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
import module namespace csd_qus =  "https://github.com/openhie/openinfoman/csd_qus";

declare updating
  %rest:path("/CSD/registerService/named/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:register_named($name)
{

  (
    let $sample := $csd_webconf:remote_services//serviceDirectory[@name=$name]
    return if (exists($sample)) then
      csd_psd:register_service($name,text{$sample/@url},$sample/credentials)
    else ()
  ,
  csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/basic_auth")
  %output:method("xhtml")
  %rest:query-param("name", "{$name}")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:register_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/registerService/basic_auth/{$name}")
  %output:method("xhtml")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:update_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/cache_meta")
  %rest:GET
  function page:get_cache_meta()
{
  csd_lsc:get_cache_data(())
};

declare
  %rest:path("/CSD/pollService/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response :=
{$name}
{page:service_menu($name) }
  return csd_webui:nocache(csd_webui:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/directory/{$name}/cache_meta")
  %rest:GET
  function page:get_service_cache_meta($name)
{
  csd_lsc:get_cache_data($name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/create_cache")
  %rest:GET
  function page:create_cache($name)
{

  (
    if (csd_lsc:directory_exists($name))
    then csd_lsc:empty_cache($name)
    else csd_dm:empty($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/drop_cache_meta")
  %rest:GET
  function page:drop_service_cache_meta($name)
{
  (
  csd_lsc:drop_cache_data($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/get_cache")
  %rest:GET
  function page:get_cache($name)
{
 csd_lsc:get_cache($name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/empty_cache")
  %rest:GET
  function page:empty_cache($name)
{
  (
  csd_lsc:empty_cache($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/update_cache")
  %rest:GET
  function page:update_cache($name)
{
(
  csd_lsc:update_cache($name)   ,
  csd_webui:redirect_out("CSD/pollService")
)

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/show_update_cache")
  %rest:GET
  function page:show_update_cache($name)
{

  let $mtime :=  csd_lsc:get_service_directory_mtime($name)
  let $soap := csd_psd:generate_soap_request($name,$mtime)
  let $result := http:send-request($soap)
  return <r>{$result}</r><s>{$soap}</s>

};

declare
  %rest:path("/CSD/pollService/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:display_service_menu($name)
{
  let $response :=

	{page:service_menu($name)}

  return  csd_webui:nocache(page:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/{$name}/get")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
  try {
    if ($mtime) then
      csd_psd:poll_service_directory_soap_response($name,xs:dateTime($mtime))
    else
      csd_psd:poll_service_directory_soap_response($name,csd_lsc:get_service_directory_mtime($name))
  } catch * {
    let $msg := concat("Could retrieve remote directory soap response: " ,
      $err:code, $err:value, " module: ", $err:module, "(", $err:line-number, ",", $err:column-number, ")")
    return
      <rest:response>
	<http:response status="500" message="$msg">
	</http:response>
      </rest:response>
  }
};

declare
  %rest:path("/CSD/pollService/{$name}/get_csd")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_csd($name,$mtime)
{
  try {
    if ($mtime) then
      csd_psd:poll_service_directory($name,xs:dateTime($mtime))
    else
      csd_psd:poll_service_directory($name,csd_lsc:get_service_directory_mtime($name))
  } catch * {
    let $msg := concat("Could not initiate poll of remote directory: " ,
      $err:code, $err:value, " module: ", $err:module, "(", $err:line-number, ",", $err:column-number, ")")
    return
      <rest:response>
	<http:response status="500" message="$msg">
	</http:response>
      </rest:response>
  }
};

declare
  %rest:path("/CSD/pollService/{$name}/get_soap")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_soap($name,$mtime)
{
 let $url := csd_psd:get_service_directory_url($name)
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="application/soap+xml"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   if ($mtime) then
     csd_qus:create_last_update_request($url,$mtime)
   else
     csd_qus:create_last_update_request($url,csd_lsc:get_service_directory_mtime($name))
 )

};

declare function page:wrapper($response) {
  let $headers :=
  (<link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css')}"/>
  ,
  )
  return csd_webui:wrapper($response,$headers)
};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{

   let $services := csd_psd:registered_directories()
   let $unreg_services :=
     for $sample in  $csd_webconf:remote_services//serviceDirectory
     where not(csd_psd:is_registered($sample/text{@name}))
     return  $sample
    let $response :=

Add New Service (Basic Auth)

	 <form method='get' action="{csd_webui:generateURL('/CSD/registerService/basic_auth')}">

 Name<input class='pull-right'  size="35"      name='name' type="text" value=""/>

URL<input  class='pull-right' size="35"     name='url' type="text" value=""/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="password" value=""/>

	   <input type='submit' />
	 </form>

	 {
	   if (count($unreg_services) > 0) then

Add New Default Service

	       {for $sample in $unreg_services
	       let $name := $sample/text{@name}
	       return

		 Register {$name}

	       }

	   else ()
         }

Global Operations

 Get all cache Meta-Data

Registered Service Directories

	 {if (count($services) = 0)
	 then
No Services Registered

       else

	 {for $name in $services
	 let $mtime := csd_lsc:get_service_directory_mtime($name)
	 order by $name
	 return

	   {$name} last cached on {$mtime}

	 }

	 }

Update Service (Basic Auth)

	 {
	   for $name in $services
	   let $url := csd_psd:get_service_directory_url($name)
	   return

{$name}

	       <form method='get' action="{csd_webui:generateURL(('/CSD/registerService/basic_auth',$name))}">

URL<input  class='pull-right' size="35"     name='url' type="text" value="{$url}"/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="password" value=""/>

		 <input type='submit' />
	       </form>

	 }

  return csd_webui:nocache(page:wrapper($response))

};

declare function page:service_menu($name) {
  let $url := csd_psd:get_service_directory_url($name)
  let $mtime := csd_lsc:get_service_directory_mtime($name)
  return

{$url}

    modified: {$mtime}

Caching
{csd_lsc:get_document_name($name)}

    {if (not(csd_lsc:directory_exists($name))) then
      (

Create cache of {$name}

      )
  else
    (

Empty local cache of {$name}
,

Get local cache  of {$name}
,

      Update local cache  of {$name}

	WARNING:An InfoMan trying to cache its own service directory will result in a deadlock.  see this issue

,

Get cache Meta Data  for {$name}
,

Drop cache Meta Data  of {$name}

  )
    }

Testing

 Query  {$name} for Updated Services using stored last modified time (SOAP result)

 Query  {$name} for Updated Services using stored last modified time (CSD result)

 Get {$name}'s Soap Query for Updated Services Request using stored last modified time

    Query {$name} for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',$name,'get'))}">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',concat('soap_query_updated_services_',$name)))}">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

  To test submission on your machine you can do:

curl --header "content-type: application/soap+xml" --data "@soap_query_updated_services_{$name}.xml" {$url}

  where soap_updated_services_{$name}.xml is  the downloaded soap request document.  Add authorization parameters as neccesary.

};

module namespace page = 'http://basex.org/modules/web-page';

import module namespace csd_psd = "https://github.com/openhie/openinfoman/csd_psd";
import module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
import module namespace csd_webui =  "https://github.com/openhie/openinfoman/csd_webui";
import module namespace csd_qus =  "https://github.com/openhie/openinfoman/csd_qus";

declare updating
  %rest:path("/CSD/registerService/named/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:register_named($name)
{

  (
    let $sample := $csd_webconf:remote_services//serviceDirectory[@name=$name]
    return if (exists($sample)) then
      csd_psd:register_service($name,text{$sample/@url},$sample/credentials)
    else ()
  ,
  csd_webui:redirect_out("CSD/pollService")
  )
};

declare updating
  %rest:path("/CSD/registerService/basic_auth")
  %output:method("xhtml")
  %rest:query-param("name", "{$name}")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:register_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/registerService/basic_auth/{$name}")
  %output:method("xhtml")
  %rest:query-param("url", "{$url}")
  %rest:query-param("password", "{$password}")
  %rest:query-param("username", "{$username}")
  %rest:GET
  function page:update_basic_auth($name,$url,$username,$password)
{

  (
    let $credentials := <credentials type="basic_auth" username="{$username}" password="{$password}"/>
    return csd_psd:register_service($name,$url,$credentials)
      ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/cache_meta")
  %rest:GET
  function page:get_cache_meta()
{
  csd_lsc:get_cache_data(())
};

declare
  %rest:path("/CSD/pollService/directory/{$name}")
  %rest:GET
  %output:method("xhtml")
  function page:get_service_menu($name)
{
  let $response :=
{$name}
{page:service_menu($name) }
  return csd_webui:nocache(csd_webui:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/directory/{$name}/cache_meta")
  %rest:GET
  function page:get_service_cache_meta($name)
{
  csd_lsc:get_cache_data($name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/create_cache")
  %rest:GET
  function page:create_cache($name)
{

  (
    if (csd_lsc:directory_exists($name))
    then csd_lsc:empty_cache($name)
    else csd_dm:empty($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/drop_cache_meta")
  %rest:GET
  function page:drop_service_cache_meta($name)
{
  (
  csd_lsc:drop_cache_data($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/get_cache")
  %rest:GET
  function page:get_cache($name)
{
 csd_lsc:get_cache($name)
};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/empty_cache")
  %rest:GET
  function page:empty_cache($name)
{
  (
  csd_lsc:empty_cache($name)
  ,
  csd_webui:redirect_out("CSD/pollService")
  )

};

declare updating
  %rest:path("/CSD/pollService/directory/{$name}/update_cache")
  %rest:GET
  function page:update_cache($name)
{
(
  csd_lsc:update_cache($name)   ,
  csd_webui:redirect_out("CSD/pollService")
)

};

declare
  %rest:path("/CSD/pollService/directory/{$name}/show_update_cache")
  %rest:GET
  function page:show_update_cache($name)
{

  let $mtime :=  csd_lsc:get_service_directory_mtime($name)
  let $soap := csd_psd:generate_soap_request($name,$mtime)
  let $result := http:send-request($soap)
  return <r>{$result}</r><s>{$soap}</s>

};

declare
  %rest:path("/CSD/pollService/{$name}")
  %output:method("xhtml")
  %rest:GET
  function page:display_service_menu($name)
{
  let $response :=

	{page:service_menu($name)}

  return  csd_webui:nocache(page:wrapper($response))
};

declare
  %rest:path("/CSD/pollService/{$name}/get")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
  try {
    if ($mtime) then
      csd_psd:poll_service_directory_soap_response($name,xsd:dateTime($mtime))
    else
      csd_psd:poll_service_directory_soap_response($name,csd_lsc:get_service_directory_mtime($name))
  } catch * {
    let $msg := concat("Could retrieve remote directory soap response: " ,
      $err:code, $err:value, " module: ", $err:module, "(", $err:line-number, ",", $err:column-number, ")")
    return
      <rest:response>
	<http:response status="500" message="$msg">
	</http:response>
      </rest:response>
  }
};

declare
  %rest:path("/CSD/pollService/{$name}/get_csd")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_csd($name,$mtime)
{
  try {
    if ($mtime) then
      csd_psd:poll_service_directory($name,xs:dateTime($mtime))
    else
      csd_psd:poll_service_directory($name,csd_lsc:get_service_directory_mtime($name))
  } catch * {
    let $msg := concat("Could not initiate poll of remote directory: " ,
      $err:code, $err:value, " module: ", $err:module, "(", $err:line-number, ",", $err:column-number, ")")
    return
      <rest:response>
	<http:response status="500" message="$msg">
	</http:response>
      </rest:response>
  }
};

declare
  %rest:path("/CSD/pollService/{$name}/get_soap")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_soap($name,$mtime)
{
 let $url := csd_psd:get_service_directory_url($name)
 return (
 <rest:response>
   <http:response status="200" >
     <http:header name="Content-Type" value="application/soap+xml"/>
     <http:header name="Content-Disposition"  value="inline; filename=soap_query_updated_services_{$name}"/>
   </http:response>
   </rest:response>
   ,
   if ($mtime) then
     csd_qus:create_last_update_request($url,$mtime)
   else
     csd_qus:create_last_update_request($url,csd_lsc:get_service_directory_mtime($name))
 )

};

declare function page:wrapper($response) {
  let $headers :=
  (<link rel="stylesheet" type="text/css" media="screen"   href="{csd_webui:generateURL('static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css')}"/>
  ,
  )
  return csd_webui:wrapper($response,$headers)
};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{

   let $services := csd_psd:registered_directories()
   let $unreg_services :=
     for $sample in  $csd_webconf:remote_services//serviceDirectory
     where not(csd_psd:is_registered($sample/text{@name}))
     return  $sample
    let $response :=

Add New Service (Basic Auth)

	 <form method='get' action="{csd_webui:generateURL('/CSD/registerService/basic_auth')}">

 Name<input class='pull-right'  size="35"      name='name' type="text" value=""/>

URL<input  class='pull-right' size="35"     name='url' type="text" value=""/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="password" value=""/>

	   <input type='submit' />
	 </form>

	 {
	   if (count($unreg_services) > 0) then

Add New Default Service

	       {for $sample in $unreg_services
	       let $name := $sample/text{@name}
	       return

		 Register {$name}

	       }

	   else ()
         }

Global Operations

 Get all cache Meta-Data

Registered Service Directories

	 {if (count($services) = 0)
	 then
No Services Registered

       else

	 {for $name in $services
	 let $mtime := csd_lsc:get_service_directory_mtime($name)
	 order by $name
	 return

	   {$name} last cached on {$mtime}

	 }

	 }

Update Service (Basic Auth)

	 {
	   for $name in $services
	   let $url := csd_psd:get_service_directory_url($name)
	   return

{$name}

	       <form method='get' action="{csd_webui:generateURL(('/CSD/registerService/basic_auth',$name))}">

URL<input  class='pull-right' size="35"     name='url' type="text" value="{$url}"/>

User Name<input  class='pull-right' size="35"     name='username' type="text" value=""/>

Password<input  class='pull-right' size="35"     name='password' type="password" value=""/>

		 <input type='submit' />
	       </form>

	 }

  return csd_webui:nocache(page:wrapper($response))

};

declare function page:service_menu($name) {
  let $url := csd_psd:get_service_directory_url($name)
  let $mtime := csd_lsc:get_service_directory_mtime($name)
  return

{$url}

    modified: {$mtime}

Caching
{csd_lsc:get_document_name($name)}

    {if (not(csd_lsc:directory_exists($name))) then
      (

Create cache of {$name}

      )
  else
    (

Empty local cache of {$name}
,

Get local cache  of {$name}
,

      Update local cache  of {$name}

	WARNING:An InfoMan trying to cache its own service directory will result in a deadlock.  see this issue

,

Get cache Meta Data  for {$name}
,

Drop cache Meta Data  of {$name}

  )
    }

Testing

 Query  {$name} for Updated Services using stored last modified time (SOAP result)

 Query  {$name} for Updated Services using stored last modified time (CSD result)

 Get {$name}'s Soap Query for Updated Services Request using stored last modified time

    Query {$name} for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',$name,'get'))}">
      <input  size="35" id="datetimepicker_{$name}"    name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

    Get {$name}'s SOAP reuest for Query for Updated Services by time
    <form method='get' action="{csd_webui:generateURL(('/CSD/pollService',concat('soap_query_updated_services_',$name)))}">
      <input  size="35" id="soap_datetimepicker_{$name}"  name='mtime' type="text" value="{$mtime}"/>
      <input type='submit' />
    </form>

  To test submission on your machine you can do:

curl --header "content-type: application/soap+xml" --data "@soap_query_updated_services_{$name}.xml" {$url}

  where soap_updated_services_{$name}.xml is  the downloaded soap request document.  Add authorization parameters as neccesary.

};


[bug-fix] xforms shakespeare example now displays the number of summarized items in the kwic not the number of LINEs they come from.

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

xquery version "1.0";

declare namespace q="http://exist-db.org/xquery/query";

import module namespace kwic="http://exist-db.org/xquery/kwic";

declare function q:filter($node as node(), $mode as xs:string) as xs:string? {
  if ($node/parent::SPEAKER or $node/parent::STAGEDIR) then
      ()
  else if ($mode eq 'before') then
      concat($node, ' ')
  else
      concat(' ', $node)
};

declare function q:createQuery($input as element()) {
    let $queryStr := $input/query/string()
    let $mode := $input/query/@mode
    return
        <query>
        {
            if ($mode eq 'any') then
                for $term in tokenize($queryStr, '\s')
                return
                    <term occur="should">{$term}</term>
            else if ($mode eq 'all') then
                for $term in tokenize($queryStr, '\s')
                return
                    <term occur="must">{$term}</term>
            else if ($mode eq 'phrase') then
                <phrase>{$input/query/@slop, $queryStr}</phrase>
            else
                <near>{$input/query/@slop, $queryStr}</near>
        }
        </query>
};

declare function q:query($input as element()) {
    let $query := q:createQuery($input)
    let $hits :=
        for $hit in //SPEECH[ft:query(., $query)]
        order by ft:score($hit) descending
        return $hit
    let $callback := util:function(xs:QName("q:filter"), 2)
    let $summarized-items :=
      for $hit in subsequence($hits, 1, 20)
        return
	  kwic:summarize($hit, <config width="40"/>, $callback)

    return
        <search xmlns="">
            {$input/query}
            <hits>{count($summarized-items)}</hits>
            {
                $summarized-items
            }
        </search>
};

let $input := request:get-data()
return
    q:query($input)

xquery version "1.0";

declare namespace q="http://exist-db.org/xquery/query";

import module namespace kwic="http://exist-db.org/xquery/kwic";

declare function q:filter($node as node(), $mode as xs:string) as xs:string? {
  if ($node/parent::SPEAKER or $node/parent::STAGEDIR) then
      ()
  else if ($mode eq 'before') then
      concat($node, ' ')
  else
      concat(' ', $node)
};

declare function q:createQuery($input as element()) {
    let $queryStr := $input/query/string()
    let $mode := $input/query/@mode
    return
        <query>
        {
            if ($mode eq 'any') then
                for $term in tokenize($queryStr, '\s')
                return
                    <term occur="should">{$term}</term>
            else if ($mode eq 'all') then
                for $term in tokenize($queryStr, '\s')
                return
                    <term occur="must">{$term}</term>
            else if ($mode eq 'phrase') then
                <phrase>{$input/query/@slop, $queryStr}</phrase>
            else
                <near>{$input/query/@slop, $queryStr}</near>
        }
        </query>
};

declare function q:query($input as element()) {
    let $query := q:createQuery($input)
    let $hits :=
        for $hit in //SPEECH[ft:query(., $query)]
        order by ft:score($hit) descending
        return $hit
    let $callback := util:function(xs:QName("q:filter"), 2)
    return
        <search xmlns="">
            {$input/query}
            <hits>{count($hits)}</hits>
            {
                for $hit in subsequence($hits, 1, 20)
                return
                    kwic:summarize($hit, <config width="40"/>, $callback)
            }
        </search>
};

let $input := request:get-data()
return
    q:query($input)


rolling back relative paths - problems, when invoking from other scripts

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "../../repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";
declare namespace rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
declare namespace skos="http://www.w3.org/2004/02/skos/core#";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := repo-utils:config("/db/apps/cr/conf/cr/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
(: avoid absolute paths - but probably this should be a config-option anyway
not possible, because when passed to fcs:repo-utils, it does not know, where they are: :)
declare variable $fcs-tests:testsets-coll := "/db/apps/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/apps/cr/modules/testing/results/";
(:declare variable $fcs-tests:testsets-coll := "testsets/";
declare variable $fcs-tests:results-coll := "results/";:)

declare variable $fcs-tests:href-prefix := "tests.xql";

(:~ this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else if ($key eq "operation") then $config//property[@key='operation']/text()
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
@param $operation run or run-store; with `run-store` also the fetched individual results stored, the final result is stored anyway
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string, $operation as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key],
                                <property key="operation">{$operation}</property>)}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests, ())
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*, attribute class {"test"}, fcs-tests:process-test($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result (only if $operation='run-store') and evaluates the associated xpaths

expects:

      search: Haus
      //sru:numberOfRecords

 or rather ?:
    <test id="clarin-at-mdrepo">
        clarin-at mdrepo
        <xpath key="html">exists($result-data//html)</xpath>
        <xpath key="xhtml">exists($result-data//xhtml:html)</xpath>
    </test>

@returns the requested-url, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-test($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $test-list := xs:string($test/@list),
        $list-doc := if (doc-available($test-list)) then doc($test-list) else (),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $operation := fcs-tests:config-value("operation")

    return if (empty($list-doc)) then
                let $request := concat($target, xs:string($a/@href))
                return fcs-tests:process-request ($test, $request, $a/text(), $target-key, $test-id, $operation)
            else
            (: if we have a list, iterate over the items of the list and run a request for each :)
                for $i at $c in $list-doc/lst/*
                  let $q := xs:string($i/@q),
                            (: has to have the varaible there - currenlty only supports $q-variable :)
                      $request := concat($target,  replace(xs:string($a/@href), '%q', xmldb:encode($q))),
                      $i-id := if ($i/@id) then xs:string($i/@id) else $c,
                      $request-id := concat($test-id, $i-id),
                      $a-text := replace(xs:string($a/text()), '%q', $q)
                  return fcs-tests:process-request ($test, $request, $a-text, $target-key, $request-id, $operation)
};

declare function fcs-tests:process-request($test, $request as xs:string, $a-text as xs:string, $target-key as xs:string, $request-id as xs:string, $operation as xs:string) as item()* {

    let $a-processed := {$a-text}
    let $result-data := httpclient:get(xs:anyURI($request), false(), () )

    let $store := if ($operation eq 'run-store') then fcs-tests:store-result($target-key, $request-id, $result-data) else ()

    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data//xs:string(@statusCode)
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

(:~ generates a html-view of the resulting testset
relies on repo-utils serialization function, expecting a stylesheet with the key: test2view
:)
declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

(:~ generates the html-page displaying either the overview, or the result of selected testset
:)
declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

                overview

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="run-store" >{if ($operation = 'run-store') then attribute selected { "selected" } else ()} run-store</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};

xquery version "1.0";
module namespace fcs-tests  = "http://clarin.eu/fcs/1.0/tests";

import module namespace httpclient = "http://exist-db.org/xquery/httpclient";
import module namespace t="http://exist-db.org/xquery/testing";
import module namespace repo-utils = "http://aac.ac.at/content_repository/utils" at  "../../repo-utils.xqm";

declare namespace zr="http://explain.z3950.org/dtd/2.1/";
declare namespace sru = "http://www.loc.gov/zing/srw/";
declare namespace fcs = "http://clarin.eu/fcs/1.0";
declare namespace diag = "http://www.loc.gov/zing/srw/diagnostic/";
declare namespace xhtml="http://www.w3.org/1999/xhtml";
declare namespace rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
declare namespace skos="http://www.w3.org/2004/02/skos/core#";

(: sample input:

 :)
declare variable $fcs-tests:config := doc("config.xml");
declare variable $fcs-tests:cr-config := repo-utils:config("../../conf/cr/config.xml");
declare variable $fcs-tests:run-config := "run-config.xml";
(: avoid absolute paths - but probably this should be a config-option anyway
declare variable $fcs-tests:testsets-coll := "/db/apps/cr/modules/testing/testsets/";
declare variable $fcs-tests:results-coll := "/db/apps/cr/modules/testing/results/";:)
declare variable $fcs-tests:testsets-coll := "testsets/";
declare variable $fcs-tests:results-coll := "results/";

declare variable $fcs-tests:href-prefix := "tests.xql";

(:~ this function is accessed by the testing-code to get configuration-options from the run-config :)
declare function fcs-tests:config-value($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else if ($key eq "operation") then $config//property[@key='operation']/text()
                        else $config//target/text()
};

declare function fcs-tests:config-key($key as xs:string) as xs:string* {
            let $config := doc(concat($fcs-tests:testsets-coll, $fcs-tests:run-config))/config
                return if ($key eq "testset") then  xs:string($config//testset/@key)
                        else xs:string($config//target/@key)
};

declare function fcs-tests:get-result-paths($target  as xs:string, $testset as xs:string) as xs:string* {
        (concat($fcs-tests:results-coll, $target, "/"), concat($testset, ".xml"))
};

declare function fcs-tests:get-result-path($target  as xs:string, $testset as xs:string) as xs:string* {
        string-join(fcs-tests:get-result-paths($target , $testset ), "" )
};

declare function fcs-tests:get-result($target  as xs:string, $testset as xs:string) as item() {
  let $result-path := fcs-tests:get-result-path($target, $testset)
   let $result := if ($target = '' or $testset = '') then ()
                            else if (doc-available($result-path)) then
                            doc($result-path)
                        else <diagnostics><diagnostic key="result-unavailable">result unavailable: {$result-path}</diagnostic>
                                <diagnostic>{fcs-tests:get-testset($testset)}</diagnostic>
                              </diagnostics>
 return $result
};

(:~ try to get the testset-file based on the testset-key
@returns testset-file if available, otherwise empty result
:)
declare function fcs-tests:get-testset($testset as xs:string) as item()* {
    let $testset-path := concat($fcs-tests:testsets-coll, $testset, ".xml")
    return if (doc-available($testset-path)) then
                    doc($testset-path)
                  else
                  <diagnostic>unknown testset: {$testset}</diagnostic>
};

(:~ main function governing the execution of the tests

Generates a run-config out of the full config based on the parameters.
@param $target identifying key of the target  as set in the config
@param $testset-key identifying key of the testset as set in the config (that also has to be the name of the testset-file)
@param $operation run or run-store; with `run-store` also the fetched individual results stored, the final result is stored anyway
:)
declare function fcs-tests:run-testset($target  as xs:string, $testset-key as xs:string, $operation as xs:string) as item()* {

    (: preparing a configuration for given run, based on the parameters :)
    let $run-config := <config>{($fcs-tests:config//target[xs:string(@key) = $target],
                                $fcs-tests:config//testset[xs:string(@key) = $testset-key],
                                <property key="operation">{$operation}</property>)}</config>
    let $store := repo-utils:store($fcs-tests:testsets-coll, $fcs-tests:run-config, $run-config, true())
    let $testset := fcs-tests:get-testset($testset-key)
    let $start-time := util:system-dateTime()
    let $result := if (exists($testset)) then
                            let $tests := $testset//TestSet
                            (: distinguish the testset, that the testing-module can process
                               and the home-made test-doc, that tests URLs :)
                            return if (exists($tests)) then
                                        t:run-testSet($tests, ())
                                     else
                                        fcs-tests:test-rest($testset)
                       else
                           $testset
    let $end-time := util:system-dateTime()
    let $test-wrap := <testrun duration="{$end-time - $start-time}" on="{fn:current-dateTime()}" >{$result}</testrun>
    let $store-result := fcs-tests:store-result($target, $testset-key, $test-wrap)
    (:for $test in $tests/tests/test return fcs-tests:run-test($test):)
    return $store-result
};

(:~ process a test-doc (target is expected to be set in the config)
:)
declare function fcs-tests:test-rest($test-doc as node()) as item()* {

    let $result := local:dispatch($test-doc)

(:
let $targets := if (exists($test/target)) then $test/target else $test/preceding-sibling::target
let $requests := for $target in $targets return concat($target, $test/request/text())
let $data := for $request in $requests return
                <request href="{$request}" id
                httpclient:get(xs:anyURI($request), false(), () )

let $check := for $condition in $test/condition
                        let $expr :=concat("($data/", $condition/text(), " eq ", xs:string($condition/@result), ")")
                         return <check expr="{$expr}" >{util:eval($expr)} </check>
return <test><id>{$test/id}</id>{$test/label}
            <requests>{$requests}</requests>
            <results>{$check}</results>
        </test>
:)
return $result

};

(:~ This function takes the children of the node and passes them
   back into the typeswitch function. :)
declare function local:passthru($x as node()) as node()*
{
for $z in $x/node() return local:dispatch($z)
};

(:~ This is the recursive typeswitch function, to traverse the testset-document :)
declare function local:dispatch($x as node()) as node()*
{
typeswitch ($x)
  case text() return $x
  case element (test) return element div {$x/@*, attribute class {"test"}, fcs-tests:process-test($x)}
  case element() return element {$x/name()} {$x/@*, local:passthru($x)}
  default return local:passthru($x)
};

(:~ executes one URL-test.

Issues one http-call to the target-url in the a@href-attribute, stores the incoming result (only if $operation='run-store') and evaluates the associated xpaths

expects:

      search: Haus
      //sru:numberOfRecords

 or rather ?:
    <test id="clarin-at-mdrepo">
        clarin-at mdrepo
        <xpath key="html">exists($result-data//html)</xpath>
        <xpath key="xhtml">exists($result-data//xhtml:html)</xpath>
    </test>

@returns the requested-url, results of the xpath-evaluations as a div-list and any diagnostics
:)
declare function fcs-tests:process-test($test as node()) as item()* {

    let $a := $test/a,
        $test-id := xs:string($test/@id),
        $test-list := xs:string($test/@list),
        $list-doc := if (doc-available($test-list)) then doc($test-list) else (),
        $target := fcs-tests:config-value("target"),
        $target-key := fcs-tests:config-key("target"),
        $operation := fcs-tests:config-value("operation")

    return if (empty($list-doc)) then
                let $request := concat($target, xs:string($a/@href))
                return fcs-tests:process-request ($test, $request, $a/text(), $target-key, $test-id, $operation)
            else
            (: if we have a list, iterate over the items of the list and run a request for each :)
                for $i at $c in $list-doc/lst/*
                  let $q := xs:string($i/@q),
                            (: has to have the varaible there - currenlty only supports $q-variable :)
                      $request := concat($target,  replace(xs:string($a/@href), '%q', xmldb:encode($q))),
                      $i-id := if ($i/@id) then xs:string($i/@id) else $c,
                      $request-id := concat($test-id, $i-id),
                      $a-text := replace(xs:string($a/text()), '%q', $q)
                  return fcs-tests:process-request ($test, $request, $a-text, $target-key, $request-id, $operation)
};

declare function fcs-tests:process-request($test, $request as xs:string, $a-text as xs:string, $target-key as xs:string, $request-id as xs:string, $operation as xs:string) as item()* {

    let $a-processed := {$a-text}
    let $result-data := httpclient:get(xs:anyURI($request), false(), () )

    let $store := if ($operation eq 'run-store') then fcs-tests:store-result($target-key, $request-id, $result-data) else ()

    (: evaluate all xpaths defined for given request :)
    let $check := for $xpath in $test/xpath
                    let $evald := util:eval($xpath/text())

                    return

{if (exists($xpath/@key)) then xs:string($xpath/@key) else $xpath/text()}:
                          {$evald}

     (: checking extra for diagnostics :)
     let $http-status := $result-data//xs:string(@statusCode)
     let $diag := ($result-data//diag:diagnostic, $result-data//exception,
                if ($http-status ne '200') then <http-status>{$http-status}</http-status> else ())
      let $wrapped-diag := if (exists($diag)) then
                <diagnostics type="{string-join($diag/name(),',')}" >{$diag}</diagnostics> else ()
return ($a-processed, $check, $wrapped-diag)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $result as node()) as item()* {
    fcs-tests:store-result ($target, $testset, "", $result)
};

declare function fcs-tests:store-result($target as xs:string, $testset as xs:string, $test as xs:string, $result as node()) as item()* {
(: create collection for results for one target :)
   let $create-coll := if (not(xmldb:collection-available(concat($fcs-tests:results-coll, $target)))) then
                           xmldb:create-collection($fcs-tests:results-coll, $target) else ()

  let $result-path := fcs-tests:get-result-paths($target, concat($testset, $test))

  let $store-result := repo-utils:store($result-path[1], $result-path[2], $result, true())

return $store-result
};

(:~ generates a html-view of the resulting testset
relies on repo-utils serialization function, expecting a stylesheet with the key: test2view
:)
declare function fcs-tests:format-result($result as node()) as item()* {

    if ($result[self::element(diagnostics)]) then

{$result/text()}

       else if (exists($result/testrun)) then
          repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
       else repo-utils:serialise-as ($result, "html", "test", $fcs-tests:cr-config)
              (: return quite empty html ??
                t:format-testResult($result) :)
};

(:~ generates the html-page displaying either the overview, or the result of selected testset
:)
declare function fcs-tests:display-page($target  as xs:string, $testset as xs:string, $operation) as item()* {

    let $result := fcs-tests:get-result($target, $testset)

    let $formatted-result := fcs-tests:format-result($result)
    let $opt := util:declare-option("exist:serialize", "media-type=text/html method=xhtml")
    return

            <title>FCS - test suite</title>
            <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
             <link rel="stylesheet" type="text/css" href="tests.css" />
             <link rel="stylesheet" type="text/css" href="../../scripts/style/cmds-ui.css" />

FCS - test suite

                overview

            {if ($operation = 'overview') then fcs-tests:display-overview() else () }
            <form>
                targets<select name="target">
                    {
                    for $target-elem  in $fcs-tests:config//target
                        let $target-key := xs:string($target-elem/@key)
                        let $option :=  if ($target = $target-key) then
                                            <option selected="selected" value="{$target-key}" >{$target-key}</option>
                                         else
                                            <option value="{$target-key}" >{$target-key } </option>
                        return $option
                    }
                </select>
                test-set<select name="testset">
                    {
                    for $testset-elem in $fcs-tests:config//testset
                        let $testset-key := xs:string($testset-elem/@key)
                        let $option :=  if ($testset= $testset-key) then
                                            <option selected="selected" value="{$testset-key}" >{$testset-key}</option>
                                         else
                                            <option value="{$testset-key}" >{$testset-key}</option>
                        return $option
                    }
                </select>
                test-set
                    <select name="operation">
                       <option value="run" >{if ($operation = 'run') then attribute selected { "selected" } else ()} run</option>
                       <option value="run-store" >{if ($operation = 'run-store') then attribute selected { "selected" } else ()} run-store</option>
                       <option value="view" > {if ($operation = 'view') then attribute selected { "selected" } else ()} view</option>
                       <option value="overview" > {if ($operation = 'overview') then attribute selected { "selected" } else ()} overview</option>
                    </select>
                <input type="submit" value="View/Run" />
                </form>

{$formatted-result}

};

declare function fcs-tests:display-overview() as item()* {

	{for $target in $fcs-tests:config//target return {xs:string($target/@key)}	}

            {for $testset in $fcs-tests:config//testset
                    let $testset-key := $testset/xs:string(@key)
                    return

                        {$testset-key}
                        {for $target in $fcs-tests:config//target
                           let $target-key := $target/xs:string(@key)
                           let $test-result := fcs-tests:get-result($target-key , $testset-key )
                           let $root-elem := $test-result/*/name()
                           let $op := if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then 'run' else 'view'
                           (: display number of all and failed tests in the testset, operates on the HTML produced during the test-run :)
                           let $view:= if ($test-result//diagnostic["result-unavailable" = xs:string(@key)]) then ()
                                       else
                                            let $show := if ($root-elem[1] eq 'testrun') then
                                                            {count($test-result//div[@class='test'][.//span[@class='value true']])}{"/"}
                                                                   {count($test-result//div[@class='test'][.//span[@class='value false']])}{"/"}
                                                                {count($test-result//div[@class='test'])}
                                                                {if (exists($test-result//diagnostics)) then !! else () }

                                                            else $root-elem
                                            return {$show}

                        return {$view} [run]
                        }

            }

};


Successive approximation ;->

Successive approximation ;->

declare function local:token($t)
{
  <w>
    {
      attribute role {$t/@relation},
      attribute id {$t/@id},
      string($t/@form)
    }
  </w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg role="{$t/@relation}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

for $s in //sentence
return
  <sentence>
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>

declare function local:token($t)
{
  <w>{ string($t/@form) }</w>,
  $t/@presentation-after[. != ' '] ! <pc>{string(.)}</pc>
};

declare function local:unwrap($t, $stok)
{
  let $children :=  $stok[@head-id = $t/@id]
  let $seq := ($children | $t)/.
  return
    if ($children)
    then
      <wg relation="{$t/@relation}">
        {
          for $s in $seq
          return
            if ($s is $t)
            then local:token($t)
            else local:unwrap($s, $stok)
        }
      </wg>
    else local:token($t)
};

for $s in //sentence
return
  <sentence>
    {
      let $stok := $s//token
      for $t in $stok[not(@head-id)]
      return local:unwrap($t, $stok)
    }
  </sentence>