improved soap request for query updated services exposed

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

import module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd" at "../repo/csd_poll_service_directories.xqm";
import module namespace csd_lsc = "https://github.com/his-interop/openinfoman/csd_lsc" at "../repo/csd_local_services_cache.xqm";
import module namespace request = "http://exquery.org/ns/request";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "../repo/csd_query_updated_services.xqm";
declare variable $page:db := 'provider_directory';
declare
  %rest:path("/CSD/pollService/get/{$name}")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory_soap_response($name,$mtime)
else
 csd_psd:poll_service_directory_soap_response($name,csd_lsc:get_service_directory_mtime($page:db,$name))
};

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

};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{
let $services := csd_psd:get_services()
return

    <link href="http://{request:hostname()}:{request:port()}/static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="http://{request:hostname()}:{request:port()}/static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

    <link rel="stylesheet" type="text/css" media="screen"   href="http://{request:hostname()}:{request:port()}/static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>

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

          </button>
          OpenInfoMan

Service Directories

	    {for $name in $services
	    let $url := csd_psd:get_service_directory_url($name)
	    let $mtime := csd_lsc:get_service_directory_mtime($page:db,$name)
	    order by $name
	    return

	      {$name} last cached on {$mtime}:

 Query  {$name} for Updated Services using stored last modified time

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

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

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

	      To test submission on your machine you can do:

curl --form "fileupload=@soap_query_updated_services_{$name}.xml" {$url}

	      where soap_updated_services_{$name}.xml is  the downloaded soap request document

	    }

};

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

import module namespace csd_psd = "https://github.com/his-interop/openinfoman/csd_psd" at "../repo/csd_poll_service_directories.xqm";
import module namespace csd_lsc = "https://github.com/his-interop/openinfoman/csd_lsc" at "../repo/csd_local_services_cache.xqm";
import module namespace request = "http://exquery.org/ns/request";
import module namespace csd_qus =  "https://github.com/his-interop/openinfoman/csd_qus" at "../repo/csd_query_updated_services.xqm";
declare variable $page:db := 'provider_directory';
declare
  %rest:path("/CSD/pollService/get/{$name}")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service($name,$mtime)
{
if ($mtime) then
 csd_psd:poll_service_directory_soap_response($name,$mtime)
else
 csd_psd:poll_service_directory_soap_response($name,csd_lsc:get_service_directory_mtime($page:db,$name))
};

declare
  %rest:path("/CSD/pollService/get_soap/{$name}")
  %rest:query-param("mtime", "{$mtime}")
  %rest:GET
  function page:poll_service_soap($name,$mtime)
{
 let $url := csd_psd:get_service_directory_url($name)
 return if ($mtime) then
   csd_qus:create_last_update_request($url,$mtime)
 else
  csd_qus:create_last_update_request($url,csd_lsc:get_service_directory_mtime($page:db,$name))
};

declare
  %rest:path("/CSD/pollService")
  %rest:GET
  %output:method("xhtml")
  function page:poll_service_list()
{
let $services := csd_psd:get_services()
return

    <link href="http://{request:hostname()}:{request:port()}/static/bootstrap/css/bootstrap.css" rel="stylesheet"/>
    <link href="http://{request:hostname()}:{request:port()}/static/bootstrap/css/bootstrap-theme.css" rel="stylesheet"/>

    <link rel="stylesheet" type="text/css" media="screen"   href="http://{request:hostname()}:{request:port()}/static/bootstrap-datetimepicker/css/bootstrap-datetimepicker.min.css"/>

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

          </button>
          OpenInfoMan

Service Directories

	    {for $name in $services
	    let $url := csd_psd:get_service_directory_url($name)
	    let $mtime := csd_lsc:get_service_directory_mtime($page:db,$name)
	    order by $name
	    return

	      {$name} last cached on {$mtime}:

 Query  {$name} for Updated Services using stored last modified time

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

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

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

	      To test submission on your machine you can do:

curl --form "fileupload=@soap.xml" {$url}

	      where soap.xml is  the downloaded soap request document

	    }

};


Improvements to user management admin panel:
- select user's group from a list
- add group and select group's manager from a list
- hitting edit/remove buttons without a user selection no longer results in an error; we simply ignore these
Known issues:
- removing a user seems to result in database corruption (node not found), which is very strange, since xmldb:delete-user() alone doesn't seem to cause this error
- we don't have an xmldb function to delete a group, so there is no 'remove user' button.

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

xquery version "1.0";
(: $Id$ :)
(:
    Module: display and edit users.
:)

module namespace users="http://exist-db.org/xquery/admin-interface/users";

declare namespace util="http://exist-db.org/xquery/util";
declare namespace xdb="http://exist-db.org/xquery/xmldb";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace config="http://exist-db.org/Configuration";

declare function users:main() as element() {

User Management

Note: This is work in progress.  Don't use this page to manage
        users in a production environment.  Use the Java admin client instead.

        {
        (: We do not need to check if the current user is an admin user, since admin.xql does this. :)
        (: if (not(xdb:is-admin-user(xdb:get-current-user()))) then

                Only users of the "dba" group can change user settings.

        else :)
            users:process()
        }

};

declare function users:process() as element()* {
    let $action := request:get-parameter("action", "")
    return
        if ($action eq "Create User") then
            users:new-user()
        else if ($action eq "Change User") then
            users:update-user()
        else if ($action eq "Remove User" and exists(request:get-parameter("uid", ()))) then
            users:remove-user()
        else if ($action eq "Create Group") then
            users:new-group()
        else
            users:display()
};

declare variable $users:all-users {
    collection("/db/system/security/exist/accounts")/config:account
};

declare variable $users:current-users {
    $users:all-users[util:collection-name(.) ne '/db/system/security/exist/accounts/removed']
};

declare variable $users:all-groups {
    collection("/db/system/security/exist/groups")/config:group
};

declare variable $users:current-groups {
    $users:all-groups[util:collection-name(.) ne '/db/system/security/exist/groups/removed']
};

