 output←regexes(op Run options)input;from;to;options;lines;trans;Expand

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⎕NGET regexes 1
 :EndTrap

options←(0⍴⊂⍬),('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' '1')('UCP' 1)('OM')/⍨'gidmauo'∊819⌶options~' -'

 :If 2|≢regexes
 :OrIf '⍵'∊⊃⌽regexes
     from←¯1↓regexes
     :If ~'⍵'∊⊃⌽regexes
     Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX'to←{,⍕{'(Expand⊃⌽regexes)'}⍵}'
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 :If ∨/'Rr'∊op
     output←from ⎕R to⍠options⊢input
 :ElseIf ∨/'Ss'∊op
     output←from ⎕S to⍠options⊢input
 :Else
     'Left operand must be ''R'' or ''S'''⎕SIGNAL 11
 :EndIf

 output←regexes(op Run options)input;from;to;options;lines;trans;Expand

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap

options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' '1')('UCP' 1)('OM')/⍨1,'gidmauo'∊819⌶options~' -'

 :If 2|≢regexes
 :OrIf '⍵'∊⊃⌽regexes
     from←¯1↓regexes
     :If ~'⍵'∊⊃⌽regexes
     Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX'to←{,⍕{'(Expand⊃⌽regexes)'}⍵}'
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 :If ∨/'Rr'∊op
     output←from ⎕R to⍠options⊢input
 :ElseIf ∨/'Ss'∊op
     output←from ⎕S to⍠options⊢input
 :Else
     'Left operand must be ''R'' or ''S'''⎕SIGNAL 11
 :EndIf

Fix missing ⊃ and always give simple result.


