STLXML2STL: add non-abbreviated special char names

(: STLXML to STL converter - library module
 :
 : Copyright 2012-15 BaseX GmbH, Konstanz, Germany, and
 : Copyright 2016 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 _ = 'stlxml2stl';
declare default function namespace 'stlxml2stl';

declare namespace file = "http://expath.org/ns/file";
declare namespace bin = "http://expath.org/ns/binary";

declare variable $_:ERROR := xs:QName("err:ERROR");

(: Read document function - bypasses fn:doc() whitespace chopping issues :)
declare function read-document($path as xs:string) as document-node() {
  fn:parse-xml(file:read-text($path))

};

(:declare variable $_:STLXML-XSD := fn:doc(file:base-dir() || '../../etc/stlxml.xsd');:)
(:declare function check-schema($stlxml as document-node()) as xs:boolean {
  let $info := validate:xsd-info($stlxml, $_:STLXML-XSD)
  return if(fn:empty($info)) then fn:true() else
    fn:error($_:ERROR, "Invalid (XSD) input data: " || fn:string-join($info, ' -- '))
};:)

(: convert STLXML to STL :)
declare function encode($stlxml as document-node()) as xs:hexBinary {
(:  let $schema-ok := check-schema($stlxml):)
  (: character code table number for TTI text field encoding :)
  let $cct := $stlxml//HEAD/GSI/CCT/fn:string()
  let $GSI := encode-gsi($stlxml//HEAD/GSI)
  let $TTI :=
    for $t in $stlxml//BODY/TTICONTAINER/TTI
    return encode-tti($t, $cct)
  return xs:hexBinary($GSI || xs:hexBinary(fn:string-join($TTI ! xs:string(.), '')))
};

(: output STL result to file :)
declare function serialize($path as xs:string, $value as xs:hexBinary) as empty-sequence() {
  file:write-binary($path, bin:hex(xs:string($value)))
};

(: convert GSI block from STLXML to STL :)
declare function encode-gsi($gsi as element(GSI)) as xs:hexBinary {
  let $GSI-CPN := map {
    '437': '343337',
    '850': '383530',
    '860': '383630',
    '863': '383633',
    '865': '383635'
  }
  let $GSI-DSC := map {
     '': '20',
    '0': '30',
    '1': '31',
    '2': '32'
  }
  let $CPN-number := $gsi/CPN/fn:string()
  (: concatenate all fields :)
  let $s :=
       $GSI-CPN($gsi/CPN)
    || gsi-encode-chars($gsi/DFC, $CPN-number, 8)
    || $GSI-DSC($gsi/DSC)
    || gsi-encode-chars($gsi/CCT, $CPN-number, 2)
    || gsi-encode-chars($gsi/LC , $CPN-number, 2)
    || gsi-encode-chars($gsi/OPT, $CPN-number, 32)
    || gsi-encode-chars($gsi/OET, $CPN-number, 32)
    || gsi-encode-chars($gsi/TPT, $CPN-number, 32)
    || gsi-encode-chars($gsi/TET, $CPN-number, 32)
    || gsi-encode-chars($gsi/TN , $CPN-number, 32)
    || gsi-encode-chars($gsi/TCD, $CPN-number, 32)
    || gsi-encode-chars($gsi/SLR, $CPN-number, 16)
    || gsi-encode-chars($gsi/CD , $CPN-number, 6)
    || gsi-encode-chars($gsi/RD , $CPN-number, 6)
    || gsi-encode-chars($gsi/RN , $CPN-number, 2)
    || gsi-encode-chars($gsi/TNB, $CPN-number, 5)
    || gsi-encode-chars($gsi/TNS, $CPN-number, 5)
    || gsi-encode-chars($gsi/TNG, $CPN-number, 3)
    || gsi-encode-chars($gsi/MNC, $CPN-number, 2)
    || gsi-encode-chars($gsi/MNR, $CPN-number, 2)
    || gsi-encode-chars($gsi/TCS, $CPN-number, 1)
    || gsi-encode-chars($gsi/TCP, $CPN-number, 8)
    || gsi-encode-chars($gsi/TCF, $CPN-number, 8)
    || gsi-encode-chars($gsi/TND, $CPN-number, 1)
    || gsi-encode-chars($gsi/DSN, $CPN-number, 1)
    || gsi-encode-chars($gsi/CO , $CPN-number, 3)
    || gsi-encode-chars($gsi/PUB, $CPN-number, 32)
    || gsi-encode-chars($gsi/EN , $CPN-number, 32)
    || gsi-encode-chars($gsi/ECD, $CPN-number, 32)
    (: spare bytes :)
    || fn:string-join(for $i in 1 to 75 return '20')
    (: UDA / user-defined area - consider older STLXML files without UDA :)
    || (if($gsi/UDA) then gsi-user-defined-area($gsi/UDA) else fn:string-join(for $i in 1 to 576 return '20'))
  return xs:hexBinary($s)
};

(: convert TTI block from STLXML to STL :)
declare function encode-tti($tti as element(TTI), $cct-number as xs:string) as xs:hexBinary {
  (: concatenate all fields :)
  let $s :=
       tti-non-negative-integer($tti/SGN, 1)
    || tti-non-negative-integer($tti/SN, 2)
    || tti-hex($tti/EBN)
    || tti-hex($tti/CS)
    || tti-time-code($tti/TCI)
    || tti-time-code($tti/TCO)
    || tti-non-negative-integer($tti/VP, 1)
    || tti-hex($tti/JC)
    || tti-hex($tti/CF)
    || (if ($tti/EBN = 'fe') then tti-text-field_user_data($tti/TF) else tti-text-field_text($tti/TF, $cct-number))
  return xs:hexBinary($s)
};

(: ----------------------- START: converter functions ------------------------------ :)
declare function tti-non-negative-integer($v as xs:string?, $octets as xs:integer) as item()? {
  $v ! bin:pack-integer(xs:integer(.), $octets, 'LE') ! xs:hexBinary(.)
};

declare function tti-hex($v as xs:string?) as item()? {
  $v ! xs:hexBinary(.)
};

declare function tti-time-code($v as xs:string?) as item()? {
  (: hr/min/sec/frames given as integers xx/xx/xx/xx :)
  let $s := $v ! (
    (for $i in 0 to 3
    return fn:substring($v, 2 * $i + 1, 2))
    ! xs:integer(.)
    ! bin:pack-integer(., 1, 'LE')
    ! xs:hexBinary(.)
  ) return fn:string-join($s ! xs:string(.), '')
};

(: convert UDA from STLXML to STL :)
declare function gsi-user-defined-area($v as element(UDA)) as item()? {
  xs:base64Binary($v) ! bin:pad-right(., 576 - bin:length(.), 32) ! xs:hexBinary(.)
};

(: convert TF (with user data) from STLXML to STL :)
declare function tti-text-field_user_data($v as element(TF)) as item()? {
  xs:base64Binary($v) ! xs:hexBinary(.)
};

(: convert TF (with text) from STLXML to STL :)
declare function tti-text-field_text($v as element(TF), $cct-number as xs:string) as item()? {
  let $encoding := tti-text-field-encoding($cct-number)
  let $s :=
    for $ch in $v/child::node()
    return
      if($ch instance of element()) then
        (: convert control character :)
        let $cs := $_:TTI-TF-CTRL-CHARS(fn:name($ch))
        return if(fn:empty($cs)) then
          fn:error($_:ERROR, "Invalid control character element '" || fn:name($ch) || "'.")
        else $cs
      else if($ch instance of text()) then
        (: convert text :)
        tti-encode-text-field-chars(fn:replace($ch, '\s', ''), $cct-number)
      else
        ()
  return
    fn:string-join($s, '')
    ! bin:hex(.)
    (: fill remaining space with 0x8F :)
    ! bin:pad-right(., 112 - bin:length(.), 143)
    ! xs:hexBinary(.)
    ! xs:string(.)
};

declare function tti-text-field-encoding($cct as xs:string) {
  (: currently only CCT 00 is supported! :)
  let $encoding := map {
    '00': '6937-2'
  }($cct)
  return
    if(fn:empty($encoding)) then
      fn:error($_:ERROR, "Character code table " || $cct || " is not supported.")
    else ()
};

declare function tti-encode-text-field-chars($s as xs:string, $cct as xs:string) as xs:string? {
  let $s :=
    let $encoding := tti-text-field-encoding($cct)
    (:
      * STL format encodes diacritics by 'floating accent' principle, f.i.: ü -> 0xC875
      * normalized UTF-8 diacritics work similar, but order is switched:    ü -> 0x75C8
      --> Algorithm
        1. given string is chopped to individual characters
        2. each char C is UTF-8 normalized (diacritics are encoded with two bytes)
        3. codepoints are determined for C and reversed, if there are two
        4. each codepoint is mapped to its STL representation via the specified encoding (f.i. iso-6937-2)
    :)
    let $utf8-normalized-cps :=
      let $chars := for $cp in fn:string-to-codepoints($s) return fn:codepoints-to-string($cp)
      for $ch in $chars
      let $norm-cps := fn:normalize-unicode($ch, 'NFD') ! fn:string-to-codepoints(.)
      let $reversed-norm-cps := ($norm-cps[2], $norm-cps[1])
      return $reversed-norm-cps
    for $cp in $utf8-normalized-cps
    let $hex := bin:pack-integer($cp, 2) ! xs:hexBinary(.)
    (: use mapping for non-ascii characters :)
    return if(($hex ge xs:hexBinary('00A0')) or ($hex eq xs:hexBinary('0024'))) then
      ($_:CCT-00(xs:string($hex)), $_:DIACRITIC(xs:string($hex)))[1]
    else
      $hex ! fn:string(.) ! fn:substring(., 3, 2)
  return fn:string-join($s, '')
};

declare function gsi-encode-chars($v as element(), $cpn as xs:string, $l as xs:integer) as item()? {
  let $code-page := map {
    '850': $_:CP850,
    '437': $_:CP437
  }($cpn)
  let $err :=
    if(fn:empty($code-page)) then
      fn:error($_:ERROR, "Character code page " || $cpn || " is not supported.")
    else ()
  let $hex :=
    for $cp in fn:string-to-codepoints($v/fn:string())
    return xs:string($code-page(xs:string($cp)))
  (: fill remaining space with 0x20 :)
  let $padded :=
    fn:string-join($hex, '')
    ! bin:hex(.)
    ! bin:pad-right(., $l - bin:length(.), bin:to-octets(bin:hex('20')))
    ! xs:hexBinary(.)
    ! xs:string(.)
  return xs:hexBinary($padded)
};
(: ----------------------- END: converter functions ------------------------------ :)

(: ------------------------------- ENCODINGS ------------------------------------- :)
(: Text field control character mapping (hex values) :)
declare variable $_:TTI-TF-CTRL-CHARS := map {
  'AlphaBlack'       : '00',
  'AlphaRed'         : '01',
  'AlphaGreen'       : '02',
  'AlphaYellow'      : '03',
  'AlphaBlue'        : '04',
  'AlphaMagenta'     : '05',
  'AlphaCyan'        : '06',
  'AlphaWhite'       : '07',
  'Flash'            : '08',
  'Steady'           : '09',
  'EndBox'           : '0A',
  'StartBox'         : '0B',
  'NormalHeight'     : '0C',
  'DoubleHeight'     : '0D',
  'DoubleWidth'      : '0E',
  'DoubleSize'       : '0F',
  'MosaicBlack'      : '10',
  'MosaicRed'        : '11',
  'MosaicGreen'      : '12',
  'MosaicYellow'     : '13',
  'MosaicBlue'       : '14',
  'MosaicMagenta'    : '15',
  'MosaicCyan'       : '16',
  'MosaicWhite'      : '17',
  'Conceal'          : '18',
  'ContiguousMosaic' : '19',
  'SeparatedMosaic'  : '1A',
  'Reserved'         : '1B',
  'BlackBackground'  : '1C',
  'NewBackground'    : '1D',
  'HoldMosaic'       : '1E',
  'ReleaseMosaic'    : '1F',
  'space'            : '20',
  'newline'          : '8A'
};
(: Character code table 00: ISO 6937/2-1983 :)
declare variable $_:DIACRITIC := map {
    '0300' : 'C1',  (: grave accent :)
    '0301' : 'C2',  (: acute accent :)
    '0302' : 'C3',  (: circumflex :)
    '0303' : 'C4',  (: tilde :)
    '0304' : 'C5',  (: macron :)
    '0306' : 'C6',  (: breve :)
    '0307' : 'C7',  (: dot :)
    '0308' : 'C8',  (: umlaut :)
    '030A' : 'CA',  (: ring :)
    '0327' : 'CB',  (: cedilla :)
    '030B' : 'CD',  (: double acute accent :)
    '0328' : 'CE',  (: ogonek :)
    '030C' : 'CF'   (: caron :)
};
declare variable $_:CCT-00 := map {
  '000A': '8A', (: line break:)

  '00A4': '24', (: ¤:)

  '00A0': 'A0', (:   (NBSP = NO-BREAK SPACE):)
  '00A1': 'A1', (: ¡:)
  '00A2': 'A2', (: ¢:)
  '00A3': 'A3', (: £:)
  '0024': 'A4', (: $:)
  '00A5': 'A5', (: ¥:)
  '00A7': 'A7', (: §:)
  '2018': 'A9', (: ‘:)
  '201C': 'AA', (: “:)
  '00AB': 'AB', (: «:)
  '2190': 'AC', (: ←:)
  '2191': 'AD', (: ↑:)
  '2192': 'AE', (: →:)
  '2193': 'AF', (: ↓:)

  '00B0': 'B0', (: °:)
  '00B1': 'B1', (: ±:)
  '00B2': 'B2', (: ²:)
  '00B3': 'B3', (: ³:)
  '00D7': 'B4', (: ×:)
  '00B5': 'B5', (: µ:)
  '00B6': 'B6', (: ¶:)
  '00B7': 'B7', (: ·:)
  '00F7': 'B8', (: ÷:)
  '2019': 'B9', (: ’:)
  '201D': 'BA', (: ”:)
  '00BB': 'BB', (: »:)
  '00BC': 'BC', (: ¼:)
  '00BD': 'BD', (: ½:)
  '00BE': 'BE', (: ¾:)
  '00BF': 'BF', (: ¿:)

  '2015': 'D0', (: ―:)
  '00B9': 'D1', (: ¹:)
  '00AE': 'D2', (: ®:)
  '00A9': 'D3', (: ©:)
  '2122': 'D4', (: ™:)
  '266A': 'D5', (: ♪:)
  '00AC': 'D6', (: ¬:)
  '00A6': 'D7', (: ¦:)
  '215B': 'DC', (: ⅛:)
  '215C': 'DD', (: ⅜:)
  '215D': 'DE', (: ⅝:)
  '215E': 'DF', (: ⅞:)

  '03A9': 'E0', (: Ω:)
  '00C6': 'E1', (: Æ:)
  '0110': 'E2', (: Đ:)
  '00AA': 'E3', (: ª:)
  '0126': 'E4', (: Ħ:)
  '0132': 'E6', (: Ĳ:)
  '013F': 'E7', (: Ŀ:)
  '0141': 'E8', (: Ł:)
  '00D8': 'E9', (: Ø:)
  '0152': 'EA', (: Œ:)
  '00BA': 'EB', (: º:)
  '00DE': 'EC', (: Þ:)
  '0166': 'ED', (: Ŧ:)
  '014A': 'EE', (: Ŋ:)
  '0149': 'EF', (: ŉ:)

  '0138': 'F0', (: ĸ:)
  '00E6': 'F1', (: æ:)
  '0111': 'F2', (: đ:)
  '00F0': 'F3', (: ð:)
  '0127': 'F4', (: ħ:)
  '0131': 'F5', (: ı:)
  '0133': 'F6', (: ĳ:)
  '0140': 'F7', (: ŀ:)
  '0142': 'F8', (: ł:)
  '00F8': 'F9', (: ø:)
  '0153': 'FA', (: œ:)
  '00DF': 'FB', (: ß:)
  '00FE': 'FC', (: þ:)
  '0167': 'FD', (: ŧ:)
  '014B': 'FE', (: ŋ:)
  '00AD': 'FF'  (:  (SHY = SOFT HYPHEN):)
};
(: map Unicode code point to CP850 hex :)
declare variable $_:CP850 := map {
  '32' : '20',  (:   :)
  '33' : '21',  (: ! :)
  '34' : '22',  (: " :)
  '35' : '23',  (: # :)
  '36' : '24',  (: $ :)
  '37' : '25',  (: % :)
  '38' : '26',  (: & :)
  '39' : '27',  (: ' :)
  '40' : '28',  (: ( :)
  '41' : '29',  (: ) :)
  '42' : '2A',  (: * :)
  '43' : '2B',  (: + :)
  '44' : '2C',  (: , :)
  '45' : '2D',  (: - :)
  '46' : '2E',  (: . :)
  '47' : '2F',  (: / :)
  '48' : '30',  (: 0 :)
  '49' : '31',  (: 1 :)
  '50' : '32',  (: 2 :)
  '51' : '33',  (: 3 :)
  '52' : '34',  (: 4 :)
  '53' : '35',  (: 5 :)
  '54' : '36',  (: 6 :)
  '55' : '37',  (: 7 :)
  '56' : '38',  (: 8 :)
  '57' : '39',  (: 9 :)
  '58' : '3A',  (: : :)
  '59' : '3B',  (: ; :)
  '60' : '3C',  (: < :)
  '61' : '3D',  (: = :)
  '62' : '3E',  (: > :)
  '63' : '3F',  (: ? :)
  '64' : '40',  (: @ :)
  '65' : '41',  (: A :)
  '66' : '42',  (: B :)
  '67' : '43',  (: C :)
  '68' : '44',  (: D :)
  '69' : '45',  (: E :)
  '70' : '46',  (: F :)
  '71' : '47',  (: G :)
  '72' : '48',  (: H :)
  '73' : '49',  (: I :)
  '74' : '4A',  (: J :)
  '75' : '4B',  (: K :)
  '76' : '4C',  (: L :)
  '77' : '4D',  (: M :)
  '78' : '4E',  (: N :)
  '79' : '4F',  (: O :)
  '80' : '50',  (: P :)
  '81' : '51',  (: Q :)
  '82' : '52',  (: R :)
  '83' : '53',  (: S :)
  '84' : '54',  (: T :)
  '85' : '55',  (: U :)
  '86' : '56',  (: V :)
  '87' : '57',  (: W :)
  '88' : '58',  (: X :)
  '89' : '59',  (: Y :)
  '90' : '5A',  (: Z :)
  '91' : '5B',  (: [ :)
  '92' : '5C',  (: \ :)
  '93' : '5D',  (: ] :)
  '94' : '5E',  (: ^ :)
  '95' : '5F',  (: _ :)
  '96' : '60',  (: ` :)
  '97' : '61',  (: a :)
  '98' : '62',  (: b :)
  '99' : '63',  (: c :)
  '100' : '64',  (: d :)
  '101' : '65',  (: e :)
  '102' : '66',  (: f :)
  '103' : '67',  (: g :)
  '104' : '68',  (: h :)
  '105' : '69',  (: i :)
  '106' : '6A',  (: j :)
  '107' : '6B',  (: k :)
  '108' : '6C',  (: l :)
  '109' : '6D',  (: m :)
  '110' : '6E',  (: n :)
  '111' : '6F',  (: o :)
  '112' : '70',  (: p :)
  '113' : '71',  (: q :)
  '114' : '72',  (: r :)
  '115' : '73',  (: s :)
  '116' : '74',  (: t :)
  '117' : '75',  (: u :)
  '118' : '76',  (: v :)
  '119' : '77',  (: w :)
  '120' : '78',  (: x :)
  '121' : '79',  (: y :)
  '122' : '7A',  (: z :)
  '123' : '7B',  (: { :)
  '124' : '7C',  (: | :)
  '125' : '7D',  (: } :)
  '126' : '7E',  (: ~ :)
  '8962' : '7F',  (: ⌂ :)
  '199' : '80',  (: Ç :)
  '252' : '81',  (: ü :)
  '233' : '82',  (: é :)
  '226' : '83',  (: â :)
  '228' : '84',  (: ä :)
  '224' : '85',  (: à :)
  '229' : '86',  (: å :)
  '231' : '87',  (: ç :)
  '234' : '88',  (: ê :)
  '235' : '89',  (: ë :)
  '232' : '8A',  (: è :)
  '239' : '8B',  (: ï :)
  '238' : '8C',  (: î :)
  '236' : '8D',  (: ì :)
  '196' : '8E',  (: Ä :)
  '197' : '8F',  (: Å :)
  '201' : '90',  (: É :)
  '230' : '91',  (: æ :)
  '198' : '92',  (: Æ :)
  '244' : '93',  (: ô :)
  '246' : '94',  (: ö :)
  '242' : '95',  (: ò :)
  '251' : '96',  (: û :)
  '249' : '97',  (: ù :)
  '255' : '98',  (: ÿ :)
  '214' : '99',  (: Ö :)
  '220' : '9A',  (: Ü :)
  '248' : '9B',  (: ø :)
  '163' : '9C',  (: £ :)
  '216' : '9D',  (: Ø :)
  '215' : '9E',  (: × :)
  '402' : '9F',  (: ƒ :)
  '225' : 'A0',  (: á :)
  '237' : 'A1',  (: í :)
  '243' : 'A2',  (: ó :)
  '250' : 'A3',  (: ú :)
  '241' : 'A4',  (: ñ :)
  '209' : 'A5',  (: Ñ :)
  '170' : 'A6',  (: ª :)
  '186' : 'A7',  (: º :)
  '191' : 'A8',  (: ¿ :)
  '174' : 'A9',  (: ® :)
  '172' : 'AA',  (: ¬ :)
  '189' : 'AB',  (: ½ :)
  '188' : 'AC',  (: ¼ :)
  '161' : 'AD',  (: ¡ :)
  '171' : 'AE',  (: « :)
  '187' : 'AF',  (: » :)
  '9617' : 'B0',  (: ░ :)
  '9618' : 'B1',  (: ▒ :)
  '9619' : 'B2',  (: ▓ :)
  '9474' : 'B3',  (: │ :)
  '9508' : 'B4',  (: ┤ :)
  '193' : 'B5',  (: Á :)
  '194' : 'B6',  (: Â :)
  '192' : 'B7',  (: À :)
  '169' : 'B8',  (: © :)
  '9571' : 'B9',  (: ╣ :)
  '9553' : 'BA',  (: ║ :)
  '9559' : 'BB',  (: ╗ :)
  '9565' : 'BC',  (: ╝ :)
  '162' : 'BD',  (: ¢ :)
  '165' : 'BE',  (: ¥ :)
  '9488' : 'BF',  (: ┐ :)
  '9492' : 'C0',  (: └ :)
  '9524' : 'C1',  (: ┴ :)
  '9516' : 'C2',  (: ┬ :)
  '9500' : 'C3',  (: ├ :)
  '9472' : 'C4',  (: ─ :)
  '9532' : 'C5',  (: ┼ :)
  '227' : 'C6',  (: ã :)
  '195' : 'C7',  (: Ã :)
  '9562' : 'C8',  (: ╚ :)
  '9556' : 'C9',  (: ╔ :)
  '9577' : 'CA',  (: ╩ :)
  '9574' : 'CB',  (: ╦ :)
  '9568' : 'CC',  (: ╠ :)
  '9552' : 'CD',  (: ═ :)
  '9580' : 'CE',  (: ╬ :)
  '164' : 'CF',  (: ¤ :)
  '240' : 'D0',  (: ð :)
  '208' : 'D1',  (: Ð :)
  '202' : 'D2',  (: Ê :)
  '203' : 'D3',  (: Ë :)
  '200' : 'D4',  (: È :)
  '305' : 'D5',  (: ı :)
  '205' : 'D6',  (: Í :)
  '206' : 'D7',  (: Î :)
  '207' : 'D8',  (: Ï :)
  '9496' : 'D9',  (: ┘ :)
  '9484' : 'DA',  (: ┌ :)
  '9608' : 'DB',  (: █ :)
  '9604' : 'DC',  (: ▄ :)
  '166' : 'DD',  (: ¦ :)
  '204' : 'DE',  (: Ì :)
  '9600' : 'DF',  (: ▀ :)
  '211' : 'E0',  (: Ó :)
  '223' : 'E1',  (: ß :)
  '212' : 'E2',  (: Ô :)
  '210' : 'E3',  (: Ò :)
  '245' : 'E4',  (: õ :)
  '213' : 'E5',  (: Õ :)
  '181' : 'E6',  (: µ :)
  '254' : 'E7',  (: þ :)
  '222' : 'E8',  (: Þ :)
  '218' : 'E9',  (: Ú :)
  '219' : 'EA',  (: Û :)
  '217' : 'EB',  (: Ù :)
  '253' : 'EC',  (: ý :)
  '221' : 'ED',  (: Ý :)
  '175' : 'EE',  (: ¯ :)
  '180' : 'EF',  (: ´ :)
  '173' : 'F0',  (:  :)
  '177' : 'F1',  (: ± :)
  '8215' : 'F2',  (: ‗ :)
  '190' : 'F3',  (: ¾ :)
  '182' : 'F4',  (: ¶ :)
  '167' : 'F5',  (: § :)
  '247' : 'F6',  (: ÷ :)
  '184' : 'F7',  (: ¸ :)
  '176' : 'F8',  (: ° :)
  '168' : 'F9',  (: ¨ :)
  '183' : 'FA',  (: · :)
  '185' : 'FB',  (: ¹ :)
  '179' : 'FC',  (: ³ :)
  '178' : 'FD',  (: ² :)
  '9632' : 'FE',  (: ■ :)
  '160' : 'FF'   (:   :)
};
(: map Unicode code point to CP437 hex :)
declare variable $_:CP437 := map {
  '32' : '20',  (:   :)
  '33' : '21',  (: ! :)
  '34' : '22',  (: " :)
  '35' : '23',  (: # :)
  '36' : '24',  (: $ :)
  '37' : '25',  (: % :)
  '38' : '26',  (: & :)
  '39' : '27',  (: ' :)
  '40' : '28',  (: ( :)
  '41' : '29',  (: ) :)
  '42' : '2A',  (: * :)
  '43' : '2B',  (: + :)
  '44' : '2C',  (: , :)
  '45' : '2D',  (: - :)
  '46' : '2E',  (: . :)
  '47' : '2F',  (: / :)
  '48' : '30',  (: 0 :)
  '49' : '31',  (: 1 :)
  '50' : '32',  (: 2 :)
  '51' : '33',  (: 3 :)
  '52' : '34',  (: 4 :)
  '53' : '35',  (: 5 :)
  '54' : '36',  (: 6 :)
  '55' : '37',  (: 7 :)
  '56' : '38',  (: 8 :)
  '57' : '39',  (: 9 :)
  '58' : '3A',  (: : :)
  '59' : '3B',  (: ; :)
  '60' : '3C',  (: < :)
  '61' : '3D',  (: = :)
  '62' : '3E',  (: > :)
  '63' : '3F',  (: ? :)
  '64' : '40',  (: @ :)
  '65' : '41',  (: A :)
  '66' : '42',  (: B :)
  '67' : '43',  (: C :)
  '68' : '44',  (: D :)
  '69' : '45',  (: E :)
  '70' : '46',  (: F :)
  '71' : '47',  (: G :)
  '72' : '48',  (: H :)
  '73' : '49',  (: I :)
  '74' : '4A',  (: J :)
  '75' : '4B',  (: K :)
  '76' : '4C',  (: L :)
  '77' : '4D',  (: M :)
  '78' : '4E',  (: N :)
  '79' : '4F',  (: O :)
  '80' : '50',  (: P :)
  '81' : '51',  (: Q :)
  '82' : '52',  (: R :)
  '83' : '53',  (: S :)
  '84' : '54',  (: T :)
  '85' : '55',  (: U :)
  '86' : '56',  (: V :)
  '87' : '57',  (: W :)
  '88' : '58',  (: X :)
  '89' : '59',  (: Y :)
  '90' : '5A',  (: Z :)
  '91' : '5B',  (: [ :)
  '92' : '5C',  (: \ :)
  '93' : '5D',  (: ] :)
  '94' : '5E',  (: ^ :)
  '95' : '5F',  (: _ :)
  '96' : '60',  (: ` :)
  '97' : '61',  (: a :)
  '98' : '62',  (: b :)
  '99' : '63',  (: c :)
  '100' : '64',  (: d :)
  '101' : '65',  (: e :)
  '102' : '66',  (: f :)
  '103' : '67',  (: g :)
  '104' : '68',  (: h :)
  '105' : '69',  (: i :)
  '106' : '6A',  (: j :)
  '107' : '6B',  (: k :)
  '108' : '6C',  (: l :)
  '109' : '6D',  (: m :)
  '110' : '6E',  (: n :)
  '111' : '6F',  (: o :)
  '112' : '70',  (: p :)
  '113' : '71',  (: q :)
  '114' : '72',  (: r :)
  '115' : '73',  (: s :)
  '116' : '74',  (: t :)
  '117' : '75',  (: u :)
  '118' : '76',  (: v :)
  '119' : '77',  (: w :)
  '120' : '78',  (: x :)
  '121' : '79',  (: y :)
  '122' : '7A',  (: z :)
  '123' : '7B',  (: { :)
  '124' : '7C',  (: | :)
  '125' : '7D',  (: } :)
  '126' : '7E',  (: ~ :)
  '8962' : '7F',  (: ⌂ :)
  '199' : '80',  (: Ç :)
  '252' : '81',  (: ü :)
  '233' : '82',  (: é :)
  '226' : '83',  (: â :)
  '228' : '84',  (: ä :)
  '224' : '85',  (: à :)
  '229' : '86',  (: å :)
  '231' : '87',  (: ç :)
  '234' : '88',  (: ê :)
  '235' : '89',  (: ë :)
  '232' : '8A',  (: è :)
  '239' : '8B',  (: ï :)
  '238' : '8C',  (: î :)
  '236' : '8D',  (: ì :)
  '196' : '8E',  (: Ä :)
  '197' : '8F',  (: Å :)
  '201' : '90',  (: É :)
  '230' : '91',  (: æ :)
  '198' : '92',  (: Æ :)
  '244' : '93',  (: ô :)
  '246' : '94',  (: ö :)
  '242' : '95',  (: ò :)
  '251' : '96',  (: û :)
  '249' : '97',  (: ù :)
  '255' : '98',  (: ÿ :)
  '214' : '99',  (: Ö :)
  '220' : '9A',  (: Ü :)
  '162' : '9B',  (: ¢ :)
  '163' : '9C',  (: £ :)
  '165' : '9D',  (: ¥ :)
  '8359' : '9E',  (: ₧ :)
  '402' : '9F',  (: ƒ :)
  '225' : 'A0',  (: á :)
  '237' : 'A1',  (: í :)
  '243' : 'A2',  (: ó :)
  '250' : 'A3',  (: ú :)
  '241' : 'A4',  (: ñ :)
  '209' : 'A5',  (: Ñ :)
  '170' : 'A6',  (: ª :)
  '186' : 'A7',  (: º :)
  '191' : 'A8',  (: ¿ :)
  '8976' : 'A9',  (: ⌐ :)
  '172' : 'AA',  (: ¬ :)
  '189' : 'AB',  (: ½ :)
  '188' : 'AC',  (: ¼ :)
  '161' : 'AD',  (: ¡ :)
  '171' : 'AE',  (: « :)
  '187' : 'AF',  (: » :)
  '9617' : 'B0',  (: ░ :)
  '9618' : 'B1',  (: ▒ :)
  '9619' : 'B2',  (: ▓ :)
  '9474' : 'B3',  (: │ :)
  '9508' : 'B4',  (: ┤ :)
  '9569' : 'B5',  (: ╡ :)
  '9570' : 'B6',  (: ╢ :)
  '9558' : 'B7',  (: ╖ :)
  '9557' : 'B8',  (: ╕ :)
  '9571' : 'B9',  (: ╣ :)
  '9553' : 'BA',  (: ║ :)
  '9559' : 'BB',  (: ╗ :)
  '9565' : 'BC',  (: ╝ :)
  '9564' : 'BD',  (: ╜ :)
  '9563' : 'BE',  (: ╛ :)
  '9488' : 'BF',  (: ┐ :)
  '9492' : 'C0',  (: └ :)
  '9524' : 'C1',  (: ┴ :)
  '9516' : 'C2',  (: ┬ :)
  '9500' : 'C3',  (: ├ :)
  '9472' : 'C4',  (: ─ :)
  '9532' : 'C5',  (: ┼ :)
  '9566' : 'C6',  (: ╞ :)
  '9567' : 'C7',  (: ╟ :)
  '9562' : 'C8',  (: ╚ :)
  '9556' : 'C9',  (: ╔ :)
  '9577' : 'CA',  (: ╩ :)
  '9574' : 'CB',  (: ╦ :)
  '9568' : 'CC',  (: ╠ :)
  '9552' : 'CD',  (: ═ :)
  '9580' : 'CE',  (: ╬ :)
  '9575' : 'CF',  (: ╧ :)
  '9576' : 'D0',  (: ╨ :)
  '9572' : 'D1',  (: ╤ :)
  '9573' : 'D2',  (: ╥ :)
  '9561' : 'D3',  (: ╙ :)
  '9560' : 'D4',  (: ╘ :)
  '9554' : 'D5',  (: ╒ :)
  '9555' : 'D6',  (: ╓ :)
  '9579' : 'D7',  (: ╫ :)
  '9578' : 'D8',  (: ╪ :)
  '9496' : 'D9',  (: ┘ :)
  '9484' : 'DA',  (: ┌ :)
  '9608' : 'DB',  (: █ :)
  '9604' : 'DC',  (: ▄ :)
  '9612' : 'DD',  (: ▌ :)
  '9616' : 'DE',  (: ▐ :)
  '9600' : 'DF',  (: ▀ :)
  '945' : 'E0',  (: α :)
  '223' : 'E1',  (: ß :)
  '915' : 'E2',  (: Γ :)
  '960' : 'E3',  (: π :)
  '931' : 'E4',  (: Σ :)
  '963' : 'E5',  (: σ :)
  '181' : 'E6',  (: µ :)
  '964' : 'E7',  (: τ :)
  '934' : 'E8',  (: Φ :)
  '920' : 'E9',  (: Θ :)
  '937' : 'EA',  (: Ω :)
  '948' : 'EB',  (: δ :)
  '8734' : 'EC',  (: ∞ :)
  '966' : 'ED',  (: φ :)
  '949' : 'EE',  (: ε :)
  '8745' : 'EF',  (: ∩ :)
  '8801' : 'F0',  (: ≡ :)
  '177' : 'F1',  (: ± :)
  '8805' : 'F2',  (: ≥ :)
  '8804' : 'F3',  (: ≤ :)
  '8992' : 'F4',  (: ⌠ :)
  '8993' : 'F5',  (: ⌡ :)
  '247' : 'F6',  (: ÷ :)
  '8776' : 'F7',  (: ≈ :)
  '176' : 'F8',  (: ° :)
  '8729' : 'F9',  (: ∙ :)
  '183' : 'FA',  (: · :)
  '8730' : 'FB',  (: √ :)
  '8319' : 'FC',  (: ⁿ :)
  '178' : 'FD',  (: ² :)
  '9632' : 'FE',  (: ■ :)
  '160' : 'FF'   (:   :)
};

(: STLXML to STL converter - library module
 :
 : Copyright 2012-15 BaseX GmbH, Konstanz, Germany, and
 : Copyright 2016 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 _ = 'stlxml2stl';
declare default function namespace 'stlxml2stl';

declare namespace file = "http://expath.org/ns/file";
declare namespace bin = "http://expath.org/ns/binary";

declare variable $_:ERROR := xs:QName("err:ERROR");

(: Read document function - bypasses fn:doc() whitespace chopping issues :)
declare function read-document($path as xs:string) as document-node() {
  fn:parse-xml(file:read-text($path))

};

(:declare variable $_:STLXML-XSD := fn:doc(file:base-dir() || '../../etc/stlxml.xsd');:)
(:declare function check-schema($stlxml as document-node()) as xs:boolean {
  let $info := validate:xsd-info($stlxml, $_:STLXML-XSD)
  return if(fn:empty($info)) then fn:true() else
    fn:error($_:ERROR, "Invalid (XSD) input data: " || fn:string-join($info, ' -- '))
};:)

(: convert STLXML to STL :)
declare function encode($stlxml as document-node()) as xs:hexBinary {
(:  let $schema-ok := check-schema($stlxml):)
  (: character code table number for TTI text field encoding :)
  let $cct := $stlxml//HEAD/GSI/CCT/fn:string()
  let $GSI := encode-gsi($stlxml//HEAD/GSI)
  let $TTI :=
    for $t in $stlxml//BODY/TTICONTAINER/TTI
    return encode-tti($t, $cct)
  return xs:hexBinary($GSI || xs:hexBinary(fn:string-join($TTI ! xs:string(.), '')))
};

(: output STL result to file :)
declare function serialize($path as xs:string, $value as xs:hexBinary) as empty-sequence() {
  file:write-binary($path, bin:hex(xs:string($value)))
};

(: convert GSI block from STLXML to STL :)
declare function encode-gsi($gsi as element(GSI)) as xs:hexBinary {
  let $GSI-CPN := map {
    '437': '343337',
    '850': '383530',
    '860': '383630',
    '863': '383633',
    '865': '383635'
  }
  let $GSI-DSC := map {
     '': '20',
    '0': '30',
    '1': '31',
    '2': '32'
  }
  let $CPN-number := $gsi/CPN/fn:string()
  (: concatenate all fields :)
  let $s :=
       $GSI-CPN($gsi/CPN)
    || gsi-encode-chars($gsi/DFC, $CPN-number, 8)
    || $GSI-DSC($gsi/DSC)
    || gsi-encode-chars($gsi/CCT, $CPN-number, 2)
    || gsi-encode-chars($gsi/LC , $CPN-number, 2)
    || gsi-encode-chars($gsi/OPT, $CPN-number, 32)
    || gsi-encode-chars($gsi/OET, $CPN-number, 32)
    || gsi-encode-chars($gsi/TPT, $CPN-number, 32)
    || gsi-encode-chars($gsi/TET, $CPN-number, 32)
    || gsi-encode-chars($gsi/TN , $CPN-number, 32)
    || gsi-encode-chars($gsi/TCD, $CPN-number, 32)
    || gsi-encode-chars($gsi/SLR, $CPN-number, 16)
    || gsi-encode-chars($gsi/CD , $CPN-number, 6)
    || gsi-encode-chars($gsi/RD , $CPN-number, 6)
    || gsi-encode-chars($gsi/RN , $CPN-number, 2)
    || gsi-encode-chars($gsi/TNB, $CPN-number, 5)
    || gsi-encode-chars($gsi/TNS, $CPN-number, 5)
    || gsi-encode-chars($gsi/TNG, $CPN-number, 3)
    || gsi-encode-chars($gsi/MNC, $CPN-number, 2)
    || gsi-encode-chars($gsi/MNR, $CPN-number, 2)
    || gsi-encode-chars($gsi/TCS, $CPN-number, 1)
    || gsi-encode-chars($gsi/TCP, $CPN-number, 8)
    || gsi-encode-chars($gsi/TCF, $CPN-number, 8)
    || gsi-encode-chars($gsi/TND, $CPN-number, 1)
    || gsi-encode-chars($gsi/DSN, $CPN-number, 1)
    || gsi-encode-chars($gsi/CO , $CPN-number, 3)
    || gsi-encode-chars($gsi/PUB, $CPN-number, 32)
    || gsi-encode-chars($gsi/EN , $CPN-number, 32)
    || gsi-encode-chars($gsi/ECD, $CPN-number, 32)
    (: spare bytes :)
    || fn:string-join(for $i in 1 to 75 return '20')
    (: UDA / user-defined area - consider older STLXML files without UDA :)
    || (if($gsi/UDA) then gsi-user-defined-area($gsi/UDA) else fn:string-join(for $i in 1 to 576 return '20'))
  return xs:hexBinary($s)
};

(: convert TTI block from STLXML to STL :)
declare function encode-tti($tti as element(TTI), $cct-number as xs:string) as xs:hexBinary {
  (: concatenate all fields :)
  let $s :=
       tti-non-negative-integer($tti/SGN, 1)
    || tti-non-negative-integer($tti/SN, 2)
    || tti-hex($tti/EBN)
    || tti-hex($tti/CS)
    || tti-time-code($tti/TCI)
    || tti-time-code($tti/TCO)
    || tti-non-negative-integer($tti/VP, 1)
    || tti-hex($tti/JC)
    || tti-hex($tti/CF)
    || (if ($tti/EBN = 'fe') then tti-text-field_user_data($tti/TF) else tti-text-field_text($tti/TF, $cct-number))
  return xs:hexBinary($s)
};

(: ----------------------- START: converter functions ------------------------------ :)
declare function tti-non-negative-integer($v as xs:string?, $octets as xs:integer) as item()? {
  $v ! bin:pack-integer(xs:integer(.), $octets, 'LE') ! xs:hexBinary(.)
};

declare function tti-hex($v as xs:string?) as item()? {
  $v ! xs:hexBinary(.)
};

declare function tti-time-code($v as xs:string?) as item()? {
  (: hr/min/sec/frames given as integers xx/xx/xx/xx :)
  let $s := $v ! (
    (for $i in 0 to 3
    return fn:substring($v, 2 * $i + 1, 2))
    ! xs:integer(.)
    ! bin:pack-integer(., 1, 'LE')
    ! xs:hexBinary(.)
  ) return fn:string-join($s ! xs:string(.), '')
};

(: convert UDA from STLXML to STL :)
declare function gsi-user-defined-area($v as element(UDA)) as item()? {
  xs:base64Binary($v) ! bin:pad-right(., 576 - bin:length(.), 32) ! xs:hexBinary(.)
};

(: convert TF (with user data) from STLXML to STL :)
declare function tti-text-field_user_data($v as element(TF)) as item()? {
  xs:base64Binary($v) ! xs:hexBinary(.)
};

(: convert TF (with text) from STLXML to STL :)
declare function tti-text-field_text($v as element(TF), $cct-number as xs:string) as item()? {
  let $encoding := tti-text-field-encoding($cct-number)
  let $s :=
    for $ch in $v/child::node()
    return
      if($ch instance of element()) then
        (: convert control character :)
        let $cs := $_:TTI-TF-CTRL-CHARS(fn:name($ch))
        return if(fn:empty($cs)) then
          fn:error($_:ERROR, "Invalid control character element '" || fn:name($ch) || "'.")
        else $cs
      else if($ch instance of text()) then
        (: convert text :)
        tti-encode-text-field-chars(fn:replace($ch, '\s', ''), $cct-number)
      else
        ()
  return
    fn:string-join($s, '')
    ! bin:hex(.)
    (: fill remaining space with 0x8F :)
    ! bin:pad-right(., 112 - bin:length(.), 143)
    ! xs:hexBinary(.)
    ! xs:string(.)
};

declare function tti-text-field-encoding($cct as xs:string) {
  (: currently only CCT 00 is supported! :)
  let $encoding := map {
    '00': '6937-2'
  }($cct)
  return
    if(fn:empty($encoding)) then
      fn:error($_:ERROR, "Character code table " || $cct || " is not supported.")
    else ()
};

declare function tti-encode-text-field-chars($s as xs:string, $cct as xs:string) as xs:string? {
  let $s :=
    let $encoding := tti-text-field-encoding($cct)
    (:
      * STL format encodes diacritics by 'floating accent' principle, f.i.: ü -> 0xC875
      * normalized UTF-8 diacritics work similar, but order is switched:    ü -> 0x75C8
      --> Algorithm
        1. given string is chopped to individual characters
        2. each char C is UTF-8 normalized (diacritics are encoded with two bytes)
        3. codepoints are determined for C and reversed, if there are two
        4. each codepoint is mapped to its STL representation via the specified encoding (f.i. iso-6937-2)
    :)
    let $utf8-normalized-cps :=
      let $chars := for $cp in fn:string-to-codepoints($s) return fn:codepoints-to-string($cp)
      for $ch in $chars
      let $norm-cps := fn:normalize-unicode($ch, 'NFD') ! fn:string-to-codepoints(.)
      let $reversed-norm-cps := ($norm-cps[2], $norm-cps[1])
      return $reversed-norm-cps
    for $cp in $utf8-normalized-cps
    let $hex := bin:pack-integer($cp, 2) ! xs:hexBinary(.)
    (: use mapping for non-ascii characters :)
    return if(($hex ge xs:hexBinary('00A0')) or ($hex eq xs:hexBinary('0024'))) then
      ($_:CCT-00(xs:string($hex)), $_:DIACRITIC(xs:string($hex)))[1]
    else
      $hex ! fn:string(.) ! fn:substring(., 3, 2)
  return fn:string-join($s, '')
};

declare function gsi-encode-chars($v as element(), $cpn as xs:string, $l as xs:integer) as item()? {
  let $code-page := map {
    '850': $_:CP850,
    '437': $_:CP437
  }($cpn)
  let $err :=
    if(fn:empty($code-page)) then
      fn:error($_:ERROR, "Character code page " || $cpn || " is not supported.")
    else ()
  let $hex :=
    for $cp in fn:string-to-codepoints($v/fn:string())
    return xs:string($code-page(xs:string($cp)))
  (: fill remaining space with 0x20 :)
  let $padded :=
    fn:string-join($hex, '')
    ! bin:hex(.)
    ! bin:pad-right(., $l - bin:length(.), bin:to-octets(bin:hex('20')))
    ! xs:hexBinary(.)
    ! xs:string(.)
  return xs:hexBinary($padded)
};
(: ----------------------- END: converter functions ------------------------------ :)

(: ------------------------------- ENCODINGS ------------------------------------- :)
(: Text field control character mapping (hex values) :)
declare variable $_:TTI-TF-CTRL-CHARS := map {
  'AlphaBlack'       : '00',
  'AlphaRed'         : '01',
  'AlphaGreen'       : '02',
  'AlphaYellow'      : '03',
  'AlphaBlue'        : '04',
  'AlphaMagenta'     : '05',
  'AlphaCyan'        : '06',
  'AlphaWhite'       : '07',
  'Flash'            : '08',
  'Steady'           : '09',
  'EndBox'           : '0A',
  'StartBox'         : '0B',
  'NormalHeight'     : '0C',
  'DoubleHeight'     : '0D',
  'DoubleWidth'      : '0E',
  'DoubleSize'       : '0F',
  'MosaicBlack'      : '10',
  'MosaicRed'        : '11',
  'MosaicGreen'      : '12',
  'MosaicYellow'     : '13',
  'MosaicBlue'       : '14',
  'MosaicMagenta'    : '15',
  'MosaicCyan'       : '16',
  'MosaicWhite'      : '17',
  'Conceal'          : '18',
  'ContiguousMosaic' : '19',
  'SeparatedMosaic'  : '1A',
  'Reserved'         : '1B',
  'BlackBackground'  : '1C',
  'NewBackground'    : '1D',
  'HoldMosaic'       : '1E',
  'ReleaseMosaic'    : '1F',
  'space'            : '20',
  'newline'          : '8A'
};
(: Character code table 00: ISO 6937/2-1983 :)
declare variable $_:DIACRITIC := map {
    '0300' : 'C1',  (: grave accent :)
    '0301' : 'C2',  (: acute accent :)
    '0302' : 'C3',  (: circumflex :)
    '0303' : 'C4',  (: tilde :)
    '0304' : 'C5',  (: macron :)
    '0306' : 'C6',  (: breve :)
    '0307' : 'C7',  (: dot :)
    '0308' : 'C8',  (: umlaut :)
    '030A' : 'CA',  (: ring :)
    '0327' : 'CB',  (: cedilla :)
    '030B' : 'CD',  (: double acute accent :)
    '0328' : 'CE',  (: ogonek :)
    '030C' : 'CF'   (: caron :)
};
declare variable $_:CCT-00 := map {
  '000A': '8A', (: line break:)

  '00A4': '24', (: ¤:)

  '00A0': 'A0', (:   (NBSP):)
  '00A1': 'A1', (: ¡:)
  '00A2': 'A2', (: ¢:)
  '00A3': 'A3', (: £:)
  '0024': 'A4', (: $:)
  '00A5': 'A5', (: ¥:)
  '00A7': 'A7', (: §:)
  '2018': 'A9', (: ‘:)
  '201C': 'AA', (: “:)
  '00AB': 'AB', (: «:)
  '2190': 'AC', (: ←:)
  '2191': 'AD', (: ↑:)
  '2192': 'AE', (: →:)
  '2193': 'AF', (: ↓:)

  '00B0': 'B0', (: °:)
  '00B1': 'B1', (: ±:)
  '00B2': 'B2', (: ²:)
  '00B3': 'B3', (: ³:)
  '00D7': 'B4', (: ×:)
  '00B5': 'B5', (: µ:)
  '00B6': 'B6', (: ¶:)
  '00B7': 'B7', (: ·:)
  '00F7': 'B8', (: ÷:)
  '2019': 'B9', (: ’:)
  '201D': 'BA', (: ”:)
  '00BB': 'BB', (: »:)
  '00BC': 'BC', (: ¼:)
  '00BD': 'BD', (: ½:)
  '00BE': 'BE', (: ¾:)
  '00BF': 'BF', (: ¿:)

  '2015': 'D0', (: ―:)
  '00B9': 'D1', (: ¹:)
  '00AE': 'D2', (: ®:)
  '00A9': 'D3', (: ©:)
  '2122': 'D4', (: ™:)
  '266A': 'D5', (: ♪:)
  '00AC': 'D6', (: ¬:)
  '00A6': 'D7', (: ¦:)
  '215B': 'DC', (: ⅛:)
  '215C': 'DD', (: ⅜:)
  '215D': 'DE', (: ⅝:)
  '215E': 'DF', (: ⅞:)

  '03A9': 'E0', (: Ω:)
  '00C6': 'E1', (: Æ:)
  '0110': 'E2', (: Đ:)
  '00AA': 'E3', (: ª:)
  '0126': 'E4', (: Ħ:)
  '0132': 'E6', (: Ĳ:)
  '013F': 'E7', (: Ŀ:)
  '0141': 'E8', (: Ł:)
  '00D8': 'E9', (: Ø:)
  '0152': 'EA', (: Œ:)
  '00BA': 'EB', (: º:)
  '00DE': 'EC', (: Þ:)
  '0166': 'ED', (: Ŧ:)
  '014A': 'EE', (: Ŋ:)
  '0149': 'EF', (: ŉ:)

  '0138': 'F0', (: ĸ:)
  '00E6': 'F1', (: æ:)
  '0111': 'F2', (: đ:)
  '00F0': 'F3', (: ð:)
  '0127': 'F4', (: ħ:)
  '0131': 'F5', (: ı:)
  '0133': 'F6', (: ĳ:)
  '0140': 'F7', (: ŀ:)
  '0142': 'F8', (: ł:)
  '00F8': 'F9', (: ø:)
  '0153': 'FA', (: œ:)
  '00DF': 'FB', (: ß:)
  '00FE': 'FC', (: þ:)
  '0167': 'FD', (: ŧ:)
  '014B': 'FE', (: ŋ:)
  '00AD': 'FF'  (:  (SHY):)
};
(: map Unicode code point to CP850 hex :)
declare variable $_:CP850 := map {
  '32' : '20',  (:   :)
  '33' : '21',  (: ! :)
  '34' : '22',  (: " :)
  '35' : '23',  (: # :)
  '36' : '24',  (: $ :)
  '37' : '25',  (: % :)
  '38' : '26',  (: & :)
  '39' : '27',  (: ' :)
  '40' : '28',  (: ( :)
  '41' : '29',  (: ) :)
  '42' : '2A',  (: * :)
  '43' : '2B',  (: + :)
  '44' : '2C',  (: , :)
  '45' : '2D',  (: - :)
  '46' : '2E',  (: . :)
  '47' : '2F',  (: / :)
  '48' : '30',  (: 0 :)
  '49' : '31',  (: 1 :)
  '50' : '32',  (: 2 :)
  '51' : '33',  (: 3 :)
  '52' : '34',  (: 4 :)
  '53' : '35',  (: 5 :)
  '54' : '36',  (: 6 :)
  '55' : '37',  (: 7 :)
  '56' : '38',  (: 8 :)
  '57' : '39',  (: 9 :)
  '58' : '3A',  (: : :)
  '59' : '3B',  (: ; :)
  '60' : '3C',  (: < :)
  '61' : '3D',  (: = :)
  '62' : '3E',  (: > :)
  '63' : '3F',  (: ? :)
  '64' : '40',  (: @ :)
  '65' : '41',  (: A :)
  '66' : '42',  (: B :)
  '67' : '43',  (: C :)
  '68' : '44',  (: D :)
  '69' : '45',  (: E :)
  '70' : '46',  (: F :)
  '71' : '47',  (: G :)
  '72' : '48',  (: H :)
  '73' : '49',  (: I :)
  '74' : '4A',  (: J :)
  '75' : '4B',  (: K :)
  '76' : '4C',  (: L :)
  '77' : '4D',  (: M :)
  '78' : '4E',  (: N :)
  '79' : '4F',  (: O :)
  '80' : '50',  (: P :)
  '81' : '51',  (: Q :)
  '82' : '52',  (: R :)
  '83' : '53',  (: S :)
  '84' : '54',  (: T :)
  '85' : '55',  (: U :)
  '86' : '56',  (: V :)
  '87' : '57',  (: W :)
  '88' : '58',  (: X :)
  '89' : '59',  (: Y :)
  '90' : '5A',  (: Z :)
  '91' : '5B',  (: [ :)
  '92' : '5C',  (: \ :)
  '93' : '5D',  (: ] :)
  '94' : '5E',  (: ^ :)
  '95' : '5F',  (: _ :)
  '96' : '60',  (: ` :)
  '97' : '61',  (: a :)
  '98' : '62',  (: b :)
  '99' : '63',  (: c :)
  '100' : '64',  (: d :)
  '101' : '65',  (: e :)
  '102' : '66',  (: f :)
  '103' : '67',  (: g :)
  '104' : '68',  (: h :)
  '105' : '69',  (: i :)
  '106' : '6A',  (: j :)
  '107' : '6B',  (: k :)
  '108' : '6C',  (: l :)
  '109' : '6D',  (: m :)
  '110' : '6E',  (: n :)
  '111' : '6F',  (: o :)
  '112' : '70',  (: p :)
  '113' : '71',  (: q :)
  '114' : '72',  (: r :)
  '115' : '73',  (: s :)
  '116' : '74',  (: t :)
  '117' : '75',  (: u :)
  '118' : '76',  (: v :)
  '119' : '77',  (: w :)
  '120' : '78',  (: x :)
  '121' : '79',  (: y :)
  '122' : '7A',  (: z :)
  '123' : '7B',  (: { :)
  '124' : '7C',  (: | :)
  '125' : '7D',  (: } :)
  '126' : '7E',  (: ~ :)
  '8962' : '7F',  (: ⌂ :)
  '199' : '80',  (: Ç :)
  '252' : '81',  (: ü :)
  '233' : '82',  (: é :)
  '226' : '83',  (: â :)
  '228' : '84',  (: ä :)
  '224' : '85',  (: à :)
  '229' : '86',  (: å :)
  '231' : '87',  (: ç :)
  '234' : '88',  (: ê :)
  '235' : '89',  (: ë :)
  '232' : '8A',  (: è :)
  '239' : '8B',  (: ï :)
  '238' : '8C',  (: î :)
  '236' : '8D',  (: ì :)
  '196' : '8E',  (: Ä :)
  '197' : '8F',  (: Å :)
  '201' : '90',  (: É :)
  '230' : '91',  (: æ :)
  '198' : '92',  (: Æ :)
  '244' : '93',  (: ô :)
  '246' : '94',  (: ö :)
  '242' : '95',  (: ò :)
  '251' : '96',  (: û :)
  '249' : '97',  (: ù :)
  '255' : '98',  (: ÿ :)
  '214' : '99',  (: Ö :)
  '220' : '9A',  (: Ü :)
  '248' : '9B',  (: ø :)
  '163' : '9C',  (: £ :)
  '216' : '9D',  (: Ø :)
  '215' : '9E',  (: × :)
  '402' : '9F',  (: ƒ :)
  '225' : 'A0',  (: á :)
  '237' : 'A1',  (: í :)
  '243' : 'A2',  (: ó :)
  '250' : 'A3',  (: ú :)
  '241' : 'A4',  (: ñ :)
  '209' : 'A5',  (: Ñ :)
  '170' : 'A6',  (: ª :)
  '186' : 'A7',  (: º :)
  '191' : 'A8',  (: ¿ :)
  '174' : 'A9',  (: ® :)
  '172' : 'AA',  (: ¬ :)
  '189' : 'AB',  (: ½ :)
  '188' : 'AC',  (: ¼ :)
  '161' : 'AD',  (: ¡ :)
  '171' : 'AE',  (: « :)
  '187' : 'AF',  (: » :)
  '9617' : 'B0',  (: ░ :)
  '9618' : 'B1',  (: ▒ :)
  '9619' : 'B2',  (: ▓ :)
  '9474' : 'B3',  (: │ :)
  '9508' : 'B4',  (: ┤ :)
  '193' : 'B5',  (: Á :)
  '194' : 'B6',  (: Â :)
  '192' : 'B7',  (: À :)
  '169' : 'B8',  (: © :)
  '9571' : 'B9',  (: ╣ :)
  '9553' : 'BA',  (: ║ :)
  '9559' : 'BB',  (: ╗ :)
  '9565' : 'BC',  (: ╝ :)
  '162' : 'BD',  (: ¢ :)
  '165' : 'BE',  (: ¥ :)
  '9488' : 'BF',  (: ┐ :)
  '9492' : 'C0',  (: └ :)
  '9524' : 'C1',  (: ┴ :)
  '9516' : 'C2',  (: ┬ :)
  '9500' : 'C3',  (: ├ :)
  '9472' : 'C4',  (: ─ :)
  '9532' : 'C5',  (: ┼ :)
  '227' : 'C6',  (: ã :)
  '195' : 'C7',  (: Ã :)
  '9562' : 'C8',  (: ╚ :)
  '9556' : 'C9',  (: ╔ :)
  '9577' : 'CA',  (: ╩ :)
  '9574' : 'CB',  (: ╦ :)
  '9568' : 'CC',  (: ╠ :)
  '9552' : 'CD',  (: ═ :)
  '9580' : 'CE',  (: ╬ :)
  '164' : 'CF',  (: ¤ :)
  '240' : 'D0',  (: ð :)
  '208' : 'D1',  (: Ð :)
  '202' : 'D2',  (: Ê :)
  '203' : 'D3',  (: Ë :)
  '200' : 'D4',  (: È :)
  '305' : 'D5',  (: ı :)
  '205' : 'D6',  (: Í :)
  '206' : 'D7',  (: Î :)
  '207' : 'D8',  (: Ï :)
  '9496' : 'D9',  (: ┘ :)
  '9484' : 'DA',  (: ┌ :)
  '9608' : 'DB',  (: █ :)
  '9604' : 'DC',  (: ▄ :)
  '166' : 'DD',  (: ¦ :)
  '204' : 'DE',  (: Ì :)
  '9600' : 'DF',  (: ▀ :)
  '211' : 'E0',  (: Ó :)
  '223' : 'E1',  (: ß :)
  '212' : 'E2',  (: Ô :)
  '210' : 'E3',  (: Ò :)
  '245' : 'E4',  (: õ :)
  '213' : 'E5',  (: Õ :)
  '181' : 'E6',  (: µ :)
  '254' : 'E7',  (: þ :)
  '222' : 'E8',  (: Þ :)
  '218' : 'E9',  (: Ú :)
  '219' : 'EA',  (: Û :)
  '217' : 'EB',  (: Ù :)
  '253' : 'EC',  (: ý :)
  '221' : 'ED',  (: Ý :)
  '175' : 'EE',  (: ¯ :)
  '180' : 'EF',  (: ´ :)
  '173' : 'F0',  (:  :)
  '177' : 'F1',  (: ± :)
  '8215' : 'F2',  (: ‗ :)
  '190' : 'F3',  (: ¾ :)
  '182' : 'F4',  (: ¶ :)
  '167' : 'F5',  (: § :)
  '247' : 'F6',  (: ÷ :)
  '184' : 'F7',  (: ¸ :)
  '176' : 'F8',  (: ° :)
  '168' : 'F9',  (: ¨ :)
  '183' : 'FA',  (: · :)
  '185' : 'FB',  (: ¹ :)
  '179' : 'FC',  (: ³ :)
  '178' : 'FD',  (: ² :)
  '9632' : 'FE',  (: ■ :)
  '160' : 'FF'   (:   :)
};
(: map Unicode code point to CP437 hex :)
declare variable $_:CP437 := map {
  '32' : '20',  (:   :)
  '33' : '21',  (: ! :)
  '34' : '22',  (: " :)
  '35' : '23',  (: # :)
  '36' : '24',  (: $ :)
  '37' : '25',  (: % :)
  '38' : '26',  (: & :)
  '39' : '27',  (: ' :)
  '40' : '28',  (: ( :)
  '41' : '29',  (: ) :)
  '42' : '2A',  (: * :)
  '43' : '2B',  (: + :)
  '44' : '2C',  (: , :)
  '45' : '2D',  (: - :)
  '46' : '2E',  (: . :)
  '47' : '2F',  (: / :)
  '48' : '30',  (: 0 :)
  '49' : '31',  (: 1 :)
  '50' : '32',  (: 2 :)
  '51' : '33',  (: 3 :)
  '52' : '34',  (: 4 :)
  '53' : '35',  (: 5 :)
  '54' : '36',  (: 6 :)
  '55' : '37',  (: 7 :)
  '56' : '38',  (: 8 :)
  '57' : '39',  (: 9 :)
  '58' : '3A',  (: : :)
  '59' : '3B',  (: ; :)
  '60' : '3C',  (: < :)
  '61' : '3D',  (: = :)
  '62' : '3E',  (: > :)
  '63' : '3F',  (: ? :)
  '64' : '40',  (: @ :)
  '65' : '41',  (: A :)
  '66' : '42',  (: B :)
  '67' : '43',  (: C :)
  '68' : '44',  (: D :)
  '69' : '45',  (: E :)
  '70' : '46',  (: F :)
  '71' : '47',  (: G :)
  '72' : '48',  (: H :)
  '73' : '49',  (: I :)
  '74' : '4A',  (: J :)
  '75' : '4B',  (: K :)
  '76' : '4C',  (: L :)
  '77' : '4D',  (: M :)
  '78' : '4E',  (: N :)
  '79' : '4F',  (: O :)
  '80' : '50',  (: P :)
  '81' : '51',  (: Q :)
  '82' : '52',  (: R :)
  '83' : '53',  (: S :)
  '84' : '54',  (: T :)
  '85' : '55',  (: U :)
  '86' : '56',  (: V :)
  '87' : '57',  (: W :)
  '88' : '58',  (: X :)
  '89' : '59',  (: Y :)
  '90' : '5A',  (: Z :)
  '91' : '5B',  (: [ :)
  '92' : '5C',  (: \ :)
  '93' : '5D',  (: ] :)
  '94' : '5E',  (: ^ :)
  '95' : '5F',  (: _ :)
  '96' : '60',  (: ` :)
  '97' : '61',  (: a :)
  '98' : '62',  (: b :)
  '99' : '63',  (: c :)
  '100' : '64',  (: d :)
  '101' : '65',  (: e :)
  '102' : '66',  (: f :)
  '103' : '67',  (: g :)
  '104' : '68',  (: h :)
  '105' : '69',  (: i :)
  '106' : '6A',  (: j :)
  '107' : '6B',  (: k :)
  '108' : '6C',  (: l :)
  '109' : '6D',  (: m :)
  '110' : '6E',  (: n :)
  '111' : '6F',  (: o :)
  '112' : '70',  (: p :)
  '113' : '71',  (: q :)
  '114' : '72',  (: r :)
  '115' : '73',  (: s :)
  '116' : '74',  (: t :)
  '117' : '75',  (: u :)
  '118' : '76',  (: v :)
  '119' : '77',  (: w :)
  '120' : '78',  (: x :)
  '121' : '79',  (: y :)
  '122' : '7A',  (: z :)
  '123' : '7B',  (: { :)
  '124' : '7C',  (: | :)
  '125' : '7D',  (: } :)
  '126' : '7E',  (: ~ :)
  '8962' : '7F',  (: ⌂ :)
  '199' : '80',  (: Ç :)
  '252' : '81',  (: ü :)
  '233' : '82',  (: é :)
  '226' : '83',  (: â :)
  '228' : '84',  (: ä :)
  '224' : '85',  (: à :)
  '229' : '86',  (: å :)
  '231' : '87',  (: ç :)
  '234' : '88',  (: ê :)
  '235' : '89',  (: ë :)
  '232' : '8A',  (: è :)
  '239' : '8B',  (: ï :)
  '238' : '8C',  (: î :)
  '236' : '8D',  (: ì :)
  '196' : '8E',  (: Ä :)
  '197' : '8F',  (: Å :)
  '201' : '90',  (: É :)
  '230' : '91',  (: æ :)
  '198' : '92',  (: Æ :)
  '244' : '93',  (: ô :)
  '246' : '94',  (: ö :)
  '242' : '95',  (: ò :)
  '251' : '96',  (: û :)
  '249' : '97',  (: ù :)
  '255' : '98',  (: ÿ :)
  '214' : '99',  (: Ö :)
  '220' : '9A',  (: Ü :)
  '162' : '9B',  (: ¢ :)
  '163' : '9C',  (: £ :)
  '165' : '9D',  (: ¥ :)
  '8359' : '9E',  (: ₧ :)
  '402' : '9F',  (: ƒ :)
  '225' : 'A0',  (: á :)
  '237' : 'A1',  (: í :)
  '243' : 'A2',  (: ó :)
  '250' : 'A3',  (: ú :)
  '241' : 'A4',  (: ñ :)
  '209' : 'A5',  (: Ñ :)
  '170' : 'A6',  (: ª :)
  '186' : 'A7',  (: º :)
  '191' : 'A8',  (: ¿ :)
  '8976' : 'A9',  (: ⌐ :)
  '172' : 'AA',  (: ¬ :)
  '189' : 'AB',  (: ½ :)
  '188' : 'AC',  (: ¼ :)
  '161' : 'AD',  (: ¡ :)
  '171' : 'AE',  (: « :)
  '187' : 'AF',  (: » :)
  '9617' : 'B0',  (: ░ :)
  '9618' : 'B1',  (: ▒ :)
  '9619' : 'B2',  (: ▓ :)
  '9474' : 'B3',  (: │ :)
  '9508' : 'B4',  (: ┤ :)
  '9569' : 'B5',  (: ╡ :)
  '9570' : 'B6',  (: ╢ :)
  '9558' : 'B7',  (: ╖ :)
  '9557' : 'B8',  (: ╕ :)
  '9571' : 'B9',  (: ╣ :)
  '9553' : 'BA',  (: ║ :)
  '9559' : 'BB',  (: ╗ :)
  '9565' : 'BC',  (: ╝ :)
  '9564' : 'BD',  (: ╜ :)
  '9563' : 'BE',  (: ╛ :)
  '9488' : 'BF',  (: ┐ :)
  '9492' : 'C0',  (: └ :)
  '9524' : 'C1',  (: ┴ :)
  '9516' : 'C2',  (: ┬ :)
  '9500' : 'C3',  (: ├ :)
  '9472' : 'C4',  (: ─ :)
  '9532' : 'C5',  (: ┼ :)
  '9566' : 'C6',  (: ╞ :)
  '9567' : 'C7',  (: ╟ :)
  '9562' : 'C8',  (: ╚ :)
  '9556' : 'C9',  (: ╔ :)
  '9577' : 'CA',  (: ╩ :)
  '9574' : 'CB',  (: ╦ :)
  '9568' : 'CC',  (: ╠ :)
  '9552' : 'CD',  (: ═ :)
  '9580' : 'CE',  (: ╬ :)
  '9575' : 'CF',  (: ╧ :)
  '9576' : 'D0',  (: ╨ :)
  '9572' : 'D1',  (: ╤ :)
  '9573' : 'D2',  (: ╥ :)
  '9561' : 'D3',  (: ╙ :)
  '9560' : 'D4',  (: ╘ :)
  '9554' : 'D5',  (: ╒ :)
  '9555' : 'D6',  (: ╓ :)
  '9579' : 'D7',  (: ╫ :)
  '9578' : 'D8',  (: ╪ :)
  '9496' : 'D9',  (: ┘ :)
  '9484' : 'DA',  (: ┌ :)
  '9608' : 'DB',  (: █ :)
  '9604' : 'DC',  (: ▄ :)
  '9612' : 'DD',  (: ▌ :)
  '9616' : 'DE',  (: ▐ :)
  '9600' : 'DF',  (: ▀ :)
  '945' : 'E0',  (: α :)
  '223' : 'E1',  (: ß :)
  '915' : 'E2',  (: Γ :)
  '960' : 'E3',  (: π :)
  '931' : 'E4',  (: Σ :)
  '963' : 'E5',  (: σ :)
  '181' : 'E6',  (: µ :)
  '964' : 'E7',  (: τ :)
  '934' : 'E8',  (: Φ :)
  '920' : 'E9',  (: Θ :)
  '937' : 'EA',  (: Ω :)
  '948' : 'EB',  (: δ :)
  '8734' : 'EC',  (: ∞ :)
  '966' : 'ED',  (: φ :)
  '949' : 'EE',  (: ε :)
  '8745' : 'EF',  (: ∩ :)
  '8801' : 'F0',  (: ≡ :)
  '177' : 'F1',  (: ± :)
  '8805' : 'F2',  (: ≥ :)
  '8804' : 'F3',  (: ≤ :)
  '8992' : 'F4',  (: ⌠ :)
  '8993' : 'F5',  (: ⌡ :)
  '247' : 'F6',  (: ÷ :)
  '8776' : 'F7',  (: ≈ :)
  '176' : 'F8',  (: ° :)
  '8729' : 'F9',  (: ∙ :)
  '183' : 'FA',  (: · :)
  '8730' : 'FB',  (: √ :)
  '8319' : 'FC',  (: ⁿ :)
  '178' : 'FD',  (: ² :)
  '9632' : 'FE',  (: ■ :)
  '160' : 'FF'   (:   :)
};


Fixed SF#3102373. Recursive file:files with pattern was not working.

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

(:~
 : This library module provides simple file system I/O operations.
 :
 : @author Gabriel Petrovay
 :
 :)
module namespace file = "http://www.zorba-xquery.com/modules/file";

(:~
 : Copies a file given a source and a destination paths/URIs. The operation
 : fails if the source path/URI does not point to a file or the destination
 : path/URI is already used.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destinationFile The detination <tt>path/URI</tt>.
 : @return true if the copy operation was successful.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:copy(
  $sourceFile as xs:string,
  $destinationFile as xs:string
) as xs:boolean external;

(:~
 : Copies a file given a source and a destination paths/uris. The operation
 : fails if the source path/URI does not point to a file or the destination
 : path/URI is already used if the overwrite flag is se to false.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destinationFile The destination path/URI.
 : @param $overwrite Flag to control if the operation should succeed if a the
 :        destination file already exists.
 : @return true if the copy operation was successful
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:copy(
  $sourceFile as xs:string,
  $destinationFile as xs:string,
  $overwrite as xs:boolean
) as xs:boolean external;

(:~
 : Tests if a path/URI is already used in the file system
 :
 : @param $fileOrDir The path/URI to test for existance.
 : @return true if the path/URI points to an existing file system item.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:exists(
  $fileOrDir as xs:string
) as xs:boolean external;

(:~
 : Lists the file system items in a certain directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not returned.
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @return The sequence of names of the direct children.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:files(
  $path as xs:string
) as xs:string* external;

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The result of this function is equivalent to the following call:
 : <tt>file:files($path, $pattern, fn:false())</tt>
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @param $pattern The file name condition to be checked.
 : @return A sequence of file names matching the pattern.
 :)
declare function file:files(
  $path as xs:string,
  $pattern as xs:string
) as xs:string* {
  file:files($path, $pattern, fn:false())
};

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @param $pattern The file name condition to be checked.
 : @param $recursive A boolean flag indicating whether directories
 :        should be searched recursively.
 : @return A sequence of file names matching the pattern.
 :)
declare function file:files(
  $path as xs:string,
  $pattern as xs:string,
  $recursive as xs:boolean
) as xs:string* {
  for $f in file:files($path)
  let $full := fn:concat($path, file:path-separator(), $f)
  let $is_directory := file:is-directory($full)
  let $result :=
    (
      if (fn:matches($f, $pattern))
      then $f
      else ()
      ,
      if ($recursive and $is_directory)
      then
        for $child in file:files($full, $pattern, $recursive)
        return fn:concat($f, file:path-separator(), $child)
      else ()
  )
  return $result
};

(:~
 : Tests if a path/URI points to a directory. On UNIX-based systems, the root
 : and the volumes roots are considered directories.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a directory.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:is-directory(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a file.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a file.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:is-file(
  $file as xs:string
) as xs:boolean external;

(:~
 : Retrieves the timestamp of the last modification of the file system item
 : pointed by the path/URI.
 :
 : @param $fileOrDir The file system item to read the last modification
 :        timestamp from.
 : @return The date and time of the last modification of the item.
 : @error An error is thrown if the provided path does not point to an existing
 :        item or if IO or Security problems occur.
 :)
declare %nondeterministic function file:last-modified(
  $fileOrDir as xs:string
) as xs:dateTime external;

(:~
 : Creates a directory. The operation is equivalent to calling:
 : file:mkdir($dir, true()).
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @return true if the operation succeeds.
 : @error An error is thrown if a recursive directory creation is attempted,
 :        or if IO or Security problems occur.
 :)
declare sequential function file:mkdir(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Creates a directory. This function is not recursive. The $create flag
 : controls the behavior of this function in case the provided path/URI points
 : to an already existing directory.
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @param $create Flag indicating whether the directory must be created or not.
 : @return When $create is true, this operation returns true only when the
 :         directory is created. If $create is false, this operation succeeds
 :         even if $dir points to an existing directory.
 : @error An error is thrown if a recursive directory creation is attempted,
 :        or if IO or Security problems occur.
 :)
declare sequential function file:mkdir(
  $dir as xs:string,
  $create as xs:boolean
) as xs:boolean external;

(:~
 : Creates directories recursively. All the missing parent directories from the
 : path/URI are created.
 :
 : @param $dir The path/URI denoting the directories to be created.
 : @return true if the directory was successfully created.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:mkdirs(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Creates directories recursively. The $create flag controls the behavior of
 : this function in case the provided path/URI points to an already existing
 : directory.
 :
 : @param $dir The path/URI denoting the directories to be created.
 : @param $create Flag indicating whether the directory must be created or not.
 : @return When $create is true, this operation returns true only when the
 :         directory is created. If $create is false, this operation succeeds
 :         even if $dir points to an existing directory.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:mkdirs(
  $dir as xs:string,
  $create as xs:boolean
) as xs:boolean external;

(:~
 : This function returns the file path separator used by this operating system.
 :
 : @return The operating system file path separator.
 :)
declare function file:path-separator() as xs:string external;

(:~
 : Transforms a path/URI into a full operating system path. The URI must have
 : the file:// scheme. The operation is performed redardless the existence
 : of the provided path.
 :
 : @param $path The path/URI to transform.
 : @return The operating system file path.
 :)
declare function file:path-to-full-path(
  $path as xs:string
) as xs:string external;

(:~
 : Transforms a file system path into a URI with the file:// scheme. No checks
 : are performed redardless of the existence of the provided file system path.
 :
 : @param $path The path to transform.
 : @return The file URI corresponding to the provided path.
 :)
declare function file:path-to-uri(
  $path as xs:string
) as xs:anyURI external;

(:~
 : Reads the content of a file and returns a Base64 representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as Base64.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:read(
  $file as xs:string
) as xs:base64Binary external;

(:~
 : NOT IMPLEMENTED YET!
 : This function reads the content of an HTML file, uses the Tidy library to
 : clean the HTML content and obtain a valid XML document.
 :
 : @param
 : @param
 : @return An XML document containing the tidy-ed HTML from $file
 : @error The function returns an error if it cannot build a valid XML document
 :        after trying to "tidy" the file content. An error is also thrown if
 :        IO or Security problems occur.
 :)
declare sequential function file:read-html(
  $file as xs:string,
  $tidyOptions as xs:string
) as xs:string external;

(:~
 : Reads the content of a file and returns a string representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as string.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:read-text(
  $file as xs:string
) as xs:string external;

(:~
 : Reads a file as an XML file and returns an XML document. The file content
 : must be a valid XML otherwise an error will be thrown.
 :
 : @param $file The file path/URI to be read.
 : @return An XML document containing the content of the file.
 : @error An error is thrown if the does not contain a valid XML, or if IO or
 :        Security problems occur.
 :)
declare sequential function file:read-xml(
  $file as xs:string
) as node() external;

(:~
 : Delete a file or a directory from the file system. This operation is not
 : recursive and it will fail for non-emty directories.
 :
 : @param $fileOrDir The path/URI of the file or directory to delete.
 : @return true is the operation is succeeds.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:remove(
  $fileOrDir as xs:string
) as xs:boolean external;

(:~
 : Write a sequence of items to a file. This operation creates a new file
 : regardless if the given path/URI points to an existing file or not.
 :
 : @param $file The file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content. The semantics is the same with the <tt>$params</tt>
 :        parameter of the <tt>fn:serialize</tt> function.
 : @return The empty sequence
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as node()*
) external;

(:~
 : Write a sequence of items to a file. This operation creates a new file or
 : appends the serialized content to the file pointed by the given path/URI
 : If the append flag is true and the file does not exist, a new one is
 : created.
 :
 : @param $file The file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content. The semantics is the same with the <tt>$params</tt>
 :        parameter of the <tt>fn:serialize</tt> function.
 : @param $append Flag to specify if this is an append operation or not.
 : @return The empty sequence
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as node()*,
  $append as xs:boolean
) external;

(:~
 : This is a helper function. Since relative paths are assumed to have its
 : base directory on the current working directory, a user can still construct
 : the uri of the directory where your base uri is in. This function assumes,
 : that the base uri from the given item is a file uri. If it is not, this
 : function can file or return senseless results.
 :
 : @param $node The node, where the base uri should read from (it uses
 :              fn:base-uri to do so).
 : @return The directory, where of the base uri of $node.
 :)
declare function file:dir-of-base-uri($node as node()) as xs:string
{
  fn:concat(
    let $arg := fn:base-uri($node)
    let $delim := "/"
    return
      if (matches($arg, $delim)) then
        replace($arg,
                concat('^(.*)', $delim,'.*'),
                       '$1')
      else '',
      "/")
};

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

(:~
 : This library module provides simple file system I/O operations.
 :
 : @author Gabriel Petrovay
 :
 :)
module namespace file = "http://www.zorba-xquery.com/modules/file";

(:~
 : Copies a file given a source and a destination paths/URIs. The operation
 : fails if the source path/URI does not point to a file or the destination
 : path/URI is already used.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destinationFile The detination <tt>path/URI</tt>.
 : @return true if the copy operation was successful.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:copy(
  $sourceFile as xs:string,
  $destinationFile as xs:string
) as xs:boolean external;

(:~
 : Copies a file given a source and a destination paths/uris. The operation
 : fails if the source path/URI does not point to a file or the destination
 : path/URI is already used if the overwrite flag is se to false.
 :
 : @param $sourceFile The path/URI of the file to copy.
 : @param $destinationFile The destination path/URI.
 : @param $overwrite Flag to control if the operation should succeed if a the
 :        destination file already exists.
 : @return true if the copy operation was successful
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:copy(
  $sourceFile as xs:string,
  $destinationFile as xs:string,
  $overwrite as xs:boolean
) as xs:boolean external;

(:~
 : Tests if a path/URI is already used in the file system
 :
 : @param $fileOrDir The path/URI to test for existance.
 : @return true if the path/URI points to an existing file system item.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:exists(
  $fileOrDir as xs:string
) as xs:boolean external;

(:~
 : Lists the file system items in a certain directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not returned.
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @return The sequence of names of the direct children.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:files(
  $path as xs:string
) as xs:string* external;

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The result of this function is equivalent to the following call:
 : <tt>file:files($path, $pattern, fn:false())</tt>
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @param $pattern The file name condition to be checked.
 : @return A sequence of file names matching the pattern.
 :)
declare function file:files(
  $path as xs:string,
  $pattern as xs:string
) as xs:string* {
  file:files($path, $pattern, fn:false())
};

(:~
 : Lists all files matching the given pattern in a given directory.
 : The order of the items in the result is not defined.
 : The "." and ".." items are not considered for the match.
 : The file paths are relative to the provided <tt>$path</tt>.
 :
 : @param $path The path/URI to retrieve the children from.
 : @param $pattern The file name condition to be checked.
 : @param $recursive A boolean flag indicating whether directories
 :        should be searched recursively.
 : @return A sequence of file names matching the pattern.
 :)
declare function file:files(
  $path as xs:string,
  $pattern as xs:string,
  $recursive as xs:boolean
) as xs:string* {
  for $f in file:files($path)
  let $full := fn:concat($path, "/", $f)
  let $is_directory := file:is-directory($full)
  let $result :=
    if ($recursive and $is_directory)
    then
      for $child in file:files($full, $pattern, $recursive)
      return fn:concat($f, file:path-separator(), $child)
    else
      if (fn:matches($f, $pattern))
      then $f
      else ()
  return $result
};

(:~
 : Tests if a path/URI points to a directory. On UNIX-based systems, the root
 : and the volumes roots are considered directories.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a directory.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:is-directory(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Tests if a path/URI points to a file.
 :
 : @param $dir The path/URI to test.
 : @return true if the path/URI points to a file.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:is-file(
  $file as xs:string
) as xs:boolean external;

(:~
 : Retrieves the timestamp of the last modification of the file system item
 : pointed by the path/URI.
 :
 : @param $fileOrDir The file system item to read the last modification
 :        timestamp from.
 : @return The date and time of the last modification of the item.
 : @error An error is thrown if the provided path does not point to an existing
 :        item or if IO or Security problems occur.
 :)
declare %nondeterministic function file:last-modified(
  $fileOrDir as xs:string
) as xs:dateTime external;

(:~
 : Creates a directory. The operation is equivalent to calling:
 : file:mkdir($dir, true()).
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @return true if the operation succeeds.
 : @error An error is thrown if a recursive directory creation is attempted,
 :        or if IO or Security problems occur.
 :)
declare sequential function file:mkdir(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Creates a directory. This function is not recursive. The $create flag
 : controls the behavior of this function in case the provided path/URI points
 : to an already existing directory.
 :
 : @param $dir The path/URI denoting the directory to be created.
 : @param $create Flag indicating whether the directory must be created or not.
 : @return When $create is true, this operation returns true only when the
 :         directory is created. If $create is false, this operation succeeds
 :         even if $dir points to an existing directory.
 : @error An error is thrown if a recursive directory creation is attempted,
 :        or if IO or Security problems occur.
 :)
declare sequential function file:mkdir(
  $dir as xs:string,
  $create as xs:boolean
) as xs:boolean external;

(:~
 : Creates directories recursively. All the missing parent directories from the
 : path/URI are created.
 :
 : @param $dir The path/URI denoting the directories to be created.
 : @return true if the directory was successfully created.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:mkdirs(
  $dir as xs:string
) as xs:boolean external;

(:~
 : Creates directories recursively. The $create flag controls the behavior of
 : this function in case the provided path/URI points to an already existing
 : directory.
 :
 : @param $dir The path/URI denoting the directories to be created.
 : @param $create Flag indicating whether the directory must be created or not.
 : @return When $create is true, this operation returns true only when the
 :         directory is created. If $create is false, this operation succeeds
 :         even if $dir points to an existing directory.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:mkdirs(
  $dir as xs:string,
  $create as xs:boolean
) as xs:boolean external;

(:~
 : This function returns the file path separator used by this operating system.
 :
 : @return The operating system file path separator.
 :)
declare function file:path-separator() as xs:string external;

(:~
 : Transforms a path/URI into a full operating system path. The URI must have
 : the file:// scheme. The operation is performed redardless the existence
 : of the provided path.
 :
 : @param $path The path/URI to transform.
 : @return The operating system file path.
 :)
declare function file:path-to-full-path(
  $path as xs:string
) as xs:string external;

(:~
 : Transforms a file system path into a URI with the file:// scheme. No checks
 : are performed redardless of the existence of the provided file system path.
 :
 : @param $path The path to transform.
 : @return The file URI corresponding to the provided path.
 :)
declare function file:path-to-uri(
  $path as xs:string
) as xs:anyURI external;

(:~
 : Reads the content of a file and returns a Base64 representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as Base64.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:read(
  $file as xs:string
) as xs:base64Binary external;

(:~
 : NOT IMPLEMENTED YET!
 : This function reads the content of an HTML file, uses the Tidy library to
 : clean the HTML content and obtain a valid XML document.
 :
 : @param
 : @param
 : @return An XML document containing the tidy-ed HTML from $file
 : @error The function returns an error if it cannot build a valid XML document
 :        after trying to "tidy" the file content. An error is also thrown if
 :        IO or Security problems occur.
 :)
declare sequential function file:read-html(
  $file as xs:string,
  $tidyOptions as xs:string
) as xs:string external;

(:~
 : Reads the content of a file and returns a string representation of the
 : content.
 :
 : @param $file The file to read.
 : @return The content of the file as string.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare %nondeterministic function file:read-text(
  $file as xs:string
) as xs:string external;

(:~
 : Reads a file as an XML file and returns an XML document. The file content
 : must be a valid XML otherwise an error will be thrown.
 :
 : @param $file The file path/URI to be read.
 : @return An XML document containing the content of the file.
 : @error An error is thrown if the does not contain a valid XML, or if IO or
 :        Security problems occur.
 :)
declare sequential function file:read-xml(
  $file as xs:string
) as node() external;

(:~
 : Delete a file or a directory from the file system. This operation is not
 : recursive and it will fail for non-emty directories.
 :
 : @param $fileOrDir The path/URI of the file or directory to delete.
 : @return true is the operation is succeeds.
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:remove(
  $fileOrDir as xs:string
) as xs:boolean external;

(:~
 : Write a sequence of items to a file. This operation creates a new file
 : regardless if the given path/URI points to an existing file or not.
 :
 : @param $file The file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content. The semantics is the same with the <tt>$params</tt>
 :        parameter of the <tt>fn:serialize</tt> function.
 : @return The empty sequence
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as node()*
) external;

(:~
 : Write a sequence of items to a file. This operation creates a new file or
 : appends the serialized content to the file pointed by the given path/URI
 : If the append flag is true and the file does not exist, a new one is
 : created.
 :
 : @param $file The file to write the content to.
 : @param $content The content to be serialized to the file.
 : @param $serializer-params Parameter to control the serialization of the
 :        content. The semantics is the same with the <tt>$params</tt>
 :        parameter of the <tt>fn:serialize</tt> function.
 : @param $append Flag to specify if this is an append operation or not.
 : @return The empty sequence
 : @error An error is thrown if IO or Security problems occur.
 :)
declare sequential function file:write(
  $file as xs:string,
  $content as item()*,
  $serializer-params as node()*,
  $append as xs:boolean
) external;

(:~
 : This is a helper function. Since relative paths are assumed to have its
 : base directory on the current working directory, a user can still construct
 : the uri of the directory where your base uri is in. This function assumes,
 : that the base uri from the given item is a file uri. If it is not, this
 : function can file or return senseless results.
 :
 : @param $node The node, where the base uri should read from (it uses
 :              fn:base-uri to do so).
 : @return The directory, where of the base uri of $node.
 :)
declare function file:dir-of-base-uri($node as node()) as xs:string
{
  fn:concat(
    let $arg := fn:base-uri($node)
    let $delim := "/"
    return
      if (matches($arg, $delim)) then
        replace($arg,
                concat('^(.*)', $delim,'.*'),
                       '$1')
      else '',
      "/")
};


[ignore] try to fix failing tests

[ignore] try to fix failing tests

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

xquery version "1.0";

module namespace t="http://exist-db.org/xquery/testing";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        case element(remove-document) return
            xdb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xdb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:run-test($test as element(test), $count as xs:integer) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $queryOutput :=
		util:catch("*",
			util:eval(concat($context, $test/code/string()), false()),
			<error>Compilation error: {$util:exception-message}</error>
		)
	let $output := if ($test/@trace eq 'yes') then system:trace() else $queryOutput
    let $expanded :=
        if ($output instance of element(error)) then
            $output
        else if ($test/@serialize) then
            let $options := $test/@serialize
            let $serialized :=
                util:catch("*",
                    for $x in $output
                    return
                        util:serialize($x, $options),
                    <error>Serialization error: {$util:exception-message}</error>
                )
            return
                if ($serialized instance of element(error)) then
                    $serialized
                else
                    normalize-space(string-join($serialized, ' '))
		else if ($output instance of node()) then
        	util:expand($output, $serialize-options)
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            $expanded instance of element(error) and contains($expanded, $test/error)
        else if ($test/xpath) then
            t:test(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded
                else
                    normalize-space(string-join(for $x in $output return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded)
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$expanded}</result>)
            else
                ()
        }
        </test>
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

declare function t:normalize-node($node as node()) {
	typeswitch ($node)
		case element() return
			element { node-name($node) } {
				$node/@*, for $child in $node/node() return t:normalize-node($child)
			}
		case text() return
			let $norm := normalize-space($node)
			return
				if (string-length($norm) eq 0) then () else $node
		default return
			$node
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet)) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $copy/test[empty(@ignore) or @ignore = "no"]
               return
                   t:run-test($test, $p)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};

xquery version "1.0";

module namespace t="http://exist-db.org/xquery/testing";

import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";

declare function t:setup-action($action) {
    typeswitch ($action)
        case element(create-collection) return
            xdb:create-collection($action/@parent, $action/@name)
        case element(store) return
			t:store($action)
		case element(store-files) return
            t:store-files($action)
        case element(remove-collection) return
            xdb:remove($action/@collection)
        case element(remove-document) return
            xdb:remove($action/@collection, $action/@name)
        default return
            ()
};

declare function t:store($action as element(store)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    let $data :=
		if ($action/*) then
			$action/*[1]
		else
			$action/string()
	return
        xdb:store($action/@collection, $action/@name, $data, $type)
};

declare function t:store-files($action as element(store-files)) {
    let $type := if ($action/@type) then $action/@type/string() else "application/xml"
    return
        xdb:store-files-from-pattern($action/@collection, $action/@dir, $action/@pattern, $type)
};

declare function t:setup($setup as element(setup)) {
    for $action in $setup/*
    return
        t:setup-action($action)
};

declare function t:tearDown($tearDown as element(tearDown)?) {
    for $action in $tearDown/*
    return
        t:setup-action($action)
};

declare function t:declare-variable($var as element(variable)) as item()? {
    let $children := $var/*
    return
        if (empty($children)) then
            string-join($var/node(), '')
        else
            util:serialize($children, ())
};

declare function t:init-prolog($test as element(test)) {
	let $imports := $test/../imports
	let $vars :=
	    string-join(
        	for $var in $test/../variable
        	return
        	    concat("declare variable $", $var/@name, " := ", t:declare-variable($var), ";"),
            ""
        )
	return
		string-join(($imports, $vars, $test/../functions), '')
};

declare function t:test($result as item()*) {
    if ($result instance of xs:boolean) then
        $result
    else
        exists($result)
};

declare function t:run-test($test as element(test), $count as xs:integer) {
	let $context := t:init-prolog($test)
	let $null :=
	   if ($test/@trace eq 'yes') then
	       (system:clear-trace(), system:enable-tracing(true(), false()))
       else ()
    let $highlight-option := concat("highlight-matches=",
          if ($test/expected//@*[matches(., '^(\|{3}).*\1$')] and $test/expected//exist:match) then "both"
          else if ($test/expected//@*[matches(., '^(\|{3}).*\1$')]) then "attributes"
          else if ($test/expected//exist:match) then "elements"
          else "none"
          )
    let $serialize-options :=
      let $decls := ($test/../*[name() ne 'test']|$test/code)[matches(., 'declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|').*?\4[;)]')]
      let $ops1 := $decls/replace(., "declare[\- ]option(\(("|')|\s+)exist:serialize(\2,)?\s+("|')(.*?)\4[;)]", "_|$5_")
      let $ops2 :=
        for $a in $ops1
        for $b in tokenize($a, '_')[starts-with(., '|')]
        return tokenize(substring-after($b, '|'), '\s+')
      return if (count($ops2[matches(., 'highlight-matches')]))
        then string-join($ops2, ' ')
        else string-join(($ops2, $highlight-option), ' ')
    let $queryOutput :=
		util:catch("*",
			util:eval(concat($context, $test/code/string())),
			<error>Compilation error: {$util:exception-message}</error>
		)
	let $output := if ($test/@trace eq 'yes') then system:trace() else $queryOutput
    let $expanded :=
        if ($output instance of element(error)) then
            $output
        else if ($test/@serialize) then
            let $options := $test/@serialize
            let $serialized :=
                util:catch("*",
                    for $x in $output
                    return
                        util:serialize($x, $options),
                    <error>Serialization error: {$util:exception-message}</error>
                )
            return
                if ($serialized instance of element(error)) then
                    $serialized
                else
                    normalize-space(string-join($serialized, ' '))
		else if ($output instance of node()) then
        	util:expand($output, $serialize-options)
		else
			$output
    let $expected :=
        if ($test/@output eq 'text') then
            data($test/expected)
        else $test/expected/node()
    let $OK :=
        if ($test/error) then
            $expanded instance of element(error) and contains($expanded, $test/error)
        else if ($test/xpath) then
            t:test(t:xpath($output, $test/xpath))
        else if ($test/@output eq 'text') then
            let $asString :=
                if ($test/@serialize) then
                    $expanded
                else
                    normalize-space(string-join(for $x in $output return string($x),' '))
            return
                $asString eq normalize-space($expected)
        else
            let $xn := t:normalize($expanded)
            let $en := t:normalize($expected)
            return
        	   deep-equal($xn, $en)
    return
        <test n="{$count}" pass="{$OK}">
        {
            if (not($OK)) then
                ($test/task, $test/expected, <result>{$expanded}</result>)
            else
                ()
        }
        </test>
};

declare function t:normalize($nodes as node()*) {
	for $node in $nodes return t:normalize-node($node)
};

declare function t:normalize-node($node as node()) {
	typeswitch ($node)
		case element() return
			element { node-name($node) } {
				$node/@*, for $child in $node/node() return t:normalize-node($child)
			}
		case text() return
			let $norm := normalize-space($node)
			return
				if (string-length($norm) eq 0) then () else $node
		default return
			$node
};

declare function t:xpath($output as item()*, $xpath as element()) {
    for $prefix in in-scope-prefixes($xpath)
    let $nsuri := namespace-uri-for-prefix($prefix, $xpath)
    return
        if ($prefix != 'xml') then
            util:declare-namespace($prefix, $nsuri)
        else (),
    let $expr := $xpath/string()
    return
        if (matches($expr, "^\s*/")) then
            util:eval(concat("$output", $expr))
        else
            util:eval($expr)
};

declare function t:run-testSet($set as element(TestSet)) {
    let $copy := util:expand($set)
    let $null := t:setup($copy/setup)
    let $result := util:expand(
           <TestSet>
           {$copy/testName}
           {$copy/description}
           {
               for $test at $p in $copy/test[empty(@ignore) or @ignore = "no"]
               return
                   t:run-test($test, $p)
           }
           </TestSet>
        )
    let $null := t:tearDown($copy/tearDown)
    return $result
};

declare function t:format-testResult($result) {
    let $formatted :=

{$result/testName}

{$result/description/p}

          {for $test in $result//test
           return

                    {$test/@n/.}
                    {$test/@pass/.}

          }

     return
        $formatted
};


fixed issue with max parameter in facility search

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare  variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
    {
      let $facs0 := if (exists($careServicesRequest/id))
	then csd_bl:filter_by_primary_id(/CSD/facilityDirectory/*,$careServicesRequest/id)
      else /CSD/facilityDirectory/*

      let $facs1 := if (exists($careServicesRequest/primaryName))
	then csd_bl:filter_by_primary_name($facs0,$careServicesRequest/primaryName)
      else $facs0

      let $facs2 := if (exists($careServicesRequest/name))
	then csd_bl:filter_by_name($facs1,$careServicesRequest/name)
      else $facs1

      let $facs3 := if(exists($careServicesRequest/codedType))
	then csd_bl:filter_by_coded_type($facs2,$careServicesRequest/codedType)
      else $facs2

      let $facs4 := if(exists($careServicesRequest/address/addressLine))
	then csd_bl:filter_by_address($facs3, $careServicesRequest/address/addressLine)
      else $facs3

      let $facs5 := if (exists($careServicesRequest/record))
	then csd_bl:filter_by_record($facs4,$careServicesRequest/record)
      else $facs4

      let $facs6 := if(exists($careServicesRequest/otherID))
	then csd_bl:filter_by_other_id($facs5,$careServicesRequest/otherID)
      else $facs5

      let $facs7 :=  if (exists($careServicesRequest/organizations/organization))
	then csd_bl:filter_by_organizations($facs6,$careServicesRequest/organizations/organization)
      else  $facs6

      return if (exists($careServicesRequest/start)) then
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($facs7,$careServicesRequest/start,$careServicesRequest/max)
	else csd_bl:limit_items($facs7,$careServicesRequest/start,<max/>)
      else
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($facs7,<start/>,$careServicesRequest/max)
	else $facs7

    }
  </facilityDirectory>
  <providerDirectory/>
</CSD>

import module namespace csd_bl = "https://github.com/openhie/openinfoman/csd_bl";
declare default element  namespace   "urn:ihe:iti:csd:2013";
declare  variable $careServicesRequest as item() external;

(:
   The query will be executed against the root element of the CSD document.

   The dynamic context of this query has $careServicesRequest set to contain any of the search
   and limit paramaters as sent by the Service Finder
:)
<CSD xmlns:csd="urn:ihe:iti:csd:2013"  >
  <organizationDirectory/>
  <serviceDirectory/>
  <facilityDirectory>
    {
      let $facs0 := if (exists($careServicesRequest/id))
	then csd_bl:filter_by_primary_id(/CSD/facilityDirectory/*,$careServicesRequest/id)
      else /CSD/facilityDirectory/*

      let $facs1 := if (exists($careServicesRequest/primaryName))
	then csd_bl:filter_by_primary_name($facs0,$careServicesRequest/primaryName)
      else $facs0

      let $facs2 := if (exists($careServicesRequest/name))
	then csd_bl:filter_by_name($facs1,$careServicesRequest/name)
      else $facs1

      let $facs3 := if(exists($careServicesRequest/codedType))
	then csd_bl:filter_by_coded_type($facs2,$careServicesRequest/codedType)
      else $facs2

      let $facs4 := if(exists($careServicesRequest/address/addressLine))
	then csd_bl:filter_by_address($facs3, $careServicesRequest/address/addressLine)
      else $facs3

      let $facs5 := if (exists($careServicesRequest/record))
	then csd_bl:filter_by_record($facs4,$careServicesRequest/record)
      else $facs4

      let $facs6 := if(exists($careServicesRequest/otherID))
	then csd_bl:filter_by_other_id($facs5,$careServicesRequest/otherID)
      else $facs5

      let $facs7 :=  if (exists($careServicesRequest/organizations/organization))
	then csd_bl:filter_by_organizations($facs6,$careServicesRequest/organizations/organization)
      else  $facs6

      return if (exists($careServicesRequest/start)) then
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($facs7,$careServicesRequest/start,$careServicesRequest/max)
	else csd_bl:limit_items($facs7,$careServicesRequest/start,<max/>)
      else
	if (exists($careServicesRequest/max))
	  then csd_bl:limit_items($facs7,<start/>,$careServicesRequest/max)
	else $facs6

    }
  </facilityDirectory>
  <providerDirectory/>
</CSD>