:class abbrsample: MiPage
⍝ Control:: HTML.abbr
⍝ Description:: this is an example of use of abbr which allows you to display text when hovering over an area
⍝
⍝ This is an example of using the HTML 'abbr' element.

    ∇ Compose
      :Access public
    ⍝ We simply display the text 'Hover over THIS to reveal.'

    ⍝ First we add the text 'Hover over', then
      Add'Hover over '
    ⍝ Then we add the element 'abbr' containing the text 'THIS',
    ⍝ making sure the text to display when hovering over it
    ⍝ (the title) displays 'True Http Internet Scripts'
      'title' 'True Http Internet Scripts'Add _.abbr'THIS'
    ⍝ then we add the final text.
      Add' to reveal.'
    ∇
:endclass

:class abbrsample: MiPage
⍝ Control:: HTML.abbr
⍝ Description:: this is an example of use of abbr which allows you to display text when hovering over an area

⍝ This is an example of using the HTML 'abbr' element.

    ∇ Compose
      :Access public
    ⍝ We simply display the text 'Hover over THIS to reveal.'

    ⍝ First we add the text 'Hover over', then
      Add'Hover over '
    ⍝ Then we add the element 'abbr' containing the text 'THIS',
    ⍝ making sure the text to display when hovering over it
    ⍝ (the title) displays 'True Http Internet Scripts'
      'title' 'True Http Internet Scripts'Add _.abbr'THIS'
    ⍝ then we add the final text.
      Add' to reveal.'
    ∇
:endclass

Remove empty comment that messes up the index page