declare function users:remove-user() as element()* {
    let $uid := request:get-parameter("uid", ())
    let $name := $users:all-users[@id = $uid]/config:name/text()
    return
        if ($name eq xdb:get-current-user()) then

You cannot remove the current user!

        else if ($name eq 'guest') then

You cannot remove guest!

        else
            (
            xdb:delete-user($name),

User {$name} removed.

            )
        ,
        users:display()
};

declare function users:new-user() as element()* {
    let $name := request:get-parameter("name", ())
    let $grp := string-join(request:get-parameter("groups", ()), ',')
    let $groups :=
        if ($grp) then
            if (contains($grp, ",")) then
                tokenize($grp, "\s*,\s*")
            else
                $grp
         else ()
    let $pass1 := request:get-parameter("pass1", "")
    let $pass2 := request:get-parameter("pass2", "")
    let $home := request:get-parameter("home", ())
    return
        if ($pass1 != $pass2) then
            (

Passwords are not identical.
,
            users:correct-user(-1, $name, $grp, $home)
            )
        else if (empty($groups)) then
            (

Please specify one group at least.
,
            users:correct-user(-1, $name, $grp, $home)
            )
        else
            (
            xdb:create-user($name, $pass1, $groups, $home),
            users:display()
            )
};

declare function users:update-user() as element()* {
    let $name := request:get-parameter("name", ())
    let $grp := string-join(request:get-parameter("groups", ()), ',')
    let $groups :=
        if ($grp) then
            if (contains($grp, ",")) then
                tokenize($grp, "\s*,\s*")
            else
                $grp
        else ()
    let $pass1 := request:get-parameter("pass1", "")
    let $pass2 := request:get-parameter("pass2", "")
    let $nopass := request:get-parameter("nopass", ())
    let $pass := if ($nopass) then () else $pass1
    let $home := request:get-parameter("home", ())
    let $uid := request:get-parameter("uid", "")
    return
        if (not($nopass) and $pass1 ne $pass2) then
            (

Passwords are not identical.
,
            users:correct-user($uid, $name, $grp, $home)
            )
        else if (empty($groups)) then
            (

Please specify one group at least.
,
            users:correct-user($uid, $name, $grp, $home)
            )
        else
            (
            xdb:change-user($name, $pass, $groups, $home),
            if (xdb:get-current-user() eq $name) then
                session:set-attribute("password", $pass)
            else (),
            users:display()
            )
};

declare function users:new-group() as element()* {
    let $group := request:get-parameter("group", ())
    let $manager := request:get-parameter("manager", ())
    return
        if (empty($manager)) then
            (

Please specify a manager.
,
            users:correct-group(-1, $group, $manager)
            )
        else
            (
            xdb:create-group($group, $manager),
            users:display()
            )
};

declare function users:display() as element() {
    let $action := request:get-parameter("action", "")
    return
    <form action="{session:encode-url(request:get-uri())}" method="GET">
        {
        if ($action = ("New User", "Edit User", "New Group")) then ()
        else
            (

                    {$action}

                    Name
                    Groups
                    Home

                {
                for $user in $users:current-users
                let $name := $user/config:name/text()
                let $groups := string-join($user/config:group/@name, ", ") (: alternatively, use xmldb:get-user-groups() :)
                let $home := if ($user/config:home ne "") then $user/config:home/text() else not set
                order by $name
                return

                        <input type="radio" name="uid" value="{$user/@id}"/>
                        {$name}
                        {$groups}
                        {$home}

                }

            ,

                        <input type="submit" name="action" value="Edit User"/>
                        <input type="submit" name="action" value="Remove User"/>
                        <input type="submit" name="action" value="New User"/>

            ,

                    Group
                    Manager

                {
                for $group in $users:current-groups
                let $name := $group/config:name/text()
                let $manager := $group/config:manager/@name/string()
                order by $name
                return

                        {(:{if ($name = ('dba', 'guest')) then () else <input type="radio" name="gid" value="{$group/@id}"/>}:)''}
                        {$name}
                        {if ($name = 'dba') then 'admin' else if ($name = 'guest') then 'guest' else $manager}

                }

            ,

                        <input type="submit" name="action" value="New Group"/>

            )
        ,

        let $uid := request:get-parameter("uid", "")
        let $gid := request:get-parameter("gid", "")
        return
            (
            if ($action eq "Edit User" and (: prevent error if no user selected :) $uid ne "") then
                let $user := $users:all-users[@id = $uid]
                return
                    users:edit-user(xs:integer($uid), xs:string($user/config:name), string-join($user/config:group/@name, ", "), xs:string($user/config:home))
            else if ($action eq "New User") then
                users:edit-user(-1, "", "", ())
            else if ($action eq "New Group") then
                users:edit-group(-1, "", "")
            else if ($action = ("", "Remove User")) then
                ()
            else
                response:redirect-to(xs:anyURI('admin.xql?panel=users'))
            )
        }
        <input type="hidden" name="panel" value="users"/>
    </form>
};

declare function users:correct-user($uid as xs:integer, $name as xs:string, $groups as xs:string, $home as xs:string?) as element() {
    <form action="{session:encode-url(request:get-uri())}" method="GET">
        { users:edit-user($uid, $name, $groups, $home) }
        <input type="hidden" name="panel" value="users"/>
    </form>
};

declare function users:correct-group($uid as xs:integer, $group as xs:string, $manager) as element() {
    <form action="{session:encode-url(request:get-uri())}" method="GET">
        { users:edit-group($uid, $group, $manager) }
        <input type="hidden" name="panel" value="users"/>
    </form>
};