:Namespace _HTML

  :class Form : #._html.form

    :field public Method←'post'
    :field public Action←''
    :field public Serialize←0

    ∇ make;c
      :Access public
      :Implements constructor
      :If {6::0 ⋄ ''≢c∘←##.context ⍵}'_Request'
        Action←c._Request.Page
      :EndIf
    ∇

    ∇ make1 action
      :Access public
      :Implements constructor
      Action←action
    ∇

    ∇ r←Render
      :Access public
      Attr['action' 'method']←Action Method
      r←⎕BASE.Render
    ∇
  :endclass

  :class InputSubmit : #._html.input

    ∇ Make
      :Access public
      :Implements constructor :base
      (name value)←'submit' 'submit'
      SetAttr('type' 'submit')
    ∇

    ∇ Make1 args;n;v
      :Access public
      :Implements constructor :base
      args←eis args
      (n v)←2↑args,(⍴args)↓'submit' 'submit'
      (name value)←n v
      SetAttr('type' 'submit')
    ∇
  :endclass

  :class Input : #._html.input

    :field public Label←''

    ∇ Make1 args;l;n;t;v
      :Access public
      :Implements constructor
      args←eis args
      t n v l←4↑args,(⍴args)↓'text' '' '' ''
      (type value Label)←t v l
      :If ~0∊⍴n ⋄ name←id←n ⋄ :EndIf
    ∇

    ∇ html←Render
      :Access public
      html←''
      :If ~0∊⍴Label
        :If id≡⎕NULL ⋄ id←'gen',⍕?1000 ⋄ :EndIf
        html,←'<label for="',(⍕id),'">',Label,'</label>'
      :EndIf
      html,←⎕BASE.Render
    ∇
  :endclass

  :class InputGrid : #._html.table

    :field public Border←0
    :field public Labels←''
    :field public Inputs←''
    :field public Headings←''

    ∇ html←Render;cells;rows
      :Access public
      cells←{⎕NEW #._html.td(⍵)}¨renderIt¨Labels,[1.1]Inputs
      cells[;1].style←⊂'text-align:right'
      rows←⎕NEW¨(⊃⍴cells)⍴#._html.tr
      rows.Add↓cells
      Content←rows.Render
      SetAttr'border'(⍕Border)
      html←⎕BASE.Render
    ∇
  :endclass

  :class EditField : #._html.input

    ∇ make1 nm
      :Access public
      :Implements constructor
      name←nm
      id←name
      type←'text'
    ∇
    ∇ make2(nm val)
      :Access public
      :Implements constructor
      :If ~1=≡name←nm val    ⍝ handle 2-character names
        (name value)←nm val
      :EndIf
      id←name
      type←'text'
    ∇
    ∇ make3(nm val att)
      :Access public
      :Implements constructor
      :If ~1=≡name←nm val att    ⍝ handle 3-character names
        (name value)←nm val
        SetAttr att
      :EndIf
      id←name
      type←'text'
    ∇
  :endclass

  :class Button : #._html.button

    :field _content←''

    ∇ Make0
      :Access public
      :Implements constructor :base
      SetAttr('type' 'button')
    ∇

    ∇ Make args;n;v
      :Access public
      :Implements constructor :base
          ⍝ arguments are name value {content}
      args←eis args
      (n v _content)←3↑args,(⍴args)↓'button' 'button' ''
      :If 0∊⍴_content ⋄ _content←v ⋄ :EndIf
      (name value)←n v
      id←name
      SetAttr('type' 'button')
    ∇

    ∇ html←Render
      :Access public
      :If 0∊⍴Content
        Content←_content
      :EndIf
      html←⎕BASE.Render
    ∇

  :endclass

  :class Script : #._html.script

    :field public File←''
    :field public Code←''

    ∇ Make0
      :Access public
      :Implements constructor
      SetAttr'type="text/javascript"'
    ∇

    ∇ Make1 params
      :Access public
      :Implements constructor
      params←eis params
      Code File←2↑params,(⍴params)↓'' ''
      SetAttr'type="text/javascript"'
    ∇

    ∇ html←Render
      :Access public
      :If ~0∊⍴File
        SetAttr('src'File)
      :ElseIf ~0∊⍴Code
        Content←Code
      :EndIf
      html←⎕BASE.Render
    ∇

  :endclass

  :class Style : #._html.style

    :field public Selector←''
    :field public Styles←''

    ∇ Make1 params
      :Access public
      :Implements constructor
      params←eis params
      (Selector Styles)←2↑params,(⍴params)↓'' ''
    ∇

    ∇ html←Render
      :Access public
      Content←Selector,#.HTMLUtils.Styles Styles
      html←⎕BASE.Render
    ∇
  :endclass

  :class StyleSheet : #._html.link

    :field public href←''

    ∇ Make1 params
      :Access public
      :Implements constructor
      href←params
    ∇

    ∇ html←Render
      :Access public
      SetAttr(('href'href)('rel' 'stylesheet')('type' 'text/css'))
      html←⎕BASE.Render
    ∇
  :endclass

  :class Table : #._html.table
    :field public Data←0 0⍴⊂''
    :field public CellAttr←''
    :field public HeaderRows←0
    :field public HeaderAttr←''
    :field public MakeCellIds←0
    :field public MakeRowIds←0

    ∇ Make0
      :Access public
      :Implements constructor
    ∇

    ∇ Make1 data
      :Access public
      :Implements constructor
      Data←data
    ∇

    ∇ html←Render;data;atts;tda;tha;hdrrows;cellids;rowids;rows;x;head;body;table;thead;tbody
      :Access public
      data tda tha hdrrows cellids rowids←Data CellAttr HeaderAttr HeaderRows MakeCellIds MakeRowIds
      hdrrows←⍬⍴hdrrows
      data←((rows←×/¯1↓⍴data),¯1↑⍴data)⍴data
      head←body←(0 1×⍴data)⍴⊂''
      :If 0≠hdrrows
        head←{⎕NEW #._html.th ⍵}¨hdrrows↑data
        :If cellids
          head.id←{∊'rc',¨⍕¨⍵}¨⍳⍴head
        :EndIf
        :If ~0∊⍴tha
          head.SetAttr¨(⍴head)⍴⊂¨eis tha
        :EndIf
      :EndIf
      :If 0<(⊃⍴data)-hdrrows
        body←{⎕NEW #._html.td ⍵}¨hdrrows↓data
        :If cellids
          body.id←{∊'rc',¨⍕¨⍵}¨hdrrows↓⍳⍴data
        :EndIf
        :If ~0∊⍴tda
          body.SetAttr¨(⍴body)⍴⊂¨eis tda
        :EndIf
      :EndIf
      (table←⎕NEW¨rows⍴#._html.tr).Add↓head⍪body
      :If rowids
        table.id←{'row',⍕⍵}⍳rows
      :EndIf
      thead←tbody←''
      :If 0≠hdrrows
        (thead←⎕NEW #._html.thead).Add hdrrows↑table
      :EndIf
      :If 0<(⊃⍴data)-hdrrows
        (tbody←⎕NEW #._html.tbody).Add hdrrows↓table
      :EndIf
      Content←thead,tbody
      html←⎕BASE.Render
    ∇
  :endclass

:EndNamespace

:Namespace _HTML

  :class Form : #._html.form

    :field public Method←'post'
    :field public Action←''
    :field public Serialize←0

    ∇ make;c
      :Access public
      :Implements constructor
      :If {6::0 ⋄ ''≢c∘←##.context ⍵}'_Request'
        Action←c._Request.Page
      :EndIf
    ∇

    ∇ make1 action
      :Access public
      :Implements constructor
      Action←action
    ∇

    ∇ r←Render
      :Access public
      Attr['action' 'method']←Action Method
      r←⎕BASE.Render
    ∇
  :endclass

  :class InputSubmit : #._html.input

    ∇ Make
      :Access public
      :Implements constructor :base
      (name value)←'submit' 'submit'
      SetAttr('type' 'submit')
    ∇

    ∇ Make1 args;n;v
      :Access public
      :Implements constructor :base
      args←eis args
      (n v)←2↑args,(⍴args)↓'submit' 'submit'
      (name value)←n v
      SetAttr('type' 'submit')
    ∇
  :endclass

  :class Input : #._html.input

    :field public Label←''

    ∇ Make1 args;l;n;t;v
      :Access public
      :Implements constructor
      args←eis args
      t n v l←4↑args,(⍴args)↓'text' '' '' ''
      (type value Label)←t v l
      :If ~0∊⍴n ⋄ name←id←n ⋄ :EndIf
    ∇

    ∇ html←Render
      :Access public
      html←''
      :If ~0∊⍴Label
        :If id≡⎕NULL ⋄ id←'gen',⍕?1000 ⋄ :EndIf
        html,←'<label for="',(⍕id),'">',Label,'</label>'
      :EndIf
      html,←⎕BASE.Render
    ∇
  :endclass

  :class InputGrid : #._html.table

    :field public Border←0
    :field public Labels←''
    :field public Inputs←''
    :field public Headings←''

    ∇ html←Render;cells;rows
      :Access public
      cells←{⎕NEW #._html.td(⍵)}¨renderIt¨Labels,[1.1]Inputs
      cells[;1].style←⊂'text-align:right'
      rows←⎕NEW¨(⊃⍴cells)⍴#._html.tr
      rows.Add↓cells
      Content←rows.Render
      SetAttr'border'(⍕Border)
      html←⎕BASE.Render
    ∇
  :endclass

  :class EditField : #._html.input

    ∇ make1 nm
      :Access public
      :Implements constructor
      name←nm
      id←name
      type←'text'
    ∇
    ∇ make2(nm val)
      :Access public
      :Implements constructor
      :If ~1=≡name←nm val    ⍝ handle 2-character names
        (name value)←nm val
      :EndIf
      id←name
      type←'text'
    ∇
    ∇ make3(nm val att)
      :Access public
      :Implements constructor
      :If ~1=≡name←nm val att    ⍝ handle 3-character names
        (name value)←nm val
        SetAttr att
      :EndIf
      id←name
      type←'text'
    ∇
  :endclass

  :class Button : #._html.button

    :field _content←''

    ∇ Make0
      :Access public
      :Implements constructor :base
      SetAttr('type' 'button')
    ∇

    ∇ Make args;n;v
      :Access public
      :Implements constructor :base
          ⍝ arguments are name value {content}
      args←eis args
      (n v _content)←3↑args,(⍴args)↓'button' 'button' ''
      :If 0∊⍴_content ⋄ _content←v ⋄ :EndIf
      (name value)←n v
      id←name
      SetAttr('type' 'button')
    ∇

    ∇ html←Render
      :Access public
      :If 0∊⍴Content
        Content←_content
      :EndIf
      html←⎕BASE.Render
    ∇

  :endclass

  :class Script : #._html.script

    :field public File←''
    :field public Code←''

    ∇ Make0
      :Access public
      :Implements constructor
      SetAttr'type="text/javascript"'
    ∇

    ∇ Make1 params
      :Access public
      :Implements constructor
      params←eis params
      Code File←2↑params,(⍴params)↓'' ''
      SetAttr'type="text/javascript"'
    ∇

    ∇ html←Render
      :Access public
      :If ~0∊⍴File
        SetAttr('src'File)
      :ElseIf ~0∊⍴Code
        Content←Code
      :EndIf
      html←⎕BASE.Render
    ∇

  :endclass

  :class Style : #._html.style

    :field public Selector←''
    :field public Styles←''

    ∇ Make1 params
      :Access public
      :Implements constructor
      params←eis params
      (Selector Styles)←2↑params,(⍴params)↓'' ''
    ∇

    ∇ html←Render
      :Access public
      Content←Selector,#.HTMLUtils.Styles Styles
      html←⎕BASE.Render
    ∇
  :endclass

  :class StyleSheet : #._html.link

    :field public href←''

    ∇ Make1 params
      :Access public
      :Implements constructor
      href←params
    ∇

    ∇ html←Render
      :Access public
      SetAttr(('href'href)('rel' 'stylesheet')('type' 'text/css'))
      html←⎕BASE.Render
    ∇
  :endclass

  :class Table : #._html.table
    :field public Data←0 0⍴⊂''
    :field public CellAttr←''
    :field public HeaderRows←0
    :field public HeaderAttr←''
    :field public MakeCellIds←0
    :field public MakeRowIds←0

    ∇ Make0
      :Access public
      :Implements constructor
    ∇

    ∇ Make1 data
      :Access public
      :Implements constructor
      data←eis data
      (Data CellAttr HeaderRows HeaderAttr MakeCellIds MakeRowIds)←6↑data,(⍴data)↓Data CellAttr HeaderRows HeaderAttr MakeCellIds MakeRowIds
    ∇

    ∇ html←Render;data;atts;tda;tha;hdrrows;cellids;rowids;rows;x;head;body;table;thead;tbody
      :Access public
      data tda tha hdrrows cellids rowids←Data CellAttr HeaderAttr HeaderRows MakeCellIds MakeRowIds
      hdrrows←⍬⍴hdrrows
      data←((rows←×/¯1↓⍴data),¯1↑⍴data)⍴data
      head←body←(0 1×⍴data)⍴⊂''
      :If 0≠hdrrows
        head←{⎕NEW #._html.th ⍵}¨hdrrows↑data
        :If cellids
          head.id←{∊'rc',¨⍕¨⍵}¨⍳⍴head
        :EndIf
        :If ~0∊⍴tha
          head.SetAttr¨(⍴head)⍴⊂¨eis tha
        :EndIf
      :EndIf
      :If 0<(⊃⍴data)-hdrrows
        body←{⎕NEW #._html.td ⍵}¨hdrrows↓data
        :If cellids
          body.id←{∊'rc',¨⍕¨⍵}¨hdrrows↓⍳⍴data
        :EndIf
        :If ~0∊⍴tda
          body.SetAttr¨(⍴body)⍴⊂¨eis tda
        :EndIf
      :EndIf
      (table←⎕NEW¨rows⍴#._html.tr).Add↓head⍪body
      :If rowids
        table.id←{'row',⍕⍵}⍳rows
      :EndIf
      thead←tbody←''
      :If 0≠hdrrows
        (thead←⎕NEW #._html.thead).Add hdrrows↑table
      :EndIf
      :If 0<(⊃⍴data)-hdrrows
        (tbody←⎕NEW #._html.tbody).Add hdrrows↓table
      :EndIf
      Content←thead,tbody
      html←⎕BASE.Render
    ∇
  :endclass

:EndNamespace

Extend _HTML.Table

Extend _HTML.Table


:Class SimpleSessions
⍝ Default Session Handler, used by the WebServer sample
⍝ Manages HTTP sessions using cookies
⍝ When a HTTP request arrives, checks to see if the session cookie is included and the session
⍝ is in the list of valid sessions. If it is, assign the Session property of the request.
⍝ If it isn't, create a new session and set the cookie

    :Field Public Sessions ⍝ Should be private, really
    :Field Public Server

    :Class Page
        :Field Public URL←''
        :Field Public State←⎕NS ''
    :EndClass

    :Class Session
        :Field Public ID←0
        :Field Public User←''
        :Field Public LastActive←0
        :Field Public Cookie←''
        :Field Public AuthCookieName←''
        :Field Public Timeout←0
        :Field Public State
        :Field Public New←1
        :Field Public Pages←0⍴⎕NEW Page
        :Field Public Server←⍬
    :EndClass

    ∇ Start server;tn;root
      :Access Public
      :Implements Constructor
    ⍝ Initialize Session handler

      Sessions←0⍴⎕NEW Session
      root←server.Config.Root
      Timeout←server.Config.SessionTimeout
      timeout←Timeout÷24×60 ⍝ Convert minutes to fractions of a day

      :Trap 22
          tn←(root,'sessions.dcf')⎕FCREATE 0
          (0 ¯1 0)⎕FSTAC tn
          0 ⎕FAPPEND tn ⍝ Session Number
          ⎕FUNTIE tn
      :EndTrap
      tn←(root,'sessions.dcf')⎕FSTIE 0
      NextSession←⎕FREAD tn,1
      ⎕FUNTIE tn
      Server←server
    ∇

    ∇ GetSession req;c;tn;now;session;ns;new;t_out;i;r
      :Access Public
    ⍝ Return session. Right argument is a HTTPRequest.
      :If (1=Server.Config.CreateSession)∨'get'≢req.Method
          :Hold 'Sessions'
              session←req.GetCookie'Session'
              now←#.Dates.DateToIDN ⎕TS

              :If new←(1⊃⍴Sessions)<i←Sessions.Cookie⍳⊂session ⍝ Cookie is not in the table
                  c←SessionCookie NextSession
                  Sessions←Sessions,r←⎕NEW Session
                  r.(ID User LastActive Cookie State Server)←NextSession''now c(⎕NS'')Server
                  NextSession←(2*30)|NextSession+1
                  tn←(req.Server.Config.Root,'sessions.dcf')⎕FSTIE 0
                  NextSession ⎕FREPLACE tn,1
                  ⎕FUNTIE tn
                  req.SetCookie'Session'c'/' 30 'HttpOnly'
                  req.Session←r
                  req.Server.onSessionStart req

              :Else ⍝ Old session
                  (r←i⊃Sessions).LastActive←now ⍝ Just register activity
                  r.New←0
                  req.Session←r
              :EndIf
          :EndHold
      :EndIf
    ∇

    ∇ KillSessions ids;mask;i
      :Access Public
      :Hold 'Sessions'
          :If ∨/mask←Sessions.ID∊ids
              :For i :In mask/⍳⍴mask
                  Server.onSessionEnd i⊃Sessions
              :EndFor
              Sessions/⍨←~mask
          :EndIf
      :EndHold
    ∇

    ∇ Logout req;session;i;z
      :Access Public Instance
     ⍝ End session due to user request

      session←req.GetCookie'Session'
      :If (1⊃⍴Sessions)≥i←Sessions.Cookie⍳⊂session ⍝ Cookie is in the table
          req.Server.onSessionEnd(i⊃Sessions)
          req.DelCookie'Session'
          :If 0≠⍴z←req.Session.AuthCookieName ⋄ req.DelCookie z ⋄ :EndIf
          req.Return'Logged out ...'
      :Else
          req.Return'No session established ...'
      :EndIf
    ∇

    ∇ r←SessionCookie n;⎕RL;z;seed;p
      ⍝ Create Cookie from session ID or vice versa

      :If (10|⎕DR n)∊0 2 ⍝ Session ID from Cookie
          z←⎕UCS #.Base64.Decode n
          ⎕RL←256⊥2↑z ⋄ p←30?30
          r←30⍴0 ⋄ r[p]←2↓z
          r←256⊥4↑r

      :Else ⍝ Session ID to Cookie
          ⎕RL←10000000|3⊃⎕AI
          ⎕RL←seed←?¯1+256*2 ⋄ p←30?30
          r←#.Base64.Encode #.Base64.Char(256 256⊤seed),((256 256 256 256⊤n),¯1+?26⍴256)[p]
      :EndIf
    ∇

    ∇ HouseKeeping Server;now;m;i;p
    ⍝ Check to see if any sessions have expired due to inactivity
    ⍝ Call any page application callbacks (_Close) if necessary

      :Access Public
      now←#.Dates.DateToIDN ⎕TS
      :If ∨/m←Sessions.LastActive<now-timeout
          :Hold 'Sessions'
              :For i :In m/⍳⍴m
                  Server.onSessionEnd i⊃Sessions
                  :If 0≠⍴p←(i⊃Sessions).Pages
                  :AndIf 0≠⊃p.⎕NC⊂'_Close'
                      p._Close i⊃Sessions
                  :EndIf
              :EndFor
              Sessions←(~m)/Sessions
          :EndHold
      :EndIf
    ∇

:EndClass

:Class SimpleSessions
⍝ Default Session Handler, used by the WebServer sample
⍝ Manages HTTP sessions using cookies
⍝ When a HTTP request arrives, checks to see if the session cookie is included and the session
⍝ is in the list of valid sessions. If it is, assign the Session property of the request.
⍝ If it isn't, create a new session and set the cookie

    :Field Public Sessions ⍝ Should be private, really
    :Field Public Server

    :Class Page
        :Field Public URL←''
        :Field Public State←⎕NS ''
    :EndClass

    :Class Session
        :Field Public ID←0
        :Field Public User←''
        :Field Public LastActive←0
        :Field Public Cookie←''
        :Field Public AuthCookieName←''
        :Field Public Timeout←0
        :Field Public State
        :Field Public New←1
        :Field Public Pages←0⍴⎕NEW Page
        :Field Public Server←⍬
    :EndClass

    ∇ Start server;tn;root
      :Access Public
      :Implements Constructor
    ⍝ Initialize Session handler

      Sessions←0⍴⎕NEW Session
      root←server.Config.Root
      Timeout←server.Config.SessionTimeout
      timeout←Timeout÷24×60 ⍝ Convert minutes to fractions of a day

      :Trap 22
          tn←(root,'sessions.dcf')⎕FCREATE 0
          (0 ¯1 0)⎕FSTAC tn
          0 ⎕FAPPEND tn ⍝ Session Number
          ⎕FUNTIE tn
      :EndTrap
      tn←(root,'sessions.dcf')⎕FSTIE 0
      NextSession←⎕FREAD tn,1
      ⎕FUNTIE tn
      Server←server
    ∇

    ∇ GetSession req;c;tn;now;session;ns;new;t_out;i;r
      :Access Public
    ⍝ Return session. Right argument is a HTTPRequest.
      :If (1=Server.Config.CreateSession)∨'get'≢req.Method
          :Hold 'Sessions'
              session←req.GetCookie'Session'
              now←#.Dates.DateToIDN ⎕TS

              :If new←(1⊃⍴Sessions)<i←Sessions.Cookie⍳⊂session ⍝ Cookie is not in the table
                  c←SessionCookie NextSession
                  Sessions←Sessions,r←⎕NEW Session
                  r.(ID User LastActive Cookie State Server Timeout)←NextSession''now c(⎕NS'')Server timeout
                  NextSession←(2*30)|NextSession+1
                  tn←(req.Server.Config.Root,'sessions.dcf')⎕FSTIE 0
                  NextSession ⎕FREPLACE tn,1
                  ⎕FUNTIE tn
                  req.SetCookie'Session'c'/' 30 'HttpOnly'
                  req.Session←r
                  req.Server.onSessionStart req

              :Else ⍝ Old session
                  (r←i⊃Sessions).LastActive←now ⍝ Just register activity
                  r.New←0
                  req.Session←r
              :EndIf
          :EndHold
      :EndIf
    ∇

    ∇ KillSessions ids;mask;i
      :Access Public
      :Hold 'Sessions'
          :If ∨/mask←Sessions.ID∊ids
              :For i :In mask/⍳⍴mask
                  Server.onSessionEnd i⊃Sessions
              :EndFor
              Sessions/⍨←~mask
          :EndIf
      :EndHold
    ∇

    ∇ Logout req;session;i;z
      :Access Public Instance
     ⍝ End session due to user request

      session←req.GetCookie'Session'
      :If (1⊃⍴Sessions)≥i←Sessions.Cookie⍳⊂session ⍝ Cookie is in the table
          req.Server.onSessionEnd(i⊃Sessions)
          req.DelCookie'Session'
          :If 0≠⍴z←req.Session.AuthCookieName ⋄ req.DelCookie z ⋄ :EndIf
          req.Return'Logged out ...'
      :Else
          req.Return'No session established ...'
      :EndIf
    ∇

    ∇ r←SessionCookie n;⎕RL;z;seed;p
      ⍝ Create Cookie from session ID or vice versa

      :If (10|⎕DR n)∊0 2 ⍝ Session ID from Cookie
          z←⎕UCS #.Base64.Decode n
          ⎕RL←256⊥2↑z ⋄ p←30?30
          r←30⍴0 ⋄ r[p]←2↓z
          r←256⊥4↑r

      :Else ⍝ Session ID to Cookie
          ⎕RL←10000000|3⊃⎕AI
          ⎕RL←seed←?¯1+256*2 ⋄ p←30?30
          r←#.Base64.Encode #.Base64.Char(256 256⊤seed),((256 256 256 256⊤n),¯1+?26⍴256)[p]
      :EndIf
    ∇

    ∇ HouseKeeping Server;now;m;i;p
    ⍝ Check to see if any sessions have expired due to inactivity
    ⍝ Call any page application callbacks (_Close) if necessary

      :Access Public
      now←#.Dates.DateToIDN ⎕TS
      :If ∨/m←Sessions.LastActive<now-Sessions.Timeout
          :Hold 'Sessions'
              :For i :In m/⍳⍴m
                  Server.onSessionEnd i⊃Sessions
                  :If 0≠⍴p←(i⊃Sessions).Pages
                  :AndIf 0≠⊃p.⎕NC⊂'_Close'
                      p._Close i⊃Sessions
                  :EndIf
              :EndFor
              Sessions←(~m)/Sessions
          :EndHold
      :EndIf
    ∇

:EndClass

Allow each session to have its own timeout


 output←regexes(op Run options)input;from;to;options;lines;trans;Expand

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap

options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' '1')('UCP' 1)('OM')/⍨1,'gidmauo'∊819⌶options~' -'

 :If 2|≢regexes
 :OrIf '⍵'∊⊃⌽regexes
     from←¯1↓regexes
     :If ~'⍵'∊⊃⌽regexes
     Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX'to←{,⍕{'(Expand⊃⌽regexes)'}⍵}'
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 :If ∨/'Rr'∊op
     output←from ⎕R to⍠options⊢input
 :ElseIf ∨/'Ss'∊op
     output←from ⎕S to⍠options⊢input
 :Else
     'Left operand must be ''R'' or ''S'''⎕SIGNAL 11
 :EndIf

 output←regexes(op Run options)input;from;to;options;lines;trans;Expand

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap

 options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' '1')('UCP' 1)('OM' 1)/⍨1,'gidmauo'∊819⌶options~' -'
 options↓⍨←∨/'Ss'∊op

 :If 2|≢regexes
 :OrIf '⍵'∊⊃⌽regexes
     from←¯1↓regexes
     :If ~'⍵'∊⊃⌽regexes
         Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX'to←{,⍕{'(Expand⊃⌽regexes)'}⍵}'
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 :If ∨/'Rr'∊op
     output←from ⎕R to⍠options⊢input
 :ElseIf ∨/'Ss'∊op
     output←from ⎕S to⍠options⊢input
 :Else
     'Left operand must be ''R'' or ''S'''⎕SIGNAL 11
 :EndIf

add missing OM option value and remove ResultText for QuadS


:Namespace SQL
    (⎕IO ⎕ML)←1

    ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
      ms←#.Boot.ms
      find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
      r←601 'No datasources defined'
      :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
          :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
              r←601 ''('Datasource "',database,'" not found')
              :Return
          :Else ⍝ found it
              ds←ind⊃ms.Datasources
              r←601 'SQAPL not available'
              :If 0=⊃#.SQA.Init''
                  (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
                  conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
                  :If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
                  :Else ⋄ r←601 ''('Unable to connect to "',database,'" due to ',⍕3⊃rc)
                  :EndIf
              :EndIf
          :EndIf
      :EndIf
    ∇

    ∇ r←Do ctl;c;m;z;ns;conx;data
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars} {nulls}
      r←⎕NS''
      r.(ReturnCode Data Message)←¯1(0 0⍴0)''
      →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
      →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
      →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
      data←''
      :If 3≤⍴ctl
          :If 1<|≡3⊃ctl ⋄ data←3⊃ctl
              :If 3<⍴ctl ⋄ data←(⊂data),ctl[4] ⋄ :EndIf  ⍝ deal with nulls
          :Else ⋄ data←2↓ctl ⋄ :EndIf
      :EndIf
      →(0<1⊃z←#.SQA.Exec(⊂c),data)⍴l2
      →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
      →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
      r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
     l1:
      →(0<1⊃z←1 #.SQA.Fetch c)⍴l2
      r.Data←⊃2⊃z
     l2:
      :If 0<r.ReturnCode←1⊃z ⋄ r.Message←3⊃z ⋄ :EndIf
      →(0<1⊃z←#.SQA.Close conx)↓0
     l3:
      r.ReturnCode←1⊃z
      r.Message←3⊃z
    ∇

    ∇ r←CloseAll
      →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
      r←#.SQA.Close¨1⊃¨r
    ∇

:EndNamespace

:Namespace SQL
    (⎕IO ⎕ML)←1

    ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
      ms←#.Boot.ms
      find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
      r←601 'No datasources defined'
      :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
          :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
              r←601 ''('Datasource "',database,'" not found')
              :Return
          :Else ⍝ found it
              ds←ind⊃ms.Datasources
              r←601 'SQAPL not available'
              :If 0=⊃#.SQA.Init''
                  (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
                  conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
                 ⍝:If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
                  :If 1>1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
                 ⍝ Baas: warning (¯1) means conn was established, so return ok!
                 ⍝ discussed with BHC in Italy ;-)
                  :Else ⋄ r←601 ''('Unable to connect to "',database,'" due to ',⍕3⊃rc)
                  :EndIf
                  :Else ⋄ r←601 ''('Unable to connect to "',database,'" due to ',⍕3⊃rc)
                  :EndIf
              :EndIf
          :EndIf
      :EndIf
    ∇

    ∇ r←Do ctl;c;m;z;ns;conx;data
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars} {nulls}
      r←⎕NS''
      r.(ReturnCode Data Message)←¯1(0 0⍴0)''
      →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
      →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
      →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
      data←''
      :If 3≤⍴ctl
          :If 1<|≡3⊃ctl ⋄ data←3⊃ctl
              :If 3<⍴ctl ⋄ data←(⊂data),ctl[4] ⋄ :EndIf  ⍝ deal with nulls
          :Else ⋄ data←2↓ctl ⋄ :EndIf
      :EndIf
      →(0<1⊃z←#.SQA.Exec(⊂c),data)⍴l2
      →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
      →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
      r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
     l1:
      →(0<1⊃z←1 #.SQA.Fetch c)⍴l2
      r.Data←⊃2⊃z
     l2:
      :If 0<r.ReturnCode←1⊃z ⋄ r.Message←3⊃z ⋄ :EndIf
      →(0<1⊃z←#.SQA.Close conx)↓0
     l3:
      r.ReturnCode←1⊃z
      r.Message←3⊃z
    ∇

    ∇ r←CloseAll
      →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
      r←#.SQA.Close¨1⊃¨r
    ∇

:EndNamespace

Update SQL.dyalog

Update SQL.dyalog

Connection warnings imply that conn was established, so the result of ConnectTo should show that (and not indicate failure as before)


 output←regexes(op Run args)input;from;to;options;lines;trans;Expand;repeat;s;r;last;fns;Quote;q;hasrepeat;postproc;combine

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap

 repeat←⍎{×≢⍵:⍵ ⋄ '1'}args∩'≡',⎕D ⍝ extract repetition, if any, else 1
 hasrepeat←∨/args∊⍨'≡',⎕D
 ⍝ select options:
 options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' '1')('UCP' 1)('OM' 1)/⍨1,'gidmauo'∊819⌶args~' -'
 s r←(∨/∊∘op)¨'Ss' 'Rr'
 options↓⍨←s ⍝ ResultText is not for ⎕S

 fns←+/∧\'⍵'∊¨regexes
 postproc←∊'{⍵}','∘{'∘,¨,∘'}'¨fns↑regexes ⍝ post-processing functions
 regexes↓⍨←fns

 last←⊃⌽regexes
 :If 2|≢regexes ⍝ odd number of strings → many-to-one
 :OrIf '⍵'∊last ⍝ transformation function → many-to-function
     from←¯1↓regexes ⍝ remove transformation pattern/function
     :If ~'⍵'∊last ⍝ no ⍵ → pattern
         Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX'to←{'(r/',⍕{')(Expand last)(r/'}⍵')'}' ⍝ if definition fails, revert to pattern (allows ⍵ in pattern)
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 combine←'{⊃,/⍵↑¨⍨⌈/≢¨⍵}'
 q←⎕NS ⍬
 :If s r∨.∧'?'∊args
     Quote←{q,q,⍨⍵/⍨1+⍵=q←''''}
     q.from←⍕Quote¨from
     :If 3=⎕NC'to'
         q.to←1⌽'  ',3↓∊⎕NR'to'
     :Else
         q.to←⍕Quote¨to
     :EndIf
     :If 3=⎕NC'repeat'
         q.repeat←'⍣',∊⎕NR'repeat'
     :ElseIf 1≢repeat
         q.repeat←'⍣',⍕repeat
     :Else
         q.repeat←''
     :EndIf
     :If ×≢options
         q.options←'⍠',∊{' (',(Quote⊃⍵),' ',({0 1∊⍨⊂⍵:⍕⍵ ⋄ '''',⍵,''''}⊃⌽⍵),')'}¨options
     :Else
         q.options←''
     :EndIf
     q.op←s r/'SR'
     q.postproc←4↓postproc
     q.postproc,←(hasrepeat∧s)/(''≡q.postproc)↓'∘',combine
     output←q.(postproc,from,'⎕',op,to,options,repeat)
 :Else
     :Trap 6 11
         :If r
             output←from ⎕R to⍠options⍣repeat⊢input
         :ElseIf s
             output←from ⎕S to⍠options⍣repeat⊢input
             output←(⍎combine)⍣hasrepeat⊢output ⍝ merge search results if we need to continue
         :EndIf
         output←(⍎postproc)output
     :Case 6 ⍝ no output
         output←'*** Left operand must be ''R'' or ''S'' ***'
     :Case 11 ⍝ faulty regex
         output←'*** ',⎕DMX.Message,' ─ try adding ? to the Arguments to see the attempted APL expression ***'
     :EndTrap
 :EndIf

 output←regexes(op Run args)input;from;to;options;lines;trans;Expand;repeat;s;r;last;fns;Quote;q;hasrepeat;postproc;combine

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap

 repeat←⍎{×≢⍵:⍵ ⋄ '1'}args∩'≡',⎕D ⍝ extract repetition, if any, else 1
 hasrepeat←∨/args∊⍨'≡',⎕D
 ⍝ select options:
 options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' 1)('UCP' 1)('OM' 1)/⍨1,'gidmauo'∊819⌶args~' -'
 s r←(∨/∊∘op)¨'Ss' 'Rr'
 options↓⍨←s ⍝ ResultText is not for ⎕S

 fns←+/∧\'⍵'∊¨regexes
 postproc←∊'{⍵}','∘{'∘,¨,∘'}'¨fns↑regexes ⍝ post-processing functions
 regexes↓⍨←fns

 last←⊃⌽regexes
 :If 2|≢regexes ⍝ odd number of strings → many-to-one
 :OrIf '⍵'∊last ⍝ transformation function → many-to-function
     from←¯1↓regexes ⍝ remove transformation pattern/function
     :If ~'⍵'∊last ⍝ no ⍵ → pattern
         Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
     :OrIf ~≡⎕FX,⊂'to←{',(r/',⍕{'),(Expand last),(r/'}⍵'),'}' ⍝ if definition fails, revert to pattern (allows ⍵ in pattern)
         to←⊃⌽regexes
     :EndIf
 :Else
     lines←2÷⍨≢regexes
     from←lines↑regexes
     to←lines↓regexes
 :EndIf

 combine←'{⊃,/⍵↑¨⍨⌈/≢¨⍵}'
 q←⎕NS ⍬
 :If s r∨.∧'?'∊args
     Quote←{q,q,⍨⍵/⍨1+⍵=q←''''}
     q.from←⍕Quote¨from
     :If 3=⎕NC'to'
         q.to←1⌽'  ',3↓∊⎕NR'to'
     :Else
         q.to←⍕Quote¨to
     :EndIf
     :If 3=⎕NC'repeat'
         q.repeat←'⍣',∊⎕NR'repeat'
     :ElseIf 1≢repeat
         q.repeat←'⍣',⍕repeat
     :Else
         q.repeat←''
     :EndIf
     :If ×≢options
         q.options←'⍠',∊{' (',(Quote⊃⍵),' ',({0 1∊⍨⊂⍵:⍕⍵ ⋄ '''',⍵,''''}⊃⌽⍵),')'}¨options
     :Else
         q.options←''
     :EndIf
     q.op←s r/'SR'
     q.postproc←4↓postproc
     q.postproc,←(hasrepeat∧s)/(''≡q.postproc)↓'∘',combine
     output←q.(postproc,from,'⎕',op,to,options,repeat)
 :Else
     :Trap 6 11
         :If r
             output←from ⎕R to⍠options⍣repeat⊢input
         :ElseIf s
             output←from ⎕S to⍠options⍣repeat⊢input
             output←(⍎combine)⍣hasrepeat⊢output ⍝ merge search results if we need to continue
         :EndIf
         output←(⍎postproc)output
     :Case 6 ⍝ no output
         output←'*** Left operand must be ''R'' or ''S'' ***'
     :Case 11 ⍝ faulty regex
         output←'*** ',⎕DMX.Message,' ─ try adding ? to the Arguments to see the attempted APL expression ***'
     :EndTrap
 :EndIf

Remove bad quotes. Use one-liner transformation function.


:Namespace SQL
    (⎕IO ⎕ML)←1

    ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
      ms←#.Boot.ms
      find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
      r←601 'No datasources defined'
      :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
          :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
              r←601 ''('Datasource "',database,'" not found')
              :Return
          :Else ⍝ found it
              ds←ind⊃ms.Datasources
              r←601 'SQAPL not available'
              :If 0=⊃#.SQA.Init''
                  (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
                  conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
                  :If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
                  :Else ⋄ r←601('Unable to connect to "',database,'"')
                  :EndIf
              :EndIf
          :EndIf
      :EndIf
    ∇

    ∇ r←Do ctl;c;m;z;ns;conx
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars}

      r←⎕NS''
      →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
      →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
      →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
      →(0<1⊃z←#.SQA.Exec(⊂c),2↓ctl)⍴l2
      →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
      →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
      r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
     l1:→(0<1⊃z←1 #.SQA.Fetch c)⍴l2
      r.ReturnCode←1⊃z
      r.Data←⊃2⊃z
     l2:→(0<1⊃z←#.SQA.Close conx)↓0
     l3:r.ReturnCode←1⊃z
    ∇

    ∇ r←CloseAll
      →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
      r←#.SQA.Close¨1⊃¨r
    ∇

:EndNamespace

:Namespace SQL
  (⎕IO ⎕ML)←1

  ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
    ms←#.Boot.ms
    find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
    r←601 'No datasources defined'
    :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
      :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
        r←601 ''('Datasource "',database,'" not found')
        :Return
      :Else ⍝ found it
        ds←ind⊃ms.Datasources
        r←601 'SQAPL not available'
        :If 0=⊃#.SQA.Init''
          (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
          conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
          :If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
          :Else ⋄ r←601('Unable to connect to "',database,'"')
          :EndIf
        :EndIf
      :EndIf
    :EndIf
  ∇

  ∇ r←Do ctl;c;m;z;ns;conx;data
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars}

    r←⎕NS''
    →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
    →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
    →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
    :If 1<|≡3⊃ctl ⋄ data←3⊃ctl ⋄ :Else ⋄ data←2↓ctl ⋄ :EndIf
    →(0<1⊃z←#.SQA.Exec(⊂c),data)⍴l2
    →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
    →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
    r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
   l1:→(0<1⊃z←1 #.SQA.Fetch c)⍴l2
    r.ReturnCode←1⊃z
    r.Data←⊃2⊃z
   l2:→(0<1⊃z←#.SQA.Close conx)↓0
   l3:r.ReturnCode←1⊃z
  ∇

  ∇ r←CloseAll
    →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
    r←#.SQA.Close¨1⊃¨r
  ∇

:EndNamespace

Improve SQL.Do bind variable handling

Improve SQL.Do bind variable handling


Throw the correct errors from matrix inverse, as specified in the ISO standard.


: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;controls;sp;c
      :Access Public

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

          controls←∪Walk Body.Content

        ⍝ 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

        ⍝ 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 <body> 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⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

          :If ~0∊⍴controls
              c←Body.Content
              Body.Content←''
              (sp←Body.Add _.StackPanel(⊂FormatControls controls)c).Horizontal←1

          :EndIf

        ⍝ wrap the content of the <body> 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←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<hr/>'
      :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/#!/azure/',(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;controls;sp;c
      :Access Public

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

          controls←∪Walk Body.Content

        ⍝ 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

        ⍝ 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 <body> 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⊃⊃⎕CLASS ⎕THIS)).Set'id="codeblock"' 'style="display: none;"'

          :If ~0∊⍴controls
              c←Body.Content
              Body.Content←''
              (sp←Body.Add _.StackPanel(⊂FormatControls controls)c).Horizontal←1

          :EndIf

        ⍝ wrap the content of the <body> 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←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<hr/>'
      :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

Update links to Syncfusion samples from MiPageSample - they moved again...


⍝ Using the ⍳ (iota) function to generate a set of ordered numbers in a 3D array
⍳ 9 9 9

Update iota999.apl

Update iota999.apl


:Class SimpleSessions
⍝ Default Session Handler, used by the WebServer sample
⍝ Manages HTTP sessions using cookies
⍝ When a HTTP request arrives, checks to see if the session cookie is included and the session
⍝ is in the list of valid sessions. If it is, assign the Session property of the request.
⍝ If it isn't, create a new session and set the cookie

    :Field Public Sessions ⍝ Should be private, really

    :Class Page
        :Field Public URL←''
        :Field Public State←⎕NS ''
    :EndClass

    :Class Session
        :Field Public ID←0
        :Field Public User←''
        :Field Public LastActive←0
        :Field Public Cookie←''
        :Field Public AuthCookieName←''
        :Field Public Timeout←0
        :Field Public State
        :Field Public New←1
        :Field Public Pages←0⍴⎕NEW Page
    :EndClass

    ∇ Start Server;tn;root
      :Access Public
      :Implements Constructor
    ⍝ Initialize Session handler

      Sessions←0⍴⎕NEW Session
      root←Server.Config.Root
      Timeout←Server.Config.SessionTimeout
      timeout←Timeout÷24×60 ⍝ Convert minutes to fractions of a day

      :Trap 22
          tn←(root,'sessions.dcf')⎕FCREATE 0
          (0 ¯1 0)⎕FSTAC tn
          0 ⎕FAPPEND tn ⍝ Session Number
          ⎕FUNTIE tn
      :EndTrap
      tn←(root,'sessions.dcf')⎕FSTIE 0
      NextSession←⎕FREAD tn,1
      ⎕FUNTIE tn
    ∇

    ∇ GetSession req;c;tn;now;session;ns;new;t_out;i;r
      :Access Public
    ⍝ Return session. Right argument is a HTTPRequest.

      :Hold 'Sessions'
          session←req.GetCookie'Session'
          now←#.Dates.DateToIDN ⎕TS

          :If new←(1⊃⍴Sessions)<i←Sessions.Cookie⍳⊂session ⍝ Cookie is not in the table
              c←SessionCookie NextSession
              Sessions←Sessions,r←⎕NEW Session
              r.(ID User LastActive Cookie State)←NextSession''now c(⎕NS'')
              NextSession←(2*30)|NextSession+1
              tn←(req.Server.Config.Root,'sessions.dcf')⎕FSTIE 0
              NextSession ⎕FREPLACE tn,1
              ⎕FUNTIE tn
              req.SetCookie'Session'c
              req.Session←r
              req.Server.onSessionStart req

          :Else ⍝ Old session
              (r←i⊃Sessions).LastActive←now ⍝ Just register activity
              r.New←0
              req.Session←r
          :EndIf

      :EndHold
    ∇

    ∇ KillSessions ids;mask;i
      :Access Public
      :Hold 'Sessions'
          :If ∨/mask←Sessions.ID∊id
              :For i :In mask/⍳⍴mask
                  Server.onSessionEnd i⊃Sessions
              :EndFor
              Sessions/⍨←~mask
          :EndIf
      :EndHold
    ∇

    ∇ Logout req;session;i;z
      :Access Public Instance
     ⍝ End session due to user request

      session←req.GetCookie'Session'
      :If (1⊃⍴Sessions)≥i←Sessions.Cookie⍳⊂session ⍝ Cookie is in the table
          req.Server.onSessionEnd(i⊃Sessions)
          req.DelCookie'Session'
          :If 0≠⍴z←req.Session.AuthCookieName ⋄ req.DelCookie z ⋄ :EndIf
          req.Return'Logged out ...'
      :Else
          req.Return'No session established ...'
      :EndIf
    ∇

    ∇ r←SessionCookie n;⎕RL;z;seed;p
      ⍝ Create Cookie from session ID or vice versa

      :If (10|⎕DR n)∊0 2 ⍝ Session ID from Cookie
          z←⎕UCS #.Base64.Decode n
          ⎕RL←256⊥2↑z ⋄ p←30?30
          r←30⍴0 ⋄ r[p]←2↓z
          r←256⊥4↑r

      :Else ⍝ Session ID to Cookie
          ⎕RL←10000000|3⊃⎕AI
          ⎕RL←seed←?¯1+256*2 ⋄ p←30?30
          r←#.Base64.Encode #.Base64.Char(256 256⊤seed),((256 256 256 256⊤n),¯1+?26⍴256)[p]
      :EndIf
    ∇

    ∇ HouseKeeping Server;now;m;i;p
    ⍝ Check to see if any sessions have expired due to inactivity
    ⍝ Call any page application callbacks (_Close) if necessary

      :Access Public
      now←#.Dates.DateToIDN ⎕TS
      :If ∨/m←Sessions.LastActive<now-timeout
          :Hold 'Sessions'
              :For i :In m/⍳⍴m
                  Server.onSessionEnd i⊃Sessions
                  :If 0≠⍴p←(i⊃Sessions).Pages
                  :AndIf 0≠⊃p.⎕NC⊂'_Close'
                      p._Close i⊃Sessions
                  :EndIf
              :EndFor
              Sessions←(~m)/Sessions
          :EndHold
      :EndIf
    ∇

:EndClass

:Class SimpleSessions
⍝ Default Session Handler, used by the WebServer sample
⍝ Manages HTTP sessions using cookies
⍝ When a HTTP request arrives, checks to see if the session cookie is included and the session
⍝ is in the list of valid sessions. If it is, assign the Session property of the request.
⍝ If it isn't, create a new session and set the cookie

    :Field Public Sessions ⍝ Should be private, really
    :Field Public Server

    :Class Page
        :Field Public URL←''
        :Field Public State←⎕NS ''
    :EndClass

    :Class Session
        :Field Public ID←0
        :Field Public User←''
        :Field Public LastActive←0
        :Field Public Cookie←''
        :Field Public AuthCookieName←''
        :Field Public Timeout←0
        :Field Public State
        :Field Public New←1
        :Field Public Pages←0⍴⎕NEW Page
        :Field Public Server←⍬
    :EndClass

    ∇ Start server;tn;root
      :Access Public
      :Implements Constructor
    ⍝ Initialize Session handler

      Sessions←0⍴⎕NEW Session
      root←server.Config.Root
      Timeout←server.Config.SessionTimeout
      timeout←Timeout÷24×60 ⍝ Convert minutes to fractions of a day

      :Trap 22
          tn←(root,'sessions.dcf')⎕FCREATE 0
          (0 ¯1 0)⎕FSTAC tn
          0 ⎕FAPPEND tn ⍝ Session Number
          ⎕FUNTIE tn
      :EndTrap
      tn←(root,'sessions.dcf')⎕FSTIE 0
      NextSession←⎕FREAD tn,1
      ⎕FUNTIE tn
      Server←server
    ∇

    ∇ GetSession req;c;tn;now;session;ns;new;t_out;i;r
      :Access Public
    ⍝ Return session. Right argument is a HTTPRequest.

      :Hold 'Sessions'
          session←req.GetCookie'Session'
          now←#.Dates.DateToIDN ⎕TS

          :If new←(1⊃⍴Sessions)<i←Sessions.Cookie⍳⊂session ⍝ Cookie is not in the table
              c←SessionCookie NextSession
              Sessions←Sessions,r←⎕NEW Session
              r.(ID User LastActive Cookie State Server)←NextSession''now c(⎕NS'')Server
              NextSession←(2*30)|NextSession+1
              tn←(req.Server.Config.Root,'sessions.dcf')⎕FSTIE 0
              NextSession ⎕FREPLACE tn,1
              ⎕FUNTIE tn
              req.SetCookie'Session'c
              req.Session←r
              req.Server.onSessionStart req

          :Else ⍝ Old session
              (r←i⊃Sessions).LastActive←now ⍝ Just register activity
              r.New←0
              req.Session←r
          :EndIf

      :EndHold
    ∇

    ∇ KillSessions ids;mask;i
      :Access Public
      :Hold 'Sessions'
          :If ∨/mask←Sessions.ID∊ids
              :For i :In mask/⍳⍴mask
                  Server.onSessionEnd i⊃Sessions
              :EndFor
              Sessions/⍨←~mask
          :EndIf
      :EndHold
    ∇

    ∇ Logout req;session;i;z
      :Access Public Instance
     ⍝ End session due to user request

      session←req.GetCookie'Session'
      :If (1⊃⍴Sessions)≥i←Sessions.Cookie⍳⊂session ⍝ Cookie is in the table
          req.Server.onSessionEnd(i⊃Sessions)
          req.DelCookie'Session'
          :If 0≠⍴z←req.Session.AuthCookieName ⋄ req.DelCookie z ⋄ :EndIf
          req.Return'Logged out ...'
      :Else
          req.Return'No session established ...'
      :EndIf
    ∇

    ∇ r←SessionCookie n;⎕RL;z;seed;p
      ⍝ Create Cookie from session ID or vice versa

      :If (10|⎕DR n)∊0 2 ⍝ Session ID from Cookie
          z←⎕UCS #.Base64.Decode n
          ⎕RL←256⊥2↑z ⋄ p←30?30
          r←30⍴0 ⋄ r[p]←2↓z
          r←256⊥4↑r

      :Else ⍝ Session ID to Cookie
          ⎕RL←10000000|3⊃⎕AI
          ⎕RL←seed←?¯1+256*2 ⋄ p←30?30
          r←#.Base64.Encode #.Base64.Char(256 256⊤seed),((256 256 256 256⊤n),¯1+?26⍴256)[p]
      :EndIf
    ∇

    ∇ HouseKeeping Server;now;m;i;p
    ⍝ Check to see if any sessions have expired due to inactivity
    ⍝ Call any page application callbacks (_Close) if necessary

      :Access Public
      now←#.Dates.DateToIDN ⎕TS
      :If ∨/m←Sessions.LastActive<now-timeout
          :Hold 'Sessions'
              :For i :In m/⍳⍴m
                  Server.onSessionEnd i⊃Sessions
                  :If 0≠⍴p←(i⊃Sessions).Pages
                  :AndIf 0≠⊃p.⎕NC⊂'_Close'
                      p._Close i⊃Sessions
                  :EndIf
              :EndFor
              Sessions←(~m)/Sessions
          :EndHold
      :EndIf
    ∇

:EndClass

Fix to SimpleSessions.KillSessions

Fix to SimpleSessions.KillSessions


:Class ejDateTimePickerAdvanced : MiPageSample
⍝ Control:: _SF.ejDateTimePicker
⍝ Description::  advance functionality.
⍝ Show 2 calendars to select reservation dates.
⍝ Display the time difference as result.

    ∇ Compose;today;fromidn;tbl;tr;td;head;todate;from;now;to
      :Access Public
      today←3↑now←⎕TS
      fromidn←dateToIDN today

      Add _.h2'R.U. Inn'_.br'Motel reservation system'

    ⍝ The in date
      from←'in'New _SF.ejDateTimePicker now'yyyy/MM/dd HH:mm'
    ⍝ The callback should return the date (value) of the argument for the IN date/time
    ⍝ and the model's value for the OUT date/time
      from.On'change' 'setNewDate',⊂('in' 'argument' 'value')('out' 'eval' '$("#out").ejDateTimePicker("model.value")')

    ⍝ The out date
      todate←IDNToDate fromidn+7
      to←'out'New _SF.ejDateTimePicker todate'yyyy/MM/dd HH:mm'
      to.On'change' 'setNewDate',⊂('out' 'argument' 'value')('in' 'eval' '$("#in").ejDateTimePicker("model.value")')

      Add #._.InputGrid('Check In' 'Check Out',⍪from to)

      'diff'Add _.div
    ∇

    newDate←{'⍎new Date("',(⍕⍵),'")'}
    dateToIDN←{d←2 ⎕NQ'.' 'datetoidn'⍵ ⋄ d+(60⊥3↓6↑⍵)÷86400}
    IDNToDate←{d←3↑2 ⎕NQ'.' 'idntodate'⍵ ⋄ d,0 60 60⊤⌊86400×1|⍵}

    ∇ r←setNewDate;in;out
      :Access public

    ⍝ Find the difference between the dates
      in←dateToIDN stringToDate⍕Get'in'
      out←dateToIDN 6↑{b←~⍵∊'/-:' ⋄ FI b\b/⍵}Get'out'

    ⍝ If the new IN date is not before the OUT date we reset OUT to 1 week after
      :If in>out
          r←'#diff'Replace'Going back in time?'
      :Else
          r←'#diff'Replace'The difference in days is: ',⍕out-in
      :EndIf
    ∇

    MONTHS←↓12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec'

    FI←{(b v)←⎕vfi ⍵ ⋄ b/v}

    ∇ dt←stringToDate str;pos;mon;t;ymd
     ⍝ str is of the genre "Wed Aug 05 2015 07:30:21 GMT-0400 (Eastern Daylight Time)"
     ⍝ We need to weed out the day of the week and the time
      str←(+/∧\' '=str)↓str           ⍝ remove the leading spaces
      :If 0∊⍴t←MONTHS ⎕S 0 3⊢str      ⍝ look for the month as a string. If not found
          ymd←3↑FI str                ⍝ grab the 1st 3 numbers found
          ymd←ymd[⍒(2×31<ymd)+ymd<12] ⍝ put in correct order
      :Else                           ⍝ otherwise (if found)
          (pos mon)←0 1+1⊃t
          :If ~0∊⍴t←FI pos↑str        ⍝ any number before the month? (e.g. 2 May 2021)
              ymd←⌽⍣(31<⍬⍴t)⊢(1↑FI pos↓str),mon,t
          :Else
              ymd←¯1⌽mon,2↑FI pos↓str
          :EndIf
      :EndIf
     ⍝ Now grab the time
      dt←ymd,FI⍕'(\d+):(\d+):(\d+)'⎕S'\1 \2 \3'⊢str
    ∇

:EndClass

:Class ejDateTimePickerAdvanced : MiPageSample
⍝ Control:: _SF.ejDateTimePicker
⍝ Description::  advance functionality.
⍝ Show 2 calendars to select reservation dates.
⍝ Display the time difference as result.

    ∇ Compose;today;fromidn;tbl;tr;td;head;todate;from;now;to
      :Access Public
      today←3↑now←⎕TS
      fromidn←dateToIDN today

      Add _.h2'R.U. Inn'_.br'Motel reservation system'

    ⍝ The in date
      from←'in'New _SF.ejDateTimePicker now'yyyy/MM/dd HH:mm'
    ⍝ The callback should return the date (value) of the argument for the IN date/time
    ⍝ and the model's value for the OUT date/time
      from.On'change' 'setNewDate',⊂('in' 'argument' 'value')('out' 'eval' '$("#out").ejDateTimePicker("model.value")')

    ⍝ The out date
      todate←IDNToDate fromidn+7
      to←'out'New _SF.ejDateTimePicker todate'yyyy/MM/dd HH:mm'
      to.On'change' 'setNewDate',⊂('out' 'argument' 'value')('in' 'eval' '$("#in").ejDateTimePicker("model.value")')

      Add #._.InputGrid('Check In' 'Check Out',⍪from to)

      'diff'Add _.div
    ∇

    newDate←{'⍎new Date("',(⍕⍵),'")'}
    dateToIDN←{d←2 ⎕NQ'.' 'datetoidn'⍵ ⋄ d+(60⊥3↓6↑⍵)÷86400}
    IDNToDate←{d←3↑2 ⎕NQ'.' 'idntodate'⍵ ⋄ d,0 60 60⊤⌊86400×1|⍵}

    ∇ r←setNewDate;in;out
      :Access public

    ⍝ Find the difference between the dates
      in←dateToIDN stringToDate Get'in'
      out←dateToIDN stringToDate Get'out'
      :If in>out
          r←'#diff'Replace'Going back in time?'
      :Else
          r←'#diff'Replace'The difference in days is: ',⍕out-in
      :EndIf
    ∇

    MONTHS←↓12 3⍴'JanFebMarAprMayJunJulAugSepOctNovDec'

    FI←{(b v)←⎕vfi ⍵ ⋄ b/v}

    ∇ dt←stringToDate str;pos;mon;t;ymd
     ⍝ str is of the genre "Wed Aug 05 2015 07:30:21 GMT-0400 (Eastern Daylight Time)"
     ⍝ We need to weed out the day of the week and the time
      str←(+/∧\' '=str)↓str           ⍝ remove the leading spaces
     ⍝ What kind of string is this?
      :If ~∧/1⊃(dt dt)←{b←~⍵∊'/-:' ⋄ ⎕VFI b\b/⍵}str  ⍝ yyyy/mm/dd hh:mm:ss ?
          :If 0∊⍴t←MONTHS ⎕S 0 3⊢str      ⍝ look for the month as a string. If not found
              ymd←3↑FI str                ⍝ grab the 1st 3 numbers found
              ymd←ymd[⍒(2×31<ymd)+ymd<12] ⍝ put in correct order
          :Else                           ⍝ otherwise (if found)
              (pos mon)←0 1+1⊃t
              :If ~0∊⍴t←FI pos↑str        ⍝ any number before the month? (e.g. 2 May 2021)
                  ymd←⌽⍣(31<⍬⍴t)⊢(1↑FI pos↓str),mon,t
              :Else
                  ymd←¯1⌽mon,2↑FI pos↓str
              :EndIf
          :EndIf
     ⍝ Now grab the time
          dt←ymd,FI⍕'(\d+):(\d+):(\d+)'⎕S'\1 \2 \3'⊢str
      :EndIf
    ∇

:EndClass

format fixed

format fixed


:class ii :MiPageSample
⍝ Description:: Search the FinnAPL and Dyalog idiom lists

    ∇ Compose;fm;bn
      :Access public

      :If 0=⎕NC'idioms'
          idioms←⎕SE.SALT.Load'[ws]\MS3\Examples\Data\idioms -noname -nolink'
      :EndIf

      Add _.h1'Search Idiom Database'
      Add _.br
      ef←Add _.EditField'str'
      ef.On'keyup' ''('str' 'val')
      Add'      Press '
      Add _.Button'Enter'
      Add'to search'
      Add _.br
      (Add _.div).id←'res'  ⍝ This is a container that will be filled with result
    ∇

    ∇ r←APLJax;found;finn;dyal
      :Access public
      found←idioms⌿⍨∨/∨/¨idioms[;2 3 4]⍷¨⍨⊂Get'str'
      found←found\⍨7⍴1 0
      found[;2×⍳3]←⊂6/⎕UCS 160
      finn←found[;2+⍳5]⌿⍨~found[;1]
      dyal←found[;3 4 7]⌿⍨found[;1]
      :If ×≢found
          r←'#res'Replace''
          :If ×≢finn
              r,←'#res'Append _.h3'One-liners from the reknown FinnAPL Idiom Library'
              r,←'#res'Append _.Table finn
          :EndIf
          :If ×≢dyal
              r,←'#res'Append _.h3'Recognised and evaluated internally for performance'
              r,←'#res'Append _.Table dyal
          :EndIf
      :Else
          r←'#res'Replace _.h3'No matching idioms found'
      :EndIf
    ∇

:endclass

:class ii :MiPageSample
⍝ Description:: Search the FinnAPL and Dyalog idiom lists

    ∇ Compose;fm;bn
      :Access public

      :If 0=⎕NC'idioms'
          idioms←⎕SE.SALT.Load'[ws]\MS3\Examples\Data\idioms -noname -nolink'
      :EndIf

      Add _.h1'Search Idiom Database'
      Add _.br
      ef←Add _.EditField'str'
      ef.On'keyup' ''('str' 'val')
      Add'      Press '
      Add _.Button'Enter'
      Add'to search'
      Add _.br
      (Add _.div).id←'res'  ⍝ This is a container that will be filled with result
    ∇

    ∇ r←APLJax;found;finn;dyal;rows
      :Access public
      found←idioms⌿⍨∨/∨/¨idioms[;2 3 4]⍷¨⍨⊂Get'str'
      found←found\⍨7⍴1 0
      found[;2×⍳3]←⊂6/⎕UCS 160
      finn←found[;2+⍳5]⌿⍨~found[;1]
      dyal←found[;3 4 7]⌿⍨found[;1]

    ⍝ Speedup: If more than 25 rows, then hide after 20
      :If 25<rows←≢finn
          finn↑⍨←20 5
          finn⍪←('[',(⍕rows-20),' more results...]')'' '' '' ''
      :EndIf
      :If 25<rows←≢dyal
          dyal↑⍨←20 3
          dyal⍪←('[',(⍕rows-20),' more results...]')'' ''
      :EndIf

      :If ×≢found
          r←'#res'Replace''
          :If ×≢finn
              r,←'#res'Append _.h3'One-liners from the reknown FinnAPL Idiom Library'
              r,←'#res'Append _.Table finn
          :EndIf
          :If ×≢dyal
              r,←'#res'Append _.h3'Recognised and evaluated internally for performance'
              r,←'#res'Append _.Table dyal
          :EndIf
      :Else
          r←'#res'Replace _.h3'No matching idioms found'
      :EndIf
    ∇

:endclass

Truncate long results for speedup.

ii: Truncate long results for speedup.


:Class MiPage : #.HtmlPage

    ⍝∇:require =\HtmlPage.dyalog
    ⍝∇:require =\JSON.dyalog

    :Field Public _PageName←'' ⍝ Page file name
    :Field Public _PageDate←'' ⍝ Page saved date
    :field Public _Request     ⍝ HTTPRequest
    :field Public _Scripts←''
    :field Public _Styles←''
    :field Public _CssReset←''    ⍝ location of CSS Reset file (if any)
    :field Public _CssOverride←'' ⍝ location of CSS Override file (if any)
    :field public _Serialized←1   ⍝ serialized forms to return in _PageData
    :field Public _event          ⍝ set by APLJAX callback - event that was triggered
    :field Public _what           ⍝ set by APLJAX callback - name or id of the triggering element
    :field Public _value          ⍝ set by APLJAX callback - value of the triggering element
    :field Public _selector       ⍝ set by APLJAX callback - CSS/jQuery selector for the element that triggered the event
    :field Public _callback       ⍝ set by APLJAX callback - name of the callback function
    :field public _PageData
    :field public _AjaxResponse←''
    :field public _DebugCallbacks←0
    :field public OnLoad←''     ⍝ page equivalent to ⎕LX

    _used←'' ⍝ keep track of what's been used

    ∇ Make
      :Access public
      :Implements constructor :Base
      MakeCommon
    ∇

    ∇ Make1 req
      :Access public
      _Request←req
      :Implements constructor :base
      MakeCommon
    ∇

    ∇ MakeCommon
      _PageData←⎕NS''
    ∇

    ∇ {r}←Render;b;styles
      :Access public
      ∘∘∘
      :If ''≢OnLoad
          Use'JQuery'
      :EndIf
      b←RenderBody
      styles←_Styles
      styles←styles,⍨{0∊⍴⍵:⍵ ⋄ ⊂⍵}_CssReset
      styles←styles,{0∊⍴⍵:⍵ ⋄ ⊂⍵}_CssOverride
      :If ~0∊⍴styles
          {(Head.Add _html.link).Set(('href=',⍵)('rel' 'stylesheet')('type' 'text/css'))}¨∪styles
      :EndIf
      :If ~0∊⍴_Scripts
          {(Head.Add _html.script).Set('src=',⍵)}¨∪_Scripts
      :EndIf
      :If ~0∊⍴Handlers
          b,←∊Handlers.Render
      :EndIf
      :If ''≢OnLoad
          b,←(⎕NEW #._html.script('$(function(){',OnLoad,'});')).Render
      :EndIf
      r←RenderPage b
      :If 0≠⎕NC⊂'_Request.Response'
          _Request.Response.HTML←r
      :EndIf
    ∇

    ∇ {r}←Wrap
      :Access public
      r←Render
    ∇

    ∇ Use resources;n;ind;t;x
      :Access public
      resources←eis resources
      :For x :In resources
          :If ~(⊂x)∊_used
              :Select ⊃x
              :Case '⍎' ⍝ script
                  _Scripts,←⊂1↓x
              :Case '⍕' ⍝ style sheet
                  _Styles,←⊂1↓x
              :Else
                  :If 0≠⎕NC⊂'_Request.Server.Config.Resources'
                  :AndIf ~0∊n←1↑⍴_Request.Server.Config.Resources
                      :If n≥ind←_Request.Server.Config.Resources[;1]⍳⊂x
                          :If ~0∊⍴t←{(~0∘∊∘⍴¨⍵)/⍵}(⊂ind 2)⊃_Request.Server.Config.Resources
                              _Scripts,←t
                          :EndIf
                          :If ~0∊⍴t←{(~0∘∊∘⍴¨⍵)/⍵}(⊂ind 3)⊃_Request.Server.Config.Resources
                              _Styles,←t
                          :EndIf
                      :Else
                          1 _Request.Server.Log _PageName,' references unknown resource: ',x
                      :EndIf
                  :EndIf
              :EndSelect
              _used,←⊂x
          :EndIf
      :EndFor
    ∇

    ∇ r←{proto}Get names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←eis names
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘Get¨names
      :ElseIf 2≠_PageData.⎕NC names
          r←,proto
      :Else
          r←_PageData⍎names
          :If 2=≡r
              :If 1=⍴,r
                  r←⊃r
              :EndIf
          :EndIf
          r←#.JSON.toAPL r
⍝          :If ~isChar proto
⍝              r←{0::⍵ ⋄ 0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
⍝          :EndIf
      :EndIf
    ∇

    ∇ r←{proto}GetRaw names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←eis names
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘Get¨names
      :ElseIf 2≠_PageData.⎕NC names
          r←,proto
      :Else
          r←_PageData⍎names
          :If 2=≡r
              :If 1=⍴,r
                  r←⊃r
              :EndIf
          :EndIf
          :If ~isChar proto
              r←{0::⍵ ⋄ 0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
          :EndIf
      :EndIf
    ∇

    ∇ r←{proto}SessionGet names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘SessionGet¨names
      :ElseIf 2≠_Request.Session.⎕NC names
          r←proto
      :Else
          r←_Request.Session⍎names
          :If 1<|≡r ⋄ r←∊r ⋄ :EndIf
          :If ~0 2∊⍨10|⎕DR proto
              r←{0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
          :EndIf
      :EndIf
    ∇

    ∇ Close session ⍝ Called when the session ends
      :Access Public Overridable
    ∇

    :section APLJax  ⍝ used for building APLJAX responses
    ∇ _resetAjax
      :Access public
      _AjaxResponse←''
    ∇

    ∇ r←_id
      :Access public
      ⍝ as there seems to be a problem with at least some Syncfusion widgets
      ⍝ being able to provide the id (or name) of the triggering element, we try to obtain it from _what or _selector
      r←''
      :Trap 0
          :If 0∊⍴r←_what
          :AndIf '#'=⊃_selector
              r←1↓_selector
          :EndIf
      :EndTrap
    ∇

    ∇ Respond arg
      :Access public
      ∘∘∘
    ∇

    ∇ r←renderContent content;c
      r←''
      content←eis content
      :While ~0∊⍴content
          :Select ≡c←⊃content
          :Case 0
              :If isClass c
                  :Select ⊃⍴content
                  :Case 1
                      r,←(⎕NEW c).Render
                  :Case 2
                      r,←(⎕NEW c(2⊃content)).Render
                  :Else
                      r,←(⎕NEW c(1↓content)).Render
                  :EndSelect
              :ElseIf isInstance c
                  r,←c.Render
              :Else
                  r,←(⎕NEW #.HtmlElement(''content)).Render
              :EndIf
              content←''
          :Case 1
              :If isClass⊃c
                  r,←(⎕NEW(⊃c)(1↓c)).Render
              :ElseIf isInstance⊃c
                  ∘∘∘ ⍝ should not happen! (I think)
              :Else
                  r,←(⎕NEW #.HtmlElement(''c)).Render
              :EndIf
              content←1↓content
          :Else
              r,←renderContent c
              content←1↓content
          :EndSelect
      :EndWhile
    ∇

    ∇ r←selector Replace content
      :Access public
      r←⊂('replace'selector)('data'(renderContent content))
    ∇
    ∇ r←selector Append content
      :Access public
      r←⊂('append'selector)('data'(renderContent content))
    ∇
    ∇ r←selector Prepend content
      :Access public
      r←⊂('prepend'selector)('data'(renderContent content))
    ∇
    ∇ r←Execute content
      :Access public
      r←⊂('execute'content)
    ∇

    ∇ r←name Assign data
      :Access public
      r←⊂('assign'name)('data'data)
    ∇

    :endsection

    :section Position
    ∇ ref Position args;inds;mask;parameters;my;at;of;collision;within;q
      :Access public shared
      ⍝ ref  - a reference to an instance of anything based on HtmlElement
      ⍝ args - position information per jQueryUI's Position widget http://api.jqueryui.com/position/
      ⍝        can be in any of the following forms
      ⍝      1) positional (my at of collision within)  N.B. we don't use the "using" parameter
      ⍝         example:  myDiv Position 'left top' 'right bottom' '#otherElement'
      ⍝                   positions myDiv's top left corner at the bottom right corner of the element with id "otherElement"
      ⍝      2) paired
      ⍝                   myDiv Position 'my' 'left top' 'at' 'right bottom' 'of' '#otherElement'
      ⍝                   myDiv Position ('my' 'left top') ('at' 'right bottom') ('of' '#otherElement')
      ⍝                   myDiv Position 3 2⍴'my' 'left top' 'at' 'right bottom' 'of' '#otherElement'
      ⍝ Note: positional arguments are in form horizontal (left center right) vertical (top center bottom)

      parameters←'my' 'at' 'of' 'collision' 'within'
      q←{1⌽'''''',{⍵/⍨1+''''=⍵}⍕⍵}
      :If isInstance ref
          :If 2=⍴⍴args ⍝ matrix
              args←,args
          :ElseIf 3=≡args
              args←⊃,/args
          :EndIf
          args←eis args
          inds←parameters⍳args
          :If ∨/mask←inds≤⍴parameters
              :If mask≡(2×+/mask)⍴1 0
                  parameters←mask/args
                  args←(1⌽mask)/args
              :EndIf
          :Else
              parameters←(⍴args)↑parameters
          :EndIf
          parameters(ref{⍺⍺⍎'Position.',⍺,'←',q ⍵})¨args
          ref.Uses,←⊂'JQueryUI'
          ref.Use
      :EndIf
    ∇
    :endsection

    :section Event Handling Support
    ∇ r←isPost
      :Access public
      r←{0::0 ⋄ _Request.isPost}⍬
    ∇

    ∇ r←isAPLJax
      :Access public
      r←{0::0 ⋄ _Request.isAPLJAX}⍬
    ∇

    ∇ r←sel Css args ⍝ JQuery css cover
      :Access public
      r←(sel #._JSS.JQuery'css')args
    ∇

    ∇ r←sel Val args ⍝ JQuery val cover
      :Access public
      r←(sel #._JSS.JQuery'val')args
    ∇

    ∇ r←sel Attr args ⍝ JQuery attr cover
      :Access public
      r←(sel #._JSS.JQuery'attr')args
    ∇

    ∇ r←sel RemoveAttr args ⍝ JQuery removeAttr cover
      :Access public
      r←(sel #._JSS.JQuery'removeAttr')args
    ∇

    ∇ r←sel Html args ⍝ JQuery html cover
      :Access public
      r←(sel #._JSS.JQuery'html')args
    ∇

    :endsection

    ∇ Debug;⎕TRAP
      :Access public
      ⎕TRAP←0⍴⎕TRAP
      ∘∘∘
    ∇

:EndClass

:Class MiPage : #.HtmlPage

    ⍝∇:require =\HtmlPage.dyalog
    ⍝∇:require =\JSON.dyalog

    :Field Public _PageName←'' ⍝ Page file name
    :Field Public _PageDate←'' ⍝ Page saved date
    :field Public _Request     ⍝ HTTPRequest
    :field Public _Scripts←''
    :field Public _Styles←''
    :field Public _CssReset←''    ⍝ location of CSS Reset file (if any)
    :field Public _CssOverride←'' ⍝ location of CSS Override file (if any)
    :field public _Serialized←1   ⍝ serialized forms to return in _PageData
    :field Public _event          ⍝ set by APLJAX callback - event that was triggered
    :field Public _what           ⍝ set by APLJAX callback - name or id of the triggering element
    :field Public _value          ⍝ set by APLJAX callback - value of the triggering element
    :field Public _selector       ⍝ set by APLJAX callback - CSS/jQuery selector for the element that triggered the event
    :field Public _callback       ⍝ set by APLJAX callback - name of the callback function
    :field public _PageData
    :field public _AjaxResponse←''
    :field public _DebugCallbacks←0
    :field public OnLoad←''     ⍝ page equivalent to ⎕LX

    _used←'' ⍝ keep track of what's been used

    ∇ Make
      :Access public
      :Implements constructor :Base
      MakeCommon
    ∇

    ∇ Make1 req
      :Access public
      _Request←req
      :Implements constructor :base
      MakeCommon
    ∇

    ∇ MakeCommon
      _PageData←⎕NS''
    ∇

    ∇ {r}←Render;b;styles
      :Access public
⍝      ∘∘∘
      :If ''≢OnLoad
          Use'JQuery'
      :EndIf
      b←RenderBody
      styles←_Styles
      styles←styles,⍨{0∊⍴⍵:⍵ ⋄ ⊂⍵}_CssReset
      styles←styles,{0∊⍴⍵:⍵ ⋄ ⊂⍵}_CssOverride
      :If ~0∊⍴styles
          {(Head.Add _html.link).Set(('href=',⍵)('rel' 'stylesheet')('type' 'text/css'))}¨∪styles
      :EndIf
      :If ~0∊⍴_Scripts
          {(Head.Add _html.script).Set('src=',⍵)}¨∪_Scripts
      :EndIf
      :If ~0∊⍴Handlers
          b,←∊Handlers.Render
      :EndIf
      :If ''≢OnLoad
          b,←(⎕NEW #._html.script('$(function(){',OnLoad,'});')).Render
      :EndIf
      r←RenderPage b
      :If 0≠⎕NC⊂'_Request.Response'
          _Request.Response.HTML←r
      :EndIf
    ∇

    ∇ {r}←Wrap
      :Access public
      r←Render
    ∇

    ∇ Use resources;n;ind;t;x
      :Access public
      resources←eis resources
      :For x :In resources
          :If ~(⊂x)∊_used
              :Select ⊃x
              :Case '⍎' ⍝ script
                  _Scripts,←⊂1↓x
              :Case '⍕' ⍝ style sheet
                  _Styles,←⊂1↓x
              :Else
                  :If 0≠⎕NC⊂'_Request.Server.Config.Resources'
                  :AndIf ~0∊n←1↑⍴_Request.Server.Config.Resources
                      :If n≥ind←_Request.Server.Config.Resources[;1]⍳⊂x
                          :If ~0∊⍴t←{(~0∘∊∘⍴¨⍵)/⍵}(⊂ind 2)⊃_Request.Server.Config.Resources
                              _Scripts,←t
                          :EndIf
                          :If ~0∊⍴t←{(~0∘∊∘⍴¨⍵)/⍵}(⊂ind 3)⊃_Request.Server.Config.Resources
                              _Styles,←t
                          :EndIf
                      :Else
                          1 _Request.Server.Log _PageName,' references unknown resource: ',x
                      :EndIf
                  :EndIf
              :EndSelect
              _used,←⊂x
          :EndIf
      :EndFor
    ∇

    ∇ r←{proto}Get names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←eis names
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘Get¨names
      :ElseIf 2≠_PageData.⎕NC names
          r←,proto
      :Else
          r←_PageData⍎names
          :If 2=≡r
              :If 1=⍴,r
                  r←⊃r
              :EndIf
          :EndIf
          r←#.JSON.toAPL r
⍝          :If ~isChar proto
⍝              r←{0::⍵ ⋄ 0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
⍝          :EndIf
      :EndIf
    ∇

    ∇ r←{proto}GetRaw names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←eis names
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘Get¨names
      :ElseIf 2≠_PageData.⎕NC names
          r←,proto
      :Else
          r←_PageData⍎names
          :If 2=≡r
              :If 1=⍴,r
                  r←⊃r
              :EndIf
          :EndIf
          :If ~isChar proto
              r←{0::⍵ ⋄ 0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
          :EndIf
      :EndIf
    ∇

    ∇ r←{proto}SessionGet names
      :Access public
      proto←{6::⍵ ⋄ proto}''
      names←,⍕names
      names←#.Strings.deb names
      :If ' '∊names
          names←{⎕ML←3 ⋄ ⍵⊂⍨⍵≠' '}names
          r←proto∘SessionGet¨names
      :ElseIf 2≠_Request.Session.⎕NC names
          r←proto
      :Else
          r←_Request.Session⍎names
          :If 1<|≡r ⋄ r←∊r ⋄ :EndIf
          :If ~0 2∊⍨10|⎕DR proto
              r←{0∊⍴⍵:⍬ ⋄ w←⍵ ⋄ ((w='-')/w)←'¯' ⋄ ⊃(//)⎕VFI w}r
          :EndIf
      :EndIf
    ∇

    ∇ Close session ⍝ Called when the session ends
      :Access Public Overridable
    ∇

    :section APLJax  ⍝ used for building APLJAX responses
    ∇ _resetAjax
      :Access public
      _AjaxResponse←''
    ∇

    ∇ r←_id
      :Access public
      ⍝ as there seems to be a problem with at least some Syncfusion widgets
      ⍝ being able to provide the id (or name) of the triggering element, we try to obtain it from _what or _selector
      r←''
      :Trap 0
          :If 0∊⍴r←_what
          :AndIf '#'=⊃_selector
              r←1↓_selector
          :EndIf
      :EndTrap
    ∇

    ∇ Respond arg
      :Access public
      ∘∘∘
    ∇

    ∇ r←renderContent content;c
      r←''
      content←eis content
      :While ~0∊⍴content
          :Select ≡c←⊃content
          :Case 0
              :If isClass c
                  :Select ⊃⍴content
                  :Case 1
                      r,←(⎕NEW c).Render
                  :Case 2
                      r,←(⎕NEW c(2⊃content)).Render
                  :Else
                      r,←(⎕NEW c(1↓content)).Render
                  :EndSelect
              :ElseIf isInstance c
                  r,←c.Render
              :Else
                  r,←(⎕NEW #.HtmlElement(''content)).Render
              :EndIf
              content←''
          :Case 1
              :If isClass⊃c
                  r,←(⎕NEW(⊃c)(1↓c)).Render
              :ElseIf isInstance⊃c
                  ∘∘∘ ⍝ should not happen! (I think)
              :Else
                  r,←(⎕NEW #.HtmlElement(''c)).Render
              :EndIf
              content←1↓content
          :Else
              r,←renderContent c
              content←1↓content
          :EndSelect
      :EndWhile
    ∇

    ∇ r←selector Replace content
      :Access public
      r←⊂('replace'selector)('data'(renderContent content))
    ∇
    ∇ r←selector Append content
      :Access public
      r←⊂('append'selector)('data'(renderContent content))
    ∇
    ∇ r←selector Prepend content
      :Access public
      r←⊂('prepend'selector)('data'(renderContent content))
    ∇
    ∇ r←Execute content
      :Access public
      r←⊂('execute'content)
    ∇

    ∇ r←name Assign data
      :Access public
      r←⊂('assign'name)('data'data)
    ∇

    :endsection

    :section Position
    ∇ ref Position args;inds;mask;parameters;my;at;of;collision;within;q
      :Access public shared
      ⍝ ref  - a reference to an instance of anything based on HtmlElement
      ⍝ args - position information per jQueryUI's Position widget http://api.jqueryui.com/position/
      ⍝        can be in any of the following forms
      ⍝      1) positional (my at of collision within)  N.B. we don't use the "using" parameter
      ⍝         example:  myDiv Position 'left top' 'right bottom' '#otherElement'
      ⍝                   positions myDiv's top left corner at the bottom right corner of the element with id "otherElement"
      ⍝      2) paired
      ⍝                   myDiv Position 'my' 'left top' 'at' 'right bottom' 'of' '#otherElement'
      ⍝                   myDiv Position ('my' 'left top') ('at' 'right bottom') ('of' '#otherElement')
      ⍝                   myDiv Position 3 2⍴'my' 'left top' 'at' 'right bottom' 'of' '#otherElement'
      ⍝ Note: positional arguments are in form horizontal (left center right) vertical (top center bottom)

      parameters←'my' 'at' 'of' 'collision' 'within'
      q←{1⌽'''''',{⍵/⍨1+''''=⍵}⍕⍵}
      :If isInstance ref
          :If 2=⍴⍴args ⍝ matrix
              args←,args
          :ElseIf 3=≡args
              args←⊃,/args
          :EndIf
          args←eis args
          inds←parameters⍳args
          :If ∨/mask←inds≤⍴parameters
              :If mask≡(2×+/mask)⍴1 0
                  parameters←mask/args
                  args←(1⌽mask)/args
              :EndIf
          :Else
              parameters←(⍴args)↑parameters
          :EndIf
          parameters(ref{⍺⍺⍎'Position.',⍺,'←',q ⍵})¨args
          ref.Uses,←⊂'JQueryUI'
          ref.Use
      :EndIf
    ∇
    :endsection

    :section Event Handling Support
    ∇ r←isPost
      :Access public
      r←{0::0 ⋄ _Request.isPost}⍬
    ∇

    ∇ r←isAPLJax
      :Access public
      r←{0::0 ⋄ _Request.isAPLJAX}⍬
    ∇

    ∇ r←sel Css args ⍝ JQuery css cover
      :Access public
      r←(sel #._JSS.JQuery'css')args
    ∇

    ∇ r←sel Val args ⍝ JQuery val cover
      :Access public
      r←(sel #._JSS.JQuery'val')args
    ∇

    ∇ r←sel Attr args ⍝ JQuery attr cover
      :Access public
      r←(sel #._JSS.JQuery'attr')args
    ∇

    ∇ r←sel RemoveAttr args ⍝ JQuery removeAttr cover
      :Access public
      r←(sel #._JSS.JQuery'removeAttr')args
    ∇

    ∇ r←sel Html args ⍝ JQuery html cover
      :Access public
      r←(sel #._JSS.JQuery'html')args
    ∇

    :endsection

    ∇ Debug;⎕TRAP
      :Access public
      ⎕TRAP←0⍴⎕TRAP
      ∘∘∘
    ∇

:EndClass

remove MiPage stop

remove MiPage stop


∇ output←regexes(op Run args)input;from;to;options;lines;Expand;repeat;s;r;last;fns;q;hasrepeat;postproc;combine;Quote;Nest;a;n
 output←⍬⊤⍬ ⍝ default result is empty matrix

 n←⎕UCS 10 ⍝ newline
 a←⎕UCS 39 ⍝ apostrofe
 ⍎'Nest←{⊂⍣(1=≡,⍵)⊢⍵}'
 ⍎'Quote←{a,a,⍨⍵/⍨1+⍵=a}'

 :Trap 11 22 ⍝ accept filename or actual input
     input←input ⎕NTIE 0
 :EndTrap

 :Trap 11 22 ⍝ accept filename or actual regex
     regexes←⊃⎕NGET regexes 1
 :EndTrap
 ⍎'regexes←{,¨⍣(¯2=≡⍵)⊢⍵}Nest regexes'

 repeat←⍎{×≢⍵:⍵ ⋄ '1'}args∩'≡',⎕D ⍝ extract repetition, if any, else 1
 hasrepeat←∨/args∊⍨'≡',⎕D
 ⍝ select options:
 options←('ResultText' 'Simple')('Greedy' 0)('IC' 1)('Mode' 'D')('Mode' 'M')('DotAll' 1)('UCP' 1)('OM' 1)/⍨1,'gidmauo'∊819⌶args~' -'
 s r←(∨/∊∘op)¨'Ss' 'Rr'
 :If s∨r
     options↓⍨←s ⍝ ResultText is not for ⎕S

     fns←+/∧\'⍵'∊¨regexes
     postproc←∊'⊢','∘{'∘,¨,∘'}'¨fns↑regexes ⍝ post-processing functions
     regexes↓⍨←fns

     last←⊃regexes↓⍨¯1+≢regexes
     :If '⍵'∊last ⍝ transformation function → many-to-function
     :OrIf 2|≢regexes ⍝ odd number of strings → many-to-one
         from←¯1↓regexes ⍝ remove transformation pattern/function
         :If ~'⍵'∊last ⍝ no ⍵ → pattern
             Expand←'⍵B' '⍵b' '⍵P' '⍵p' '⍵M' '⍵O' '⍵L' '⍵N'⎕R'⍵.Block' '⍵.BlockNum' '⍵.Pattern' '⍵.PatternNum' '⍵.Match' '⍵.Offsets' '⍵.Lengths' '⍵.Names'
         :OrIf ~≡⎕FX,⊂'to←{',(r/',⍕{'),(Expand last),(r/'}⍵'),'}' ⍝ if definition fails, revert to pattern (allows ⍵ in pattern)
             to←last
         :EndIf
     :Else
         lines←2÷⍨≢regexes
         from←regexes↓⍨-lines
         to←lines↓regexes
     :EndIf

     combine←'{⊃,/⍵↑¨⍨⌈/≢¨⍵}'
     q←⎕NS ⍬
     q.from←⍕Quote¨Nest from
     :If 0=≢q.from
         q.from←a a
     :EndIf
     :If 1∧.=≢¨from
         q.(from←'(,¨',from,')')
     :EndIf
     :If 3=⎕NC'to'
         q.to←1⌽'  ',3↓∊⎕NR'to'
     :Else
         q.to←⍕Quote¨Nest to
         :If 0=≢q.to
             q.to←a a
         :EndIf
         :If 1∧.=≢¨to
             q.(to←'(,¨',to,')')
         :EndIf
     :EndIf
     :If 3=⎕NC'repeat'
         q.repeat←'⍣',∊⎕NR'repeat'
     :ElseIf 1≢repeat
         q.repeat←'⍣',⍕repeat
     :Else
         q.repeat←''
     :EndIf
     :If ×≢options
         q.options←'⍠',∊{' (',(Quote⊃⍵),' ',({0 1∊⍨⊂⍵:⍕⍵ ⋄ Quote ⍵}⊃⌽⍵),')'}¨options
     :Else
         q.options←''
     :EndIf
     q.op←s r/'SR'
     q.postproc←2↓postproc
     q.postproc,←(hasrepeat∧s)/(''≡q.postproc)↓'∘',combine
     q.(expr←postproc,from,'⎕',op,to,options,repeat)
     :If '?'∊args
         ⍞←q.expr,n
     :EndIf

     :If 0=≢from
         from←''
     :EndIf
     :If 2=⎕NC'to'
     :AndIf 0=≢to
         to←''
     :EndIf

     :Trap 11
         :If r
             output←from ⎕R to⍠options⍣repeat⊢input
         :ElseIf s
             output←from ⎕S to⍠options⍣repeat⊢input
             output←(⍎combine)⍣hasrepeat⊢output ⍝ merge search results if we need to continue
         :EndIf
         output←(⍎postproc)output
     :Case 11 ⍝ faulty regex
         ⍞←'*** ',⎕DMX.(Message,(''≡Message)/⊃DM),' ***',n
         ⍞←'Attempted APL expression: ',q.expr,n
     :EndTrap
 :Else
     ⍞←'*** Left operand must be ''R'' or ''S'' ***'
 :EndIf
∇

Prepend and append ∇ for stricter ⎕FIX

Prepend and append ∇ for stricter ⎕FIX


:Namespace SQL
  (⎕IO ⎕ML)←1

  ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
    ms←#.Boot.ms
    find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
    r←601 'No datasources defined'
    :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
      :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
        r←601 ''('Datasource "',database,'" not found')
        :Return
      :Else ⍝ found it
        ds←ind⊃ms.Datasources
        r←601 'SQAPL not available'
        :If 0=⊃#.SQA.Init''
          (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
          conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
          :If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
          :Else ⋄ r←601('Unable to connect to "',database,'"')
          :EndIf
        :EndIf
      :EndIf
    :EndIf
  ∇

  ∇ r←Do ctl;c;m;z;ns;conx;data
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars}

    r←⎕NS''
    →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
    →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
    →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
    :If 1<|≡3⊃ctl ⋄ data←3⊃ctl ⋄ :Else ⋄ data←2↓ctl ⋄ :EndIf
    →(0<1⊃z←#.SQA.Exec(⊂c),data)⍴l2
    →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
    →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
    r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
   l1:→(0<1⊃z←1 #.SQA.Fetch c)⍴l2
    r.ReturnCode←1⊃z
    r.Data←⊃2⊃z
   l2:→(0<1⊃z←#.SQA.Close conx)↓0
   l3:r.ReturnCode←1⊃z
  ∇

  ∇ r←CloseAll
    →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
    r←#.SQA.Close¨1⊃¨r
  ∇

:EndNamespace

:Namespace SQL
  (⎕IO ⎕ML)←1

  ∇ r←ConnectTo database;ind;ds;dsn;opts;rc;conx;pwd;user;ms;find
    ms←#.Boot.ms
    find←{(⍴⍺){⍵×⍺≥⍵}⍺⍳⊂⍵}
    r←601 'No datasources defined'
    :If 0<⍴{6::'' ⋄ ⍵.Datasources}ms ⍝ do we have Datasources defined?
      :If 0=ind←ms.Datasources.Name find database ⍝ try to find it
        r←601 ''('Datasource "',database,'" not found')
        :Return
      :Else ⍝ found it
        ds←ind⊃ms.Datasources
        r←601 'SQAPL not available'
        :If 0=⊃#.SQA.Init''
          (dsn opts user pwd)←{6::'' ⋄ ⍎⍵}¨'ds.'∘,¨'DSN' 'DriverOptions' 'User' 'Password'
          conx←{⊃('C'∘,¨⍕¨⍳1+⍴⍵)~⍵}⊃¨2 2⊃#.SQA.Tree'.'
          :If 0=1⊃rc←#.SQA.Connect conx dsn pwd user('DriverOptions'(opts)) ⋄ r←0 conx
          :Else ⋄ r←601('Unable to connect to "',database,'"')
          :EndIf
        :EndIf
      :EndIf
    :EndIf
  ∇

  ∇ r←Do ctl;c;m;z;ns;conx;data
  ⍝ Prepare, Execute, Fetch a statement.
  ⍝       ctl: database sqlstmt {bindvars} {nulls}
    r←⎕NS''
    r.(ReturnCode Data Message)←¯1(0 0⍴0)''
    →(0<1⊃z←ConnectTo(1⊃ctl))⍴l3 ⋄ conx←2⊃z
    →(0<1⊃z←#.SQA.CursorName conx)⍴l3 ⋄ c←2⊃z
    →(0<1⊃z←#.SQA.Prepare c(2⊃ctl))⍴l3
    :If 1<|≡3⊃ctl ⋄ data←3⊃ctl
      :If 3<⍴ctl ⋄ data←(⊂data),ctl[4] ⋄ :EndIf  ⍝ deal with nulls
    :Else ⋄ data←2↓ctl ⋄ :EndIf
    →(0<1⊃z←#.SQA.Exec(⊂c),data)⍴l2
    →(0<1⊃z←0 #.SQA.Describe c)⍴l2 ⋄ r.Columns←{(0=(⊂1 3)⊃¨⍵)/(⊂1 1)⊃¨⍵}2 2⊃z
    →(0<2 1 5⊃z)⍴l1        ⍝ Fetch if there are Bind Vars
    r.(ReturnCode Data)←0(0 0⍴0) ⋄ →l2
   l1:
    →(0<1⊃z←1 #.SQA.Fetch c)⍴l2
    r.Data←⊃2⊃z
   l2:
    :If 0<r.ReturnCode←1⊃z ⋄ r.Message←3⊃z ⋄ :EndIf
    →(0<1⊃z←#.SQA.Close conx)↓0
   l3:
    r.ReturnCode←1⊃z
    r.Message←3⊃z
  ∇

  ∇ r←CloseAll
    →(0∊⍴r←2 2⊃#.SQA.Tree'.')⍴0
    r←#.SQA.Close¨1⊃¨r
  ∇

:EndNamespace

Update SQL.dyalog to handle null values and return better diagnostics


#!/usr/bin/env apl

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

#!/usr/bin/env apl

queens←{                            ⍝ 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

Fix issue #30: remove misleading line of code.