Service: use relative XSLT paths

Service: use relative XSLT paths

(: Subtitle Conversion Framework (SCF) - SCF service
 :
 : Copyright 2019 Institut für Rundfunktechnik GmbH, Munich, Germany
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, the subject work
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

module namespace scf = 'http://www.irt.de/irt_restxq/scf_service';

declare variable $scf:modules_path as xs:string := "modules/";

declare variable $scf:subtitle_format :=
    map {
        'stl': 'STL',
        'stlxml': 'STLXML',
        'ebu-tt': 'EBU-TT',
        'ebu-tt-d': 'EBU-TT-D',
        'ebu-tt-d-basic-de': 'EBU-TT-D-Basic-DE'
    };

declare variable $scf:params_all := ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'separate_tti', 'clear_uda', 'discard_user_data', 'use_line_height_125', 'ignore_manual_offset_for_tcp', 'indent');

(: returns a simple HTML form for a conversion from one format to another :)
declare function scf:form_conversion($format_source, $format_target, $params) {

{concat($scf:subtitle_format($format_source), ' → ', $scf:subtitle_format($format_target))}
,
    <form action="convert" method="post" enctype="multipart/form-data">
        <input type="hidden" name="format_source" value="{$format_source}"/>
        <input type="hidden" name="format_target" value="{$format_target}"/>
        {scf:form_conversion_fields($params)}
    </form>
};

(: returns the necessary form input fields for a conversion :)
declare function scf:form_conversion_fields($params) {
    Input file: <input type="file" name="input" required="required"/>,
    <button type="submit">Convert</button>,

        {if($params = 'offset_seconds') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> consider <input type="text" size="10" name="offset_seconds" value="36000" disabled="disabled"/> seconds offset
 else ()}
        {if($params = 'offset_frames') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> consider <input type="text" size="10" name="offset_frames" value="10:00:00:00" disabled="disabled"/> frames offset
 else ()}
        {if($params = 'offset_start_of_programme') then
<input type="checkbox" name="offset_start_of_programme" value="1"/> consider Start-of-Programme offset
 else ()}
        {if($params = 'separate_tti') then
<input type="checkbox" name="separate_tti" value="1"/> do not merge multiple text TTI blocks of the same subtitle
 else ()}
        {if($params = 'clear_uda') then
<input type="checkbox" name="clear_uda" value="1"/> clear STL User-Defined Area (UDA)
 else ()}
        {if($params = 'discard_user_data') then
<input type="checkbox" name="discard_user_data" value="1"/> discard STL User Data (EBN 0xFE)
 else ()}
        {if($params = 'use_line_height_125') then
<input type="checkbox" name="use_line_height_125" value="1"/> use line height "125%" in EBU-TT-D
 else ()}
        {if($params = 'ignore_manual_offset_for_tcp') then
<input type="checkbox" name="ignore_manual_offset_for_tcp" value="1"/> ignore manual offset for TCP
 else ()}
        {if($params = 'indent') then
<input type="checkbox" name="indent" value="1" checked="checked"/> indented output
 else () (: enabled by default :)}

,

};

(: web interface homepage :)
declare
  %rest:path("/webif")
  %output:method("xhtml")
  function scf:overview() {

        <title>SCF service</title>

SCF service

Multi step conversions

        {scf:form_conversion('stl', 'ebu-tt', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'discard_user_data', 'ignore_manual_offset_for_tcp', 'indent'))}
        {scf:form_conversion('ebu-tt', 'stl', ())}
        {scf:form_conversion('stl', 'ebu-tt-d-basic-de', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'discard_user_data', 'use_line_height_125', 'ignore_manual_offset_for_tcp', 'indent'))}

Custom multi step conversion

        Note: For a particular conversion, not every shown option may be supported!

        <form action="convert" method="post" enctype="multipart/form-data">

                Source format:
                <select name="format_source" required="required">
                    <option selected="selected"/>
                    {for $format in map:keys($scf:subtitle_format) order by $format return <option value="{$format}">{$scf:subtitle_format($format)}</option>}
                </select>
                Target format:
                <select name="format_target" required="required">
                    <option selected="selected"/>
                    {for $format in map:keys($scf:subtitle_format) order by $format return <option value="{$format}">{$scf:subtitle_format($format)}</option>}
                </select>

            {scf:form_conversion_fields($scf:params_all)}
        </form>

Single step conversions

        {scf:form_conversion('stl', 'stlxml', ('separate_tti', 'clear_uda', 'discard_user_data', 'indent'))}
        {scf:form_conversion('stlxml', 'stl', ())}
        {scf:form_conversion('stlxml', 'ebu-tt', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'ignore_manual_offset_for_tcp', 'indent'))}
        {scf:form_conversion('ebu-tt', 'stlxml', ('indent'))}
        {scf:form_conversion('ebu-tt', 'ebu-tt-d', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'use_line_height_125', 'indent'))}
        {scf:form_conversion('ebu-tt-d', 'ebu-tt-d-basic-de', ('indent'))}

  };

(: param->options map: sets a param (key) to the value of a specific status option (value); afterwards clear the option value to indicate that it has been consumed :)