declare function users:edit-user($uid as xs:integer, $name as xs:string, $groups as xs:string, $home as xs:string?) as element() {

            {request:get-parameter('action', '')}

            User:
            {
            if ($name eq "") then
                <input type="text" name="name"/>
            else
                <input type="hidden" name="name" value="{$name}"/>{$name}
            }

            Groups:

{
                for $group in $users:current-groups/config:name
                let $selected := $group = tokenize($groups, '\s?,\s?')
                return

                        <input type="checkbox" name="groups" value="{$group}" id="{$group}"/> {if ($selected) then attribute checked {'checked'} else ()}
                        {$group/text()}

            }

            Warning: Do not modify admin or guest group settings.

            Password:
            <input type="password" name="pass1"/>

            Password (again):
            <input type="password" name="pass2"/>

        {
        if ($uid ge 0) then
            <input type="checkbox" name="nopass"/> Leave password unchanged.
        else ()
        }

            Home Collection:
            <input type="text" name="home" value="{$home}"/>
            Optional: assign a home collection, e.g. /db/home/me.
                The user will be the owner of this collection.
                Note: non-existing collections will be created automatically.

        {
        if ($uid lt 0) then
            <input type="submit" name="action" value="Create User"/>
        else
            <input type="submit" name="action" value="Change User"/>
        }

                <input type="button" value="Cancel" onClick="parent.location='admin.xql?panel=users'"/>
                <input type="hidden" name="uid" value="{$uid}"/>

};

declare function users:edit-group($uid as xs:integer, $group as xs:string, $manager as xs:string?) as element() {

            Group:
            <input type="text" name="group"/>

            Manager:

{
                for $name in $users:current-users/config:name
                let $selected := $name = $manager
                return

                        <input type="radio" name="manager" value="{$name}" id="{$name}"/> {if ($selected) then attribute checked {'checked'} else ()}
                        {$name/text()}

            }

            Every group needs a manager.

            <input type="submit" name="action" value="Create Group"/>

            <input type="button" value="Cancel" onClick="parent.location='admin.xql?panel=users'"/>

};

xquery version "1.0";
(: $Id$ :)
(:
    Module: display and edit users.
:)

module namespace users="http://exist-db.org/xquery/admin-interface/users";

declare namespace util="http://exist-db.org/xquery/util";
declare namespace xdb="http://exist-db.org/xquery/xmldb";
declare namespace request="http://exist-db.org/xquery/request";
declare namespace session="http://exist-db.org/xquery/session";
declare namespace config="http://exist-db.org/Configuration";

declare function users:main() as element() {

User Management

Note: this is work in progress. Don't use this page to manage
        users in a production environment. Use the Java client instead.

        {
        if (not(xdb:is-admin-user(xdb:get-current-user()))) then

                Only users of the "dba" group can change user settings.

        else
            users:process()
        }

};

declare function users:process() as element()* {
    let $action := request:get-parameter("action", "")
    return
        if ($action eq "Create") then
            users:new-user()
        else if ($action eq "Change") then
            users:update-user()
        else if ($action eq "Remove") then
            users:remove-user()
        else
            users:display()
};

declare function users:remove-user() as element()* {
    let $uid := request:get-parameter("uid", ())
    let $name := collection("/db/system/security/exist/accounts")/config:account[util:collection-name(.) ne '/db/system/security/exist/accounts/removed'][@id = $uid]/config:name
    return
        if ($name eq xdb:get-current-user()) then

You cannot remove the current user!

        else
            (
            xdb:delete-user($name),

User {$name} removed.

            )
        ,
        users:display()
};

declare function users:new-user() as element()* {
    let $name := request:get-parameter("name", ())
    let $grp := request:get-parameter("groups", ())
    let $groups :=
        if ($grp) then
            if (contains($grp, ",")) then
                tokenize($grp, "\s*,\s*")
            else
                $grp
         else ()
    let $pass1 := request:get-parameter("pass1", "")
    let $pass2 := request:get-parameter("pass2", "")
    let $home := request:get-parameter("home", ())
    return
        if ($pass1 != $pass2) then
            (

Passwords are not identical.
,
            users:correct-user(-1, $name, $grp, $home)
            )
        else if (empty($groups)) then
            (

Please specify one group at least.
,
            users:correct-user(-1, $name, $grp, $home)
            )
        else
            (
            xdb:create-user($name, $pass1, $groups, $home),
            users:display()
            )
};

declare function users:update-user() as element()* {
    let $name := request:get-parameter("name", ())
    let $grp := request:get-parameter("groups", ())
    let $groups :=
        if ($grp) then
            if (contains($grp, ",")) then
                tokenize($grp, "\s*,\s*")
            else
                $grp
        else ()
    let $pass1 := request:get-parameter("pass1", "")
    let $pass2 := request:get-parameter("pass2", "")
    let $nopass := request:get-parameter("nopass", ())
    let $pass := if ($nopass) then () else $pass1
    let $home := request:get-parameter("home", ())
    let $uid := request:get-parameter("uid", "")
    return
        if (not($nopass) and $pass1 ne $pass2) then
            (

Passwords are not identical.
,
            users:correct-user($uid, $name, $grp, $home)
            )
        else if (empty($groups)) then
            (

Please specify one group at least.
,
            users:correct-user($uid, $name, $grp, $home)
            )
        else
            (
            xdb:change-user($name, $pass, $groups, $home),
            if (xdb:get-current-user() eq $name) then
                session:set-attribute("password", $pass)
            else (),
            users:display()
            )
};

declare function users:display() as element() {
    <form action="{session:encode-url(request:get-uri())}" method="GET">

                Name
                Groups
                Home

            {
            for $user in collection("/db/system/security/exist/accounts")/config:account[util:collection-name(.) ne '/db/system/security/exist/accounts/removed']
            let $name := $user/config:name/text()
            let $groups := string-join($user/config:group/@name, ", ")
            let $home := if ($user/config:home ne "") then $user/config:home/text() else "not set"
            order by $name
            return

                    <input type="radio" name="uid" value="{$user/@id}"/>
                    {$name}
                    {$groups}
                    {$home}

            }

                    <input type="submit" name="action" value="Edit"/>
                    <input type="submit" name="action" value="New User"/>
                    <input type="submit" name="action" value="Remove"/>

        {
        let $action := request:get-parameter("action", "")
        let $uid := request:get-parameter("uid", "")
        return
            if ($action eq "Edit") then
                let $user := collection("/db/system/security/exist/accounts")/config:account[util:collection-name(.) ne '/db/system/security/exist/accounts/removed'][@id = $uid]
                return
                    users:edit-user(xs:integer($uid), xs:string($user/config:name), string-join($user/config:group/@name, ", "), xs:string($user/config:home))
            else if ($action eq "New User") then
                users:edit-user(-1, "", "", ())
            else ()
        }
        <input type="hidden" name="panel" value="users"/>
    </form>
};