:Class MiPageSample : #.MiPage
   ⍝ This is a template that "wraps" the page content by
   ⍝ - adding a header and footer
   ⍝ - adding a handler that will toggle the display of the web page and its APL source code

    ∇ {r}←Wrap;lang;server;c;src;ctrlsdiv
      :Access Public

      :If 0∊⍴Get'nowrapper'
          server←_Request.Server

        ⍝ we use Syncfusion (which uses jQuery) to set up the controls to do cool stuff
         ⍝ Use'Syncfusion' ⍝ this is a resource defined in Config/Resources.xml ⍝ Will be loaded anyway if needed - speedup if not

        ⍝ set the title display in the browser to the name of the application defined in Config/Server.xml
          Add _.title server.Config.Name

        ⍝ add a link to our CSS stylesheet
          _CssReset←'/Styles/cssreset.css'
          _CssOverride←'/Styles/sampleStyles.css'

        ⍝ set a meta tag to make it explicitly UTF-8
          (Add _.meta).Set'http-equiv="content-type" content="text/html;charset=UTF-8"'

        ⍝ wrap the content of the  element in a div
          Body.Push _.div'id="contentblock"'

        ⍝ add a hidden division to the body containing the APL source code
          (Add _.div(#.HTMLInput.APLToHTMLColour src←⎕SRC⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

        ⍝ create a division with info about the controls used
          ctrlsdiv←CtrlsDiv src

        ⍝ extract the content and re-write it in parallel to the controls info div
          c←Body.Content
          Body.Content←''
          (Body.Add _.StackPanel ctrlsdiv c).Horizontal←1

        ⍝ wrap the content of the  element in a div
          Body.Push _.div'class="bodyblock"'

        ⍝ add the footer to the bottom of the page
          Add #.Files.GetText server.Config.Root,'Styles\footer.txt'

        ⍝ add the header to the top of the page and wrap the body in a div with id="wrapper"
          Body.Push #.Files.GetText server.Config.Root,'Styles\banner.txt'

          Body.Push _.div'id="wrapper"'

        ⍝ add a JQuery event handler to toggle the web page/APL source code
          Add _.Script'$(function(){$("#bannerimage").on("click", function(evt){$("#contentblock,#codeblock,.widgethelp").toggle(400,"swing");});});'

        ⍝ set the language for the page
          lang←server.Config.Lang ⍝ use the language specified in Server.xml
          Set'lang="',lang,'" xml:lang="',lang,'" xmlns="http://www.w3.org/1999/xhtml"'
      :Else
          Head.Add _.StyleSheet'/Styles/sampleStyles.css'
          Body.class←'bodyblock'
      :EndIf
     ⍝ call the base class Wrap function

      r←⎕BASE.Wrap
    ∇

    ∇ r←CtrlsDiv source;control;controls;lia;ns;ul;cali;h
     ⍝ Creates a div with info on the controls used in source

     ⍝ First we extract proper lists of controls
      controls←4/⊂''
      source←(⍳∘'⍝'↑⊢)¨source      ⍝ remove comments
      source←{⍵/⍨~≠\''''=⍵}¨source ⍝ remove strings but leaves one ' as separator
      :For control :In 'Handler' 'Position'~⍨∪('_(DC|SF|JQ|html|)\.(\w+)'⎕S'\2')source ⍝ find controls
         ⍝ add to right list: /¯¯¯¯¯SF¯¯¯¯¯\  /¯¯¯¯¯JQ¯¯¯¯¯\  /¯¯¯¯DC¯¯¯¯\ /¯html
          controls[⊃2 3 1 4/⍨('ej'≡2↑control)('jq'≡2↑control)(⎕A∊⍨⊃control)1],←⊂⊂control
      :EndFor
      controls←{⍵[⍋↑⍵]}¨controls   ⍝ sort the lists

     ⍝ Now we create and populate the info div
      r←'.widgethelp'New _.div'This Page Contains
'
      lia←'
',control,'
'
              :Select ns
              :Case 1 ⋄ ul.Add lia,'/Documentation/DyalogAPIs/WidgetDoc?namespace=_DC&widget=',control,cali           ⍝ DC
              :Case 2 ⋄ ul.Add lia,h,'help.syncfusion.com/js/',(#.Strings.lc(2×'ej'≡2↑control)↓control,'/overview'),cali ⍝ SF
              :Case 3 ⋄ ul.Add lia,h,'jqueryui.com/',(2↓control),cali                                                 ⍝ JQ
              :Case 4 ⋄ ul.Add lia,h,'www.w3schools.com/tags/tag_',(('\d'⎕R'n')control),'.asp',cali                   ⍝ html
              :EndSelect
          :EndFor
      :EndFor
    ∇

    ∇ r←Walk content;e
      r←⍬
      :For e :In content
          :If (#.HtmlElement.isClass e)∨#.HtmlElement.isInstance e
              r←r,⊃⎕CLASS e
              :Trap 6
                  r,←Walk e.Content
              :EndTrap
          :EndIf
      :EndFor
    ∇

⍝    ∇ r←FormatControls controls;ctrls;ns;desc;field;n;ctrl;i;c;ref;l;u;nss;item;cn
⍝      ctrls←⊃{⍺ ⍵}#.Utils.∆key/↓[1]0 1↓↑{⎕ML←3 ⋄ {⍵⊂⍨⍵≠'.'}⍕⍵}¨controls
⍝      field←{0::'' ⋄ ⍺⍎⍵}
⍝      nss←'_DC' '_SF' '_JQ' '_html'
⍝      desc←'Dyalog Controls' 'Syncfusion Widgets' 'jQuery Widgets' 'Native HTML5 Elements'
⍝      (r←⎕NEW _.div).class←'widgethelp'
⍝      r.Add'This Page Contains
'
⍝      :Trap 0
⍝          :For (ns ctrl i) :In ctrls{↓(⍺,⍵)[⍋⍵;]}nss⍳{(⊃⍣(¯1+≡⍵))⍵}¨ctrls[;1]
⍝              (r.Add _.span(i⊃desc)).class←'widgetNs'
⍝              u←r.Add _.ul
⍝              n←#.⍎ns←⊃ns
⍝              :For c :In ctrl
⍝                  ref←n.⍎c
⍝                  item←⍬
⍝                  :Select ns
⍝                  :Case '_DC'
⍝                      item←u.Add _.li(New _.a(c(('href=/Documentation/DyalogAPIs/WidgetDoc?namespace=',ns,'&widget=',c)'target=_blank')))
⍝                  :Case '_SF'
⍝                      item←u.Add _.li(New _.a c(('href'('http://js.syncfusion.com/demos/web/default.htm#!/azure/',#.Strings.lc(2×'ej'≡2↑c)↓c,'/'))('target' '_blank')))
⍝                  :Case '_JQ'
⍝                      item←u.Add _.li(New _.a c(('href'('http://jqueryui.com/',(2×'jq'≡2↑c)↓c))('target' '_blank')))
⍝                  :Case '_html'
⍝                      cn←c
⍝                      :If ~0∊⍴('^h[1-6]$'⎕S{⍵.Match})c
⍝                          cn←'hn'
⍝                      :EndIf
⍝                      item←u.Add _.li(New _.a c(('href'('http://www.w3schools.com/tags/tag_',cn,'.asp'))('target' '_blank')))
⍝                  :EndSelect
⍝                  :If 0∊⍴item
⍝                      u.Add _.li c
⍝                  :EndIf
⍝              :EndFor
⍝          :EndFor
⍝      :EndTrap
⍝    ∇

:EndClass

:Class MiPageSample : #.MiPage
   ⍝ This is a template that "wraps" the page content by
   ⍝ - adding a header and footer
   ⍝ - adding a handler that will toggle the display of the web page and its APL source code

    ∇ {r}←Wrap;lang;server;c;src;ctrlsdiv
      :Access Public

      :If 0∊⍴Get'nowrapper'
          server←_Request.Server

        ⍝ we need jQuery to toggle content/source, other resources will be loaded if needed
          Use'JQuery' ⍝ this is a resource defined in Config/Resources.xml

        ⍝ set the title display in the browser to the name of the application defined in Config/Server.xml
          Add _.title server.Config.Name

        ⍝ add a link to our CSS stylesheet
          _CssReset←'/Styles/cssreset.css'
          _CssOverride←'/Styles/sampleStyles.css'

        ⍝ set a meta tag to make it explicitly UTF-8
          (Add _.meta).Set'http-equiv="content-type" content="text/html;charset=UTF-8"'

        ⍝ wrap the content of the  element in a div
          Body.Push _.div'id="contentblock"'

        ⍝ add a hidden division to the body containing the APL source code
          (Add _.div(#.HTMLInput.APLToHTMLColour src←⎕SRC⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

        ⍝ create a division with info about the controls used
          ctrlsdiv←CtrlsDiv src

        ⍝ extract the content and re-write it in parallel to the controls info div
          c←Body.Content
          Body.Content←''
          (Body.Add _.StackPanel ctrlsdiv c).Horizontal←1

        ⍝ wrap the content of the  element in a div
          Body.Push _.div'class="bodyblock"'

        ⍝ add the footer to the bottom of the page
          Add #.Files.GetText server.Config.Root,'Styles\footer.txt'

        ⍝ add the header to the top of the page and wrap the body in a div with id="wrapper"
          Body.Push #.Files.GetText server.Config.Root,'Styles\banner.txt'

          Body.Push _.div'id="wrapper"'

        ⍝ add a JQuery event handler to toggle the web page/APL source code
          Add _.Script'$(function(){$("#bannerimage").on("click", function(evt){$("#contentblock,#codeblock,.widgethelp").toggle(400,"swing");});});'

        ⍝ set the language for the page
          lang←server.Config.Lang ⍝ use the language specified in Server.xml
          Set'lang="',lang,'" xml:lang="',lang,'" xmlns="http://www.w3.org/1999/xhtml"'
      :Else
          Head.Add _.StyleSheet'/Styles/sampleStyles.css'
          Body.class←'bodyblock'
      :EndIf
     ⍝ call the base class Wrap function

      r←⎕BASE.Wrap
    ∇

    ∇ r←CtrlsDiv source;control;controls;lia;ns;ul;cali;h;li
     ⍝ Creates a div with info on the controls used in source

     ⍝ First we extract proper lists of controls
      controls←4/⊂''
      source←(⍳∘'⍝'↑⊢)¨source      ⍝ remove comments
      source←{⍵/⍨~≠\''''=⍵}¨source ⍝ remove strings but leaves one ' as separator
      :For control :In 'Handler' 'Position'~⍨∪('_(DC|SF|JQ|html|)\.(\w+)'⎕S'\2')source ⍝ find controls
         ⍝ add to right list: /¯¯¯¯¯SF¯¯¯¯¯\  /¯¯¯¯¯JQ¯¯¯¯¯\  /¯¯¯¯DC¯¯¯¯\ /¯html
          controls[⊃2 3 1 4/⍨('ej'≡2↑control)('jq'≡2↑control)(⎕A∊⍨⊃control)1],←⊂⊂control
      :EndFor
      controls←{⍵[⍋↑⍵]}¨controls   ⍝ sort the lists

     ⍝ Now we create and populate the info div
      r←'.widgethelp'New _.div'This Page Contains
'
      ⍝lia←'
',control,'
'
              li←'
',control,'
'
⍝              :Select ns
⍝              :Case 1 ⋄ ul.Add lia,'/Documentation/DyalogAPIs/WidgetDoc?namespace=_DC&widget=',control,cali           ⍝ DC
⍝              :Case 2 ⋄ ul.Add lia,h,'help.syncfusion.com/js/',(#.Strings.lc(2×'ej'≡2↑control)↓control,'/overview'),cali ⍝ SF
⍝              :Case 3 ⋄ ul.Add lia,h,'jqueryui.com/',(2↓control),cali                                                 ⍝ JQ
⍝              :Case 4 ⋄ ul.Add lia,h,'www.w3schools.com/tags/tag_',(('\d'⎕R'n')control),'.asp',cali                   ⍝ html
⍝              :EndSelect
          :EndFor
      :EndFor
    ∇

    ∇ r←Walk content;e
      r←⍬
      :For e :In content
          :If (#.HtmlElement.isClass e)∨#.HtmlElement.isInstance e
              r←r,⊃⎕CLASS e
              :Trap 6
                  r,←Walk e.Content
              :EndTrap
          :EndIf
      :EndFor
    ∇

⍝    ∇ r←FormatControls controls;ctrls;ns;desc;field;n;ctrl;i;c;ref;l;u;nss;item;cn
⍝      ctrls←⊃{⍺ ⍵}#.Utils.∆key/↓[1]0 1↓↑{⎕ML←3 ⋄ {⍵⊂⍨⍵≠'.'}⍕⍵}¨controls
⍝      field←{0::'' ⋄ ⍺⍎⍵}
⍝      nss←'_DC' '_SF' '_JQ' '_html'
⍝      desc←'Dyalog Controls' 'Syncfusion Widgets' 'jQuery Widgets' 'Native HTML5 Elements'
⍝      (r←⎕NEW _.div).class←'widgethelp'
⍝      r.Add'This Page Contains
'
⍝      :Trap 0
⍝          :For (ns ctrl i) :In ctrls{↓(⍺,⍵)[⍋⍵;]}nss⍳{(⊃⍣(¯1+≡⍵))⍵}¨ctrls[;1]
⍝              (r.Add _.span(i⊃desc)).class←'widgetNs'
⍝              u←r.Add _.ul
⍝              n←#.⍎ns←⊃ns
⍝              :For c :In ctrl
⍝                  ref←n.⍎c
⍝                  item←⍬
⍝                  :Select ns
⍝                  :Case '_DC'
⍝                      item←u.Add _.li(New _.a(c(('href=/Documentation/DyalogAPIs/WidgetDoc?namespace=',ns,'&widget=',c)'target=_blank')))
⍝                  :Case '_SF'
⍝                      item←u.Add _.li(New _.a c(('href'('http://js.syncfusion.com/demos/web/default.htm#!/azure/',#.Strings.lc(2×'ej'≡2↑c)↓c,'/'))('target' '_blank')))
⍝                  :Case '_JQ'
⍝                      item←u.Add _.li(New _.a c(('href'('http://jqueryui.com/',(2×'jq'≡2↑c)↓c))('target' '_blank')))
⍝                  :Case '_html'
⍝                      cn←c
⍝                      :If ~0∊⍴('^h[1-6]$'⎕S{⍵.Match})c
⍝                          cn←'hn'
⍝                      :EndIf
⍝                      item←u.Add _.li(New _.a c(('href'('http://www.w3schools.com/tags/tag_',cn,'.asp'))('target' '_blank')))
⍝                  :EndSelect
⍝                  :If 0∊⍴item
⍝                      u.Add _.li c
⍝                  :EndIf
⍝              :EndFor
⍝          :EndFor
⍝      :EndTrap
⍝    ∇

:EndClass

MiPageSample: Use 'JQuery' for big D. Controls info box now always links to WidgetDoc.


queens←{⎕IO ⎕ML←0 1                 ⍝ The N-queens problem.

    search←{                        ⍝ Search for all solutions.
        (⊂⍬)∊⍵:0⍴⊂⍬                 ⍝ stitched: abandon this branch.
        0=⍴⍵:rmdups ⍺               ⍝ all done: solution!
        hd←⊃⍵                       ⍝ head...
        tl←1↓⍵                      ⍝ ... 'n tail of remaining ranks.
        next←⍺∘,¨hd                 ⍝ possible next steps.
        rems←hd free¨⊂tl            ⍝ unchecked squares.
        ↑,/next ∇¨rems              ⍝ ... in following ranks.
    }

    cvex←(1+⍳⍵)×⊂¯1 0 1             ⍝ Checking vectors.

    free←{⍵~¨⍺+(⍴⍵)↑cvex}           ⍝ Unchecked squares.

    rmdups←{                        ⍝ Ignore duplicate solution.
        rots←{{⍒⍵}\4/⊂⍵}            ⍝ 4 rotations.
        refs←{{⍋⍵}\2/⊂⍵}            ⍝ 2 reflections.
        best←{(⊃⍋↑⍵)⊃⍵}             ⍝ best (=lowest) solution.
        all8←,↑refs¨rots ⍵          ⍝ all 8 orientations.
        (⍵≡best all8)⊃⍬(,⊂⍵)        ⍝ ignore if not best.
    }

    fmt←{                           ⍝ Format solution.
        chars←'·⍟'[(↑⍵)∘.=⍳⍺]       ⍝ char array of placed queens.
        expd←1↓,↑⍺⍴⊂0 1             ⍝ expansion mask.
        ↑¨↓↓expd\chars              ⍝ vector of char matrices.
    }

    squares←(⊂⍳⌈⍵÷2),1↓⍵⍴⊂⍳⍵        ⍝ initial squares

    ⍵ fmt ⍬ search squares          ⍝ all distinct solutions.
}

⎕←queens 5

Add dfns queens example.

Add dfns queens example.


:Namespace Dates

    (⎕ML ⎕IO)←1

    ∇ r←CookieFmt date;day;date;mon
         ⍝ Format date for cookie expiry
         ⍝ "expires Mon, 09-Dec-2002 13:46:00 GMT"

      day←(7 3⍴'MonTueWedThuFriSatSun')[WeekDay date;]
      mon←(12 3⍴'janfebmaraprmayjunjulaugsepoctnovdec')[2⊃date;]
      r←,('<',day,', >,ZI2,<-',mon,'->,ZI4,< >,ZI2,<:>,ZI2,<:>,ZI2,< GMT>')⎕FMT 1 5⍴(6↑date)[3 1 4 5 6]
    ∇

    ∇ r←{minOffset}HttpDate ts;sign;day;mon;ver;⎕USING;t
    ⍝ return RCF 1123/822 compliant date
    ⍝ minOffset is option number of minutes to offset time with (used for HTTP caching expirations)
      minOffset←{0::0 ⋄ minOffset}''
      ts←6↑ts
      :If 0=⎕NC'_UtcOffset'
          :If 'Win'≡ver←3↑1⊃'.'⎕WG'APLVersion'
              ⎕USING←,⊂''
              _UtcOffset←¯60×(System.TimeZone.CurrentTimeZone.GetUtcOffset ⎕NEW System.DateTime(ts)).Hours
          :Else
              :If (⊂ver)∊'Lin' 'AIX' 'Sol'
                  _UtcOffset←¯60×⍎¯2↓{⍵↑⍨-' '⍳⍨⌽⍵}⊃⎕SH'date -R'
              :Else
                  _UtcOffset←0 ⍝ otherwise, assume GMT
              :EndIf
          :EndIf
      :EndIf
      ts←IDNToDate((_UtcOffset+minOffset)÷24×60)+t←DateToIDN ts
      day←(7 3⍴'MonTueWedThuFriSatSun')[1+7|(⌊t)-1;]
      mon←(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[2⊃ts;]
      r←,('<',day,', >,ZI2,< ',mon,' >,ZI4,< >,ZI2,<:>,ZI2,<:>,ZI2,< GMT>')⎕FMT 1 5⍴ts[3 1 4 5 6]
    ∇

    ∇ SM←DateToIDN TS                  ⍝ Convert date format
      SM←2 ⎕NQ'.' 'DateToIDN'(3↑TS)
      :If 3<⍴TS
          SM+←(24 60 60 1000⊥4↑3↓TS)÷86400000
      :EndIf
    ∇

    ∇ TS←IDNToDate SM                ⍝ Convert IDN to date format : 3↑⎕TS ← IDN (akd TS_SM)
      TS←3↑2 ⎕NQ'.' 'IDNToDate'(⌊SM)
      TS,←⌊0.5+24 60 60 1000⊤86400000×1|SM
    ∇

    ∇ new←ts IdnAdd t
    ⍝ T is D HH MM SS
      new←ts+(0 24 60 60 1000⊥¯5↑t,0)÷86400000
    ∇

    ∇ r←Now
      r←DateToIDN ⎕TS
    ∇

    ∇ r←TSFmt ts
      r←,'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2'⎕FMT 1 5⍴ts
    ∇

    ∇ r←TSFmtNice ts;now;yday;today;z;i;m;idn;s
    ⍝ Format a vector of IDN's nicely
      s←⍴ts
      yday←¯1+today←⌊now←DateToIDN ⎕TS
      r←↑IDNToDate¨,ts←,ts ⍝ Make matrix
      r←'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2'⎕FMT 5↑[2]r
      :If 0≠⍴i←((ts≥yday)∧~m←ts≥today)/⍳⍴ts
          r[i;]←r[i;11+⍳5],' ',((⍴i),10)⍴10↑'Yesterday'
      :EndIf
      :If 0≠⍴i←m/⍳⍴ts
          r[i;]←r[i;11+⍳5],' ',((⍴i),10)⍴10↑'Today'
      :EndIf
      :If 0≠⍴i←(100>z←⌊(now-ts)×24×60)/⍳⍴ts
          r[i;]←16↑[2]↑(⍕¨⌊z[i]),¨(' minutes ago' ' minute ago')[1+1=z[i]]
      :EndIf
      :If 0≠⍴i←(z<1)/⍳⍴ts
          r[i;]←((⍴i),16)⍴16↑'Now'
      :EndIf
      r←(s,¯1↑⍴r)⍴r
    ∇

    ∇ r←WeekDay Date
    ⍝ Return weekday (Monday=1, Sunday=7)
      r←1+7|(DateToIDN 3↑Date)-1
    ∇

    ∇ r←LogFmtNow;ver
    ⍝ returns now UTC adjusted, and formatted for log files (Common Log Format)
      :If 'Win'≡ver←3↑1⊃'.'⎕WG'APLVersion'
          r←((⍎⎕NA'kernel32|GetSystemTime >{U2 U2 U2 U2 U2 U2 U2 U2}')⊂8⍴0)[4 2 1 5 6 7]
          r[2]←⊂(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[,2⊃r;]
          r←,'< [>,ZI2,</>,3A1,</>,ZI4,<:>,ZI2,<:>,ZI2,<:>,ZI2,< +0000] >'⎕FMT r
      :Else
          r←1⊃⎕SH'date +" [%d/%b/%Y:%T %z] "'
      :EndIf
    ∇

    ∇ r←LogFmt ymdhms
      r←ymdhms[3 2 1 4 5 6]
      r[2]←⊂(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[,2⊃r;]
      r←,'< [>,ZI2,</>,3A1,</>,ZI4,<:>,ZI2,<:>,ZI2,<:>,ZI2,< +0000] >'⎕FMT r
    ∇

    ∇ ts←FTT fts;md;shape;tmp;yr;z;⎕IO
     ⍝ *** convert ⎕FRDCI/⎕FHIST timestamp(s) to ⎕ts-format for Dyalog/W ***
     ⍝ right argument: ⎕FRDCI-type timestamp(s) of any shape
     ⍝ result: ⎕ts-type timestamp(s) with shape <(⍴argument),7>
      ⎕IO←0 ⋄ shape←⍴fts ⋄ ts←,fts+18626112000
      md←365.2501|1+1461|yr←⌊ts÷5184000
      tmp←31 61 92 122 153 184 214 245 275 306 337 366
      z←(,⍉<⍀tmp∘.≥md)/,((⍴md),12)⍴⍳12
      md←(1+12|z+2),[0.1]⌈md-(0,tmp)[z]
      ts←(1960+⌊(yr+60)÷365.25),md,⍉24 60 60 60⊤ts
      ts[;6]←⌊0.5+ts[;6]×100÷6
      ts←(shape,7)⍴ts
    ∇

    ∇ r←TTF ts;l;h;d;m;y
       ⍝ convert a ⎕TS style timestamp into 60ths of a second since 1st January 1970 a la ⎕FRDCI
      l←⌈60×ts[7]÷1000                                         ⍝ convert milliseconds to 60ths
      h←3600 60 60⊥ts[4 5 6]                                   ⍝ hours minutes seconds to to the nearest seconds total
      d←ts[3]-1                                                ⍝ days since start of month
      m←(2⊃ts)⊃++\0 31,(28+0=4|⊃ts),31 30 31 30 31 31 30 31 30 ⍝ days in completed months
      y←{{(365×⍵)+⌈4÷⍨⍵-2}⍵-1970}⊃ts                           ⍝ days in years since 1970, leap years since 1972
      r←l+60×h+86400×y+m+d                                     ⍝ sum, convert to seconds, add seconds in the day convert to 60ths, add on 60ths
    ∇

:EndNamespace

:Namespace Dates

    (⎕ML ⎕IO)←1

    ∇ r←CookieFmt date;day;date;mon
         ⍝ Format date for cookie expiry
         ⍝ "expires Mon, 09-Dec-2002 13:46:00 GMT"

      day←(7 3⍴'MonTueWedThuFriSatSun')[WeekDay date;]
      mon←(12 3⍴'janfebmaraprmayjunjulaugsepoctnovdec')[2⊃date;]
      r←,('<',day,', >,ZI2,<-',mon,'->,ZI4,< >,ZI2,<:>,ZI2,<:>,ZI2,< GMT>')⎕FMT 1 5⍴(6↑date)[3 1 4 5 6]
    ∇

    ∇ r←{minOffset}HttpDate ts;sign;day;mon;ver;⎕USING;t
    ⍝ return RCF 1123/822 compliant date
    ⍝ minOffset is option number of minutes to offset time with (used for HTTP caching expirations)
      minOffset←{0::0 ⋄ minOffset}''
      ts←6↑ts
      :If 0=⎕NC'_UtcOffset'
          :If 'Win'≡ver←3↑1⊃'.'⎕WG'APLVersion'
              :Hold '_UtcOffset'
                  ⎕USING←,⊂''
                  _UtcOffset←¯60×(System.TimeZone.CurrentTimeZone.GetUtcOffset ⎕NEW System.DateTime(ts)).Hours
              :EndHold
          :Else
              :If (⊂ver)∊'Lin' 'AIX' 'Sol'
                  _UtcOffset←¯60×⍎¯2↓{⍵↑⍨-' '⍳⍨⌽⍵}⊃⎕SH'date -R'
              :Else
                  _UtcOffset←0 ⍝ otherwise, assume GMT
              :EndIf
          :EndIf
      :EndIf
      ts←IDNToDate((_UtcOffset+minOffset)÷24×60)+t←DateToIDN ts
      day←(7 3⍴'MonTueWedThuFriSatSun')[1+7|(⌊t)-1;]
      mon←(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[2⊃ts;]
      r←,('<',day,', >,ZI2,< ',mon,' >,ZI4,< >,ZI2,<:>,ZI2,<:>,ZI2,< GMT>')⎕FMT 1 5⍴ts[3 1 4 5 6]
    ∇

    ∇ SM←DateToIDN TS                  ⍝ Convert date format
      SM←2 ⎕NQ'.' 'DateToIDN'(3↑TS)
      :If 3<⍴TS
          SM+←(24 60 60 1000⊥4↑3↓TS)÷86400000
      :EndIf
    ∇

    ∇ TS←IDNToDate SM                ⍝ Convert IDN to date format : 3↑⎕TS ← IDN (akd TS_SM)
      TS←3↑2 ⎕NQ'.' 'IDNToDate'(⌊SM)
      TS,←⌊0.5+24 60 60 1000⊤86400000×1|SM
    ∇

    ∇ new←ts IdnAdd t
    ⍝ T is D HH MM SS
      new←ts+(0 24 60 60 1000⊥¯5↑t,0)÷86400000
    ∇

    ∇ r←Now
      r←DateToIDN ⎕TS
    ∇

    ∇ r←TSFmt ts
      r←,'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2'⎕FMT 1 5⍴ts
    ∇

    ∇ r←TSFmtNice ts;now;yday;today;z;i;m;idn;s
    ⍝ Format a vector of IDN's nicely
      s←⍴ts
      yday←¯1+today←⌊now←DateToIDN ⎕TS
      r←↑IDNToDate¨,ts←,ts ⍝ Make matrix
      r←'ZI4,<->,ZI2,<->,ZI2,< >,ZI2,<:>,ZI2'⎕FMT 5↑[2]r
      :If 0≠⍴i←((ts≥yday)∧~m←ts≥today)/⍳⍴ts
          r[i;]←r[i;11+⍳5],' ',((⍴i),10)⍴10↑'Yesterday'
      :EndIf
      :If 0≠⍴i←m/⍳⍴ts
          r[i;]←r[i;11+⍳5],' ',((⍴i),10)⍴10↑'Today'
      :EndIf
      :If 0≠⍴i←(100>z←⌊(now-ts)×24×60)/⍳⍴ts
          r[i;]←16↑[2]↑(⍕¨⌊z[i]),¨(' minutes ago' ' minute ago')[1+1=z[i]]
      :EndIf
      :If 0≠⍴i←(z<1)/⍳⍴ts
          r[i;]←((⍴i),16)⍴16↑'Now'
      :EndIf
      r←(s,¯1↑⍴r)⍴r
    ∇

    ∇ r←WeekDay Date
    ⍝ Return weekday (Monday=1, Sunday=7)
      r←1+7|(DateToIDN 3↑Date)-1
    ∇

    ∇ r←LogFmtNow;ver
    ⍝ returns now UTC adjusted, and formatted for log files (Common Log Format)
      :If 'Win'≡ver←3↑1⊃'.'⎕WG'APLVersion'
          r←((⍎⎕NA'kernel32|GetSystemTime >{U2 U2 U2 U2 U2 U2 U2 U2}')⊂8⍴0)[4 2 1 5 6 7]
          r[2]←⊂(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[,2⊃r;]
          r←,'< [>,ZI2,</>,3A1,</>,ZI4,<:>,ZI2,<:>,ZI2,<:>,ZI2,< +0000] >'⎕FMT r
      :Else
          r←1⊃⎕SH'date +" [%d/%b/%Y:%T %z] "'
      :EndIf
    ∇

    ∇ r←LogFmt ymdhms
      r←ymdhms[3 2 1 4 5 6]
      r[2]←⊂(12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec')[,2⊃r;]
      r←,'< [>,ZI2,</>,3A1,</>,ZI4,<:>,ZI2,<:>,ZI2,<:>,ZI2,< +0000] >'⎕FMT r
    ∇

    ∇ ts←FTT fts;md;shape;tmp;yr;z;⎕IO
     ⍝ *** convert ⎕FRDCI/⎕FHIST timestamp(s) to ⎕ts-format for Dyalog/W ***
     ⍝ right argument: ⎕FRDCI-type timestamp(s) of any shape
     ⍝ result: ⎕ts-type timestamp(s) with shape <(⍴argument),7>
      ⎕IO←0 ⋄ shape←⍴fts ⋄ ts←,fts+18626112000
      md←365.2501|1+1461|yr←⌊ts÷5184000
      tmp←31 61 92 122 153 184 214 245 275 306 337 366
      z←(,⍉<⍀tmp∘.≥md)/,((⍴md),12)⍴⍳12
      md←(1+12|z+2),[0.1]⌈md-(0,tmp)[z]
      ts←(1960+⌊(yr+60)÷365.25),md,⍉24 60 60 60⊤ts
      ts[;6]←⌊0.5+ts[;6]×100÷6
      ts←(shape,7)⍴ts
    ∇

    ∇ r←TTF ts;l;h;d;m;y
       ⍝ convert a ⎕TS style timestamp into 60ths of a second since 1st January 1970 a la ⎕FRDCI
      l←⌈60×ts[7]÷1000                                         ⍝ convert milliseconds to 60ths
      h←3600 60 60⊥ts[4 5 6]                                   ⍝ hours minutes seconds to to the nearest seconds total
      d←ts[3]-1                                                ⍝ days since start of month
      m←(2⊃ts)⊃++\0 31,(28+0=4|⊃ts),31 30 31 30 31 31 30 31 30 ⍝ days in completed months
      y←{{(365×⍵)+⌈4÷⍨⍵-2}⍵-1970}⊃ts                           ⍝ days in years since 1970, leap years since 1972
      r←l+60×h+86400×y+m+d                                     ⍝ sum, convert to seconds, add seconds in the day convert to 60ths, add on 60ths
    ∇

:EndNamespace

Fix to Dates.HttpDate

Fix to Dates.HttpDate


#!/usr/local/bin/apl --script
NEWLINE ← ⎕UCS 10
HEADERS ← 'Content-Type: text/plain', NEWLINE
HEADERS
⍝ ⎕←HEADERS
⍝ ⍕⎕TS
)OFF

⍝ testVars←'FUCKYEAH'
⍝ ≠\~(testVars ∊ 'AEIOU')
⍝ (124 × 4)≠(+/124 124 124)
⍝ testVars ∊ '<>'

Add boilerplate APL script to serve CGI webpages

I can no longer tell if I've gone insane, or I've just become bored with
web development. Probably a collusion of both.

Either way, getting this script working required some changes in the GNU
APL preferences file (interpreter built from source: v1.5 / SVN revision
694). The following settings were changed to the designated values:

  * Welcome:      No
  * Color:        No
  * SharedVars:   Disabled

That last setting is especially critical for running the APL interpreter
as a CGI handler. Since multiple arguments can't be passed to a hashbang
(at least in Apache), we can't set --script and --noSV at the same time.
This leads to an error message being spat to STDOUT when the interpreter
is invoked, screwing with the HTTP headers.


:Class HTTPCommand
⍝ Issue an HTTP Command
⍝ Public Fields are:
⍝   Command  - the HTTP command to issue, typically 'GET' 'POST' 'PUT etc
⍝   URL      - the URL to direct the command at
⍝              format is:  [HTTP[S]://][user:pass@]url[:port][/page[?params]]
⍝   Params   - the parameters to pass with the command
⍝              for 'GET' you can pass parameters either in the URL or in Params (they will be appended to the URL)
⍝   Headers  - any additional HTTP headers to send with the request (all the obvious headers like 'content-length' are precomputed)
⍝              a vector of 2-element (header-name value) vectors or a matrix of [;1] header-name [;2] values
⍝   Cert     - if using a SSL, this is an instance of the X509Cert class
⍝   SSLFlags - if using SSL, these are the SSL flags as described in the Conga documentation
⍝   Priority - if using SSL, this is the

    ⎕ML←⎕IO←1

    :field public Command←'GET'
    :field public Cert←⍬
    :field public SSLFlags←32
    :field public LocalDRC
    :field public URL←''
    :field public Params←''
    :field public Headers←''
    :field public Priority←'NORMAL:!CTYPE-OPENPGP'
    :field public LDRC←''

    ∇ make
      :Access public
      :Implements constructor
    ∇

    ∇ make1 args
      :Access public
      :Implements constructor
      ⍝ args - [URL Params Headers Command Cert SSLFlags Priority]
      args←eis args
      Command URL Params Headers Cert SSLFlags Priority←7↑args,(⍴args)↓Command URL Params Headers Cert SSLFlags Priority
    ∇

    ∇ r←Run;resp
      :Access public
      r←⎕NS''
      :If 0∊⍴Cert
          resp←(Command HTTPCmd)URL Params Headers
      :Else
          resp←(Cert SSLFlags Priority)(Command HTTPCmd)URL Params Headers
      :EndIf
      r.(rc headers data peercert)←resp
    ∇

    ∇ r←{certs}(cmd HTTPCmd)args;url;parms;hdrs;urlparms;p;b;secure;port;host;page;x509;flags;priority;pars;auth;req;err;chunked;chunk;buffer;chunklength;done;data;datalen;header;wr;headerlen
⍝ issue an HTTP command
⍝ certs - optional [X509Cert [SSLValidation [Priority]]]
⍝ args  - [1] URL in format [HTTP[S]://][user:pass@]url[:port][/page]
⍝         {2} parameters is using POST - either a namespace or URL-encoded string
⍝         {3} HTTP headers in form {↑}(('hdr1' 'val1')('hdr2' 'val2'))
⍝ Makes secure connection if left arg provided or URL begins with https:

⍝ Result: (return code) (HTTP headers) (HTTP body) [PeerCert if secure]
      r←¯1(0 2⍴⊂'')''⍬

      :If 9≠⎕NC'LDRC'
      :AndIf 9=#.⎕NC'DRC'
          LDRC←#.DRC
      :Else
          ⎕←'Conga namespace DRC not found or defined'
          →0
      :EndIf

      {}LDRC.Init''
      args←eis args

      (url parms hdrs)←args,(⍴args)↓''(⎕NS'')''
      urlparms←''
      cmd←uc,cmd

      :If 326=⎕DR parms ⍝ if parms are a namespace, format them
          :If 'POST'≡cmd
              parms←{0∊⍴t←⍵.⎕NL ¯2:'' ⋄ 1↓⊃,/⍵{'&',⍵,'=',(⍕⍺⍎⍵)}¨t}parms
          :Else
              urlparms←{0∊⍴⍵:'' ⋄ '?',⍵}{0∊⍴t←⍵.⎕NL ¯2:'' ⋄ 1↓⊃,/⍵{'&',⍵,'=',(⍕⍺⍎⍵)}¨t}parms
              parms←''
          :EndIf
      :EndIf

     GET:
      p←(∨/b)×1+(b←'//'⍷url)⍳1
      secure←{6::⍵ ⋄ ⍵∨0<⍴,certs}(lc(p-2)↑url)≡'https:'
      port←(1+secure)⊃80 443 ⍝ Default HTTP/HTTPS port
      url←p↓url              ⍝ Remove HTTP[s]:// if present
      (host page)←'/'split url,(~'/'∊url)/'/'    ⍝ Extract host and page from url

      :If 0=⎕NC'certs' ⋄ certs←'' ⋄ :EndIf

      :If secure
          x509 flags priority←3↑certs,(⍴,certs)↓(⎕NEW LDRC.X509Cert)32 'NORMAL:!CTYPE-OPENPGP'  ⍝ 32=Do not validate Certs
          pars←('x509'x509)('SSLValidation'flags)('Priority'priority)
      :Else ⋄ pars←''
      :EndIf

      :If '@'∊host ⍝ Handle user:password@host...
          auth←'Authorization: Basic ',(b64Encode(¯1+p←host⍳'@')↑host),NL
          host←p↓host
      :Else ⋄ auth←''
      :EndIf

      (host port)←port{(⍴⍵)<ind←⍵⍳':':⍵ ⍺ ⋄ (⍵↑⍨ind-1)(1⊃2⊃⎕VFI ind↓⍵)}host ⍝ Check for override of port number

      hdrs←makeHeaders hdrs
      hdrs←'User-Agent'(hdrs addHeader)'Dyalog/Conga'
      hdrs←'Accept'(hdrs addHeader)'*/*'

      :If ~0∊⍴parms
          :If cmd≡'POST'
              hdrs←'Content-Length'(hdrs addHeader)⍴parms
              hdrs←'Content-Type'(hdrs addHeader)'application/x-www-form-urlencoded'
          :EndIf
      :EndIf

      hdrs←'Accept-Encoding'(hdrs addHeader)'gzip, deflate'

      req←cmd,' ',(page,urlparms),' HTTP/1.1',NL,'Host: ',host,NL
      req,←fmtHeaders hdrs
      req,←auth

      :If 0=⊃(err cmd)←2↑r←LDRC.Clt''host port'Text' 100000,pars ⍝ 100,000 is max receive buffer size
      :AndIf 0=⊃r←LDRC.Send cmd(req,NL,parms)

          chunked chunk buffer chunklength←0 '' '' 0
          done data datalen headerlen header←0 ⍬ 0 0 ⍬
          :Repeat
              :If ~done←0≠1⊃wr←LDRC.Wait cmd 5000            ⍝ Wait up to 5 secs
                  :If wr[3]∊'Block' 'BlockLast'             ⍝ If we got some data
                      :If chunked
                          chunk←4⊃wr
                      :ElseIf 0<⍴data,←4⊃wr
                      :AndIf 0=headerlen
                          (headerlen header)←DecodeHeader data
                          :If 0<headerlen
                              data←headerlen↓data
                              :If chunked←∨/'chunked'⍷header getHeader'Transfer-Encoding'
                                  chunk←data
                                  data←''
                              :Else
                                  datalen←⊃(toNum header getHeader'Content-Length'),¯1 ⍝ ¯1 if no content length not specified
                              :EndIf
                          :EndIf
                      :EndIf
                  :Else
                      ⎕←wr ⍝ Error?
                      ∘∘∘
                  :EndIf
                  :If chunked
                      buffer,←chunk
                      :While done<¯1≠⊃(len chunklength)←getchunklen buffer
                          :If (⍴buffer)≥4+len+chunklength
                              data,←chunklength↑(len+2)↓buffer
                              buffer←(chunklength+len+4)↓buffer
                              :If done←0=chunklength ⍝ chunked transfer can add headers at the end of the transmission
                                  header←⊂header⍪2⊃DecodeHeader buffer
                              :EndIf
                          :EndIf
                      :EndWhile
                  :Else
                      done←done∨'BlockLast'≡3⊃wr                        ⍝ Done if socket was closed
                      :If datalen>0
                          done←done∨datalen≤⍴data ⍝ ... or if declared amount of data rcvd
                      :Else
                          done←done∨(∨/''⍷data)∨(∨/''⍷data)
                      :EndIf
                  :EndIf
              :EndIf
          :Until done

          :Trap 0 ⍝ If any errors occur, abandon conversion
              :Select header getHeader'content-encoding' ⍝ was the response compressed?
              :Case 'deflate'
                  data←fromutf8 LDRC.flate.Inflate 120 156{(2×⍺≡2↑⍵)↓⍺,⍵}256|83 ⎕DR data ⍝ append 120 156 signature because web servers strip it out due to IE
              :Case 'gzip'
                  data←fromutf8 256|¯3(219⌶)83 ⎕DR data
              :Else
                  :If ∨/'charset=utf-8'⍷header getHeader'content-type'
                      data←'UTF-8'⎕UCS ⎕UCS data ⍝ Convert from UTF-8
                  :EndIf
              :EndSelect
          :EndTrap

          :If {(⍵[3]∊'12357')∧'30 '≡⍵[1 2 4]}4↑{⍵↓⍨⍵⍳' '}(⊂1 1)⊃header ⍝ redirected? (HTTP status codes 301, 302, 303, 305, 307)
              →GET⍴⍨0<⍴url←'location'{(⍵[;1]⍳⊂⍺)⊃⍵[;2],⊂''}header ⍝ use the "location" header field for the URL
          :EndIf

          r←(1⊃wr)header data ⍬

          :If secure ⋄ r[4]←⊂LDRC.GetProp cmd'PeerCert' ⋄ :EndIf
      :Else
          ⎕←'Connection failed ',,⍕r
          r←(⊂r)'' '' ''
      :EndIf

      {}LDRC.Close cmd
    ∇

    NL←⎕UCS 13 10
    fromutf8←{0::(⎕AV,'?')[⎕AVU⍳⍵] ⋄ 'UTF-8'⎕UCS ⍵} ⍝ Turn raw UTF-8 input into text
    utf8←{3=10|⎕DR ⍵: 256|⍵ ⋄ 'UTF-8' ⎕UCS ⍵}
    sint←{⎕io←0 ⋄ 83=⎕DR ⍵:⍵ ⋄ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 ¯128 ¯127 ¯126 ¯125 ¯124 ¯123 ¯122 ¯121 ¯120 ¯119 ¯118 ¯117 ¯116 ¯115 ¯114 ¯113 ¯112 ¯111 ¯110 ¯109 ¯108 ¯107 ¯106 ¯105 ¯104 ¯103 ¯102 ¯101 ¯100 ¯99 ¯98 ¯97 ¯96 ¯95 ¯94 ¯93 ¯92 ¯91 ¯90 ¯89 ¯88 ¯87 ¯86 ¯85 ¯84 ¯83 ¯82 ¯81 ¯80 ¯79 ¯78 ¯77 ¯76 ¯75 ¯74 ¯73 ¯72 ¯71 ¯70 ¯69 ¯68 ¯67 ¯66 ¯65 ¯64 ¯63 ¯62 ¯61 ¯60 ¯59 ¯58 ¯57 ¯56 ¯55 ¯54 ¯53 ¯52 ¯51 ¯50 ¯49 ¯48 ¯47 ¯46 ¯45 ¯44 ¯43 ¯42 ¯41 ¯40 ¯39 ¯38 ¯37 ¯36 ¯35 ¯34 ¯33 ¯32 ¯31 ¯30 ¯29 ¯28 ¯27 ¯26 ¯25 ¯24 ¯23 ¯22 ¯21 ¯20 ¯19 ¯18 ¯17 ¯16 ¯15 ¯14 ¯13 ¯12 ¯11 ¯10 ¯9 ¯8 ¯7 ¯6 ¯5 ¯4 ¯3 ¯2 ¯1[utf8 ⍵]}
    lc←(819⌶) ⍝ lower case conversion
    uc←1∘lc
    dlb←{(+/∧\' '=⍵)↓⍵} ⍝ delete leading blanks
    split←{(p↑⍵)((p←¯1+⍵⍳⍺)↓⍵)} ⍝ split ⍵ on first occurrence of ⍺
    h2d←{⎕IO←0 ⋄ 16⊥'0123456789abcdef'⍳lc ⍵} ⍝ hex to decimal
    getchunklen←{¯1=len←¯1+⊃(NL⍷⍵)/⍳⍴⍵:¯1 ¯1 ⋄ chunklen←h2d len↑⍵ ⋄ (⍴⍵)<len+chunklen+4:¯1 ¯1 ⋄ len chunklen}
    eis←{⍺←1 ⋄ ,(⊂⍣(⍺=|≡⍵))⍵} ⍝ enclose if simple
    toNum←{0∊⍴⍵:⍬ ⋄ 1⊃2⊃⎕VFI ⍵}
    getHeader←{(⍺[;2],⊂'')⊃⍨⍺[;1]⍳eis lc ⍵}
    addHeader←{0∊⍴⍺⍺ getHeader ⍺:⍺⍺⍪⍺ ⍵ ⋄ ⍺⍺}
    makeHeaders←{⎕ML←1 ⋄ 0∊⍴⍵:0 2⍴⊂'' ⋄ 2=⍴⍴⍵:⍵ ⋄ ↑2 eis ⍵}
    fmtHeaders←{⎕ML←1 ⋄ 0∊⍴⍵:'' ⋄ ∊{NL,⍨(1⊃⍵),': ',⍕2⊃⍵}¨↓⍵}
      b64Encode←{ ⍝ Base64 Encode
          raw←⊃,/11∘⎕DR¨⍵
          cols←6
          rows←⌈(⊃⍴raw)÷cols
          mat←rows cols⍴(rows×cols)↑raw
          'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'[⎕IO+2⊥⍉mat],(4|-rows)⍴'='}

    ∇ r←DecodeHeader buf;len;d;i
      ⍝ Decode HTTP Header
      r←0(0 2⍴⊂'')
      :If 0<i←⊃{((NL,NL)⍷⍵)/⍳⍴⍵}buf
          len←(¯1+⍴NL,NL)+i
          d←(⍴NL)↓¨{(NL⍷⍵)⊂⍵}NL,len↑buf
          d←↑{((p-1)↑⍵)((p←⍵⍳':')↓⍵)}¨d
          d[;1]←lc¨d[;1]
          d[;2]←dlb¨d[;2]
          r←len d
      :EndIf
    ∇
:EndClass

Add /Utils/HTTPCommand

Add /Utils/HTTPCommand


:Class FilesAndDirs
⍝ This class exists solely in support of MarkAPL from APLTeam
⍝ It provides comparable functionality to the FilesAndDirs class from https://github.com/aplteam/filesanddirs
⍝ for 2 methods - NormalizePath and Exists
    (⎕ML ⎕IO)←1 1
    ∇ r←{expand}NormalizePath f
      :Access public shared
      :If 0=⎕NC'expand' ⋄ expand←0 ⋄ :EndIf
      r←∊expand ⎕NPARTS f
    ∇
    ∇ r←Exists f
      :Access public shared
      r←⎕NEXISTS∊⎕NPARTS f
    ∇
:EndClass

Create scaled down FilesAndDirs class so the new version of MarkAPL wll work.


:NameSpace UT

    sac ← 0
    expect_orig ← expect ← ⎕NS⍬
    exception ← ⍬
    nexpect_orig ← nexpect ← ⎕NS⍬

    ∇ {Z}←{Conf}run Argument;PRE_test;POST_test;TEST_step;COVER_step;FromSpace

      load_display_if_not_already_loaded
      load_salt_scripts_into_current_namespace_if_configured

      FromSpace←1⊃⎕RSI

      PRE_test←{}
      POST_test←{}
      COVER_step←{}
      :If 0≠⎕NC'Conf'
          :If Conf has'cover_target'
              PRE_test←{{}⎕PROFILE'start'}
              POST_test←{{}⎕PROFILE'stop'}
          :EndIf
      :EndIf

      :If is_function Argument
          TEST_step←single_function_test_function
          COVER_file←Argument,'_coverage.html'

      :ElseIf is_list_of_functions Argument
          TEST_step←list_of_functions_test_function
          COVER_file←'list_coverage.html'

      :ElseIf is_file Argument
          TEST_step←file_test_function
          COVER_file←(get_file_name Argument),'_coverage.html'

      :ElseIf is_dir Argument
          test_files←test_files_in_dir Argument
          TEST_step←test_dir_function
          Argument←test_files
      :EndIf

      :If 0≠⎕NC'Conf'
          :If Conf has'cover_target'
              COVER_step←{Conf,←⊂('cover_file'COVER_file)
                  generate_coverage_page Conf}
          :EndIf
      :EndIf

      PRE_test ⍬
      Z←FromSpace TEST_step Argument
      POST_test ⍬
      COVER_step ⍬
    ∇

    ∇ load_display_if_not_already_loaded
      :If 0=⎕NC'#.DISPLAY'
          'DISPLAY'#.⎕CY'display'
      :EndIf
    ∇

    ∇ load_salt_scripts_into_current_namespace_if_configured
      :If 0≠⎕NC'#.UT.appdir'
          :If ⍬≢#.UT.appdir
              ⎕SE.SALT.Load #.UT.appdir,'src/*.dyalog -target=#'
              ⎕SE.SALT.Load #.UT.appdir,'test/*.dyalog -target=#'
          :EndIf
      :EndIf
    ∇

    ∇ Z←FromSpace single_function_test_function TestName
      Z←run_ut FromSpace TestName
    ∇

    ∇ Z←FromSpace list_of_functions_test_function ListOfNames;t
      t←⎕TS
      Z←run_ut¨{FromSpace ⍵}¨ListOfNames
      t←⎕TS-t
      ('Test execution report')print_passed_crashed_failed Z t
    ∇

    ∇ Z←FromSpace file_test_function FilePath;FileNS;Functions;TestFunctions;t
      FileNS←⎕SE.SALT.Load FilePath,' -target=#'
      Functions←↓FileNS.⎕NL 3
      TestFunctions←(is_test¨Functions)/Functions
      :If (0/⍬,⊂0/'')≡TestFunctions
          ⎕←'No test functions found'
          Z←⍬
      :Else
          t←⎕TS
          Z←run_ut¨{FileNS ⍵}¨TestFunctions
          t←⎕TS-t
          (FilePath,' tests')print_passed_crashed_failed Z t
      :EndIf
    ∇

    ∇ Z←FromSpace test_dir_function Test_files
      :If Test_files≡⍬/⍬,⊂''
          ⎕←'No test files found'
          Z←⍬
      :Else
          Z←#.UT.run¨Test_files
      :EndIf
    ∇

    ∇ Z←get_file_name Argument;separator
      separator←⊃⌽(Argument∊'/\')/⍳⍴Argument
      Z←¯7↓separator↓Argument
    ∇

    ∇ generate_coverage_page Conf;ProfileData;CoverResults;HTML
      ProfileData←⎕PROFILE'data'
      ToCover←retrieve_coverables¨(⊃'cover_target'in Conf)
      :If (⍴ToCover)≡(⍴⊂1)
          ToCover←⊃ToCover
      :EndIf
      Representations←get_representation¨ToCover
      CoverResults←ProfileData∘generate_cover_result¨↓ToCover,[1.5]Representations
      HTML←generate_html CoverResults
      Conf write_html_to_page HTML
      ⎕PROFILE'clear'
    ∇

    ∇ Z←retrieve_coverables Something;nc;functions
      nc←⎕NC Something
      :If nc=3
          Z←Something
      :ElseIf nc=9
          functions←strip¨↓⍎Something,'.⎕NL 3'
          Z←{(Something,'.',⍵)}¨functions
      :EndIf
    ∇

    ∇ Z←strip input
      Z←(input≠' ')/input
    ∇

    ∇ Z←get_representation Function;nc;rep
      nc←⎕NC⊂Function
      :If nc=3.1
          rep←↓⎕CR Function
          rep[1]←⊂'∇',⊃rep[1]
          rep,←⊂'∇'
          rep←↑rep
      :Else
          rep←⎕CR Function
      :EndIf
      Z←rep
    ∇

    ∇ Z←ProfileData generate_cover_result(name representation);Indices;lines;functionlines;covered_lines
      Indices←({name≡⍵}¨ProfileData[;1])/⍳⍴ProfileData[;1]
      lines←ProfileData[Indices;2]
      nc←⎕NC⊂name
      :If 3.1=nc
          functionlines←¯2+⍴↓representation
      :Else
          functionlines←⊃⍴↓representation
      :EndIf
      covered_lines←(⍬∘≢¨lines)/lines
      Z←(nc lines functionlines covered_lines representation)
    ∇

    ∇ Z←generate_html CoverResults;Covered;Total;Percentage;CoverageText;ColorizedCode;Timestamp;Page
      Covered←⊃⊃+/{⍴4⊃⍵}¨CoverResults
      Total←⊃⊃+/{3⊃⍵}¨CoverResults
      Percentage←100×Covered÷Total
      CoverageText←'Coverage: ',Percentage,'% (',Covered,'/',Total,')'
      ColorizedCode←⊃,/{colorize_code_by_coverage ⍵}¨CoverResults
      Timestamp←generate_timestamp_text
      Page←⍬
      Page,←⊂⍬,''
      Page,←⊂⍬,'<meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>'
      Page,←⊂⍬,''
      Page,←⊂⍬,CoverageText
      Page,←⊂⍬,'
'
      Page,←ColorizedCode
      Page,←⊂⍬,'
'
      Page,←Timestamp
      Page,←⊂⍬,''
      Z←Page
    ∇

    ∇ Z←colorize_code_by_coverage CoverResult;Colors;Ends;Code
      :If 3.1=⊃CoverResult
          Colors←(2+3⊃CoverResult)⍴⊂'<uncov>'
          Colors[1]←⊂''
          Colors[⍴Colors]←⊂''
          Ends←(2+3⊃CoverResult)⍴⊂'</uncov>'
          Ends[1]←⊂''
          Ends[⍴Ends]←⊂''
      :Else
          Colors←(3⊃CoverResult)⍴⊂'<uncov>'
          Ends←(3⊃CoverResult)⍴⊂'</uncov>'
      :EndIf
      Colors[1+4⊃CoverResult]←⊂'<cov>'
      Ends[1+4⊃CoverResult]←⊂'</cov>'
      Code←↓5⊃CoverResult
      Z←Colors,[1.5]Code
      Z←{⍺,(⎕UCS 13),⍵}/Z,Ends
    ∇

    ∇ Z←generate_timestamp_text;TS;YYMMDD;HHMMSS
      TS←⎕TS
      YYMMDD←⊃{⍺,'-',⍵}/3↑TS
      HHMMSS←⊃{⍺,':',⍵}/3↑3↓TS
      Z←'Page generated: ',YYMMDD,'|',HHMMSS
    ∇

    ∇ Conf write_html_to_page Page;tie;filename
      filename←(⊃'cover_out'in Conf),(⊃'cover_file'in Conf)
      :Trap 22
          tie←filename ⎕NTIE 0
          filename ⎕NERASE tie
          filename ⎕NCREATE tie
      :Else
          tie←filename ⎕NCREATE 0
      :EndTrap
      Simple_array←⍕⊃,/Page
      (⎕UCS'UTF-8'⎕UCS Simple_array)⎕NAPPEND tie
    ∇

    ∇ Z←is_function Argument
      Z←'_TEST'≡¯5↑Argument
    ∇

    ∇ Z←is_list_of_functions Argument
      Z←2=≡Argument
    ∇

    ∇ Z←is_file Argument
      Z←'.dyalog'≡¯7↑Argument
    ∇

    ∇ Z←is_dir Argument;attr
      :If 'Linux'≡5↑⊃'.'⎕WG'APLVersion'
          Z←'yes'≡⊃⎕CMD'test -d ',Argument,' && echo yes || echo no'
      :Else
          'gfa'⎕NA'I kernel32|GetFileAttributes* <0t'
          :If Z←¯1≠attr←gfa⊂Argument ⍝ If file exists
              Z←⊃2 16⊤attr           ⍝ Return bit 4
          :EndIf
      :EndIf
    ∇

    ∇ Z←test_files_in_dir Argument
      :If 'Linux'≡5↑⊃'.'⎕WG'APLVersion'
          Z←⎕SH'find ',Argument,' -name \*_tests.dyalog'
      :Else
          #.⎕CY'files'
          Z←#.Files.Dir Argument,'\*_tests.dyalog'
          Z←(Argument,'\')∘,¨Z
      :EndIf
    ∇

    ∇ Z←run_ut ut_data;returned;crashed;pass;crash;fail;message
      (returned crashed time)←execute_function ut_data
      (pass crash fail)←determine_pass_crash_or_fail returned crashed
      message←determine_message pass fail crashed(2⊃ut_data)returned time
      print_message_to_screen message
      Z←(pass crash fail)
    ∇

    ∇ Z←execute_function ut_data;function;t
      reset_UT_globals
      function←(⍕(⊃ut_data[1])),'.',⊃ut_data[2]
      :Trap sac
          :If 3.2≡⎕NC⊂function
              t←⎕TS
              Z←(⍎function,' ⍬')0
              t←⎕TS-t
          :Else
              t←⎕TS
              Z←(⍎function)0
              t←⎕TS-t
          :EndIf

      :Else
          Z←(↑⎕DM)1
          :If exception≢⍬
              expect←exception
              Z[2]←0
              t←⎕TS-t
          :EndIf
      :EndTrap
      Z,←⊂t
    ∇

    ∇ reset_UT_globals
      expect_orig ← expect← ⎕NS⍬
      exception←⍬
      nexpect_orig ← nexpect← ⎕NS⍬
    ∇

    ∇ Z←is_test FunctionName;wsIndex
      wsIndex←FunctionName⍳' '
      FunctionName←(wsIndex-1)↑FunctionName
      Z←'_TEST'≡¯5↑FunctionName
    ∇

    ∇ Heading print_passed_crashed_failed(ArrayRes time)
      ⎕←'-----------------------------------------'
      ⎕←Heading
      ⎕←'    ⍋  Passed: ',+/{1⊃⍵}¨ArrayRes
      ⎕←'    ⍟ Crashed: ',+/{2⊃⍵}¨ArrayRes
      ⎕←'    ⍒  Failed: ',+/{3⊃⍵}¨ArrayRes
      ⎕←'    ○ Runtime: ',time[5],'m',time[6],'s',time[7],'ms'
    ∇

    determine_pass_crash_or_fail←{
      r c←⍵ ⋄ 0≠c:0 1 0 ⋄ z←(0 0 1)(1 0 0)
      expect_orig≢expect:(⎕IO+expect≡r)⊃z ⋄ (⎕IO+nexpect≢r)⊃z
    }

    ∇ Z←determine_message(pass fail crashed name returned time)
      :If crashed
          Z←'CRASHED: 'failure_message name returned
      :ElseIf pass
          Z←'Passed ',time[5],'m',time[6],'s',time[7],'ms'
      :Else
          Z←'FAILED: 'failure_message name returned
      :EndIf
    ∇

    ∇ print_message_to_screen message
      ⎕←message
    ∇

    ∇ Z←term_to_text Term;Text;Rows
      Text←#.DISPLAY Term
      Rows←1⊃⍴Text
      Z←(Rows 4⍴''),Text
    ∇

    ∇ Z←Cause failure_message(name returned);hdr;exp;expterm;got;gotterm
      hdr←Cause,name
      exp←'Expected'
      expterm←term_to_text #.UT.expect
      got←'Got'
      gotterm←term_to_text returned
      Z←align_and_join_message_parts hdr exp expterm got gotterm
    ∇

    ∇ Z←align_and_join_message_parts Parts;hdr;exp;expterm;got;gotterm;R1;C1;R2;C2;W
      (hdr exp expterm got gotterm)←Parts
      (R1 C1)←⍴expterm
      (R2 C2)←⍴gotterm
      W←⊃⊃⌈/C1 C2(⍴hdr)(⍴exp)(⍴got)
      Z←(W↑hdr),[0.5](W↑exp)
      Z←Z⍪(R1 W↑expterm)
      Z←Z⍪(W↑got)
      Z←Z⍪(R2 W↑gotterm)
    ∇

    ∇ Z←confparam in config
      Z←1↓⊃({confparam≡⊃⍵}¨config)/config
    ∇

    ∇ Z←config has confparam
      Z←∨/{confparam≡⊃⍵}¨config
    ∇

:EndNameSpace

Add sample .dyalog file for file type APL

Taken from
https://github.com/Gianfrancoalongi/APLUnit/blob/master/UT.dyalog