1. Added yet more documentation. 2. Added %ann:streamable.

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

xquery version "3.0";

 (:~
  : Using this module, you can parse JSON data into XML, manipulate it like any
  : other XML data using XQuery, and serialize the result back as JSON.
  :
  : There are many ways to represent JSON data in XML, some loss-less ("round
  : tripable") and some lossy ("one way").  Loss-less representations preserve
  : the JSON data types boolean, number, and null; lossy
  : representations convert all data to strings.
  :
  : For a loss-less representation, Zorba implements that proposed by
  : John Snelson.
  : For example:
  :

  :   <json type="object">
  :     <pair name="firstName" type="string">John</pair>
  :     <pair name="lastName" type="string">Smith</pair>
  :     <pair name="address" type="object">
  :       <pair name="streetAddress" type="string">21 2nd Street</pair>
  :       <pair name="city" type="string">New York</pair>
  :       <pair name="state" type="string">NY</pair>
  :       <pair name="postalCode" type="number">10021</pair>
  :     </pair>
  :     <pair name="phoneNumbers" type="array">
  :       <item type="string">212 732-1234</item>
  :       <item type="string">646 123-4567</item>
  :     </pair>
  :   </json>
  :

  : For a lossy representation, Zorba implements
  : JsonML (the array form).
  : For example:
  :

  :   <person created="2006-11-11T19:23" modified="2006-12-31T23:59">
  :     <firstName>Robert</firstName>
  :     <lastName>Smith</lastName>
  :     <address type="home">
  :       <street>12345 Sixth Ave</street>
  :       <city>Anytown</city>
  :       <state>CA</state>
  :       <postalCode>98765-4321</postalCode>
  :     </address>
  :   </person>
  :

  :)

module namespace json = "http://www.zorba-xquery.com/modules/converters/json";

import module namespace schema = "http://www.zorba-xquery.com/modules/schema";

import schema namespace json-options =
  "http://www.zorba-xquery.com/modules/converters/json-options";

declare namespace ann = "http://www.zorba-xquery.com/annotations";
declare namespace err = "http://www.w3.org/2005/xqt-errors";
declare namespace zerr = "http://www.zorba-xquery.com/errors";

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

(:~
 : Parses JSON data from a string and returns an XDM instance using one of the
 : representations described above.
 :
 : @param $json The JSON data to parse.
 : @param $options The parsing options.
 : @return said XDM instance.
 : @error err:XQDY0027 if $options can not be validated against the
 : json-options schema.
 : @error zerr:ZJPE0001 if $json contains an illegal JSON character.
 : @error zerr:ZJPE0002 if $json contains an illegal Unicode code-point.
 : @error zerr:ZJPE0003 if $json contains an illegal JSON character escape.
 : @error zerr:ZJPE0004 if $json contains an illegal JSON literal.
 : @error zerr:ZJPE0005 if $json contains an illegal JSON number.
 : @error zerr:ZJPE0007 if $json contains an unterminated string.
 : @error zerr:ZJPE0008 if $json contains an illegal QName.
 :)
declare function json:parse(
  $json as xs:string?,
  $options as element(json-options:options)
) as element(*,xs:untyped)*
{
  let $validated-options := if ( schema:is-validated( $options ) ) then
                              $options
                            else
                              validate { $options }
  return json:parse-internal( $json, $validated-options )
};

(:~
 : Parses JSON data from a string and returns an XDM instance using the Snelson
 : representation described above.
 :
 : @param $json The JSON data to parse.
 : @return said XDM instance.
 : @error zerr:ZJPE0001 if $json contains an illegal JSON character.
 : @error zerr:ZJPE0002 if $json contains an illegal Unicode code-point.
 : @error zerr:ZJPE0003 if $json contains an illegal JSON character escape.
 : @error zerr:ZJPE0004 if $json contains an illegal JSON literal.
 : @error zerr:ZJPE0005 if $json contains an illegal JSON number.
 : @error zerr:ZJPE0007 if $json contains an unterminated string.
 : @error zerr:ZJPE0008 if $json contains an illegal QName.
 :)
declare function json:parse(
  $json as xs:string?
) as element(*,xs:untyped)*
{
  json:parse-internal(
    $json,
    validate {
      <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options" >
        <json-format value="Snelson"/>
      </options>
    }
  )
};

(:~
 : Serializes an XDM into JSON using one of the representations described
 : above.
 :
 : @param $xml The XDM to serialize.
 : @param $options The serializing options.
 : @return a JSON string.
 : @error err:XQDY0027 if $options can not be validated against the
 : json-options schema.
 : @error zerr:ZJSE0001 if $xml is not a document or element node.
 : @error zerr:ZJSE0002 if $xml contains an element that is missing a required
 : attribute.
 : @error zerr:ZJSE0003 if $xml contains an attribute having an illegal value.
 : @error zerr:ZJSE0004 if $xml contains an illegal element.
 : @error zerr:ZJSE0005 if $xml contains an illegal child element for a JSON
 : type.
 : @error zerr:ZJSE0006 if $xml contains an illegal child element.
 : @error zerr:ZJSE0007 if $xml contains an illegal text node.
 : @error zerr:ZJSE0008 if $xml contains an illegal value for a JSON type.
 :)
declare function json:serialize(
  $xml as item()*,
  $options as element(json-options:options)
) as xs:string
{
  let $validated-options := if ( schema:is-validated( $options ) ) then
                              $options
                            else
                              validate { $options }
  return json:serialize-internal( $xml, $validated-options )
};

(:~
 : Serializes an XDM into JSON using one of the representations described
 : above.
 :
 : @param $xml The XDM to serialize.
 : @return a JSON string.
 : @error zerr:ZJSE0001 if $xml is not a document or element node.
 : @error zerr:ZJSE0002 if $xml contains an element that is missing a required
 : attribute.
 : @error zerr:ZJSE0003 if $xml contains an attribute having an illegal value.
 : @error zerr:ZJSE0004 if $xml contains an illegal element.
 : @error zerr:ZJSE0005 if $xml contains an illegal child element for a JSON
 : type.
 : @error zerr:ZJSE0006 if $xml contains an illegal child element.
 : @error zerr:ZJSE0007 if $xml contains an illegal text node.
 : @error zerr:ZJSE0008 if $xml contains an illegal value for a JSON type.
 :)
declare function json:serialize(
  $xml as item()*
) as xs:string
{
  json:serialize-internal($xml,
    validate {
      <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options" >
        <json-format value="Snelson"/>
      </options>
   }
 )
};

(:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::)

declare %private function json:parse-internal(
  $json as xs:string,
  $options as item()?
) as element()* external;

declare %ann:streamable %private function json:serialize-internal(
  $xml as item()*,
  $options as item()?
) as xs:string external;

(: vim:set et sw=2 ts=2: :)

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

xquery version "3.0";

 (:~
  : Using this module, you can parse JSON data into XML, manipulate it like any
  : other XML data using XQuery, and serialize the result back as JSON.
  :
  : There are many ways to represent JSON data in XML, some loss-less ("round
  : tripable") and some lossy ("one way").  Loss-less representations preserve
  : the JSON data types boolean, number, and null; lossy
  : representations convert all data to strings.
  :
  : For a loss-less representation, Zorba implements that proposed by
  : John Snelson;
  : for a lossy representation, Zorba implements
  : JsonML (the array form).
  :)

module namespace json = "http://www.zorba-xquery.com/modules/converters/json";

import module namespace schema = "http://www.zorba-xquery.com/modules/schema";

import schema namespace json-options =
  "http://www.zorba-xquery.com/modules/converters/json-options";

declare namespace err = "http://www.w3.org/2005/xqt-errors";

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

(:~
 : Parses JSON data from a string and returns an XDM instance using one of the
 : representations described above.
 :
 : @param $json The JSON data to parse.
 : @param $options The parsing options.
 : @return said XDM instance.
 : @error err:XQDY0027 if $options can not be validated against the
 : json-options schema.
 : @error ZJPE0001 if $json contains an illegal JSON character.
 : @error ZJPE0002 if $json contains an illegal Unicode code-point.
 : @error ZJPE0003 if $json contains an illegal JSON character escape.
 : @error ZJPE0004 if $json contains an illegal JSON literal.
 : @error ZJPE0005 if $json contains an illegal JSON number.
 : @error ZJPE0007 if $json contains an unterminated string.
 : @error ZJPE0008 if $json contains an illegal QName.
 :)
declare function json:parse(
  $json as xs:string?,
  $options as element(json-options:options)
) as element(*,xs:untyped)*
{
  let $validated-options := if ( schema:is-validated( $options ) ) then
                              $options
                            else
                              validate { $options }
  return json:parse-internal( $json, $validated-options )
};

(:~
 : Parses JSON data from a string and returns an XDM instance using the Snelson
 : representation described above.
 :
 : @param $json The JSON data to parse.
 : @return said XDM instance.
 : @error ZJPE0001 if $json contains an illegal JSON character.
 : @error ZJPE0002 if $json contains an illegal Unicode code-point.
 : @error ZJPE0003 if $json contains an illegal JSON character escape.
 : @error ZJPE0004 if $json contains an illegal JSON literal.
 : @error ZJPE0005 if $json contains an illegal JSON number.
 : @error ZJPE0007 if $json contains an unterminated string.
 : @error ZJPE0008 if $json contains an illegal QName.
 :)
declare function json:parse(
  $json as xs:string?
) as element(*,xs:untyped)*
{
  json:parse-internal(
    $json,
    validate {
      <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options" >
        <json-format value="Snelson"/>
      </options>
    }
  )
};

(:~
 : Serializes an XDM into JSON using one of the representations described
 : above.
 :
 : @param $xml The XDM to serialize.
 : @param $options The serializing options.
 : @return a JSON string.
 : @error err:XQDY0027 if $options can not be validated against the
 : json-options schema.
 : @error ZJSE0001 if $xml is not a document or element node.
 : @error ZJSE0002 if $xml contains an element that is missing a required
 : attribute.
 : @error ZJSE0003 if $xml contains an attribute having an illegal value.
 : @error ZJSE0004 if $xml contains an illegal element.
 : @error ZJSE0005 if $xml contains an illegal child element for a JSON type.
 : @error ZJSE0006 if $xml contains an illegal child element.
 : @error ZJSE0007 if $xml contains an illegal text node.
 : @error ZJSE0008 if $xml contains an illegal value for a JSON type.
 :)
declare function json:serialize(
  $xml as item()*,
  $options as element(json-options:options)
) as xs:string
{
  let $validated-options := if ( schema:is-validated( $options ) ) then
                              $options
                            else
                              validate { $options }
  return json:serialize-internal( $xml, $validated-options )
};

(:~
 : Serializes an XDM into JSON using one of the representations described
 : above.
 :
 : @param $xml The XDM to serialize.
 : @return a JSON string.
 : @error ZJSE0001 if $xml is not a document or element node.
 : @error ZJSE0002 if $xml contains an element that is missing a required
 : attribute.
 : @error ZJSE0003 if $xml contains an attribute having an illegal value.
 : @error ZJSE0004 if $xml contains an illegal element.
 : @error ZJSE0005 if $xml contains an illegal child element for a JSON type.
 : @error ZJSE0006 if $xml contains an illegal child element.
 : @error ZJSE0007 if $xml contains an illegal text node.
 : @error ZJSE0008 if $xml contains an illegal value for a JSON type.
 :)
declare function json:serialize(
  $xml as item()*
) as xs:string
{
  json:serialize-internal($xml,
    validate {
      <options xmlns="http://www.zorba-xquery.com/modules/converters/json-options" >
        <json-format value="Snelson"/>
      </options>
   }
 )
};

(:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::)

declare %private function json:parse-internal(
  $json as xs:string,
  $options as item()?
) as element()* external;

declare %private function json:serialize-internal(
  $xml as item()*,
  $options as item()?
) as xs:string external;

(: vim:set et sw=2 ts=2: :)


(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq'
 (:Removing conversion labels from search strings, since these are of a different nature, and need different methods to identify, being
 verbs and verbal phrases. (Voyant does not seem to handle phrases containing wildcards.):)
(:,
'Convert-to-Islam':)
)

let $search-strings := (
'حنف*|زيدي*|السنّي*|أنصاري*|خارجي*|صحابي*|إمامي*|مالكي*|شافع*|معتزل*|صوفي*|حنبل*|مرجئ*|أشعر*|علوي*|شيع*|رافض*',
'مسيح*|نسطور*|نصران*|نصارى*|راهب*|سرياني*'
,'يهود*|إسرائيلي*'
,'مجوس*'
,'صابئ*'
,'زنديق*'
 (:Removing conversion labels.:)
(:,
'اسلم*|*عتنق* الإسلام':)
)

let $prefixes := ('ب','ل','ك','ف','و')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $require-existing-shadda := 1
(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
let $require-existing-vowels := 0
(: If turned on will add a search term with the definite article prefixed to the word. :)
let $add-optional-article := 1
(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
let $add-optional-prefixes := 1

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $add-article :=
    if ($add-optional-article) then
     (: Duplicates each segment of the search string, adding the article on the front of one.
     Then removes any back-to-back | characters created in the process. :)
        replace(
            replace($remove-final-vowel,'(.*?[\|$])','$1|الْ?$1'),
            '\|\|',
            '|')
    else $remove-final-vowel

let $add-prefixes :=
    if ($add-optional-prefixes) then
        let $prefixes-to-add := concat(string-join($prefixes,'?[ً-ِْ-ٖ]?'),'?[ً-ِْ-ٖ]?')
        (: Breaks string into segments by | character and adds prefix query to each string, then rejoins them. :)
        let $prefixes-added := concat($prefixes-to-add,string-join(tokenize($add-article,'\|'),concat('|',$prefixes-to-add)))
        (: Accounts for elided ا when preposition ل is added producing لل instead of لال.
        Duplicates the form with the article (if present) and creates an additional form with لل in place
        of the article. :)
        return replace(
            replace(
                $prefixes-added,
                concat('((',$prefixes-to-add,')(الْ\?)(.*?[\|$]))'),
                '$1|لِ?لْ?$4'),
            '\|\|',
            '|')
    else $add-article

let $normalize-alif := replace($add-prefixes,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')

(: Creates search strings for macro-affiliations to use in Voyant Tools :)

(: The labels to append to each item in $search-strings :)
let $search-labels := (
'Muslim',
'Christian',
'Jewish',
'Zoroastrian',
'Sabian',
'Zindiq',
'Convert-to-Islam')

let $search-strings := (
'حنف*|زيدي*|السنّي*|أنصاري*|خارجي*|صحابي*|إمامي*|مالكي*|شافع*|معتزل*|صوفي*|حنبل*|مرجئ*|أشعر*|علوي*|شيع*|رافض*',
'مسيح*|نسطور*|نصران*|نصارى*|راهب*|سرياني*'
,'يهود*|إسرائيلي*'
,'مجوس*'
,'صابئ*'
,'زنديق*',
'اسلم*|*عتنق* الإسلام')

let $prefixes := ('ب','ل','ك','ف','و')

(: If turned on will only search for variants that include any shaddas in above strings. :)
let $require-existing-shadda := 1
(: If turned on will not allow any vowels provided in $search-strings to be absent. If off, will match any specified vowels as well as unvocalized versions, but not alternate vowels. :)
let $require-existing-vowels := 0
(: If turned on will add a search term with the definite article prefixed to the word. :)
let $add-optional-article := 1
(: If turned on will add attached prepositions and conjunctions as optional search strings. :)
let $add-optional-prefixes := 1

for $string at $i in $search-strings
let $existing-vowels :=
    if ($require-existing-vowels) then
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?([ً-ِْ-ٖ])ّ\?)|(ّ\?([ً-ِْ-ٖ])ّ\?ّ)','(ّ$2$4)|($2$4ّ)') (: optional shadda before / after required vowel, but keeps existing shaddas by replacing optional shaddas with required :)
        else
            replace(replace($string, '([ً-ِْ-ٖ])','ّ?$1ّ?'),'(ّّ\?)|(ّ\?ّ)','ّ?') (: optional shadda before / after required vowel, ignoring existing shaddas by removing duplicate shaddas :)
    else
        if ($require-existing-shadda) then
            replace(replace($string, '([ً-ِْ-ٖ])','$1?'),'(ّ([ً-ِْ-ٖ]\?))|(([ً-ِْ-ٖ]\?)ّ)','($2$4ّ)|(ّ$2$4)') (: optional existing vowel + required shadda on either side :)
        else
            replace(replace($string, '([ً-ٖ])','[ّ$1]*'),'ّ?(\[ّ[ً-ٖ]\]\*)ّ?','$1') (: optional existing vowel + optional shadda, in any order, replacing existing shaddas :)

let $add-vowels :=
    if ($require-existing-shadda) then
        replace(
            replace(
                replace(
                    $existing-vowels,
                    '([ء-ي])(ّ?)',
                    '$1$2[ً-ِْ-ٖ]*') (: Adds vowel wildcard after all consonants :)
                ,'\[ً-ِْ-ٖ\]\*([ً-ِْ-ٖ])'
                ,'$1'), (: Then removes wildcard if it is next to an existing vowel. :)
            '([ء-ي])\[ً-ِْ-ٖ\]\*',
            '$1[ً-ٖ]*') (: If there is no shadda normalizes to shadda-agnostic. :)
    else
        replace(
            replace(
                $existing-vowels,
                '([ء-ي])',
                '$1[ً-ٖ]*') (: Adds vowel wildcard after all consonants :)
            ,'\[ً-ٖ\]\*([\(ّ])'
            ,'$1') (: Then removes wildcard if it is next to an existing vowel-shadda combo. :)

let $remove-final-vowel := (: Removes final vowel because it confuses Voyant Tools. :)
    replace(
        replace($add-vowels,
        '\[ً-ٖ\]\*(\*?)($|\|)',
        '$1$2'),
    '\[ً-ِْ-ٖ\]\*(\*?)($|\|)',
    '$1$2')

let $add-article :=
    if ($add-optional-article) then
     (: Duplicates each segment of the search string, adding the article on the front of one.
     Then removes any back-to-back | characters created in the process. :)
        replace(
            replace($remove-final-vowel,'(.*?[\|$])','$1|الْ?$1'),
            '\|\|',
            '|')
    else $remove-final-vowel

let $add-prefixes :=
    if ($add-optional-prefixes) then
        let $prefixes-to-add := concat(string-join($prefixes,'?[ً-ِْ-ٖ]?'),'?[ً-ِْ-ٖ]?')
        (: Breaks string into segments by | character and adds prefix query to each string, then rejoins them. :)
        let $prefixes-added := concat($prefixes-to-add,string-join(tokenize($add-article,'\|'),concat('|',$prefixes-to-add)))
        (: Accounts for elided ا when preposition ل is added producing لل instead of لال.
        Duplicates the form with the article (if present) and creates an additional form with لل in place
        of the article. :)
        return replace(
            replace(
                $prefixes-added,
                concat('((',$prefixes-to-add,')(الْ\?)(.*?[\|$]))'),
                '$1|لِ?لْ?$4'),
            '\|\|',
            '|')
    else $add-article

let $normalize-alif := replace($add-prefixes,'ا','[آاإأ]')
let $normalize-ya := replace($normalize-alif,'ى','[يىئ]')
let $normalize-waw := replace($normalize-ya,'و','[وؤ]')

return (concat($search-labels[$i],': '),$normalize-waw,'
')


Ensure collection names are valid

Ensure collection names are valid

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

xquery version "1.0";

import module namespace security="http://exist-db.org/mods/security" at "security.xqm";
import module namespace sharing="http://exist-db.org/mods/sharing" at "sharing.xqm";

declare namespace op="http://exist-db.org/xquery/biblio/operations";

declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare namespace mods="http://www.loc.gov/mods/v3";

declare variable $rwx------ := 448;
declare variable $rwxrwx--- := 504;
declare variable $rwxrwxrwx := 511;

(:~
: Creates a collection inside a parent collection
:
: The new collection inherits the owner, group and permissions of the parent
:
: @param $parent the parent collection container
: @param $name the name for the new collection
:)
declare function op:create-collection($parent as xs:string, $name as xs:string) as element(status) {
    let $collection := xmldb:create-collection($parent, fn:lower-case(fn:replace($name, " ", ""))),

    (: by default newly created collections inherit the permissions of their parent :)
    $parent-group := xmldb:get-group($parent),
    $parent-owner := xmldb:get-owner($parent),
    $parent-permissions := xmldb:get-permissions($parent),
    $null := xmldb:set-collection-permissions($collection, $parent-owner, $parent-group, $parent-permissions) return
        <status id="created">{$collection}</status>
};

declare function op:move-collection($parent as xs:string, $path as xs:string) as element(status) {
    let $null := xmldb:move($parent, $path) return
        <status id="moved" from="{$parent}">{$path}</status>
};

declare function op:remove-collection($collection as xs:string) as element(status) {
    let $null := xmldb:remove($collection) return
        <status id="removed">{$collection}</status>
};

declare function op:update-collection-sharing($collection as xs:string, $sharing-collection-with as xs:string*, $group-list as xs:string?, $group-member as xs:string*, $group-sharing-permissions as xs:string*, $other-sharing-permissions as xs:string*) as element(status) {

    (: other :)
    let $share-with-other-outcome := if($sharing-collection-with = "other")then
    (
        sharing:share-with-other($collection, ($other-sharing-permissions = "read"), ($other-sharing-permissions = "write"))
    )
    else
    (
        (: dont share with other :)
        sharing:share-with-other($collection, false(), false())
    ),

    (: group :)
    $share-with-group-outcome := if($sharing-collection-with = "group")then
    (
        (: does the group exist? :)
        let $group-id := if(sharing:group-exists($group-list))then
        (
            let $null := util:log("debug", "********* GROUP ALREADY EXISTS ***********") return

            (: yes, are we the owner? :)
            if(sharing:is-group-owner($group-list, security:get-user-credential-from-session()[1]))then
            (
                (: yes, so update the group members :)

                (: TODO update the group members :)

                $group-list
            )
            else
            (
                (: no, so we cant modify the group members :)
                $group-list
            )
        )
        else
        (
            let $null := util:log("debug", "********* CREATE GROUP CALLED ***********") return

            (: no, so create it! :)
            sharing:create-group($group-list, security:get-user-credential-from-session()[1], $group-member)
        )
        return
            (: change the collection permissions to that of the group and appropriate read/write :)
            sharing:share-with-group($collection, $group-id, ($group-sharing-permissions = "read"), ($group-sharing-permissions = "write"))
    )
    else
    (
        (: dont share with group :)
        sharing:share-with-group($collection, false(), false())
    )
    return
        if($share-with-other-outcome and $share-with-group-outcome)then
            <status id="sharing">done</status>
        else
            <status id="sharing">invalid permissions</status>
};

declare function op:get-collection-sharing($collection as xs:string) as element(collection)
{
    <collection uri="{$collection}">
    {
        let $group-id := sharing:get-group-id($collection) return
            if($group-id)then
            (
                <group id="{$group-id}">
                {
                    if(sharing:group-readable($collection, $group-id))then(<read/>)else(),
                    if(sharing:group-writeable($collection, $group-id))then(<write/>)else()
                }
                </group>
            )else(),

        let $other-readable := sharing:other-readable($collection),
        $other-writeable := sharing:other-writeable($collection) return
        if($other-readable or $other-writeable)then
        (
            <other>
            {
                if($other-readable)then(<read/>)else(),
                if($other-writeable)then(<write/>)else()
            }
            </other>
        )else()
    }
    </collection>
};

(:~
:
: @ resource-id has the format db-document-path#node-id e.g. /db/mods/eXist/exist-articles.xml#1.36
:)
declare function op:remove-resource($resource-id as xs:string) as element(status) {

    let $path := substring-before($resource-id, "#"),
    $id := substring-after($resource-id, "#") return

        update delete util:node-by-id(doc($path), $id),

    <status id="removed">{$resource-id}</status>
};

(:~
:
: @ resource-id has the format db-document-path#node-id e.g. /db/mods/eXist/exist-articles.xml#1.36
:)
declare function op:move-resource($resource-id as xs:string, $destination-collection as xs:string) as element(status) {

    let $path := substring-before($resource-id, "#"),
    $id := substring-after($resource-id, "#"),
    $resource := util:node-by-id(doc($path), $id),
    $destination-resource-name := replace($path, ".*/", ""),
    $destination-path := concat($destination-collection, "/", $destination-resource-name) return

    let $mods-destination := if(doc-available($destination-path))then
        (
            doc($destination-path)/mods:modsCollection
        )
        else
        (
            doc(
                xmldb:store($destination-collection, $destination-resource-name,
                    <modsCollection xmlns="http://www.loc.gov/mods/v3" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.loc.gov/mods/v3 ../../webapp/WEB-INF/entities/mods-3-3.xsd"/>
                )
            )/mods:modsCollection
        )
    return
    (
        update insert util:node-by-id(doc($path), $id) into $mods-destination,
        update delete util:node-by-id(doc($path), $id),

        <status id="moved" from="{$resource-id}">{$destination-path}</status>
    )
};

declare function op:get-sharing-group-members($groupId as xs:string) as element(members){
    <members group-id="{$groupId}">
        <owner>{element {sharing:is-group-owner($groupId, security:get-user-credential-from-session()[1])} {""}}</owner>
        {
            for $group-member in sharing:get-group-members($groupId) return
                <member>{$group-member}</member>
        }
    </members>
};

declare function op:get-group-permissions($collection as xs:string, $groupId as xs:string) as element(permissions){
    <permissions>
    {
        if(sharing:group-readable($collection, $groupId))then
        (
            <read/>
        )else(),

        if(sharing:group-writeable($collection, $groupId))then
        (
            <write/>
        )else()
    }
    </permissions>
};

declare function op:get-other-permissions($collection as xs:string) as element(permissions){
    <permissions>
    {
        if(sharing:other-readable($collection))then
        (
            <read/>
        )else(),

        if(sharing:other-writeable($collection))then
        (
            <write/>
        )else()
    }
    </permissions>
};

declare function op:unknown-action($action as xs:string) {
        response:set-status-code(403),

Unknown action: {$action}.

};

let $action := request:get-parameter("action", ()),
$collection := request:get-parameter("collection", ())
return
    if($action eq "create-collection")then
        op:create-collection($collection, request:get-parameter("name",()))
    else if($action eq "move-collection")then
        op:move-collection($collection, request:get-parameter("path",()))
    else if($action eq "remove-collection")then
        op:remove-collection($collection)
    else if($action eq "update-collection-sharing")then
        op:update-collection-sharing($collection, request:get-parameter("sharingCollectionWith[]",()), request:get-parameter("groupList",()), request:get-parameter("groupMember[]",()), request:get-parameter("groupSharingPermissions[]",()), request:get-parameter("otherSharingPermissions[]",()))
    else if($action eq "get-group-permissions")then
        op:get-group-permissions($collection, request:get-parameter("groupId",()))
    else if($action eq "get-other-permissions")then
        op:get-other-permissions($collection)
    else if($action eq "get-sharing-group-members")then
        op:get-sharing-group-members(request:get-parameter("groupId",()))
    else if($action eq "remove-resource")then
        op:remove-resource(request:get-parameter("resource",()))
    else if($action eq "move-resource")then
        op:move-resource(request:get-parameter("resource",()), request:get-parameter("path",()))
    else if($action eq "get-collection-sharing")then
        op:get-collection-sharing($collection)
    else
        op:unknown-action($action)

xquery version "1.0";

import module namespace security="http://exist-db.org/mods/security" at "security.xqm";
import module namespace sharing="http://exist-db.org/mods/sharing" at "sharing.xqm";

declare namespace op="http://exist-db.org/xquery/biblio/operations";

declare namespace request="http://exist-db.org/xquery/request";
declare namespace response="http://exist-db.org/xquery/response";
declare namespace util="http://exist-db.org/xquery/util";
declare namespace xmldb="http://exist-db.org/xquery/xmldb";

declare namespace mods="http://www.loc.gov/mods/v3";

declare variable $rwx------ := 448;
declare variable $rwxrwx--- := 504;
declare variable $rwxrwxrwx := 511;

(:~
: Creates a collection inside a parent collection
:
: The new collection inherits the owner, group and permissions of the parent
:
: @param $parent the parent collection container
: @param $name the name for the new collection
:)
declare function op:create-collection($parent as xs:string, $name as xs:string) as element(status) {
    let $collection := xmldb:create-collection($parent, $name),

    (: by default newly created collections inherit the permissions of their parent :)
    $parent-group := xmldb:get-group($parent),
    $parent-owner := xmldb:get-owner($parent),
    $parent-permissions := xmldb:get-permissions($parent),
    $null := xmldb:set-collection-permissions($collection, $parent-owner, $parent-group, $parent-permissions) return
        <status id="created">{$collection}</status>
};

declare function op:move-collection($parent as xs:string, $path as xs:string) as element(status) {
    let $null := xmldb:move($parent, $path) return
        <status id="moved" from="{$parent}">{$path}</status>
};

declare function op:remove-collection($collection as xs:string) as element(status) {
    let $null := xmldb:remove($collection) return
        <status id="removed">{$collection}</status>
};

declare function op:update-collection-sharing($collection as xs:string, $sharing-collection-with as xs:string*, $group-list as xs:string?, $group-member as xs:string*, $group-sharing-permissions as xs:string*, $other-sharing-permissions as xs:string*) as element(status) {

    (: other :)
    let $share-with-other-outcome := if($sharing-collection-with = "other")then
    (
        sharing:share-with-other($collection, ($other-sharing-permissions = "read"), ($other-sharing-permissions = "write"))
    )
    else
    (
        (: dont share with other :)
        sharing:share-with-other($collection, false(), false())
    ),

    (: group :)
    $share-with-group-outcome := if($sharing-collection-with = "group")then
    (
        (: does the group exist? :)
        let $group-id := if(sharing:group-exists($group-list))then
        (
            let $null := util:log("debug", "********* GROUP ALREADY EXISTS ***********") return

            (: yes, are we the owner? :)
            if(sharing:is-group-owner($group-list, security:get-user-credential-from-session()[1]))then
            (
                (: yes, so update the group members :)

                (: TODO update the group members :)

                $group-list
            )
            else
            (
                (: no, so we cant modify the group members :)
                $group-list
            )
        )
        else
        (
            let $null := util:log("debug", "********* CREATE GROUP CALLED ***********") return

            (: no, so create it! :)
            sharing:create-group($group-list, security:get-user-credential-from-session()[1], $group-member)
        )
        return
            (: change the collection permissions to that of the group and appropriate read/write :)
            sharing:share-with-group($collection, $group-id, ($group-sharing-permissions = "read"), ($group-sharing-permissions = "write"))
    )
    else
    (
        (: dont share with group :)
        sharing:share-with-group($collection, false(), false())
    )
    return
        if($share-with-other-outcome and $share-with-group-outcome)then
            <status id="sharing">done</status>
        else
            <status id="sharing">invalid permissions</status>
};

declare function op:get-collection-sharing($collection as xs:string) as element(collection)
{
    <collection uri="{$collection}">
    {
        let $group-id := sharing:get-group-id($collection) return
            if($group-id)then
            (
                <group id="{$group-id}">
                {
                    if(sharing:group-readable($collection, $group-id))then(<read/>)else(),
                    if(sharing:group-writeable($collection, $group-id))then(<write/>)else()
                }
                </group>
            )else(),

        let $other-readable := sharing:other-readable($collection),
        $other-writeable := sharing:other-writeable($collection) return
        if($other-readable or $other-writeable)then
        (
            <other>
            {
                if($other-readable)then(<read/>)else(),
                if($other-writeable)then(<write/>)else()
            }
            </other>
        )else()
    }
    </collection>
};

(:~
:
: @ resource-id has the format db-document-path#node-id e.g. /db/mods/eXist/exist-articles.xml#1.36
:)
declare function op:remove-resource($resource-id as xs:string) as element(status) {

    let $path := substring-before($resource-id, "#"),
    $id := substring-after($resource-id, "#") return

        update delete util:node-by-id(doc($path), $id),

    <status id="removed">{$resource-id}</status>
};

(:~
:
: @ resource-id has the format db-document-path#node-id e.g. /db/mods/eXist/exist-articles.xml#1.36
:)
declare function op:move-resource($resource-id as xs:string, $destination-collection as xs:string) as element(status) {

    let $path := substring-before($resource-id, "#"),
    $id := substring-after($resource-id, "#"),
    $resource := util:node-by-id(doc($path), $id),
    $destination-resource-name := replace($path, ".*/", ""),
    $destination-path := concat($destination-collection, "/", $destination-resource-name) return

    let $mods-destination := if(doc-available($destination-path))then
        (
            doc($destination-path)/mods:modsCollection
        )
        else
        (
            doc(
                xmldb:store($destination-collection, $destination-resource-name,
                    <modsCollection xmlns="http://www.loc.gov/mods/v3" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://www.loc.gov/mods/v3 ../../webapp/WEB-INF/entities/mods-3-3.xsd"/>
                )
            )/mods:modsCollection
        )
    return
    (
        update insert util:node-by-id(doc($path), $id) into $mods-destination,
        update delete util:node-by-id(doc($path), $id),

        <status id="moved" from="{$resource-id}">{$destination-path}</status>
    )
};

declare function op:get-sharing-group-members($groupId as xs:string) as element(members){
    <members group-id="{$groupId}">
        <owner>{element {sharing:is-group-owner($groupId, security:get-user-credential-from-session()[1])} {""}}</owner>
        {
            for $group-member in sharing:get-group-members($groupId) return
                <member>{$group-member}</member>
        }
    </members>
};

declare function op:get-group-permissions($collection as xs:string, $groupId as xs:string) as element(permissions){
    <permissions>
    {
        if(sharing:group-readable($collection, $groupId))then
        (
            <read/>
        )else(),

        if(sharing:group-writeable($collection, $groupId))then
        (
            <write/>
        )else()
    }
    </permissions>
};

declare function op:get-other-permissions($collection as xs:string) as element(permissions){
    <permissions>
    {
        if(sharing:other-readable($collection))then
        (
            <read/>
        )else(),

        if(sharing:other-writeable($collection))then
        (
            <write/>
        )else()
    }
    </permissions>
};

declare function op:unknown-action($action as xs:string) {
        response:set-status-code(403),

Unknown action: {$action}.

};

let $action := request:get-parameter("action", ()),
$collection := request:get-parameter("collection", ())
return
    if($action eq "create-collection")then
        op:create-collection($collection, request:get-parameter("name",()))
    else if($action eq "move-collection")then
        op:move-collection($collection, request:get-parameter("path",()))
    else if($action eq "remove-collection")then
        op:remove-collection($collection)
    else if($action eq "update-collection-sharing")then
        op:update-collection-sharing($collection, request:get-parameter("sharingCollectionWith[]",()), request:get-parameter("groupList",()), request:get-parameter("groupMember[]",()), request:get-parameter("groupSharingPermissions[]",()), request:get-parameter("otherSharingPermissions[]",()))
    else if($action eq "get-group-permissions")then
        op:get-group-permissions($collection, request:get-parameter("groupId",()))
    else if($action eq "get-other-permissions")then
        op:get-other-permissions($collection)
    else if($action eq "get-sharing-group-members")then
        op:get-sharing-group-members(request:get-parameter("groupId",()))
    else if($action eq "remove-resource")then
        op:remove-resource(request:get-parameter("resource",()))
    else if($action eq "move-resource")then
        op:move-resource(request:get-parameter("resource",()), request:get-parameter("path",()))
    else if($action eq "get-collection-sharing")then
        op:get-collection-sharing($collection)
    else
        op:unknown-action($action)