declare function users:correct-user($uid as xs:integer, $name as xs:string, $groups as xs:string, $home as xs:string?) as element() {
    <form action="{session:encode-url(request:get-uri())}" method="GET">
        {users:edit-user($uid, $name, $groups, $home)}
        <input type="hidden" name="panel" value="users"/>
    </form>
};

declare function users:edit-user($uid as xs:integer, $name as xs:string, $groups as xs:string, $home as xs:string?) as element() {

            User:
            {
            if ($name eq "") then
                <input type="text" name="name"/>
            else
                <input type="hidden" name="name" value="{$name}"/>{$name}
            }

            Groups:
            <input type="text" name="groups" value="{$groups}"/>
            A comma-separated list of groups.
            Note: non-existing groups will be created automatically.

            Password:
            <input type="password" name="pass1"/>

            Repeat:
            <input type="password" name="pass2"/>

        {
        if ($uid ge 0) then
            <input type="checkbox" name="nopass"/> Leave password unchanged.
        else ()
        }

            Home Collection:
            <input type="text" name="home" value="{$home}"/>
            Optional: assign a home collection, e.g. /db/home/me.
            The user will be the owner of this collection.
            Note: non-existing collections will be created automatically.

        {
        if ($uid lt 0) then
            <input type="submit" name="action" value="Create"/>
        else
            <input type="submit" name="action" value="Change"/>
        }

        <input type="hidden" name="uid" value="{$uid}"/>

};


Service: move target format to status

Service: move target format to status

(: 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/";

(: fall back to default config, if needed :)
declare variable $scf:config := if(doc-available("scf_service_config.xml")) then doc("scf_service_config.xml") else doc("scf_service_config_default.xml");

(: fall back to module template path, if needed :)
declare variable $scf:config_templates_path :=
    let $config_path := $scf:config/settings/setting[@name eq 'templates_path']
    return
        if ($config_path != '')
        then $config_path
        else file:resolve-path(concat($scf:modules_path, 'SRTXML2TTML/templates/'));

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',
        'srt': 'SRT',
        'srtxml': 'SRTXML',
        'ttml': 'TTML'
    };

(: conversion between formats of different groups are not available :)
declare variable $scf:subtitle_format_group :=
    map {
        'stl': 1,
        'stlxml': 1,
        'ebu-tt': 1,
        'ebu-tt-d': 1,
        'ebu-tt-d-basic-de': 1,
        'srt': 2,
        'srtxml': 2,
        'ttml': 2
    };

(: conversion is done (with exceptions) forward/backward along the following paths :)
declare variable $scf:subtitle_format_path_1 := ('stl', 'stlxml', 'ebu-tt', 'ebu-tt-d', 'ebu-tt-d-basic-de');
declare variable $scf:subtitle_format_path_2 := ('srt', 'srtxml', 'ttml');

(: parameters to show in custom conversion case - any parameters required for a specific module are optional here! :)
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', 'markup', 'templateOPT', 'language', '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 = 'markup') then
<input type="checkbox" name="markup" value="1"/> process markup in subtitle lines
 else ()}
        {if($params = 'templateREQ') then
<input type="checkbox" checked="checked" disabled="disabled"/> use template <select name="template" required="required">{scf:template_files() ! <option>{.}</option>}</select> for conversion
 else () (: required :)}
        {if($params = 'templateOPT') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> use template <select name="template" disabled="disabled">{scf:template_files() ! <option>{.}</option>}</select> for conversion
 else () (: optional :)}
        {if($params = 'language') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> use <input type="text" size="10" name="language" value="en" disabled="disabled"/> as general language (override template)
 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'))}
        {scf:form_conversion('srt', 'ttml', ('markup', 'templateREQ', 'language', 'indent'))}
        {scf:form_conversion('ttml', 'srt', ())}

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'))}
        {scf:form_conversion('srt', 'srtxml', ('markup', 'indent'))}
        {scf:form_conversion('srtxml', 'srt', ())}
        {scf:form_conversion('srtxml', 'ttml', ('templateREQ', 'language', 'indent'))}
        {scf:form_conversion('ttml', 'srtxml', ('indent'))}

  };

(: returns an (ordered) list of the existing template files in the template folder :)
declare function scf:template_files() {
    let $path := if($scf:config_templates_path != '') then $scf:config_templates_path else concat($scf:modules_path, 'SRTXML2TTML/templates')
    return
        if (file:exists($path))
        then
            for $file in file:list($path)[matches(lower-case(.), '\.(xml|ttml)$')]
            order by $file
            return $file
        else ()
};

(: returns the aforementioned list :)
declare
  %rest:path("/templates")
  %output:method("json")
  %output:json("format=basic")
  function scf:templates() {
    <j:array xmlns:j="http://www.w3.org/2005/xpath-functions">
      {scf:template_files() ! <j:string>{.}</j:string>}
    </j:array>
};

(: 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 :)

(: generic Python invokation :)
declare function scf:call_python($status as map(*), $script as xs:string, $param_option_mapping as map(*)) as map(*) {
    (: build params sequence with present options - 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, $script)), $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_stl2stlxml($status as map(*)) as map(*) {
    scf:call_python($status, 'STL2STLXML/stl2stlxml.py', map {
        's': 'option_separate_tti',
        'a': 'option_clear_uda',
        'u': 'option_discard_user_data'
    })
};

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

declare function scf:call_srt2srtxml($status as map(*)) as map(*) {
    scf:call_python($status, 'SRT2SRTXML/srt2srtxml.py', map {
        'm': 'option_markup'
    })
};