declare function scf:call_stl2stlxml($status as map(*)) as map(*) {
    let $param_option_mapping := map {
        's': 'option_separate_tti',
        'a': 'option_clear_uda',
        'u': 'option_discard_user_data'
    }

    (: build params sequence with present options - for STL2STLXML it is sufficient that an option is present; the actual value doesn't matter! :)
    let $params :=
        for $k in map:keys($param_option_mapping)
        let $v := $k => $param_option_mapping() => $status()
        where exists($v)
        return $k

    (: transformation :)
    let $input as xs:base64Binary := $status('result')
    let $input_filename := file:create-temp-file('scf-service-', '')
    let $output_filename := concat($input_filename, '.out')
    let $write_input := file:write-binary($input_filename, $input)
    let $result_call := proc:system('python3', (file:resolve-path(concat($scf:modules_path, 'STL2STLXML/stl2stlxml.py')), $input_filename, '-x', $output_filename, $params ! concat('-', .)))
    let $result as document-node() := (# basex:non-deterministic #) {doc($output_filename)} (: prevent evaluation after deleted output file :)
    let $delete_input := file:delete($input_filename)
    let $delete_output := file:delete($output_filename)

    (: remove consumed options + replace result :)
    return map:merge((map:entry('result', $result), $params ! map:entry($param_option_mapping(.), ()), $status))
};

declare function scf:call_stlxml2stl($status as map(*)) as map(*) {
    let $input as document-node() := $status('result')
    let $result as xs:base64Binary := xs:base64Binary(
        (: also invoke STLXML-SplitBlocks :)
        let $input_splitted := xslt:transform($input, concat('../', $scf:modules_path, 'STLXML-SplitBlocks/STLXML-SplitBlocks.xslt'))
        return xquery:eval(
            concat("import module namespace stlxml2stl = 'stlxml2stl' at '../", $scf:modules_path, "STLXML2STL/stlxml2stl.xqm'; stlxml2stl:encode(.)"),
            map { '': $input_splitted }
        )
    )
    return map:put($status, 'result', $result)
};

(: generic XSLT conversion :)
declare function scf:call_xslt($status as map(*), $xslt as xs:string, $param_option_mapping as map(*)) as map(*) {
    (: build params map with present options :)
    let $params := map:merge(
        for $k in map:keys($param_option_mapping)
        let $v := $k => $param_option_mapping() => $status()
        where exists($v)
        return map:entry($k, $v)
    )

    (: transformation :)
    let $input as document-node() := $status('result')
    let $result as document-node() := xslt:transform($input, concat('../', $scf:modules_path, $xslt), $params)

    (: remove consumed options + replace result :)
    return map:merge((map:entry('result', $result), map:keys($params) ! map:entry($param_option_mapping(.), ()), $status))
};

declare function scf:call_stlxml2ebu-tt($status as map(*)) as map(*) {
    scf:call_xslt($status, 'STLXML2EBU-TT/STLXML2EBU-TT.xslt', map {
        'offsetTCP': 'option_offset_start_of_programme',
        'offsetInSeconds': 'option_offset_seconds',
        'offsetInFrames': 'option_offset_frames',
        'ignoreManualOffsetForTCP': 'option_ignore_manual_offset_for_tcp'
    })
};

declare function scf:call_ebu-tt2stlxml($status as map(*)) as map(*) {
    scf:call_xslt($status, 'EBU-TT2STLXML/EBU-TT2STLXML.xslt', map{})
};

declare function scf:call_ebu-tt2ebu-tt-d($status as map(*)) as map(*) {
    scf:call_xslt($status, 'EBU-TT2EBU-TT-D/EBU-TT2EBU-TT-D.xslt', map {
        'useLineHeight125Percent': 'option_use_line_height_125',
        'offsetStartOfProgramme': 'option_offset_start_of_programme',
        'offsetInSeconds': 'option_offset_seconds',
        'offsetInFrames': 'option_offset_frames'
    })
};

declare function scf:call_ebu-tt-d2ebu-tt-d-basic-de($status as map(*)) as map(*) {
    scf:call_xslt($status, 'EBU-TT-D2EBU-TT-D-Basic-DE/EBU-TT-D2EBU-TT-D-Basic-DE.xslt', map{})
};

(: sets an unsupported option error as status result :)
declare function scf:status_set_error($status as map(*), $description as xs:string+) as map(*) {
    map:put($status, 'result',
        <error>
            <steps>
                {$status('steps') ! <step>{$scf:subtitle_format(.)}</step>}
            </steps>

            <description>This conversion chain does not support the following option(s): {string-join($description, '; ')}.</description>
            <value/>
            <module/>
            <line-number/>
            <column-number/>
        </error>
    )
};

(:
items of the status map:
- steps: sequence of the conversion formats the source file has gone through so far (last item = current format)
- option_offset_seconds: if present, offset in seconds that shall be subtracted from all timecodes
- option_offset_frames: if present, offset in frames that shall be subtracted from all timecodes
- option_offset_start_of_programme: if present, subtract Start-of-Programme offset from all timecodes
- option_use_line_height_125: if present, use the value "125%" (instead of the special value "normal") for the line height in EBU-TT-D
- option_ignore_manual_offset_for_tcp: if present, any manual offset (seconds or frames) will *not* be subtracted from the TCP value
- option_separate_tti: if present, do not merge multiple text TTI blocks of the same subtitle
- option_clear_uda: if present, clear STL User-Defined Area (UDA)
- option_discard_user_data: if present, discard STL User Data
- result: subtitle content in the indicated format
:)

(: execute the actual conversion and return a result (or an error) :)
declare
  %rest:path("/convert")
  %rest:POST
  %rest:form-param("input", "{$input}")
  %rest:form-param("format_source", "{$format_source}")
  %rest:form-param("format_target", "{$format_target}")
  %rest:form-param("offset_seconds", "{$offset_seconds}")
  %rest:form-param("offset_frames", "{$offset_frames}")
  %rest:form-param("offset_start_of_programme", "{$offset_start_of_programme}")
  %rest:form-param("use_line_height_125", "{$use_line_height_125}")
  %rest:form-param("ignore_manual_offset_for_tcp", "{$ignore_manual_offset_for_tcp}")
  %rest:form-param("separate_tti", "{$separate_tti}")
  %rest:form-param("clear_uda", "{$clear_uda}")
  %rest:form-param("discard_user_data", "{$discard_user_data}")
  %rest:form-param("indent", "{$indent}")
  function scf:convert(
    $input as map(*),
    $format_source as xs:string,
    $format_target as xs:string,
    $offset_seconds as xs:string?,
    $offset_frames as xs:string?,
    $offset_start_of_programme as xs:string?,
    $use_line_height_125 as xs:string?,
    $ignore_manual_offset_for_tcp as xs:string?,
    $separate_tti as xs:string?,
    $clear_uda as xs:string?,
    $discard_user_data as xs:string?,
    $indent as xs:string?
  ) {
    let $conversion_option_error_messages := map {
        'option_offset_seconds': 'to consider a timecodes seconds offset',
        'option_offset_frames': 'to consider a timecodes frame offset',
        'option_offset_start_of_programme': 'to consider the Start-of-Programme offset',
        'option_use_line_height_125': 'to use the line height value "125%"',
        'option_ignore_manual_offset_for_tcp': 'to ignore any manual offset for TCP',
        'option_separate_tti': 'to disable text TTI block merging',
        'option_clear_uda': 'to clear STL User-Defined Area (UDA)',
        'option_discard_user_data': 'to remove STL User Data'
    }

    let $conversion_format := concat($format_source, '→', $format_target)
    let $source_stl := $format_source eq 'stl'
    let $target_stl := $format_target eq 'stl'

    let $input_filename := map:keys($input)[1]
    let $input_content_raw := $input($input_filename)
    let $input_content := if ($source_stl) then $input_content_raw else parse-xml(bin:decode-string($input_content_raw, 'UTF-8'))

    (: do conversion :)
    let $conversion_status_init := map {
        'steps': $format_source,
        'option_offset_seconds': $offset_seconds,
        'option_offset_frames': $offset_frames,
        'option_offset_start_of_programme': $offset_start_of_programme,
        'option_use_line_height_125': $use_line_height_125,
        'option_ignore_manual_offset_for_tcp': $ignore_manual_offset_for_tcp,
        'option_separate_tti': $separate_tti,
        'option_clear_uda': $clear_uda,
        'option_discard_user_data': $discard_user_data,
        'result': $input_content
    }
    let $conversion_status := scf:convert_step($conversion_status_init, $format_target)
    let $conversion_option_errors := map:keys($conversion_option_error_messages)[exists($conversion_status(.))] ! $conversion_option_error_messages(.)
    let $conversion := if (empty($conversion_option_errors)) then $conversion_status else scf:status_set_error($conversion_status, $conversion_option_errors)

    let $rest_response_format := if ($conversion('result') instance of xs:base64Binary) then 'application/octet-stream' else 'application/xml'
    let $rest_response_filename_without_ext := replace($input_filename, '[.]([Ss][Tt][Ll]|[Xx][Mm][Ll])$', '')
    let $rest_response_filename_suffix := if ($target_stl) then '.stl' else concat('_', $format_target, '.xml')
    let $rest_response_filename := concat($rest_response_filename_without_ext, $rest_response_filename_suffix)
    let $rest_response_success := not($conversion('result') instance of element())

    return (
        (: MIME type + filename :)
        <rest:response>
            <output:serialization-parameters>
                <output:omit-xml-declaration value='no'/>
                <output:indent value='{if (exists($indent)) then 'yes' else 'no'}'/>
                <output:media-type value='{$rest_response_format}'/>
            </output:serialization-parameters>
            <http:response status="{if ($rest_response_success) then 200 else 400}">
                {if ($rest_response_success) then <http:header name="Content-Disposition" value="attachment; filename=""{$rest_response_filename}"""/> else ()}
                <http:header name="SCF-Service-Debug-Conversion-Steps" value="{string-join($conversion('steps'), ',')}"/>
            </http:response>
        </rest:response>,
        if ($rest_response_success) then () else <?xml-stylesheet href="static/error.xsl" type="text/xsl" ?>,
        $conversion('result')
    )
  };

(: execute a single conversion step :)
declare function scf:convert_step($status as map(*), $format_target as xs:string) as map(*) {
    let $current_format := $status('steps')[last()]
    let $next_format := scf:next_format($current_format, $format_target)
    return
        (: return, if no conversion needed :)
        if (empty($next_format))
        then $status
        else
            let $next_steps := ($status('steps'), $next_format)
            return try {
                (: invoke next conversion step :)
                let $next_conversion := concat($current_format, '→', $next_format)
                let $next_step_status :=
                    switch($next_conversion)
                    case "stl→stlxml" return
                        scf:call_stl2stlxml($status)
                    case "stlxml→stl" return
                        scf:call_stlxml2stl($status)
                    case "stlxml→ebu-tt" return
                        scf:call_stlxml2ebu-tt($status)
                    case "ebu-tt→stlxml" return
                        scf:call_ebu-tt2stlxml($status)
                    case "ebu-tt→ebu-tt-d" return
                        scf:call_ebu-tt2ebu-tt-d($status)
                    case "ebu-tt-d→ebu-tt-d-basic-de" return
                        scf:call_ebu-tt-d2ebu-tt-d-basic-de($status)
                    default return
                        ()
                let $next_status := map:put($next_step_status, 'steps', $next_steps)
                return scf:convert_step($next_status, $format_target)
            } catch * {
                (: abort with error :)
                map { 'steps': $next_steps, 'result':
                    <error>
                        <steps>
                            {$next_steps ! <step>{$scf:subtitle_format(.)}</step>}
                        </steps>
                        {$err:code}
                        <description>{$err:description}</description>
                        <value>{$err:value}</value>
                        <module>{$err:module}</module>
                        <line-number>{$err:line-number}</line-number>
                        <column-number>{$err:column-number}</column-number>
                    </error>
                }
            }
};

(: determine the next format to which the current (intermediate) result has to be converted, towards the target format :)
declare function scf:next_format($format_source as xs:string, $format_target as xs:string) as xs:string? {
    switch($format_source)
    case $format_target return
        () (: no conversion needed :)
    case 'stl' return
        'stlxml'
    case 'stlxml' return
        if($format_target eq 'stl')
        then 'stl'
        else 'ebu-tt'
    default return
        (: TTML source :)
        if($format_target = ('stl', 'stlxml'))
        then 'stlxml'
        else
            (: TTML source/target :)
            switch($format_source)
            case 'ebu-tt' return
                'ebu-tt-d'
            case 'ebu-tt-d' return
                if($format_target eq 'ebu-tt')
                then () (: no conversion needed :)
                else 'ebu-tt-d-basic-de'
            case 'ebu-tt-d-basic-de'
                return () (: no conversion needed :)
            default return
                ''
};

(: Subtitle Conversion Framework (SCF) - SCF service
 :
 : Copyright 2019 Institut für Rundfunktechnik GmbH, Munich, Germany
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, the subject work
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

module namespace scf = 'http://www.irt.de/irt_restxq/scf_service';

declare variable $scf:modules_path as xs:string := "modules/";

declare variable $scf:subtitle_format :=
    map {
        'stl': 'STL',
        'stlxml': 'STLXML',
        'ebu-tt': 'EBU-TT',
        'ebu-tt-d': 'EBU-TT-D',
        'ebu-tt-d-basic-de': 'EBU-TT-D-Basic-DE'
    };

declare variable $scf:params_all := ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'separate_tti', 'clear_uda', 'discard_user_data', 'use_line_height_125', 'ignore_manual_offset_for_tcp', 'indent');

(: returns a simple HTML form for a conversion from one format to another :)
declare function scf:form_conversion($format_source, $format_target, $params) {

{concat($scf:subtitle_format($format_source), ' → ', $scf:subtitle_format($format_target))}
,
    <form action="convert" method="post" enctype="multipart/form-data">
        <input type="hidden" name="format_source" value="{$format_source}"/>
        <input type="hidden" name="format_target" value="{$format_target}"/>
        {scf:form_conversion_fields($params)}
    </form>
};

(: returns the necessary form input fields for a conversion :)
declare function scf:form_conversion_fields($params) {
    Input file: <input type="file" name="input" required="required"/>,
    <button type="submit">Convert</button>,

        {if($params = 'offset_seconds') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> consider <input type="text" size="10" name="offset_seconds" value="36000" disabled="disabled"/> seconds offset
 else ()}
        {if($params = 'offset_frames') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> consider <input type="text" size="10" name="offset_frames" value="10:00:00:00" disabled="disabled"/> frames offset
 else ()}
        {if($params = 'offset_start_of_programme') then
<input type="checkbox" name="offset_start_of_programme" value="1"/> consider Start-of-Programme offset
 else ()}
        {if($params = 'separate_tti') then
<input type="checkbox" name="separate_tti" value="1"/> do not merge multiple text TTI blocks of the same subtitle
 else ()}
        {if($params = 'clear_uda') then
<input type="checkbox" name="clear_uda" value="1"/> clear STL User-Defined Area (UDA)
 else ()}
        {if($params = 'discard_user_data') then
<input type="checkbox" name="discard_user_data" value="1"/> discard STL User Data (EBN 0xFE)
 else ()}
        {if($params = 'use_line_height_125') then
<input type="checkbox" name="use_line_height_125" value="1"/> use line height "125%" in EBU-TT-D
 else ()}
        {if($params = 'ignore_manual_offset_for_tcp') then
<input type="checkbox" name="ignore_manual_offset_for_tcp" value="1"/> ignore manual offset for TCP
 else ()}
        {if($params = 'indent') then
<input type="checkbox" name="indent" value="1" checked="checked"/> indented output
 else () (: enabled by default :)}

,

};

(: web interface homepage :)
declare
  %rest:path("/webif")
  %output:method("xhtml")
  function scf:overview() {

        <title>SCF service</title>

SCF service

Multi step conversions

        {scf:form_conversion('stl', 'ebu-tt', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'discard_user_data', 'ignore_manual_offset_for_tcp', 'indent'))}
        {scf:form_conversion('ebu-tt', 'stl', ())}
        {scf:form_conversion('stl', 'ebu-tt-d-basic-de', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'discard_user_data', 'use_line_height_125', 'ignore_manual_offset_for_tcp', 'indent'))}

Custom multi step conversion

        Note: For a particular conversion, not every shown option may be supported!

        <form action="convert" method="post" enctype="multipart/form-data">

                Source format:
                <select name="format_source" required="required">
                    <option selected="selected"/>
                    {for $format in map:keys($scf:subtitle_format) order by $format return <option value="{$format}">{$scf:subtitle_format($format)}</option>}
                </select>
                Target format:
                <select name="format_target" required="required">
                    <option selected="selected"/>
                    {for $format in map:keys($scf:subtitle_format) order by $format return <option value="{$format}">{$scf:subtitle_format($format)}</option>}
                </select>

            {scf:form_conversion_fields($scf:params_all)}
        </form>

Single step conversions

        {scf:form_conversion('stl', 'stlxml', ('separate_tti', 'clear_uda', 'discard_user_data', 'indent'))}
        {scf:form_conversion('stlxml', 'stl', ())}
        {scf:form_conversion('stlxml', 'ebu-tt', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'ignore_manual_offset_for_tcp', 'indent'))}
        {scf:form_conversion('ebu-tt', 'stlxml', ('indent'))}
        {scf:form_conversion('ebu-tt', 'ebu-tt-d', ('offset_seconds', 'offset_frames', 'offset_start_of_programme', 'use_line_height_125', 'indent'))}
        {scf:form_conversion('ebu-tt-d', 'ebu-tt-d-basic-de', ('indent'))}

  };