(: generic XSLT conversion :)
declare function scf:call_xslt($status as map(*), $xslt as xs:string, $param_option_mapping as map(*), $text_output as xs:boolean) 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 := (if ($text_output) then xslt:transform-text#3 else xslt:transform#3)($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'
    }, false())
};

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

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'
    }, false())
};

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{}, false())
};

declare function scf:call_srtxml2ttml($status as map(*)) as map(*) {
    let $template := $status('option_template')
    return
        (: abort, if the required template is not specified :)
        if (empty($template))
        then scf:status_set_error_generic($status, 'The template parameter is required, but not set!')
        else
            (: abort, if the specified template does not exist :)
            if (not($template = scf:template_files()))
            then scf:status_set_error_generic($status, 'The template parameter is set, but the specified template is unavailable!')
            else
                (: make template path absolute :)
                let $status_updated := map:put($status, 'option_template', concat($scf:config_templates_path, $template))
                return
                    scf:call_xslt($status_updated, 'SRTXML2TTML/SRTXML2TTML.xslt', map {
                        'template': 'option_template',
                        'language': 'option_language'
                    }, false())
};

declare function scf:call_ttml2srtxml($status as map(*)) as map(*) {
    scf:call_xslt($status, 'TTML2SRTXML/TTML2SRTXML.xslt', map{}, false())
};

declare function scf:call_srtxml2srt($status as map(*)) as map(*) {
    scf:call_xslt($status, 'SRTXML2SRT/SRTXML2SRT.xslt', map{}, true())
};

(: sets a specified description as status result :)
declare function scf:status_set_error_generic($status as map(*), $description as xs:string) as map(*) {
    map:put($status, 'result',
        <error>
            <steps>
                {$status('steps') ! <step>{$scf:subtitle_format(.)}</step>}
            </steps>

            <description>{$description}</description>
            <value/>
            <module/>
            <line-number/>
            <column-number/>
        </error>
    )
};

(: sets an unsupported option error as status result :)
declare function scf:status_set_error_unsupported_option($status as map(*), $description as xs:string+) as map(*) {
    let $description_merged := concat('This conversion chain does not support the following option(s): ', string-join($description, '; '), '.')
    return scf:status_set_error_generic($status, $description_merged)
};

(: returns whether the status result represents an error :)
declare function scf:is_status_error($status as map(*)) as xs:boolean {
    $status('result') instance of element()
};

(:
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
- option_markup: if present, process markup in subtitle lines
- option_template: if present, set the used TTML template
- option_language: if present, override the template's general language
- 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("markup", "{$markup}")
  %rest:form-param("template", "{$template}")
  %rest:form-param("language", "{$language}")
  %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?,
    $markup as xs:string?,
    $template as xs:string?,
    $language 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',
        'option_markup': 'to process markup in subtitle lines',
        'option_template': 'to use a TTML template',
        'option_language': 'to override the general language of the template'
    }

    let $input_filename := map:keys($input)[1]
    let $input_content_raw := $input($input_filename)
    let $input_content := if ($format_source = ('stl', 'srt')) 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,
        'target': $format_target,
        '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,
        'option_markup': $markup,
        'option_template': $template,
        'option_language': $language,
        'result': $input_content
    }
    let $conversion_status := scf:convert_step($conversion_status_init)
    let $conversion_option_errors := map:keys($conversion_option_error_messages)[exists($conversion_status(.))] ! $conversion_option_error_messages(.)
    let $conversion := if (scf:is_status_error($conversion_status) or empty($conversion_option_errors)) then $conversion_status else scf:status_set_error_unsupported_option($conversion_status, $conversion_option_errors)

    let $rest_response_filename_without_ext := replace($input_filename, '[.]([Ss][Tt][Ll]|[Ss][Rr][Tt]|[Xx][Mm][Ll])$', '')
    let $rest_response_filename := concat($rest_response_filename_without_ext, scf:filename_suffix($format_target))
    let $rest_response_success := not(scf:is_status_error($conversion))

    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='{if ($rest_response_success) then scf:media_type($format_target) else 'application/xml'}'/>
            </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')
    )
  };

declare function scf:media_type($format as xs:string) as xs:string {
    switch($format)
    case ('stl') return 'application/octet-stream'
    case ('srt') return 'text/plain'
    default return 'application/xml'
};

declare function scf:filename_suffix($format as xs:string) as xs:string {
    switch($format)
    case ('stl') return '.stl'
    case ('srt') return '.srt'
    default return concat('_', $format, '.xml')
};

(: execute a single conversion step :)
declare function scf:convert_step($status as map(*)) as map(*) {
    let $current_format := $status('steps')[last()]
    let $next_format := scf:next_format($current_format, $status('target'))
    return
        switch ($next_format)
        (: return, if no conversion needed :)
        case () return $status
        (: return error, if no conversion available :)
        case '' return scf:status_set_error_generic($status, 'There is no conversion available for the desired source/target format combination!')
        (: next step :)
        default return
            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)
                    case "srt→srtxml" return
                        scf:call_srt2srtxml($status)
                    case "srtxml→srt" return
                        scf:call_srtxml2srt($status)
                    case "srtxml→ttml" return
                        scf:call_srtxml2ttml($status)
                    case "ttml→srtxml" return
                        scf:call_ttml2srtxml($status)
                    default return
                        ()
                let $next_status := map:put($next_step_status, 'steps', $next_steps)
                return scf:convert_step($next_status)
            } 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 based on a conversion path, assuming that both formats are different formats, but part of the path :)
declare function scf:next_format_by_path($format_source as xs:string, $format_target as xs:string, $path as xs:string*) as xs:string {
    scf:next_format_by_path($format_source, $format_target, $path, true(), true())
};
declare function scf:next_format_by_path($format_source as xs:string, $format_target as xs:string, $path as xs:string*, $backward as xs:boolean, $forward as xs:boolean) as xs:string {
    let $pos_source := index-of($path, $format_source)
    let $pos_target := index-of($path, $format_target)
    return if($pos_target lt $pos_source)
        then (: move one step backwards, if desired :)
            if($backward) then $path[$pos_source - 1] else ''
        else (: move one step forwards, if desired :)
            if($forward) then $path[$pos_source + 1] else ''
};