(: param->options map: sets a param (key) to the value of a specific status option (value); afterwards clear the option value to indicate that it has been consumed :)

declare function scf:call_stl2stlxml($status as map(*)) as map(*) {
    let $param_option_mapping := map {
        's': 'option_separate_tti',
        'a': 'option_clear_uda',
        'u': 'option_discard_user_data'
    }

    (: build params sequence with present options - for STL2STLXML it is sufficient that an option is present; the actual value doesn't matter! :)
    let $params :=
        for $k in map:keys($param_option_mapping)
        let $v := $k => $param_option_mapping() => $status()
        where exists($v)
        return $k

    (: transformation :)
    let $input as xs:base64Binary := $status('result')
    let $input_filename := file:create-temp-file('scf-service-', '')
    let $output_filename := concat($input_filename, '.out')
    let $write_input := file:write-binary($input_filename, $input)
    let $result_call := proc:system('python3', (file:resolve-path(concat($scf:modules_path, 'STL2STLXML/stl2stlxml.py')), $input_filename, '-x', $output_filename, $params ! concat('-', .)))
    let $result as document-node() := (# basex:non-deterministic #) {doc($output_filename)} (: prevent evaluation after deleted output file :)
    let $delete_input := file:delete($input_filename)
    let $delete_output := file:delete($output_filename)

    (: remove consumed options + replace result :)
    return map:merge((map:entry('result', $result), $params ! map:entry($param_option_mapping(.), ()), $status))
};

declare function scf:call_stlxml2stl($status as map(*)) as map(*) {
    let $input as document-node() := $status('result')
    let $result as xs:base64Binary := xs:base64Binary(
        (: also invoke STLXML-SplitBlocks :)
        let $input_splitted := xslt:transform($input, concat('../', $scf:modules_path, 'STLXML-SplitBlocks/STLXML-SplitBlocks.xslt'))
        return xquery:eval(
            concat("import module namespace stlxml2stl = 'stlxml2stl' at '../", $scf:modules_path, "STLXML2STL/stlxml2stl.xqm'; stlxml2stl:encode(.)"),
            map { '': $input_splitted }
        )
    )
    return map:put($status, 'result', $result)
};

(: generic XSLT conversion :)
declare function scf:call_xslt($status as map(*), $xslt as xs:string, $param_option_mapping as map(*)) as map(*) {
    (: build params map with present options :)
    let $params := map:merge(
        for $k in map:keys($param_option_mapping)
        let $v := $k => $param_option_mapping() => $status()
        where exists($v)
        return map:entry($k, $v)
    )

    (: transformation :)
    let $input as document-node() := $status('result')
    let $result as document-node() := xslt:transform($input, $xslt, $params)

    (: remove consumed options + replace result :)
    return map:merge((map:entry('result', $result), map:keys($params) ! map:entry($param_option_mapping(.), ()), $status))
};

declare function scf:call_stlxml2ebu-tt($status as map(*)) as map(*) {
    scf:call_xslt($status, concat('../', $scf:modules_path, 'STLXML2EBU-TT/STLXML2EBU-TT.xslt'), map {
        'offsetTCP': 'option_offset_start_of_programme',
        'offsetInSeconds': 'option_offset_seconds',
        'offsetInFrames': 'option_offset_frames',
        'ignoreManualOffsetForTCP': 'option_ignore_manual_offset_for_tcp'
    })
};

declare function scf:call_ebu-tt2stlxml($status as map(*)) as map(*) {
    scf:call_xslt($status, concat('../', $scf:modules_path, 'EBU-TT2STLXML/EBU-TT2STLXML.xslt'), map{})
};

declare function scf:call_ebu-tt2ebu-tt-d($status as map(*)) as map(*) {
    scf:call_xslt($status, concat('../', $scf:modules_path, 'EBU-TT2EBU-TT-D/EBU-TT2EBU-TT-D.xslt'), map {
        'useLineHeight125Percent': 'option_use_line_height_125',
        'offsetStartOfProgramme': 'option_offset_start_of_programme',
        'offsetInSeconds': 'option_offset_seconds',
        'offsetInFrames': 'option_offset_frames'
    })
};

declare function scf:call_ebu-tt-d2ebu-tt-d-basic-de($status as map(*)) as map(*) {
    scf:call_xslt($status, concat('../', $scf:modules_path, 'EBU-TT-D2EBU-TT-D-Basic-DE/EBU-TT-D2EBU-TT-D-Basic-DE.xslt'), map{})
};

(: sets an unsupported option error as status result :)
declare function scf:status_set_error($status as map(*), $description as xs:string+) as map(*) {
    map:put($status, 'result',
        <error>
            <steps>
                {$status('steps') ! <step>{$scf:subtitle_format(.)}</step>}
            </steps>

            <description>This conversion chain does not support the following option(s): {string-join($description, '; ')}.</description>
            <value/>
            <module/>
            <line-number/>
            <column-number/>
        </error>
    )
};

(:
items of the status map:
- steps: sequence of the conversion formats the source file has gone through so far (last item = current format)
- option_offset_seconds: if present, offset in seconds that shall be subtracted from all timecodes
- option_offset_frames: if present, offset in frames that shall be subtracted from all timecodes
- option_offset_start_of_programme: if present, subtract Start-of-Programme offset from all timecodes
- option_use_line_height_125: if present, use the value "125%" (instead of the special value "normal") for the line height in EBU-TT-D
- option_ignore_manual_offset_for_tcp: if present, any manual offset (seconds or frames) will *not* be subtracted from the TCP value
- option_separate_tti: if present, do not merge multiple text TTI blocks of the same subtitle
- option_clear_uda: if present, clear STL User-Defined Area (UDA)
- option_discard_user_data: if present, discard STL User Data
- result: subtitle content in the indicated format
:)

(: execute the actual conversion and return a result (or an error) :)
declare
  %rest:path("/convert")
  %rest:POST
  %rest:form-param("input", "{$input}")
  %rest:form-param("format_source", "{$format_source}")
  %rest:form-param("format_target", "{$format_target}")
  %rest:form-param("offset_seconds", "{$offset_seconds}")
  %rest:form-param("offset_frames", "{$offset_frames}")
  %rest:form-param("offset_start_of_programme", "{$offset_start_of_programme}")
  %rest:form-param("use_line_height_125", "{$use_line_height_125}")
  %rest:form-param("ignore_manual_offset_for_tcp", "{$ignore_manual_offset_for_tcp}")
  %rest:form-param("separate_tti", "{$separate_tti}")
  %rest:form-param("clear_uda", "{$clear_uda}")
  %rest:form-param("discard_user_data", "{$discard_user_data}")
  %rest:form-param("indent", "{$indent}")
  function scf:convert(
    $input as map(*),
    $format_source as xs:string,
    $format_target as xs:string,
    $offset_seconds as xs:string?,
    $offset_frames as xs:string?,
    $offset_start_of_programme as xs:string?,
    $use_line_height_125 as xs:string?,
    $ignore_manual_offset_for_tcp as xs:string?,
    $separate_tti as xs:string?,
    $clear_uda as xs:string?,
    $discard_user_data as xs:string?,
    $indent as xs:string?
  ) {
    let $conversion_option_error_messages := map {
        'option_offset_seconds': 'to consider a timecodes seconds offset',
        'option_offset_frames': 'to consider a timecodes frame offset',
        'option_offset_start_of_programme': 'to consider the Start-of-Programme offset',
        'option_use_line_height_125': 'to use the line height value "125%"',
        'option_ignore_manual_offset_for_tcp': 'to ignore any manual offset for TCP',
        'option_separate_tti': 'to disable text TTI block merging',
        'option_clear_uda': 'to clear STL User-Defined Area (UDA)',
        'option_discard_user_data': 'to remove STL User Data'
    }

    let $conversion_format := concat($format_source, '→', $format_target)
    let $source_stl := $format_source eq 'stl'
    let $target_stl := $format_target eq 'stl'

    let $input_filename := map:keys($input)[1]
    let $input_content_raw := $input($input_filename)
    let $input_content := if ($source_stl) then $input_content_raw else parse-xml(bin:decode-string($input_content_raw, 'UTF-8'))

    (: do conversion :)
    let $conversion_status_init := map {
        'steps': $format_source,
        'option_offset_seconds': $offset_seconds,
        'option_offset_frames': $offset_frames,
        'option_offset_start_of_programme': $offset_start_of_programme,
        'option_use_line_height_125': $use_line_height_125,
        'option_ignore_manual_offset_for_tcp': $ignore_manual_offset_for_tcp,
        'option_separate_tti': $separate_tti,
        'option_clear_uda': $clear_uda,
        'option_discard_user_data': $discard_user_data,
        'result': $input_content
    }
    let $conversion_status := scf:convert_step($conversion_status_init, $format_target)
    let $conversion_option_errors := map:keys($conversion_option_error_messages)[exists($conversion_status(.))] ! $conversion_option_error_messages(.)
    let $conversion := if (empty($conversion_option_errors)) then $conversion_status else scf:status_set_error($conversion_status, $conversion_option_errors)

    let $rest_response_format := if ($conversion('result') instance of xs:base64Binary) then 'application/octet-stream' else 'application/xml'
    let $rest_response_filename_without_ext := replace($input_filename, '[.]([Ss][Tt][Ll]|[Xx][Mm][Ll])$', '')
    let $rest_response_filename_suffix := if ($target_stl) then '.stl' else concat('_', $format_target, '.xml')
    let $rest_response_filename := concat($rest_response_filename_without_ext, $rest_response_filename_suffix)
    let $rest_response_success := not($conversion('result') instance of element())

    return (
        (: MIME type + filename :)
        <rest:response>
            <output:serialization-parameters>
                <output:omit-xml-declaration value='no'/>
                <output:indent value='{if (exists($indent)) then 'yes' else 'no'}'/>
                <output:media-type value='{$rest_response_format}'/>
            </output:serialization-parameters>
            <http:response status="{if ($rest_response_success) then 200 else 400}">
                {if ($rest_response_success) then <http:header name="Content-Disposition" value="attachment; filename=""{$rest_response_filename}"""/> else ()}
                <http:header name="SCF-Service-Debug-Conversion-Steps" value="{string-join($conversion('steps'), ',')}"/>
            </http:response>
        </rest:response>,
        if ($rest_response_success) then () else <?xml-stylesheet href="static/error.xsl" type="text/xsl" ?>,
        $conversion('result')
    )
  };

(: execute a single conversion step :)
declare function scf:convert_step($status as map(*), $format_target as xs:string) as map(*) {
    let $current_format := $status('steps')[last()]
    let $next_format := scf:next_format($current_format, $format_target)
    return
        (: return, if no conversion needed :)
        if (empty($next_format))
        then $status
        else
            let $next_steps := ($status('steps'), $next_format)
            return try {
                (: invoke next conversion step :)
                let $next_conversion := concat($current_format, '→', $next_format)
                let $next_step_status :=
                    switch($next_conversion)
                    case "stl→stlxml" return
                        scf:call_stl2stlxml($status)
                    case "stlxml→stl" return
                        scf:call_stlxml2stl($status)
                    case "stlxml→ebu-tt" return
                        scf:call_stlxml2ebu-tt($status)
                    case "ebu-tt→stlxml" return
                        scf:call_ebu-tt2stlxml($status)
                    case "ebu-tt→ebu-tt-d" return
                        scf:call_ebu-tt2ebu-tt-d($status)
                    case "ebu-tt-d→ebu-tt-d-basic-de" return
                        scf:call_ebu-tt-d2ebu-tt-d-basic-de($status)
                    default return
                        ()
                let $next_status := map:put($next_step_status, 'steps', $next_steps)
                return scf:convert_step($next_status, $format_target)
            } catch * {
                (: abort with error :)
                map { 'steps': $next_steps, 'result':
                    <error>
                        <steps>
                            {$next_steps ! <step>{$scf:subtitle_format(.)}</step>}
                        </steps>
                        {$err:code}
                        <description>{$err:description}</description>
                        <value>{$err:value}</value>
                        <module>{$err:module}</module>
                        <line-number>{$err:line-number}</line-number>
                        <column-number>{$err:column-number}</column-number>
                    </error>
                }
            }
};

(: determine the next format to which the current (intermediate) result has to be converted, towards the target format :)
declare function scf:next_format($format_source as xs:string, $format_target as xs:string) as xs:string? {
    switch($format_source)
    case $format_target return
        () (: no conversion needed :)
    case 'stl' return
        'stlxml'
    case 'stlxml' return
        if($format_target eq 'stl')
        then 'stl'
        else 'ebu-tt'
    default return
        (: TTML source :)
        if($format_target = ('stl', 'stlxml'))
        then 'stlxml'
        else
            (: TTML source/target :)
            switch($format_source)
            case 'ebu-tt' return
                'ebu-tt-d'
            case 'ebu-tt-d' return
                if($format_target eq 'ebu-tt')
                then () (: no conversion needed :)
                else 'ebu-tt-d-basic-de'
            case 'ebu-tt-d-basic-de'
                return () (: no conversion needed :)
            default return
                ''
};


[bugfix] wrong index base used in xquery.

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

xquery version "1.0";

(: $Id$ :)

declare namespace style="http://exist-db.org/xquery/style";
declare namespace nav="http://exist-db.org/NS/sidebar";

declare option exist:serialize "method=xhtml";

declare function style:page-head($node) {

            {
                for $link in $node//nav:toolbar/nav:link
                let $href :=
                    if (matches($link/@href, "^\w+://")) then
                        $link/@href/string()
                    else
                        concat($node/@base, "/", $link/@href)
                return

{$link/string()}

            }

Open Source Native XML Database

,
    style:sidebar($node)
};

declare function style:sidebar($node) {

    {
        for $group in $node//nav:group
        return

{$group/@name/string()}

                {
                    for $item in $group/nav:item
                    let $link := $item/nav:link
                    let $href :=
                        if (matches($link/@href, "^\w+://")) then
                            $link/@href/string()
                        else
                            concat($node/@base, "/", ($link/@href)[1])
                    return

{$link/string()}

                }

    }

};

declare function style:default-styles() {
    <link rel="stylesheet" type="text/css" href="../styles/default-style2.css"/>,

};

declare function style:transform($node) {
    typeswitch ($node)
        case element(style:page-head) return
            style:page-head($node)
        case element(style:default-styles) return
            style:default-styles()
        case element() return
            element { node-name($node) } {
                $node/@*, for $child in $node/node() return style:transform($child)
            }
        default return
            $node
};

let $input := request:get-data()
let $output :=
    style:transform(util:expand($input))
return
    $output

xquery version "1.0";

declare namespace style="http://exist-db.org/xquery/style";
declare namespace nav="http://exist-db.org/NS/sidebar";

declare option exist:serialize "method=xhtml";

declare function style:page-head($node) {

            {
                for $link in $node//nav:toolbar/nav:link
                let $href :=
                    if (matches($link/@href, "^\w+://")) then
                        $link/@href/string()
                    else
                        concat($node/@base, "/", $link/@href)
                return

{$link/string()}

            }

Open Source Native XML Database

,
    style:sidebar($node)
};

declare function style:sidebar($node) {

    {
        for $group in $node//nav:group
        return

{$group/@name/string()}

                {
                    for $item in $group/nav:item
                    let $link := $item/nav:link
                    let $href :=
                        if (matches($link/@href, "^\w+://")) then
                            $link/@href/string()
                        else
                            concat($node/@base, "/", ($link/@href)[0])
                    return

{$link/string()}

                }

    }

};

declare function style:default-styles() {
    <link rel="stylesheet" type="text/css" href="../styles/default-style2.css"/>,

};

declare function style:transform($node) {
    typeswitch ($node)
        case element(style:page-head) return
            style:page-head($node)
        case element(style:default-styles) return
            style:default-styles()
        case element() return
            element { node-name($node) } {
                $node/@*, for $child in $node/node() return style:transform($child)
            }
        default return
            $node
};

let $input := request:get-data()
let $output :=
    style:transform(util:expand($input))
return
    $output


cmd overview uses crday-overview; check-linking obsoleted

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";

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: profile-name deduction not reliable  - needs 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()"):)
    let $profiles := $context//cmd:CMD/concat(cmd:Header/cmd:MdProfile/text(), '#', cmd:Components/*/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>{$profile-id}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                         </sru:term>
    let $count-all := count($context)
    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')
        (:                        $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
                        $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                                             {$ns-uris}
                        {$root-elems}	:)

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 cr-admin  = "http://aac.ac.at/content_repository/admin" at "/db/cr/admin.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
};

(:~ 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:stat-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: profile-name deduction not reliable  - needs match with cmd-terms and diagnostics
:)
declare function cmdcheck:stat-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()"):)
    let $profiles := $context//cmd:CMD/concat(cmd:Header/cmd:MdProfile/text(), '#', cmd:Components/*/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>{$profile-id}</sru:value>
                                           <sru:numberOfRecords>{$cnt }</sru:numberOfRecords>
                                           <sru:displayTerm>{$profile-name}</sru:displayTerm>
                                         </sru:term>
    let $count-all := count($context)
    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'),
       $baseadminurl := repo-utils:config-value($config, 'admin.url')

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

(:    {for $target in $config//target return {xs:string($target/@key)}	}
:)
let $overview :=

collection	path	size	(:ns	root-elem	:)base-elem	indexes	tests	profiles

           { for $map in util:eval("$mappings//map[@key]")
                    let $map-key := $map/xs:string(@key),
                        $map-dbcoll-path := $map/xs:string(@path),
                        $map-dbcoll:= if ($map-dbcoll-path ne '' and xmldb:collection-available (($map-dbcoll-path,"")[1])) then collection($map-dbcoll-path) else (),

                        $queries-doc-name := cr-admin:check-queries-doc-name($config, $map-key),
                        $invoke-check-queries-href := concat($baseadminurl, '?x-context=', repo-utils:sanitize-name($map-key) ,'&config=', $config-path, '&operation=' ),
                        $queries := if (repo-utils:is-in-cache($queries-doc-name, $config)) then
                                                view
                                              else (),
                        $invoke-scan-cmd-profile-href := concat($baseurl, '?operation=scan&scanClause=cmd.profile&x-format=htmlpage&x-context=', $map-key )
                    return

                        {$map-key}
                        {$map-dbcoll-path}
                        {count($map-dbcoll)}
                        {$map/xs:string(@base_elem)}
                        {count($map/index)}
                        {$queries} [run]
                        [profiles]

                        }

        (:                        $root-elems := for $elem in distinct-values($map-dbcoll/*/name()) return $elem,
                        $ns-uris := for $ns in distinct-values($map-dbcoll/namespace-uri(*)) return $ns,
                                             {$ns-uris}
                        {$root-elems}	:)

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
};

(:~ checking consistency of the IDs in CMD-records (MdSelfLink vs. ResourceProxies)

this is now solved better (faster) with xpaths in the cmd-testset,
so this is probably OBSOLETED.
it has very bad performance!

TODO: check (and/or generate) the inverse links in IsPartOf (vs. ResourceProxies) :)
declare function cmdcheck:check-linking($context as node()*) as item()* {

let $mdselflinks := $context//MdSelfLink
let $resourceproxies := $context//ResourceProxy
let $resourceproxies-md := $resourceproxies[ResourceType eq 'Metadata']/ResourceRef
(: )let $diff :=  $resourceproxies-md[not(index-of($mdselflinks, self::*))]
let $diff2 :=  $mdselflinks[not($resourceproxies-md = text())]:)
let $diff := for $resource-proxy in $resourceproxies-md
                    let $id := xs:string($resource-proxy/text())
                return if ($mdselflinks[ft:query(.,<term>{$id}</term>)]) then () (: $mdselflinks[ft:query(.,<term>{$id}</term>)] :)
                 else <doc n="{util:document-name($resource-proxy)}" >{$resource-proxy}</doc>

let $diff2 := for $mdselflink in $mdselflinks
                    let $id := xs:string($mdselflink/text())
                return if ($resourceproxies-md[ft:query(.,<term>{$id}</term>)]) then () (: $mdselflinks[ft:query(.,<term>{$id}</term>)] :)
                 else <doc n="{util:document-name($mdselflink)}" >{$mdselflink}</doc>
return ($diff,$diff2)
};


map syntax

map syntax

(:~
 : This module contains a sample RESTXQ function
 : @copyright Quodatum
 : @license Apache
 : @author Andy Bunce
 :)
module namespace page = 'https://github.com/Quodatum/openshift-basex-quick-start';
declare default function namespace 'https://github.com/Quodatum/openshift-basex-quick-start';

declare namespace sys="java.lang.System";
declare namespace Runtime="java.lang.Runtime";
declare variable $page:core:=(
            "java.version","java.vendor","java.vm.version",
            "os.name","os.version","os.arch");

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("")
  %output:method("html")
  %output:version("5.0")
   function page:start()
  as element(html)
{

 	<meta charset="utf-8"/>
    <meta http-equiv="X-UA-Compatible" content="IE=edge"/>
    <meta name="viewport" content="width=device-width, initial-scale=1"/>
    <meta name="description" content="BaseX Openshift quickstart"/>
    <meta name="author" content="andy bunce"/>
	<title>BaseX Openshift quickstart</title>
	<link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.3/css/bootstrap.css" rel="stylesheet" type="text/css" />

            BaseX

version: {basex-version()}

Quick start for Openshift

        {
        let $props:=property-table(about())
 		return panel("Environment Java Properties",$props)
 		}

};

(:~ @return BaseX version string :)
declare function basex-version() as xs:string{
db:system()/generalinformation/version
};

(:
 : memory status
 :http://javarevisited.blogspot.co.uk/2012/01/find-max-free-total-memory-in-java.html
:)
declare function memory()as map(*){
map{
    "memory.free":prof:human(Runtime:freeMemory(Runtime:getRuntime())),
    "memory.max":prof:human(Runtime:maxMemory(Runtime:getRuntime())),
    "memory.total":prof:human(Runtime:totalMemory(Runtime:getRuntime()))
    }
};

(:~ useful java properties :)
declare function about() as map(*){
 let $c:= map:merge($page:core!map:entry(.,sys:getProperty(.)))
 return map:new(($c,memory()))
};

declare function property-table($map){

Name	Value

{for $key in map:keys($map)
 order by $key
 return
{$key}
          {map:get($map,$key)}

}

};

declare function panel($title,$body){

{$title}

    {$body}

};

(:~
 : This module contains a sample RESTXQ function
 : @copyright Quodatum
 : @license Apache
 : @author Andy Bunce
 :)
module namespace page = 'https://github.com/Quodatum/openshift-basex-quick-start';
declare default function namespace 'https://github.com/Quodatum/openshift-basex-quick-start';

declare namespace sys="java.lang.System";
declare namespace Runtime="java.lang.Runtime";
declare variable $page:core:=(
            "java.version","java.vendor","java.vm.version",
            "os.name","os.version","os.arch");

(:~
 : This function generates the welcome page.
 : @return HTML page
 :)
declare
  %rest:path("")
  %output:method("html")
  %output:version("5.0")
   function page:start()
  as element(html)
{

 	<meta charset="utf-8"/>
    <meta http-equiv="X-UA-Compatible" content="IE=edge"/>
    <meta name="viewport" content="width=device-width, initial-scale=1"/>
    <meta name="description" content="BaseX Openshift quickstart"/>
    <meta name="author" content="andy bunce"/>
	<title>BaseX Openshift quickstart</title>
	<link href="//cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.0.3/css/bootstrap.css" rel="stylesheet" type="text/css" />

            BaseX

version: {basex-version()}

Quick start for Openshift

        {
        let $props:=property-table(about())
 		return panel("Environment Java Properties",$props)
 		}

};

(:~ @return BaseX version string :)
declare function basex-version() as xs:string{
db:system()/generalinformation/version
};

(:
 : memory status
 :http://javarevisited.blogspot.co.uk/2012/01/find-max-free-total-memory-in-java.html
:)
declare function memory()as map(*){
map{
    "memory.free":=prof:human(Runtime:freeMemory(Runtime:getRuntime())),
    "memory.max":=prof:human(Runtime:maxMemory(Runtime:getRuntime())),
    "memory.total":=prof:human(Runtime:totalMemory(Runtime:getRuntime()))
    }
};

(:~ useful java properties :)
declare function about() as map(*){
 let $c:= map:new($page:core!map:entry(.,sys:getProperty(.)))
 return map:new(($c,memory()))
};

declare function property-table($map){

Name	Value

{for $key in map:keys($map)
 order by $key
 return
{$key}
          {map:get($map,$key)}

}

};

declare function panel($title,$body){

{$title}

    {$body}

};


stored function adapter - link to document index is clearer

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

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare
  %rest:path("/CSD/adapter")
  %rest:GET
  %output:method("xhtml")
  function page:show_types()
{
  let $funcs := (csr_proc:stored_functions($csd_webconf:db), csr_proc:stored_updating_functions($csd_webconf:db))
  let $searches :=

      {
	for $adapter_func in $funcs[./csd:extension[@urn='urn:openhie.org:openinfoman:adapter']]
        let $desc := $adapter_func/csd:description
        let $types := $adapter_func/csd:extension[@urn='urn:openhie.org:openinfoman:adapter']/@type
	let $urn := string($adapter_func/@urn)
	return
	  for $type in $types
	  let $s_type := string($type)
	  return

Stored Function {$urn}

	      Type ({$s_type})

		Act on a Document

{string($desc)}

      }

  return page:wrapper($searches)
};

declare
  %rest:path("/CSD/adapter/{$type}/{$search_name}")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$type)
{
  let $function := csr_proc:get_any_function_definition($csd_webconf:db,$search_name)
  let $extensions :=  $function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter' and  @type=$type]

  let $contents :=
    if (count($extensions) = 0)
      (:not a read fhir entity query. should 404 or whatever is required by FHIR :)
    then ("Not a " , $type , " compatible stored functions" )
    else

{$type} Documents

{string($function/@urn)}

          {
  	    for $doc_name in csd_dm:registered_documents($csd_webconf:db)
	    return

	      {string($doc_name)}

	  }

  return csd_webconf:wrapper($contents)

};

declare
  %rest:path("/CSD/adapter/{$type}")
  %rest:GET
  %output:method("xhtml")
  function page:show_type($type)
{
  let $funcs := (csr_proc:stored_functions($csd_webconf:db), csr_proc:stored_updating_functions($csd_webconf:db))[./csd:extension[@type = $type] ]
  let $adaptations :=

{$type}

        {
	    for $adapter_func in $funcs
            let $desc := $adapter_func/csd:description
	    let $urn := string($adapter_func/@urn)
	    return

	      Type ({$type})

		Document Index for {$urn}

{$desc}

	}

  let $contents :=
    (
      Adapters
      ,$adaptations
      )
  return page:wrapper($contents)
};

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

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

import module namespace csr_proc = "https://github.com/openhie/openinfoman/csr_proc";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
import module namespace csd_webconf =  "https://github.com/openhie/openinfoman/csd_webconf";
declare namespace csd = "urn:ihe:iti:csd:2013";

declare
  %rest:path("/CSD/adapter")
  %rest:GET
  %output:method("xhtml")
  function page:show_types()
{
  let $funcs := (csr_proc:stored_functions($csd_webconf:db), csr_proc:stored_updating_functions($csd_webconf:db))
  let $searches :=

      {
	for $adapter_func in $funcs[./csd:extension[@urn='urn:openhie.org:openinfoman:adapter']]
        let $desc := $adapter_func/csd:description
        let $types := $adapter_func/csd:extension[@urn='urn:openhie.org:openinfoman:adapter']/@type
	let $urn := string($adapter_func/@urn)
	return
	  for $type in $types
	  let $s_type := string($type)
	  return

Stored Function {$urn}

	      Type ({$s_type})

		Act on a Document

{string($desc)}

      }

  return page:wrapper($searches)
};

declare
  %rest:path("/CSD/adapter/{$type}/{$search_name}")
  %output:method("xhtml")
  function page:show_endpoints($search_name,$type)
{
  let $function := csr_proc:get_any_function_definition($csd_webconf:db,$search_name)
  let $extensions :=  $function/csd:extension[@urn='urn:openhie.org:openinfoman:adapter' and  @type=$type]

  let $contents :=
    if (count($extensions) = 0)
      (:not a read fhir entity query. should 404 or whatever is required by FHIR :)
    then ("Not a " , $type , " compatible stored functions" )
    else

{$type} Documents

{string($function/@urn)}

          {
  	    for $doc_name in csd_dm:registered_documents($csd_webconf:db)
	    return

	      {string($doc_name)}

	  }

  return csd_webconf:wrapper($contents)

};

declare
  %rest:path("/CSD/adapter/{$type}")
  %rest:GET
  %output:method("xhtml")
  function page:show_type($type)
{
  let $funcs := (csr_proc:stored_functions($csd_webconf:db), csr_proc:stored_updating_functions($csd_webconf:db))[./csd:extension[@type = $type] ]
  let $adaptations :=

{$type}

        {
	    for $adapter_func in $funcs
            let $desc := $adapter_func/csd:description
	    let $urn := string($adapter_func/@urn)
	    return

	      Type ({$type})

	      Adapter Document Index (
	      {$urn}
			       )

{$desc}

	}

  let $contents :=
    (
      Adapters
      ,$adaptations
      )
  return page:wrapper($contents)
};

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


fixed the http-client documentation

fixed the http-client documentation

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

(:~
 : This module defines a set of functions to send HTTP and HTTPS requests
 : and handle responses. This is quite a low-level functionality, allowing
 : one to deal with most aspects of the HTTP protocol.
 :
 : @see
 : http://www.expath.org/modules/http-client/
 : @version Candidate 9 January 2010
 : @author Markus Pilman
 :)
module namespace http = "http://expath.org/ns/http-client";

import module namespace httpclientimpl = "http://expath.org/ns/httpclientimpl";
import module namespace err = "http://expath.org/ns/error";

import schema namespace https = "http://expath.org/ns/http-client";

(:~
 : This function sends an HTTP request and returns the corresponding
 : response. It supports HTTP multi-part messages.
 : If the content type of a request is html, http-client will tidy it
 : automatically. If you want to prevent that, you can also set your
 : own by settin the override-media-type attribute in the http:request
 : element.
 : When tidying, it will use the follwong tidy options:
 : - TidyXmlOut=yes
 : - TidyDoctypeMode=TidyDoctypeOmit
 : - TidyQuoteNbsp=yes
 : - TidyCharEncoding="utf8"
 : - TidyNewline="LF"
 : Please also referr to the official documentation at
 : expath.org
 : For further information (especially about the http:request and
 : http:response elements) see also the xml schema and its annotations
 : (located in $zorba_install_dir/modules/org/expath/ns/).
 :
 : @param $request Contains the various parameters of the request. See the
 :  documentation of the type requestType in the schema definition.
 : @param $href is the HTTP or HTTPS URI to send the request to. It is an
 :  xs:anyURI, but is declared as a string to be able to pass literal strings
 :  (without requiring to explicitly cast it to an xs:anyURI.)
 : @param $content is the request body content, for HTTP methods that can
 :  contain a body in the request (POST and PUT.) It is an error, if this
 :  param is not the empty sequence for methods other then DELETE, GET, HEAD
 :  and OPTIONS.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType and describes the response of the http request. If there
 :  is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare function http:send-request(
  $request as element(https:request, https:requestType)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ {
  if (fn:empty($href) and fn:empty($request)) then
    fn:error($err:HCV01,
      "Not all required arguments are set.")
  else if ($href eq "") then
    fn:error($err:HCV01,
      "The href value is set to the empty string")
  else if (not(count($request//body[not(exists(node()))]) eq count($bodies))) then
    fn:error($err:HCV01,
      "The number of bodies without children is not equal the size of the bodies sequence")
  else
    let $result := httpclientimpl:http-send-request-impl(http:set-content-type($request),
                                                         $href,
                                                         $bodies)
    return (validate {$result[1]}, fn:subsequence($result, 2))
};

(:~
 : Function for convenience.
 : @see documentation of send-request with four parameters.
 :
 : @param $request see request parameter of
 :  send-request#3
 : @return see return value of
 :  send-request#3
 :)
declare function http:send-request (
  $request as element(https:request, https:requestType)) as item()+ {
  http:send-request($request,(),())
};

(:~
 : Function for convenience.
 : @see documentation of send-request with four parameters.
 :
 : @param $request see parameter $request of
 :  send-request#3
 : @param href see parameter $href of
 :  send-request#3
 : @return see return of
 :  send-request#3
 :)
declare function http:send-request(
  $request as element(https:request, https:requestType)?,
  $href as xs:string?) as item()+ {
  http:send-request($request,$href,())
};

(:~
 : Helper function.
 :
 : This function takes a https:body element, copies it and
 : adds a method attribute to the copy if there is none
 : in the original element.
 :
 : @param $body is the original https:body element
 : @return a https:body element with a @method attribute
 :)
declare function http:create-body (
  $body as element(https:body, https:bodyType))
    as element(https:body, https:bodyType) {
  validate {
    <https:body>{$body/@*}
    {
      if ($body/@method) then
        ()
      else
        attribute method {
          if ($body/@media-type eq "text/xml" or
              $body/@media-type eq "application/xml" or
              $body/@media-type eq "text/xml-external-parsed-entity" or
              $body/@media-type eq "application/xml-external-parsed-entity") then
                "xml"
           else if ($body/@media-type eq "text/html") then "html"
           else if (fn:starts-with($body/@media-type/data(.), "text/")) then "text"
           else "binary"
        }
    }
    {$body/node()}
    </https:body>
  }
};

(:~
 : Helper function.
 :
 : This function takes a https:multipart element, copies it and
 : adds a @method attribute to all body elements which don't have
 : one.
 :
 : @param $multipart the original https:multipart
 : @return a copy of $multipart with all $multipart/body/@method set
 :)
declare function http:create-multipart (
  $multipart as element(https:multipart, https:multipartType))
    as element(https:multipart, https:multipartType) {
  validate {
    <https:multipart>{$multipart/@*}
    {
    for $x in $multipart/node()
    return
      typeswitch($x)
        case element(https:body, https:bodyType) return http:create-body($x)
        default return $x
    }
    </https:multipart>
  }
};

(:~
 : Helper function.
 :
 : This adds a default method attribute to all body elements which
 : don't contain a method attribute.
 :
 : @param $request The request which need to be copied.
 : @return A copy of $request with all request//body/@method set.
 :)
declare function http:set-content-type(
  $request as element(https:request, https:requestType)?)
    as element(https:request, https:requestType)? {
  if ($request) then
    validate
    {
      <http:request>{$request/@*}
      {
      for $x in $request/node()
      return
        typeswitch($x)
          case element(https:body, https:bodyType) return http:create-body($x)
          case element(https:multipart, https:multipartType) return http:create-multipart($x)
          default return $x
      }
      </http:request>
    }
  else ()
};

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

(:~
 : This module defines a set of functions to send HTTP and HTTPS requests
 : and handle responses. This is quite a low-level functionality, allowing
 : one to deal with most aspects of the HTTP protocol.
 :
 : @see
 : http://www.expath.org/modules/http-client/
 : @version Candidate 9 January 2010
 : @author Markus Pilman
 :)
module namespace http = "http://expath.org/ns/http-client";

import module namespace httpclientimpl = "http://expath.org/ns/httpclientimpl";
import module namespace err = "http://expath.org/ns/error";

import schema namespace https = "http://expath.org/ns/http-client";

(:~
 : This function sends an HTTP request and returns the corresponding
 : response. It supports HTTP multi-part messages.
 :
 : @param $request Contains the various parameters of the request. See the
 :  documentation of the type requestType in the schema definition.
 : @param $href is the HTTP or HTTPS URI to send the request to. It is an
 :  xs:anyURI, but is declared as a string to be able to pass literal strings
 :  (without requiring to explicitly cast it to an xs:anyURI.)
 : @param $content is the request body content, for HTTP methods that can
 :  contain a body in the request (POST and PUT.) It is an error, if this
 :  param is not the empty sequence for methods other then DELETE, GET, HEAD
 :  and OPTIONS.
 : @return a sequence of items, where the first item is a element of type
 :  http:responseType and describes the response of the http request. If there
 :  is one (or several, in case of multipart) response body, the response bodies
 :  are the next items in the sequence.
 :)
declare function http:send-request(
  $request as element(https:request, https:requestType)?,
  $href as xs:string?,
  $bodies as item()*) as item()+ {
  if (fn:empty($href) and fn:empty($request)) then
    fn:error($err:HCV01,
      "Not all required arguments are set.")
  else if ($href eq "") then
    fn:error($err:HCV01,
      "The href value is set to the empty string")
  else if (not(count($request//body[not(exists(node()))]) eq count($bodies))) then
    fn:error($err:HCV01,
      "The number of bodies without children is not equal the size of the bodies sequence")
  else
    let $result := httpclientimpl:http-send-request-impl(http:set-content-type($request),
                                                         $href,
                                                         $bodies)
    return (validate {$result[1]}, fn:subsequence($result, 2))
};

(:~
 : Function for convenience.
 : @see documentation of send-request with four parameters.
 :
 : @see http://www.expath.org/mod/http-client;send-request
 :
 : @param $request @see parameter $request of
 :  http://www.expath.org/mod/http-client;send-request
 : @return @see return of
 :  http://www.expath.org/mod/http-client;send-request
 :)
declare function http:send-request (
  $request as element(https:request, https:requestType)) as item()+ {
  http:send-request($request,(),())
};

(:~
 : Function for convenience.
 : @see documentation of send-request with four parameters.
 :
 : @see http://www.expath.org/mod/http-client;send-request
 :
 : @param $request @see parameter $request of
 :  http://www.expath.org/mod/http-client;send-request
 : @param href @see parameter $href of
 :  http://www.expath.org/mod/http-client;send-request
 : @return @see return of
 :  http://www.expath.org/mod/http-client;send-request
 :)
declare function http:send-request(
  $request as element(https:request, https:requestType)?,
  $href as xs:string?) as item()+ {
  http:send-request($request,$href,())
};

(:~
 : Helper function.
 :
 : This function takes a https:body element, copies it and
 : adds a method attribute to the copy if there is none
 : in the original element.
 :
 : @param $body is the original https:body element
 : @return a https:body element with a @method attribute
 :)
declare function http:create-body (
  $body as element(https:body, https:bodyType))
    as element(https:body, https:bodyType) {
  validate {
    <https:body>{$body/@*}
    {
      if ($body/@method) then
        ()
      else
        attribute method {
          if ($body/@media-type eq "text/xml" or
              $body/@media-type eq "application/xml" or
              $body/@media-type eq "text/xml-external-parsed-entity" or
              $body/@media-type eq "application/xml-external-parsed-entity") then
                "xml"
           else if ($body/@media-type eq "text/html") then "html"
           else if (fn:starts-with($body/@media-type/data(.), "text/")) then "text"
           else "binary"
        }
    }
    {$body/node()}
    </https:body>
  }
};

(:~
 : Helper function.
 :
 : This function takes a https:multipart element, copies it and
 : adds a @method attribute to all body elements which don't have
 : one.
 :
 : @param $multipart the original https:multipart
 : @return a copy of $multipart with all $multipart/body/@method set
 :)
declare function http:create-multipart (
  $multipart as element(https:multipart, https:multipartType))
    as element(https:multipart, https:multipartType) {
  validate {
    <https:multipart>{$multipart/@*}
    {
    for $x in $multipart/node()
    return
      typeswitch($x)
        case element(https:body, https:bodyType) return http:create-body($x)
        default return $x
    }
    </https:multipart>
  }
};

(:~
 : Helper function.
 :
 : This adds a default method attribute to all body elements which
 : don't contain a method attribute.
 :
 : @param $request The request which need to be copied.
 : @return A copy of $request with all request//body/@method set.
 :)
declare function http:set-content-type(
  $request as element(https:request, https:requestType)?)
    as element(https:request, https:requestType)? {
  if ($request) then
    validate
    {
      <http:request>{$request/@*}
      {
      for $x in $request/node()
      return
        typeswitch($x)
          case element(https:body, https:bodyType) return http:create-body($x)
          case element(https:multipart, https:multipartType) return http:create-multipart($x)
          default return $x
      }
      </http:request>
    }
  else ()
};