(: 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? {
    (: no conversion available, if source/target formats part of different format groups! :)
    if($scf:subtitle_format_group($format_source) ne $scf:subtitle_format_group($format_target))
    then ''
    else
        switch($format_source)
        case $format_target return
            () (: no conversion needed :)
        case 'stl'
        case 'stlxml'
        case 'ebu-tt'
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_1)
        case 'ebu-tt-d'
        case 'ebu-tt-d-basic-de'
            (: no way back here :)
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_1, false(), true())
        case 'srt'
        case 'srtxml'
        case 'ttml'
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_2)
        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/";

(: fall back to default config, if needed :)
declare variable $scf:config := if(doc-available("scf_service_config.xml")) then doc("scf_service_config.xml") else doc("scf_service_config_default.xml");

(: fall back to module template path, if needed :)
declare variable $scf:config_templates_path :=
    let $config_path := $scf:config/settings/setting[@name eq 'templates_path']
    return
        if ($config_path != '')
        then $config_path
        else file:resolve-path(concat($scf:modules_path, 'SRTXML2TTML/templates/'));

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',
        'srt': 'SRT',
        'srtxml': 'SRTXML',
        'ttml': 'TTML'
    };

(: conversion between formats of different groups are not available :)
declare variable $scf:subtitle_format_group :=
    map {
        'stl': 1,
        'stlxml': 1,
        'ebu-tt': 1,
        'ebu-tt-d': 1,
        'ebu-tt-d-basic-de': 1,
        'srt': 2,
        'srtxml': 2,
        'ttml': 2
    };

(: conversion is done (with exceptions) forward/backward along the following paths :)
declare variable $scf:subtitle_format_path_1 := ('stl', 'stlxml', 'ebu-tt', 'ebu-tt-d', 'ebu-tt-d-basic-de');
declare variable $scf:subtitle_format_path_2 := ('srt', 'srtxml', 'ttml');

(: parameters to show in custom conversion case - any parameters required for a specific module are optional here! :)
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', 'markup', 'templateOPT', 'language', '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 = 'markup') then
<input type="checkbox" name="markup" value="1"/> process markup in subtitle lines
 else ()}
        {if($params = 'templateREQ') then
<input type="checkbox" checked="checked" disabled="disabled"/> use template <select name="template" required="required">{scf:template_files() ! <option>{.}</option>}</select> for conversion
 else () (: required :)}
        {if($params = 'templateOPT') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> use template <select name="template" disabled="disabled">{scf:template_files() ! <option>{.}</option>}</select> for conversion
 else () (: optional :)}
        {if($params = 'language') then
<input type="checkbox" onclick="this.nextElementSibling.disabled=!this.checked"/> use <input type="text" size="10" name="language" value="en" disabled="disabled"/> as general language (override template)
 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'))}
        {scf:form_conversion('srt', 'ttml', ('markup', 'templateREQ', 'language', 'indent'))}
        {scf:form_conversion('ttml', 'srt', ())}

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'))}
        {scf:form_conversion('srt', 'srtxml', ('markup', 'indent'))}
        {scf:form_conversion('srtxml', 'srt', ())}
        {scf:form_conversion('srtxml', 'ttml', ('templateREQ', 'language', 'indent'))}
        {scf:form_conversion('ttml', 'srtxml', ('indent'))}

  };

(: returns an (ordered) list of the existing template files in the template folder :)
declare function scf:template_files() {
    let $path := if($scf:config_templates_path != '') then $scf:config_templates_path else concat($scf:modules_path, 'SRTXML2TTML/templates')
    return
        if (file:exists($path))
        then
            for $file in file:list($path)[matches(lower-case(.), '\.(xml|ttml)$')]
            order by $file
            return $file
        else ()
};

(: returns the aforementioned list :)
declare
  %rest:path("/templates")
  %output:method("json")
  %output:json("format=basic")
  function scf:templates() {
    <j:array xmlns:j="http://www.w3.org/2005/xpath-functions">
      {scf:template_files() ! <j:string>{.}</j:string>}
    </j:array>
};

(: 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 :)

(: generic Python invokation :)
declare function scf:call_python($status as map(*), $script as xs:string, $param_option_mapping as map(*)) as map(*) {
    (: build params sequence with present options - 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, $script)), $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_stl2stlxml($status as map(*)) as map(*) {
    scf:call_python($status, 'STL2STLXML/stl2stlxml.py', map {
        's': 'option_separate_tti',
        'a': 'option_clear_uda',
        'u': 'option_discard_user_data'
    })
};

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

declare function scf:call_srt2srtxml($status as map(*)) as map(*) {
    scf:call_python($status, 'SRT2SRTXML/srt2srtxml.py', map {
        'm': 'option_markup'
    })
};

(: generic XSLT conversion :)
declare function scf:call_xslt($status as map(*), $xslt as xs:string, $param_option_mapping as map(*), $text_output as xs:boolean) 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 := (if ($text_output) then xslt:transform-text#3 else xslt:transform#3)($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'
    }, false())
};

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

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'
    }, false())
};

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{}, false())
};

declare function scf:call_srtxml2ttml($status as map(*)) as map(*) {
    let $template := $status('option_template')
    return
        (: abort, if the required template is not specified :)
        if (empty($template))
        then scf:status_set_error_generic($status, 'The template parameter is required, but not set!')
        else
            (: abort, if the specified template does not exist :)
            if (not($template = scf:template_files()))
            then scf:status_set_error_generic($status, 'The template parameter is set, but the specified template is unavailable!')
            else
                (: make template path absolute :)
                let $status_updated := map:put($status, 'option_template', concat($scf:config_templates_path, $template))
                return
                    scf:call_xslt($status_updated, 'SRTXML2TTML/SRTXML2TTML.xslt', map {
                        'template': 'option_template',
                        'language': 'option_language'
                    }, false())
};

declare function scf:call_ttml2srtxml($status as map(*)) as map(*) {
    scf:call_xslt($status, 'TTML2SRTXML/TTML2SRTXML.xslt', map{}, false())
};

declare function scf:call_srtxml2srt($status as map(*)) as map(*) {
    scf:call_xslt($status, 'SRTXML2SRT/SRTXML2SRT.xslt', map{}, true())
};

(: sets a specified description as status result :)
declare function scf:status_set_error_generic($status as map(*), $description as xs:string) as map(*) {
    map:put($status, 'result',
        <error>
            <steps>
                {$status('steps') ! <step>{$scf:subtitle_format(.)}</step>}
            </steps>

            <description>{$description}</description>
            <value/>
            <module/>
            <line-number/>
            <column-number/>
        </error>
    )
};

(: sets an unsupported option error as status result :)
declare function scf:status_set_error_unsupported_option($status as map(*), $description as xs:string+) as map(*) {
    let $description_merged := concat('This conversion chain does not support the following option(s): ', string-join($description, '; '), '.')
    return scf:status_set_error_generic($status, $description_merged)
};

(: returns whether the status result represents an error :)
declare function scf:is_status_error($status as map(*)) as xs:boolean {
    $status('result') instance of element()
};

(:
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
- option_markup: if present, process markup in subtitle lines
- option_template: if present, set the used TTML template
- option_language: if present, override the template's general language
- 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("markup", "{$markup}")
  %rest:form-param("template", "{$template}")
  %rest:form-param("language", "{$language}")
  %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?,
    $markup as xs:string?,
    $template as xs:string?,
    $language 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',
        'option_markup': 'to process markup in subtitle lines',
        'option_template': 'to use a TTML template',
        'option_language': 'to override the general language of the template'
    }

    let $input_filename := map:keys($input)[1]
    let $input_content_raw := $input($input_filename)
    let $input_content := if ($format_source = ('stl', 'srt')) 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,
        'option_markup': $markup,
        'option_template': $template,
        'option_language': $language,
        '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 (scf:is_status_error($conversion_status) or empty($conversion_option_errors)) then $conversion_status else scf:status_set_error_unsupported_option($conversion_status, $conversion_option_errors)

    let $rest_response_filename_without_ext := replace($input_filename, '[.]([Ss][Tt][Ll]|[Ss][Rr][Tt]|[Xx][Mm][Ll])$', '')
    let $rest_response_filename := concat($rest_response_filename_without_ext, scf:filename_suffix($format_target))
    let $rest_response_success := not(scf:is_status_error($conversion))

    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='{if ($rest_response_success) then scf:media_type($format_target) else 'application/xml'}'/>
            </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')
    )
  };

declare function scf:media_type($format as xs:string) as xs:string {
    switch($format)
    case ('stl') return 'application/octet-stream'
    case ('srt') return 'text/plain'
    default return 'application/xml'
};

declare function scf:filename_suffix($format as xs:string) as xs:string {
    switch($format)
    case ('stl') return '.stl'
    case ('srt') return '.srt'
    default return concat('_', $format, '.xml')
};

(: 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
        switch ($next_format)
        (: return, if no conversion needed :)
        case () return $status
        (: return error, if no conversion available :)
        case '' return scf:status_set_error_generic($status, 'There is no conversion available for the desired source/target format combination!')
        (: next step :)
        default return
            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)
                    case "srt→srtxml" return
                        scf:call_srt2srtxml($status)
                    case "srtxml→srt" return
                        scf:call_srtxml2srt($status)
                    case "srtxml→ttml" return
                        scf:call_srtxml2ttml($status)
                    case "ttml→srtxml" return
                        scf:call_ttml2srtxml($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 based on a conversion path, assuming that both formats are different formats, but part of the path :)
declare function scf:next_format_by_path($format_source as xs:string, $format_target as xs:string, $path as xs:string*) as xs:string {
    scf:next_format_by_path($format_source, $format_target, $path, true(), true())
};
declare function scf:next_format_by_path($format_source as xs:string, $format_target as xs:string, $path as xs:string*, $backward as xs:boolean, $forward as xs:boolean) as xs:string {
    let $pos_source := index-of($path, $format_source)
    let $pos_target := index-of($path, $format_target)
    return if($pos_target lt $pos_source)
        then (: move one step backwards, if desired :)
            if($backward) then $path[$pos_source - 1] else ''
        else (: move one step forwards, if desired :)
            if($forward) then $path[$pos_source + 1] else ''
};

(: 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? {
    (: no conversion available, if source/target formats part of different format groups! :)
    if($scf:subtitle_format_group($format_source) ne $scf:subtitle_format_group($format_target))
    then ''
    else
        switch($format_source)
        case $format_target return
            () (: no conversion needed :)
        case 'stl'
        case 'stlxml'
        case 'ebu-tt'
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_1)
        case 'ebu-tt-d'
        case 'ebu-tt-d-basic-de'
            (: no way back here :)
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_1, false(), true())
        case 'srt'
        case 'srtxml'
        case 'ttml'
            return scf:next_format_by_path($format_source, $format_target, $scf:subtitle_format_path_2)
        default return
            ''
};


Small syntax error in admin.xql, which was not reported before but is now detected.

svn path=/trunk/eXist-1.0/; revision=2460

xquery version "1.0";

(:
    Main module of the database administration interface.
:)
declare namespace admin="http://exist-db.org/xquery/admin-interface";
declare namespace xdb="http://exist-db.org/xquery/xmldb";

import module namespace status="http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse="http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users="http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace shut="http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup="http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";

(:
    Display the version and user info in the top right corner
:)
declare function admin:info-header($user as xs:string) as element() {

Version: {util:system-property("product-version")}

Build: {util:system-property("product-build")}

User: { $user}

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel($user as xs:string, $pass as xs:string?) as element() {
    let $panel := request:request-parameter("panel", "status")
    return
        if($panel eq "browse") then
            browse:main($user, $pass)
        else if($panel eq "users") then
            users:main($user, $pass)
        else if($panel eq "shutdown") then
            shut:main($user, $pass)
        else if($panel eq "setup") then
            setup:main()
        else
            status:main()
};

(:
    Main function: display login form if no credentials have been supplied
    or logout is selected.

    $credentials is either an empty sequence or a pair (user, password).
:)
declare function admin:main($credentials as xs:string*) as element()+ {
    if(empty($credentials)) then
        admin:display-login-form()
    else
        admin:panel($credentials[1], $credentials[2])
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element() {

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. For testing purposes, you may also log in as
        "guest" with password "guest".

        <form action="{request:encode-url(request:request-uri())}">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(:~  Try to authenticate the user name and password from
    the current HTTP session. Returns a pair of (user, password)
    on success, an empty sequence otherwise.
:)
declare function admin:checkUser() as xs:string* {
    let $user := request:get-session-attribute("user") ,
        $pass := request:get-session-attribute("password"),
        $login := xdb:authenticate("xmldb:exist:///db", $user, $pass)
    return
        if($login) then
            ($user, $pass)
        else
            ()
};

(:~
    Process user and password passed from the login form.
    Returns a pair of (user, password) if the credentials are
    valid, an empty sequence if not.
:)
declare function admin:doLogin($user as xs:string) as xs:string* {
    let $pass := request:request-parameter("pass", ""),
        $login := request:set-current-user($user, $pass)
    return
        if($login) then
            ($user, $pass)
        else
            ()
};

(:~
    Authenticate the user
:)
declare function admin:login() as xs:string* {
    let $userParam := request:request-parameter("user", ())
    return
        if($userParam) then
            admin:doLogin($userParam)
        else
            admin:checkUser()
};

request:create-session(),
let $logout := request:request-parameter("logout", ()),
    $s := if($logout) then request:invalidate-session() else request:create-session(),
    $credentials := admin:login(),
    $user := if(exists($credentials)) then $credentials[1] else "not logged in"
return

        <title>eXist Database Administration</title>
        <link type="text/css" href="admin.css" rel="stylesheet"/>

            {admin:info-header($user)}

Select a Page

Home

System Status

Browse Collections

Manage Users

Examples Setup

Shutdown

Logout

                    Logged in as: {$user}

            {admin:main($credentials)}

xquery version "1.0";

(:
    Main module of the database administration interface.
:)
declare namespace admin="http://exist-db.org/xquery/admin-interface";
declare namespace xdb="http://exist-db.org/xquery/xmldb";

import module namespace status="http://exist-db.org/xquery/admin-interface/status" at "status.xqm";
import module namespace browse="http://exist-db.org/xquery/admin-interface/browse" at "browse.xqm";
import module namespace users="http://exist-db.org/xquery/admin-interface/users" at "users.xqm";
import module namespace shut="http://exist-db.org/xquery/admin-interface/shutdown" at "shutdown.xqm";
import module namespace setup="http://exist-db.org/xquery/admin-interface/setup" at "setup.xqm";

(:
    Display the version and user info in the top right corner
:)
declare function admin:info-header($user as xs:string) as element() {

Version: {util:system-property("product-version")}

Build: {util:system-property("product-build")}

User: { $user}

};

(:
    Select the page to show. Every page is defined in its own module
:)
declare function admin:panel($user as xs:string, $pass as xs:string?) as element() {
    let $panel := request:request-parameter("panel", "status")
    return
        if($panel eq "browse") then
            browse:main($user, $pass)
        else if($panel eq "users") then
            users:main($user, $pass)
        else if($panel eq "shutdown") then
            shut:main($user, $pass)
        else if($panel eq "setup") then
            setup:main()
        else
            status:main()
};

(:
    Main function: display login form if no credentials have been supplied
    or logout is selected.

    $credentials is either an empty sequence or a pair (user, password).
:)
declare function admin:main($credentials as xs:string*) as element()+ {
    if(empty($credentials)) then
        admin:display-login-form()
    else
        admin:panel($credentials[1], $credentials[2])
};

(:~
    Display the login form.
:)
declare function admin:display-login-form() as element() {

Login

This is a protected resource. Only registered database users can log
        in. If you have not set up any users, login as "admin" and leave the
        password field empty. For testing purposes, you may also log in as
        "guest" with password "guest".

        <form action="{request:encode-url(request:request-uri())}">

                    Please Login

                    Username:
                    <input name="user" type="text" size="20"/>

                    Password:
                    <input name="pass" type="password" size="20"/>

                    <input type="submit"/>

        </form>

};

(:~  Try to authenticate the user name and password from
    the current HTTP session. Returns a pair of (user, password)
    on success, an empty sequence otherwise.
:)
declare function admin:checkUser() as xs:string* {
    let $user := request:get-session-attribute("user") ,
        $pass := request:get-session-attribute("password"),
        $login := xdb:authenticate("xmldb:exist:///db", $user, $pass)
    return
        if($login) then
            ($user, $pass)
        else
            ()
};

(:~
    Process user and password passed from the login form.
    Returns a pair of (user, password) if the credentials are
    valid, an empty sequence if not.
:)
declare function admin:doLogin($user as xs:string) as xs:string* {
    let $pass := request:request-parameter("pass", ""),
        $login := request:set-current-user($user, $pass)
    return
        if($login) then
            ($user, $pass)
        else
            ()
};

(:~
    Authenticate the user
:)
declare function admin:login() as xs:string* {
    let $userParam := request:request-parameter("user", ())
    return
        if($userParam) then
            admin:doLogin($userParam)
        else
            admin:checkUser()
};

request:create-session,
let $logout := request:request-parameter("logout", ()),
    $s := if($logout) then request:invalidate-session() else request:create-session(),
    $credentials := admin:login(),
    $user := if(exists($credentials)) then $credentials[1] else "not logged in"
return

        <title>eXist Database Administration</title>
        <link type="text/css" href="admin.css" rel="stylesheet"/>

            {admin:info-header($user)}

Select a Page

Home

System Status

Browse Collections

Manage Users

Examples Setup

Shutdown

Logout

                    Logged in as: {$user}

            {admin:main($credentials)}