HandleMSP fix

HandleMSP fix

:Class MiServer

    :Field Public Config

    :Field Public TID←¯1                ⍝ Thread ID Server is running under
    :Field Public BlockSize←640000      ⍝ Blocksize when returning files

    :Field Public SessionHandler←⎕NS ''
    :Field Public Authentication←⎕NS ''
    :Field Public Logger←⎕NS ''
    :Field Public Application←⎕NS ''

    :field Public Encoders←⍬  ⍝ pointers to instances of content encoders
    :field Public Datasources←⍬

    ⎕TRAP←0/⎕TRAP ⋄ (⎕ML ⎕IO)←1 1

    unicode←80=⎕DR 'A'
    NL←(CR LF)←⎕UCS 13 10
    FindFirst←{(⍺⍷⍵)⍳1}
    enlist←{⎕ML←1 ⋄ ∊⍵}
    fromutf8←{0::(⎕AV,'?')[⎕AVU⍳⍵] ⋄ 'UTF-8' ⎕UCS ⍵} ⍝ Turn raw UTF-8 input into text
    toutf8←{'UTF-8' ⎕UCS ⍵}                          ⍝ Turn text into UTF-8 byte stream
    setting←{0=⎕NC ⍵:⍺ ⋄ ⍎⍵}
    endswith←{(,⍺){⍵≡⍺↑⍨-⍴⍵},⍵}
    I85←{}

      bit←{⎕IO←0  ⍝ used by Log
          0=⍺:0 ⍝ all bits turned off
          ¯1=⍺:1 ⍝ all bits turned on
          (⌈2⍟⍵)⊃⌽((1+⍵)⍴2)⊤⍺}

    :section Override
⍝ ↓↓↓--- Methods which are usually overridden ---

    ∇ onServerStart
      :Access Public Overridable
    ⍝ Handle any server startup processing
    ∇

    ∇ onSessionStart req
      :Access Public Overridable
    ⍝ Process a new session
    ∇

    ∇ onSessionEnd session
      :Access Public Overridable
    ⍝ Handle the end of a session
    ∇

    ∇ onIdle
      :Access Public Overridable
    ⍝ Idle time handler - called when the server has gone idle for a period of time
    ∇

    ∇ Error req
      :Access Public Overridable
    ⍝ Handle trapped errors
      req.Response.HTML←'',(⊃,/⎕DM,¨⊂'
'),''
      req.Fail 500 ⍝ Internal Server Error
      1 Log ⎕DM
    ∇

    ∇ level Log msg
      :Access Public overridable
    ⍝ Logs server messages
    ⍝ levels implemented in MildServer are:
    ⍝ 1-error/important, 2-warning, 4-informational, 8-transaction (GET/POST)
      :If Config.LogMessageLevel bit level ⍝ if set to display this level of message
          ⎕←msg ⍝ display it
      :EndIf
    ∇

    ∇ Cleanup
      :Access Public overridable
    ⍝ Perform any site specific cleanup
    ∇

⍝ ↑↑↑--- End of Overridable methods ---
    :endsection

⍝ ↓↓↓--- Begin MildServer Core Code
    :section Start/Stop
    ∇ Run
      :Access Public
      ('Already Running on Thread',⍕TID)⎕SIGNAL(TID∊⎕TNUMS)/11
      TID←RunServer&⍬
    ∇

    ∇ End;tempfiles
    ⍝ Called by destructor
      :Access Public
      Logger.Stop ⍬
      :If 0=⎕NC'ServerName'
         ⍝!!! {}1 #.DRC.Init''
      :Else
          'Not running'⎕SIGNAL(#.DRC.Exists ServerName)↓11
          {}#.DRC.Close ServerName
          :Trap 6 ⍝ ⎕TSYNC may not return a value if the thread doesn't, so handle the possible VALUE ERROR
              {}⎕TSYNC ⎕TID~⍨TID∩⎕TNUMS
          :EndTrap
      :EndIf
      :If ~0∊⍴Config.TempFolder
          tempfiles←{(~⍵[;4])/⍵[;1]}#.Files.List Config.TempFolder
          :If 0≠⍴tempfiles←(tempfiles∨.≠¨'.')/tempfiles
              {}{0::'' ⋄ #.Files.Delete Config.TempFolder,⍵}¨tempfiles
          :EndIf
      :EndIf
      Cleanup ⍝ overridable
      TID←¯1
    ∇
    :endsection

    ∇ r←RunServer arg;RESUME;⎕TRAP;Common;cmd;name;port;wres;ref;nspc;sink;Stop;secure;certpath;flags;z;rc;rate;ErrorCount;idletime;msg;uid;ts;CMTid
      ⍝ Simple HTTP (Web) Server framework
      ⍝ Assumes Conga available in #.DRC and uses #.HTTPRequest
      ⍝ arg: dummy
      ⍝ certs: RootCertDir, ServerCert, ServerKey (optional: runs Secure server)

      Common←⎕NS'' ⋄ Stop←0 ⋄ WAITING←0
      CMTid←ConnectionMonitor&ServerName

      :If Config.TrapErrors>0
          ⎕TRAP←#.DrA.TrapServer
          #.DrA.NoUser←1+#.DrA.MailRecipient∨.≠' '
      :EndIf ⍝ Trap MiServer Errors. See HandleMSP for Page Errors.

      onServerStart ⍝ meant to be overridden

      idletime←#.Dates.DateToIDN ⎕TS
      :While ~Stop
          wres←#.DRC.Wait ServerName 20000 ⍝ Tick every 20 secs
          ⍝ wres: (return code) (object name) (command) (data)

          :Select 1⊃wres
          :Case 0 ⍝ Good data from RPC.Wait
              :Select 3⊃wres

              :Case 'Error'
                  :If ServerName≡2⊃wres
                      Stop←1
                  :EndIf
                  (1+(4⊃wres)∊1008 1105 1119)Log'RunServer: DRC.Wait reported error ',(⍕#.DRC.Error 4⊃wres),' on ',2⊃wres

                  ⎕EX SpaceName 2⊃wres

              :CaseList 'Block' 'BlockLast'
                  nspc←SpaceName 2⊃wres
                  :If 0=⎕NC nspc
                      :Trap 6 ⍝ VALUE ERROR - nspc could be erased if page goes away
                          nspc ⎕NS''
                          (⍎nspc).(Pos Buffer ContentLength Req)←0 '' 0 ''
                          :If 0=1⊃z←#.DRC.GetProp(2⊃wres)'PeerAddr' ⋄ (⍎nspc).PeerAddr←2⊃z
                          :Else ⋄ (⍎nspc).PeerAddr←'Unknown'
                          :EndIf
                          :If Config.Secure
                              rc z←#.DRC.GetProp(2⊃wres)'PeerCert'
                              :If rc=0 ⋄ (⍎nspc).PeerCert←z
                              :Else
                                  1 Log'Unable to obtain peer certificate over secure connection - request ignored'
                                  ⎕EX nspc
                              :EndIf
                          :EndIf
                      :EndTrap
                  :EndIf

                  :If 0≠⎕NC nspc
                      {}(⍎nspc){⎕EX nspc/⍨('BlockLast'≡3⊃⍵)∧⍺ HandleRequest(2↑⍵)}&wres[2 4 3] ⍝ Run page handler in new thread
                  :EndIf
              :Case 'Connect' ⍝ Ignore

              :Else
                  2 Log'Error ',⍕wres
              :EndSelect

          :Case 100 ⍝ Time out - put "housekeeping" code here
              SessionHandler.HouseKeeping ⎕THIS
              :If 0<Config.IdleTimeOut ⍝ if an idle timeout (in seconds) has been specified
              :AndIf Config.IdleTimeOut<86400×-/(ts←#.Dates.DateToIDN ⎕TS)idletime ⍝ has it passed?
                  onIdle
                  idletime←ts
              :EndIf

          :Case 1010 ⍝ Object Not found
              1 Log'Object ''',ServerName,''' has been closed - Web Server shutting down'
              ⎕TKILL CMTid
              →0

          :Else
              1 Log'#.DRC.Wait failed:'
              1 Log wres
          :EndSelect

      :EndWhile

     RESUME: ⍝ Error Trapped and logged
      ⎕TKILL CMTid
      {}#.DRC.Close ServerName
      1 Log r←'Web server ''',ServerName,''' stopped '
      →0

    ∇

    :section Constructor/Destructor

    ∇ Make config;CongaVersion;rc
      :Access Public
      :Implements Constructor

      SessionHandler.GetSession←{}   ⍝ So we can always
      SessionHandler.HouseKeeping←{} ⍝    call these fns
      Authentication.Authenticate←{} ⍝    without worrying
      Logger.Log←{}
      Logger.Stop←{}
      Logger.Start←{}
      :If {0::1 ⋄ 85⌶'0'}'' ⍝ Need a left arg?
          I85←1∘(85⌶)
      :Else
          I85←85⌶
      :EndIf
      Config←config
      :If 0≠⊃rc←¯1 #.DRC.Init''
          ('Unable to initialize Conga. rc=',,⍕rc)⎕SIGNAL 11
      :EndIf

      CongaVersion←{0::0 ⋄ ⊃⊃//⎕VFI ⍵}{(2>+\'.'=⍵)/⍵}⊃{⍵/⍨{∧/⍵∊'0123456789.'}¨⍵}(⊂'')~⍨{1↓¨(⍵=⍬⍴⍵)⊂⍵}' ',2 2⊃#.DRC.Describe'.'
      :If 2.2>CongaVersion
          'MiServer 3.0 requires Conga 2.2 or later'⎕SIGNAL 11
      :EndIf

      'Unable to allocate TCP/IP port'⎕SIGNAL(0≠1⊃,AllocatePort)/11
    ∇

    ∇ UnMake
      :Implements Destructor
      :Trap 0 ⋄ End ⋄ :EndTrap
    ∇

    ∇ r←AllocatePort;ipv;server
    ⍝ Starts Conga, allocates TCP/IP port
      ipv←'Protocol'Config.IPVersion
      :If Config.Secure
          :If ∧/(~0∊⍴)¨Config.(CertFile KeyFile)
          :AndIf ⊃∧/#.Files.Exists¨Config.(CertFile KeyFile)
              {}#.DRC.SetProp'.' 'RootCertDir'Config.RootCertDir
              server←#.DRC.X509Cert.ReadCertFromFile Config.CertFile
              server.KeyOrigin←'DER'Config.KeyFile
              →(0≠1⊃r←#.DRC.Srv'' ''Config.Port'Raw' 10000('X509'server)('SSLValidation'Config.SSLFlags)ipv)⍴0 ⍝ Must have Conga v2.1
              1 Log'Starting secure server using certificate ',Config.CertFile
          :Else
              1 Log'Invalid certificate parameters'
              r←1
              →0
          :EndIf
      :Else
          →(0≠1⊃r←#.DRC.Srv'' ''Config.Port'Raw' 10000 ipv)⍴0
      :EndIf

      ServerName←2⊃r

      ⍝ If running Linux, we may want to switch users (only root can allocate a port less than 1024)

      :If ~isWin
      :AndIf 0<⍴uid←''setting'Config.UserID'
          msg←'4001⌶''',uid,''' '
          :Trap 0
              {}4001⌶uid
          :Else
              1 Log msg,'failed.'
              :Return
          :EndTrap
          4 Log msg,'succeeded.'
      :EndIf

      4 Log'Web server ''',ServerName,''' started on port ',⍕Config.Port
      4 Log'Root folder: ',Config.Root
    ∇

    :endsection

    :section RequestHandling

    ∇ names←pagedata PrepareJSONTargets names;p;m;i;nss;z
     ⍝ See if names contain JSON indexed names like editcell[Name]
     ⍝     and if so convert them to editcell.Name and make sure editcell exists
     ⍝ /// Hack by Morten awaiting cleanup or approval by Brian

      :If 0≠⍴i←(¯1=⎕NC names)/⍳⍴names ⍝ all invalid APL names
          names[i]←('%5B' '%5D'⎕R(,¨'[]'))¨names[i]
      :AndIf 0≠⍴i←i/⍨m←(p←names[i]⍳¨'[')≠∘⊃∘⍴¨names[i] ⍝ ... which contain '['
          nss←∪z←(m/p-1)↑¨names[i] ⍝ all namespaces mentions
          nss pagedata.⎕NS¨⊂⍬      ⍝ prepare empty nss
          names[i]←¯1↓¨names[i]    ⍝ drop trailing ']'
          names[i,¨p]←'.'          ⍝ replace '[' by '.'
      :EndIf
    ∇

    ∇ r←conns HandleRequest arg;buf;m;Answer;obj;CMD;pos;req;Data;z;r;hdr;REQ;status;file;tn;length;done;offset;res;closed;sess;chartype;raw;enc;which;html;encoderc;encodeMe;startsize;cacheMe;root;page;filename;eoh;n;i
      ⍝ Handle a Web Server Request
      r←0
      obj buf←arg
      conns.Buffer,←buf
      conns.Handler←{6::conns.Handler←(⎕UCS'<env>')≡5↑conns.Buffer ⋄ conns.Handler}⍬ ⍝ are we serving as a mapping handler?

      :If 0=conns.Pos ⍝ is we haven't found the end of the header yet...
          eoh←⎕UCS(1+conns.Handler)⊃(NL,NL)('</env>') ⍝ end of header marker
          pos←(¯1+⍴eoh)+eoh FindFirst conns.Buffer
          :If pos≤⍴conns.Buffer ⍝ found the end of header
              conns.Pos←pos
              conns.Req←fromutf8 conns.(Pos↑Buffer)
          :Else
              :Return ⍝ haven't found end of header yet, go back for more
          :EndIf
      :EndIf

      :If 0<⍴conns.Req
          :If conns.Pos>i←(z←LF,'content-length:')FindFirst hdr←#.Strings.lc conns.Req
          :AndIf (⍴conns.Buffer)<conns.Pos+conns.ContentLength←⊃2⊃⎕VFI(¯1+z⍳CR)↑z←(¯1+i+⍴z)↓hdr
              :Return  ⍝ a content-length was specified but we haven't yet gotten what it says to ==> go back for more
          :EndIf
      :EndIf

      conns.Buffer←fromutf8 conns.(Pos↓Buffer)

      :If conns.Handler  ⍝ if we're running as a mapping handler
          conns.(Req Buffer)←MakeHTTPRequest conns.Req ⍝ fake MiServer out by building an HTTP request from what we've got
      :EndIf

⍝      :Hold 'Request'

      REQ←⎕NEW #.HTTPRequest conns.(Req Buffer)
      REQ.Server←⎕THIS ⍝ Request will also contain reference to the Server

      :If 2=conns.⎕NC'PeerAddr' ⋄ REQ.PeerAddr←conns.PeerAddr ⋄ :EndIf       ⍝ Add Client Address Information
      8 Log REQ.(PeerAddr Command Page)

      :If 2=conns.⎕NC'PeerCert' ⋄ REQ.PeerCert←conns.PeerCert ⋄ :EndIf       ⍝ Add Client Cert Information

      :If Config.Rest  ⍝ if running RESTful web service...
          n←+/∧\2>+\REQ.Page∊'/\'
          REQ.RestReq←n↓REQ.Page
          REQ.Page←n↑REQ.Page
      :EndIf

      REQ.Page←Config.DefaultPage{∧/⍵∊'/\':'/',⍺ ⋄ '/\'∊⍨¯1↑⍵:⍵,⍺ ⋄ ⍵}REQ.Page
      REQ.Page,←(~'.'∊{⍵/⍨⌽~∨\'/'=⌽⍵}REQ.Page)/Config.DefaultExtension

      SessionHandler.GetSession REQ
      Authentication.Authenticate REQ

      :If REQ.Response.Status≠401 ⍝ Authentication did not fail

          filename←Config Virtual REQ.Page
          :If Config.AllowedHttpCommands∊⍨⊂REQ.Command

              :If REQ.Page endswith Config.DefaultExtension ⍝ MiPage?
                  filename HandleMSP REQ
              :Else
                  :If REQ.Command≡'get'
                      REQ.ReturnFile filename
                  :Else
                      REQ.Fail 501 ⍝ Service Not Implemented
                  :EndIf
              :EndIf
          :Else
              REQ.Fail 501 ⍝ Service Not Implemented
          :EndIf
      :EndIf

      res←REQ.Response

      encodeMe←conns.Handler<Config.UseContentEncoding ⍝ initialize a flag whether to encode this response, don't compresss if running as a handler
      cacheMe←0

      :If 1=res.File ⍝ See HTTPRequest.ReturnFile
          :If 83=⎕DR file←res.HTML ⍝ if we returned a byte stream, just use it
              length←⍴file ⋄ tn←0
          :Else
              :Trap 22
                  tn←file ⎕NTIE tn←0
                  length←⎕NSIZE tn
                  res.HTML←⎕NREAD tn 83 BlockSize 0
                  cacheMe←0≠Config.HttpCacheTime ⍝ for now, cache all files if set to use caching
                  :If encodeMe
                      encodeMe∧←length<BlockSize ⍝ if we can read entire file and are we encoding...
                      encodeMe>←(⊂¯4↑file)∊'.png' '.gif' '.jpg' ⍝ don't try to compress compressed graphics, should probably add zip files, etc
                  :EndIf
              :Else
                  REQ.Fail 404
                  length←⍴res.HTML
                  res.File←0
              :EndTrap
          :EndIf
          startsize←length
      :EndIf

      :If (200=res.Status)∧encodeMe ⍝ if our HTTP status is 200 (OK) and we're okay to encode
      :AndIf 1024<⍴res.HTML ⍝ BPB used to be 0
      :AndIf 0≠⍴enc←{(⊂'')~⍨1↓¨(⍵=⊃⍵)⊂⍵}' '~⍨',',REQ.GetHeader'accept-encoding' ⍝ check if client supports encoding
      :AndIf 0≠which←⊃Encoders.Encoding{(⍴⍺){(⍺≥⍵)/⍵}⍺⍳⍵}enc ⍝ try to match what encodings they accept to those we provide
          (encoderc html)←Encoders[which].Compress res.HTML
          :If 0=encoderc
              length←startsize←⍴res.HTML
              :If startsize>⍴html ⍝ did we save anything by compressing
                  length←⍴res.HTML←html ⍝ use it
                  res.Headers⍪←'Content-Encoding'(Encoders[which].Encoding)
                  4 Log'Used compression, transmitted% = ',2⍕length{⎕DIV←1 ⋄ ⍺÷⍵}startsize
              :Else
                  4 Log'Compression not used on "',REQ.Page,'", startsize = ',(⍕startsize),', compressed length = ',⍕length
                  :If 83≠⎕DR res.HTML
                      res.HTML←toutf8 res.HTML
                  :EndIf
              :EndIf
          :ElseIf 0=res.File
              2 Log'Compression failed'
              length←⍴res.HTML←toutf8 res.HTML ⍝ otherwise, send uncompressed
          :EndIf
      :ElseIf 0=res.File
          startsize←length←⍴res.HTML←toutf8∊res.HTML
      :EndIf

      :If (200=res.Status)∧cacheMe ⍝ if cacheable, set expires
      :AndIf 0<Config.HttpCacheTime
          res.Headers⍪←'Expires'(Config.HttpCacheTime #.Dates.HttpDate ⎕TS)
      :EndIf
      res.Headers⍪←{0∊⍴⍵:'' '' ⋄ 'Server'⍵}Config.Server
      status←res.((⍕Status),' ',StatusText)
      hdr←enlist{⍺,': ',⍵,NL}/res.Headers
      Answer←(toutf8((1+conns.Handler)⊃'HTTP/1.0 ' 'Status: '),status,NL,'Content-Length: ',(⍕length),NL,hdr,NL),res.HTML
      done←length≤offset←⍴res.HTML
      REQ.MSec-⍨←⎕AI[3]
      res.Bytes←startsize length
      :Repeat
          :If 0≠1⊃z←#.DRC.Send obj Answer done ⍝ Send response and
              (1+(1⊃z)∊1008 1119)Log'"Handlerequest" closed socket ',obj,' due to error: ',(⍕z),' sending response'
              done←1
          :EndIf
          closed←done
          :If ~done
              done←BlockSize>⍴Answer←⎕NREAD tn 83,BlockSize,offset
              offset+←⍴Answer
          :EndIf
      :Until closed ⍝ Everything sent

      :If res.File ⋄ ⎕NUNTIE tn ⋄ :EndIf
      8 Log REQ.PeerAddr status
      Logger.Log REQ
      r←1
 ⍝     :EndHold
    ∇

    ∇ file HandleMSP REQ;⎕TRAP;inst;class;z;props;lcp;args;i;ts;date;n;expired;data;m;oldinst;names;html;sessioned;page;root;fn;MS3;token;cb;mask;resp;t;RESTful;APLJax
    ⍝ Handle a "Mildserver Page" request
     RETRY:
      :If 0≡date←3⊃(,''#.Files.List file),0 0 0
          REQ.Fail 404 ⋄ →0
      :EndIf

      MS3←RESTful←0

      :If sessioned←326=⎕DR REQ.Session ⍝ do we think we have a session handler active?
      :AndIf 0≠⍴REQ.Session.Pages     ⍝ Look for existing Page in Session
      :AndIf (n←⍴REQ.Session.Pages)≥i←REQ.Session.Pages._PageName⍳⊂REQ.Page
          inst←i⊃REQ.Session.Pages ⍝ Get existing instance
          :If expired←inst._PageDate≢date  ⍝ Timestamp unchanged?
          :AndIf expired←(⎕SRC⊃⊃⎕CLASS inst)≢#.UnicodeFile.ReadNestedText file
              oldinst←inst
              REQ.Session.Pages~←inst
              4 Log'Page: ',REQ.Page,' ... has been updated ...'
          :EndIf
      :AndIf ~expired
          4 Log'Using existing instance of page: ',REQ.Page
          :If 9=⎕NC'#.HtmlPage'
              :If MS3←∨/(∊⎕CLASS inst)∊#.HtmlPage ⋄ inst._Request←REQ ⋄ :EndIf
          :EndIf
          :If 9=⎕NC'#.RESTful'
              :If RESTful←∨/(∊⎕CLASS inst)∊#.RESTful ⋄ inst._Request←REQ ⋄ :EndIf
          :EndIf
      :Else                        ⍝ First use of Page in this Session, or page expired
          :If 0≠⍴z←#.Files.GetText file
              :Trap 11 22
                  class←⎕SE.SALT.Load file,' -target=#.Pages'
                  inst←⎕NEW class
              :Case 11 ⋄ REQ.Fail 500 ⋄ →0 ⍝ Domain Error: HTTP Internal Error
              :Case 22 ⋄ REQ.Fail 404 ⋄ →0 ⍝ File Name Error: HTTP Page not found
              :EndTrap
              4 Log'Creating new instance of page: ',REQ.Page
              inst._PageName←REQ.Page
              inst._PageDate←date
              MS3←RESTful←0
              :If 9=⎕NC'#.HtmlPage'
                  :If MS3←∨/(∊⎕CLASS inst)∊#.HtmlPage
                  :OrIf RESTful←∨/(∊⎕CLASS inst)∊#.RESTful
                      inst.(_Request _PageRef)←REQ inst
                  :EndIf
              :EndIf
              :If sessioned ⋄ REQ.Session.Pages,←inst ⋄ :EndIf
          :Else
              REQ.Fail 404 ⋄ →0
          :EndIf
      :EndIf

      :If sessioned ⋄ token←REQ.(Page,⍕Session.ID)
      :ElseIf ~0∊⍴REQ.PeerAddr ⋄ token←REQ.(Page,PeerAddr)
      :Else ⋄ token←⍕⎕TID
      :EndIf

      :Hold token

     ⍝ Move arguments / parameters into Public Properties
          inst._PageData←⎕NS''
          :If 0≠1↑⍴data←{⍵[⍋↑⍵[;1];]}REQ.Arguments⍪REQ.Data
              m←1,2≢/data[;1]
              data←(m/data[;1]),[1.5]m⊂data[;2]
              i←{⍵/⍳⍴⍵}1=⊃∘⍴¨data[;2]
              data[i;2]←⊃¨data[i;2]
              :If 0≠⍴lcp←props←('_'≠1⊃¨props)/props←(inst.⎕NL-2) ⍝ Get list of public properties (those beginning with '_' are excluded)
              :AndIf 0≠1↑⍴args←(data[;1]∊lcp)⌿data
                  args←(2⌈⍴args)⍴args
                  i←lcp⍳args[;1]
                  ⍎'inst.(',(⍕props[i]),')←args[;2]'
              :EndIf
              :If ∨/mask←'_'≠1⊃¨data[;1]
                  args←mask⌿data
                  args[;1]←inst._PageData PrepareJSONTargets args[;1]
                  ⍎'inst._PageData.(',(⍕args[;1]),')←args[;2]'
              :EndIf
          :EndIf

          fn←cb←'Render'
          :If APLJax←REQ.isAPLJax>RESTful ⍝ if it's an APLJax (XmlHttpRequest) request (but not web service)
              REQ.Response.NoWrap←1
              fn←cb←'APLJax' ⍝ default callback function name
              :If MS3
                  inst._what←REQ.GetData'_what'
                  inst._event←REQ.GetData'_event'
                  inst._value←REQ.GetData'_value'
                  :If ~0∊⍴t←REQ.GetData'_callback' ⍝ does the request specify a callback function
                      fn←cb←t
                  :EndIf
              :EndIf
          :Else
              :If MS3
                  cb←cb inst.{3=⌊|⎕NC⊂⍵:⍵ ⋄ ⍺}fn←(1+RESTful)⊃'Compose' 'Respond' ⍝ default function to call
              :EndIf
          :EndIf

          :If 3≠⌊|inst.⎕NC⊂cb            ⍝ and is it a public method?
              1 Log'Method "',fn,'" not found (or not public) in page "',REQ.Page,'"'
              REQ.Fail 500
          :EndIf

          :If MS3
              :If (⊂cb)∊'Render' 'Compose'
                  inst._init ⍝ reset instance's content
              :ElseIf APLJax
                  inst._resetAjax
              :EndIf
          :EndIf

          :If (1=Config.TrapErrors)∧9=⎕NC'#.DrA' ⋄ ⎕TRAP←#.DrA.TrapServer
          :ElseIf (0=Config.Production) ⋄ ⎕TRAP←(800 'C' '→FAIL')(811 'E' '⎕SIGNAL 801')(813 'E' '⎕SIGNAL 803')(812 'S')(0 'E' '⍎#.Boot.Oops') ⍝ enable development debug framework
          :EndIf

          :Trap 85   ⍝ we use 85⌶ because "old" MiPages use REQ.Return internally (and don't return a result)...
              resp←I85'inst.',cb,(MS3⍱RESTful)/' REQ'  ⍝ ... whereas "new" MiPages return the HTML they generate
              resp←(#.JSON.toAPLJAX⍣APLJax)resp
              REQ.Return resp
          :Else
              :If APLJax
                  1 Log'No result returned by callback method "',cb,'" in page "',REQ.Page,'"'
                  REQ.Return''
              :EndIf
          :EndTrap

          :If ~REQ.Response.NoWrap
              :If MS3∨RESTful
                  inst.Wrap
              :Else
                  inst.Wrap REQ
              :EndIf
              :If Config.FormatHtml
                  :Trap 0
                      REQ.Response.HTML←('.'⎕R'&'⍠'NEOL' 1⍠'EOL' 'LF')((⎕XML⍠'Whitespace' 'Preserve')⍣2)REQ.Response.HTML
                  :Else
                      ⎕←'*** ⎕XML failed'
                  :EndTrap
              :EndIf
          :EndIf
      :EndHold
      →0

     FAIL:
      ⎕TRAP←0⍴⎕TRAP
      REQ.Fail 500 ⋄ →0

     RESUME: ⍝ RESUME is used by DrA
      ⎕TRAP←0/⎕TRAP ⍝ Let framework trapping take over

      :If #.DrA.UseHTTP ⋄ REQ.Fail 500 ⋄ →0 ⋄ :EndIf

      REQ.Title'Unhandled Execution Error'
      REQ.Style'Styles/error.css'
      html←'h1'#.HTMLInput.Enclose'Server Error in ''',REQ.Page,'''.
'
      html,←'
Unhandled Exception Error
'
      html,←'Description: An unhandled exception occurred during the execution of the current web request.'
      :If #.DrA.Mode=2 ⍝ Allows editing
          html,←'

Edit page: ',REQ.Page,'
'
      :EndIf
      html,←'

Exception Details:

'
      :If (#.DrA.Mode>0)∧0≠⍴#.DrA.LastFile ⋄ html,←#.DrA.(GenHTML LastFile)
      :Else ⋄ html,←'code'#.HTMLInput.Enclose'',(⊃,/#.DrA.LastError,¨⊂'
'),''
      :EndIf
      REQ.Return html
    ∇

    ∇ (req buffer)←MakeHTTPRequest req;x;v;s;p;l;m;n;i;c;h
⍝ kludge to get by ampersands in a POST - will be fixed when we build proper requests from MiServerCGI
      buffer←c←''
      :If (⍴req)≥i←1⍳⍨'>tsop<'⍷⌽req
          i←(⍴req)-i+5
          c←¯13↓(i+6)↓req
          req←(i↑req),'</env>'
      :EndIf

      :Trap 11
          x←⎕XML req
      :Else
          ∘∘∘
      :EndTrap
      v←'var'∘≡¨x[;2]
      v←{⎕ML←3 ⋄ (~<\'='=⍵)⊂⍵}¨v/x[;3]
      v←(∊2=⍴¨v)/v
      h←∊{0∊⍴⍵:'' ⋄ (#.Strings.lc{'HTTP_'≡5↑⍵:5↓⍵ ⋄ 'HTTPS_'≡6↑⍵:6↓⍵ ⋄ ⍵}⍺){('-',⍺)[('_',⍺)⍳⍺],': ',⍵,NL}⍵}/¨v
      ⍝ pull out special fields
      m p s n←(↑v)∘{3::2⊃⍵ ⋄ ⍺[;2]⊃⍨⍺[;1]⍳⊂1⊃⍵}¨↓'REQUEST_METHOD' 'PATH_INFO' 'SERVER_PROTOCOL' 'SERVER_NAME',[1.1]'GET' '' 'HTTP/1.0' 'localhost'
      (req buffer)←(m,' ',p,' ',s,NL,'Host: ',n,h,NL)c
    ∇

    :endsection

    :section Misc

    ∇ ConnectionMonitor server
    ⍝ Because AJAX calls don't send a "BlockLast" packet, we need to clean up connection namespaces that didn't get erased
      :While 1
          ⎕DL 5
          {}Common.{⎕EX(⎕NL ¯9)~'C',¨#.DRC.Names ⍵}server
      :EndWhile
    ∇

    ∇ r←SpaceName cmd
     ⍝ Generate namespace name from command name
      r←'Common.C',Subst(2⊃{1↓¨('.'=⍵)⊂⍵}'.',cmd)'-=' '_∆'
    ∇

    ∇ r←Subst arg;i;m;str;c;rep
      ⍝ Substitute character c in str with rep
      str c rep←arg
      i←c⍳str
      m←i≤⍴c
      (m/str)←rep[m/i]
      r←str
    ∇

    ∇ file←Config Virtual page;mask;f;ind;t;path;root
      :Access public shared
    ⍝ checks for virtual directory
      root←(-'/\'∊⍨¯1↑root)↓root←Config.Root
      page←('/\'∊⍨1↑page)↓page
      file←root,'/',page
      :If 0<⍴Config.Virtual
          ind←Config.Virtual.alias⍳⊂t←{(¯1+⍵⍳'/')⍴⍵}page
          :If ind≤⍴Config.Virtual.alias
              path←ind⊃Config.Virtual.path
              file←#.Files.unixfix path,('/\'∊⍨¯1↑path)↓(⍴t)↓page
          :EndIf
      :EndIf
    ∇

    ∇ r←isWin
      r←'Win'≡3↑1⊃'.'⎕WG'APLVersion'
    ∇

    :endsection

:EndClass

:Class MiServer

    :Field Public Config

    :Field Public TID←¯1                ⍝ Thread ID Server is running under
    :Field Public BlockSize←640000      ⍝ Blocksize when returning files

    :Field Public SessionHandler←⎕NS ''
    :Field Public Authentication←⎕NS ''
    :Field Public Logger←⎕NS ''
    :Field Public Application←⎕NS ''

    :field Public Encoders←⍬  ⍝ pointers to instances of content encoders
    :field Public Datasources←⍬

    ⎕TRAP←0/⎕TRAP ⋄ (⎕ML ⎕IO)←1 1

    unicode←80=⎕DR 'A'
    NL←(CR LF)←⎕UCS 13 10
    FindFirst←{(⍺⍷⍵)⍳1}
    enlist←{⎕ML←1 ⋄ ∊⍵}
    fromutf8←{0::(⎕AV,'?')[⎕AVU⍳⍵] ⋄ 'UTF-8' ⎕UCS ⍵} ⍝ Turn raw UTF-8 input into text
    toutf8←{'UTF-8' ⎕UCS ⍵}                          ⍝ Turn text into UTF-8 byte stream
    setting←{0=⎕NC ⍵:⍺ ⋄ ⍎⍵}
    endswith←{(,⍺){⍵≡⍺↑⍨-⍴⍵},⍵}
    I85←{}

      bit←{⎕IO←0  ⍝ used by Log
          0=⍺:0 ⍝ all bits turned off
          ¯1=⍺:1 ⍝ all bits turned on
          (⌈2⍟⍵)⊃⌽((1+⍵)⍴2)⊤⍺}

    :section Override
⍝ ↓↓↓--- Methods which are usually overridden ---

    ∇ onServerStart
      :Access Public Overridable
    ⍝ Handle any server startup processing
    ∇

    ∇ onSessionStart req
      :Access Public Overridable
    ⍝ Process a new session
    ∇

    ∇ onSessionEnd session
      :Access Public Overridable
    ⍝ Handle the end of a session
    ∇

    ∇ onIdle
      :Access Public Overridable
    ⍝ Idle time handler - called when the server has gone idle for a period of time
    ∇

    ∇ Error req
      :Access Public Overridable
    ⍝ Handle trapped errors
      req.Response.HTML←'',(⊃,/⎕DM,¨⊂'
'),''
      req.Fail 500 ⍝ Internal Server Error
      1 Log ⎕DM
    ∇

    ∇ level Log msg
      :Access Public overridable
    ⍝ Logs server messages
    ⍝ levels implemented in MildServer are:
    ⍝ 1-error/important, 2-warning, 4-informational, 8-transaction (GET/POST)
      :If Config.LogMessageLevel bit level ⍝ if set to display this level of message
          ⎕←msg ⍝ display it
      :EndIf
    ∇

    ∇ Cleanup
      :Access Public overridable
    ⍝ Perform any site specific cleanup
    ∇

⍝ ↑↑↑--- End of Overridable methods ---
    :endsection

⍝ ↓↓↓--- Begin MildServer Core Code
    :section Start/Stop
    ∇ Run
      :Access Public
      ('Already Running on Thread',⍕TID)⎕SIGNAL(TID∊⎕TNUMS)/11
      TID←RunServer&⍬
    ∇

    ∇ End;tempfiles
    ⍝ Called by destructor
      :Access Public
      Logger.Stop ⍬
      :If 0=⎕NC'ServerName'
         ⍝!!! {}1 #.DRC.Init''
      :Else
          'Not running'⎕SIGNAL(#.DRC.Exists ServerName)↓11
          {}#.DRC.Close ServerName
          :Trap 6 ⍝ ⎕TSYNC may not return a value if the thread doesn't, so handle the possible VALUE ERROR
              {}⎕TSYNC ⎕TID~⍨TID∩⎕TNUMS
          :EndTrap
      :EndIf
      :If ~0∊⍴Config.TempFolder
          tempfiles←{(~⍵[;4])/⍵[;1]}#.Files.List Config.TempFolder
          :If 0≠⍴tempfiles←(tempfiles∨.≠¨'.')/tempfiles
              {}{0::'' ⋄ #.Files.Delete Config.TempFolder,⍵}¨tempfiles
          :EndIf
      :EndIf
      Cleanup ⍝ overridable
      TID←¯1
    ∇
    :endsection

    ∇ r←RunServer arg;RESUME;⎕TRAP;Common;cmd;name;port;wres;ref;nspc;sink;Stop;secure;certpath;flags;z;rc;rate;ErrorCount;idletime;msg;uid;ts;CMTid
      ⍝ Simple HTTP (Web) Server framework
      ⍝ Assumes Conga available in #.DRC and uses #.HTTPRequest
      ⍝ arg: dummy
      ⍝ certs: RootCertDir, ServerCert, ServerKey (optional: runs Secure server)

      Common←⎕NS'' ⋄ Stop←0 ⋄ WAITING←0
      CMTid←ConnectionMonitor&ServerName

      :If Config.TrapErrors>0
          ⎕TRAP←#.DrA.TrapServer
          #.DrA.NoUser←1+#.DrA.MailRecipient∨.≠' '
      :EndIf ⍝ Trap MiServer Errors. See HandleMSP for Page Errors.

      onServerStart ⍝ meant to be overridden

      idletime←#.Dates.DateToIDN ⎕TS
      :While ~Stop
          wres←#.DRC.Wait ServerName 20000 ⍝ Tick every 20 secs
          ⍝ wres: (return code) (object name) (command) (data)

          :Select 1⊃wres
          :Case 0 ⍝ Good data from RPC.Wait
              :Select 3⊃wres

              :Case 'Error'
                  :If ServerName≡2⊃wres
                      Stop←1
                  :EndIf
                  (1+(4⊃wres)∊1008 1105 1119)Log'RunServer: DRC.Wait reported error ',(⍕#.DRC.Error 4⊃wres),' on ',2⊃wres

                  ⎕EX SpaceName 2⊃wres

              :CaseList 'Block' 'BlockLast'
                  nspc←SpaceName 2⊃wres
                  :If 0=⎕NC nspc
                      :Trap 6 ⍝ VALUE ERROR - nspc could be erased if page goes away
                          nspc ⎕NS''
                          (⍎nspc).(Pos Buffer ContentLength Req)←0 '' 0 ''
                          :If 0=1⊃z←#.DRC.GetProp(2⊃wres)'PeerAddr' ⋄ (⍎nspc).PeerAddr←2⊃z
                          :Else ⋄ (⍎nspc).PeerAddr←'Unknown'
                          :EndIf
                          :If Config.Secure
                              rc z←#.DRC.GetProp(2⊃wres)'PeerCert'
                              :If rc=0 ⋄ (⍎nspc).PeerCert←z
                              :Else
                                  1 Log'Unable to obtain peer certificate over secure connection - request ignored'
                                  ⎕EX nspc
                              :EndIf
                          :EndIf
                      :EndTrap
                  :EndIf

                  :If 0≠⎕NC nspc
                      {}(⍎nspc){⎕EX nspc/⍨('BlockLast'≡3⊃⍵)∧⍺ HandleRequest(2↑⍵)}&wres[2 4 3] ⍝ Run page handler in new thread
                  :EndIf
              :Case 'Connect' ⍝ Ignore

              :Else
                  2 Log'Error ',⍕wres
              :EndSelect

          :Case 100 ⍝ Time out - put "housekeeping" code here
              SessionHandler.HouseKeeping ⎕THIS
              :If 0<Config.IdleTimeOut ⍝ if an idle timeout (in seconds) has been specified
              :AndIf Config.IdleTimeOut<86400×-/(ts←#.Dates.DateToIDN ⎕TS)idletime ⍝ has it passed?
                  onIdle
                  idletime←ts
              :EndIf

          :Case 1010 ⍝ Object Not found
              1 Log'Object ''',ServerName,''' has been closed - Web Server shutting down'
              ⎕TKILL CMTid
              →0

          :Else
              1 Log'#.DRC.Wait failed:'
              1 Log wres
          :EndSelect

      :EndWhile

     RESUME: ⍝ Error Trapped and logged
      ⎕TKILL CMTid
      {}#.DRC.Close ServerName
      1 Log r←'Web server ''',ServerName,''' stopped '
      →0

    ∇

    :section Constructor/Destructor

    ∇ Make config;CongaVersion;rc
      :Access Public
      :Implements Constructor

      SessionHandler.GetSession←{}   ⍝ So we can always
      SessionHandler.HouseKeeping←{} ⍝    call these fns
      Authentication.Authenticate←{} ⍝    without worrying
      Logger.Log←{}
      Logger.Stop←{}
      Logger.Start←{}
      :If {0::1 ⋄ 85⌶'0'}'' ⍝ Need a left arg?
          I85←1∘(85⌶)
      :Else
          I85←85⌶
      :EndIf
      Config←config
      :If 0≠⊃rc←¯1 #.DRC.Init''
          ('Unable to initialize Conga. rc=',,⍕rc)⎕SIGNAL 11
      :EndIf

      CongaVersion←{0::0 ⋄ ⊃⊃//⎕VFI ⍵}{(2>+\'.'=⍵)/⍵}⊃{⍵/⍨{∧/⍵∊'0123456789.'}¨⍵}(⊂'')~⍨{1↓¨(⍵=⍬⍴⍵)⊂⍵}' ',2 2⊃#.DRC.Describe'.'
      :If 2.2>CongaVersion
          'MiServer 3.0 requires Conga 2.2 or later'⎕SIGNAL 11
      :EndIf

      'Unable to allocate TCP/IP port'⎕SIGNAL(0≠1⊃,AllocatePort)/11
    ∇

    ∇ UnMake
      :Implements Destructor
      :Trap 0 ⋄ End ⋄ :EndTrap
    ∇

    ∇ r←AllocatePort;ipv;server
    ⍝ Starts Conga, allocates TCP/IP port
      ipv←'Protocol'Config.IPVersion
      :If Config.Secure
          :If ∧/(~0∊⍴)¨Config.(CertFile KeyFile)
          :AndIf ⊃∧/#.Files.Exists¨Config.(CertFile KeyFile)
              {}#.DRC.SetProp'.' 'RootCertDir'Config.RootCertDir
              server←#.DRC.X509Cert.ReadCertFromFile Config.CertFile
              server.KeyOrigin←'DER'Config.KeyFile
              →(0≠1⊃r←#.DRC.Srv'' ''Config.Port'Raw' 10000('X509'server)('SSLValidation'Config.SSLFlags)ipv)⍴0 ⍝ Must have Conga v2.1
              1 Log'Starting secure server using certificate ',Config.CertFile
          :Else
              1 Log'Invalid certificate parameters'
              r←1
              →0
          :EndIf
      :Else
          →(0≠1⊃r←#.DRC.Srv'' ''Config.Port'Raw' 10000 ipv)⍴0
      :EndIf

      ServerName←2⊃r

      ⍝ If running Linux, we may want to switch users (only root can allocate a port less than 1024)

      :If ~isWin
      :AndIf 0<⍴uid←''setting'Config.UserID'
          msg←'4001⌶''',uid,''' '
          :Trap 0
              {}4001⌶uid
          :Else
              1 Log msg,'failed.'
              :Return
          :EndTrap
          4 Log msg,'succeeded.'
      :EndIf

      4 Log'Web server ''',ServerName,''' started on port ',⍕Config.Port
      4 Log'Root folder: ',Config.Root
    ∇

    :endsection

    :section RequestHandling

    ∇ names←pagedata PrepareJSONTargets names;p;m;i;nss;z
     ⍝ See if names contain JSON indexed names like editcell[Name]
     ⍝     and if so convert them to editcell.Name and make sure editcell exists
     ⍝ /// Hack by Morten awaiting cleanup or approval by Brian

      :If 0≠⍴i←(¯1=⎕NC names)/⍳⍴names ⍝ all invalid APL names
          names[i]←('%5B' '%5D'⎕R(,¨'[]'))¨names[i]
      :AndIf 0≠⍴i←i/⍨m←(p←names[i]⍳¨'[')≠∘⊃∘⍴¨names[i] ⍝ ... which contain '['
          nss←∪z←(m/p-1)↑¨names[i] ⍝ all namespaces mentions
          nss pagedata.⎕NS¨⊂⍬      ⍝ prepare empty nss
          names[i]←¯1↓¨names[i]    ⍝ drop trailing ']'
          names[i,¨p]←'.'          ⍝ replace '[' by '.'
      :EndIf
    ∇

    ∇ r←conns HandleRequest arg;buf;m;Answer;obj;CMD;pos;req;Data;z;r;hdr;REQ;status;file;tn;length;done;offset;res;closed;sess;chartype;raw;enc;which;html;encoderc;encodeMe;startsize;cacheMe;root;page;filename;eoh;n;i
      ⍝ Handle a Web Server Request
      r←0
      obj buf←arg
      conns.Buffer,←buf
      conns.Handler←{6::conns.Handler←(⎕UCS'<env>')≡5↑conns.Buffer ⋄ conns.Handler}⍬ ⍝ are we serving as a mapping handler?

      :If 0=conns.Pos ⍝ is we haven't found the end of the header yet...
          eoh←⎕UCS(1+conns.Handler)⊃(NL,NL)('</env>') ⍝ end of header marker
          pos←(¯1+⍴eoh)+eoh FindFirst conns.Buffer
          :If pos≤⍴conns.Buffer ⍝ found the end of header
              conns.Pos←pos
              conns.Req←fromutf8 conns.(Pos↑Buffer)
          :Else
              :Return ⍝ haven't found end of header yet, go back for more
          :EndIf
      :EndIf

      :If 0<⍴conns.Req
          :If conns.Pos>i←(z←LF,'content-length:')FindFirst hdr←#.Strings.lc conns.Req
          :AndIf (⍴conns.Buffer)<conns.Pos+conns.ContentLength←⊃2⊃⎕VFI(¯1+z⍳CR)↑z←(¯1+i+⍴z)↓hdr
              :Return  ⍝ a content-length was specified but we haven't yet gotten what it says to ==> go back for more
          :EndIf
      :EndIf

      conns.Buffer←fromutf8 conns.(Pos↓Buffer)

      :If conns.Handler  ⍝ if we're running as a mapping handler
          conns.(Req Buffer)←MakeHTTPRequest conns.Req ⍝ fake MiServer out by building an HTTP request from what we've got
      :EndIf

⍝      :Hold 'Request'

      REQ←⎕NEW #.HTTPRequest conns.(Req Buffer)
      REQ.Server←⎕THIS ⍝ Request will also contain reference to the Server

      :If 2=conns.⎕NC'PeerAddr' ⋄ REQ.PeerAddr←conns.PeerAddr ⋄ :EndIf       ⍝ Add Client Address Information
      8 Log REQ.(PeerAddr Command Page)

      :If 2=conns.⎕NC'PeerCert' ⋄ REQ.PeerCert←conns.PeerCert ⋄ :EndIf       ⍝ Add Client Cert Information

      :If Config.Rest  ⍝ if running RESTful web service...
          n←+/∧\2>+\REQ.Page∊'/\'
          REQ.RestReq←n↓REQ.Page
          REQ.Page←n↑REQ.Page
      :EndIf

      REQ.Page←Config.DefaultPage{∧/⍵∊'/\':'/',⍺ ⋄ '/\'∊⍨¯1↑⍵:⍵,⍺ ⋄ ⍵}REQ.Page
      REQ.Page,←(~'.'∊{⍵/⍨⌽~∨\'/'=⌽⍵}REQ.Page)/Config.DefaultExtension

      SessionHandler.GetSession REQ
      Authentication.Authenticate REQ

      :If REQ.Response.Status≠401 ⍝ Authentication did not fail

          filename←Config Virtual REQ.Page
          :If Config.AllowedHttpCommands∊⍨⊂REQ.Command

              :If REQ.Page endswith Config.DefaultExtension ⍝ MiPage?
                  filename HandleMSP REQ
              :Else
                  :If REQ.Command≡'get'
                      REQ.ReturnFile filename
                  :Else
                      REQ.Fail 501 ⍝ Service Not Implemented
                  :EndIf
              :EndIf
          :Else
              REQ.Fail 501 ⍝ Service Not Implemented
          :EndIf
      :EndIf

      res←REQ.Response

      encodeMe←conns.Handler<Config.UseContentEncoding ⍝ initialize a flag whether to encode this response, don't compresss if running as a handler
      cacheMe←0

      :If 1=res.File ⍝ See HTTPRequest.ReturnFile
          :If 83=⎕DR file←res.HTML ⍝ if we returned a byte stream, just use it
              length←⍴file ⋄ tn←0
          :Else
              :Trap 22
                  tn←file ⎕NTIE tn←0
                  length←⎕NSIZE tn
                  res.HTML←⎕NREAD tn 83 BlockSize 0
                  cacheMe←0≠Config.HttpCacheTime ⍝ for now, cache all files if set to use caching
                  :If encodeMe
                      encodeMe∧←length<BlockSize ⍝ if we can read entire file and are we encoding...
                      encodeMe>←(⊂¯4↑file)∊'.png' '.gif' '.jpg' ⍝ don't try to compress compressed graphics, should probably add zip files, etc
                  :EndIf
              :Else
                  REQ.Fail 404
                  length←⍴res.HTML
                  res.File←0
              :EndTrap
          :EndIf
          startsize←length
      :EndIf

      :If (200=res.Status)∧encodeMe ⍝ if our HTTP status is 200 (OK) and we're okay to encode
      :AndIf 1024<⍴res.HTML ⍝ BPB used to be 0
      :AndIf 0≠⍴enc←{(⊂'')~⍨1↓¨(⍵=⊃⍵)⊂⍵}' '~⍨',',REQ.GetHeader'accept-encoding' ⍝ check if client supports encoding
      :AndIf 0≠which←⊃Encoders.Encoding{(⍴⍺){(⍺≥⍵)/⍵}⍺⍳⍵}enc ⍝ try to match what encodings they accept to those we provide
          (encoderc html)←Encoders[which].Compress res.HTML
          :If 0=encoderc
              length←startsize←⍴res.HTML
              :If startsize>⍴html ⍝ did we save anything by compressing
                  length←⍴res.HTML←html ⍝ use it
                  res.Headers⍪←'Content-Encoding'(Encoders[which].Encoding)
                  4 Log'Used compression, transmitted% = ',2⍕length{⎕DIV←1 ⋄ ⍺÷⍵}startsize
              :Else
                  4 Log'Compression not used on "',REQ.Page,'", startsize = ',(⍕startsize),', compressed length = ',⍕length
                  :If 83≠⎕DR res.HTML
                      res.HTML←toutf8 res.HTML
                  :EndIf
              :EndIf
          :ElseIf 0=res.File
              2 Log'Compression failed'
              length←⍴res.HTML←toutf8 res.HTML ⍝ otherwise, send uncompressed
          :EndIf
      :ElseIf 0=res.File
          startsize←length←⍴res.HTML←toutf8∊res.HTML
      :EndIf

      :If (200=res.Status)∧cacheMe ⍝ if cacheable, set expires
      :AndIf 0<Config.HttpCacheTime
          res.Headers⍪←'Expires'(Config.HttpCacheTime #.Dates.HttpDate ⎕TS)
      :EndIf
      res.Headers⍪←{0∊⍴⍵:'' '' ⋄ 'Server'⍵}Config.Server
      status←res.((⍕Status),' ',StatusText)
      hdr←enlist{⍺,': ',⍵,NL}/res.Headers
      Answer←(toutf8((1+conns.Handler)⊃'HTTP/1.0 ' 'Status: '),status,NL,'Content-Length: ',(⍕length),NL,hdr,NL),res.HTML
      done←length≤offset←⍴res.HTML
      REQ.MSec-⍨←⎕AI[3]
      res.Bytes←startsize length
      :Repeat
          :If 0≠1⊃z←#.DRC.Send obj Answer done ⍝ Send response and
              (1+(1⊃z)∊1008 1119)Log'"Handlerequest" closed socket ',obj,' due to error: ',(⍕z),' sending response'
              done←1
          :EndIf
          closed←done
          :If ~done
              done←BlockSize>⍴Answer←⎕NREAD tn 83,BlockSize,offset
              offset+←⍴Answer
          :EndIf
      :Until closed ⍝ Everything sent

      :If res.File ⋄ ⎕NUNTIE tn ⋄ :EndIf
      8 Log REQ.PeerAddr status
      Logger.Log REQ
      r←1
 ⍝     :EndHold
    ∇

    ∇ file HandleMSP REQ;⎕TRAP;inst;class;z;props;lcp;args;i;ts;date;n;expired;data;m;oldinst;names;html;sessioned;page;root;fn;MS3;token;cb;mask;resp;t;RESTful;APLJax
    ⍝ Handle a "Mildserver Page" request
     RETRY:
      :If 0≡date←3⊃(,''#.Files.List file),0 0 0
          REQ.Fail 404 ⋄ →0
      :EndIf

      MS3←RESTful←0

      :If sessioned←326=⎕DR REQ.Session ⍝ do we think we have a session handler active?
      :AndIf 0≠⍴REQ.Session.Pages     ⍝ Look for existing Page in Session
      :AndIf (n←⍴REQ.Session.Pages)≥i←REQ.Session.Pages._PageName⍳⊂REQ.Page
          inst←i⊃REQ.Session.Pages ⍝ Get existing instance
          :If expired←inst._PageDate≢date  ⍝ Timestamp unchanged?
          :AndIf expired←(⎕SRC⊃⊃inst)≢#.UnicodeFile.ReadNestedText file
              oldinst←inst
              REQ.Session.Pages~←inst
              4 Log'Page: ',REQ.Page,' ... has been updated ...'
          :EndIf
      :AndIf ~expired
          4 Log'Using existing instance of page: ',REQ.Page
          :If 9=⎕NC'#.HtmlPage'
              :If MS3←∨/(∊⎕CLASS inst)∊#.HtmlPage ⋄ inst._Request←REQ ⋄ :EndIf
          :EndIf
          :If 9=⎕NC'#.RESTful'
              :If RESTful←∨/(∊⎕CLASS inst)∊#.RESTful ⋄ inst._Request←REQ ⋄ :EndIf
          :EndIf
      :Else                        ⍝ First use of Page in this Session, or page expired
          :If 0≠⍴z←#.Files.GetText file
              :Trap 11 22
                  class←⎕SE.SALT.Load file,' -target=#.Pages'
                  inst←⎕NEW class
              :Case 11 ⋄ REQ.Fail 500 ⋄ →0 ⍝ Domain Error: HTTP Internal Error
              :Case 22 ⋄ REQ.Fail 404 ⋄ →0 ⍝ File Name Error: HTTP Page not found
              :EndTrap
              4 Log'Creating new instance of page: ',REQ.Page
              inst._PageName←REQ.Page
              inst._PageDate←date
              MS3←RESTful←0
              :If 9=⎕NC'#.HtmlPage'
                  :If MS3←∨/(∊⎕CLASS inst)∊#.HtmlPage
                  :OrIf RESTful←∨/(∊⎕CLASS inst)∊#.RESTful
                      inst.(_Request _PageRef)←REQ inst
                  :EndIf
              :EndIf
              :If sessioned ⋄ REQ.Session.Pages,←inst ⋄ :EndIf
          :Else
              REQ.Fail 404 ⋄ →0
          :EndIf
      :EndIf

      :If sessioned ⋄ token←REQ.(Page,⍕Session.ID)
      :ElseIf ~0∊⍴REQ.PeerAddr ⋄ token←REQ.(Page,PeerAddr)
      :Else ⋄ token←⍕⎕TID
      :EndIf

      :Hold token

     ⍝ Move arguments / parameters into Public Properties
          inst._PageData←⎕NS''
          :If 0≠1↑⍴data←{⍵[⍋↑⍵[;1];]}REQ.Arguments⍪REQ.Data
              m←1,2≢/data[;1]
              data←(m/data[;1]),[1.5]m⊂data[;2]
              i←{⍵/⍳⍴⍵}1=⊃∘⍴¨data[;2]
              data[i;2]←⊃¨data[i;2]
              :If 0≠⍴lcp←props←('_'≠1⊃¨props)/props←(inst.⎕NL-2) ⍝ Get list of public properties (those beginning with '_' are excluded)
              :AndIf 0≠1↑⍴args←(data[;1]∊lcp)⌿data
                  args←(2⌈⍴args)⍴args
                  i←lcp⍳args[;1]
                  ⍎'inst.(',(⍕props[i]),')←args[;2]'
              :EndIf
              :If ∨/mask←'_'≠1⊃¨data[;1]
                  args←mask⌿data
                  args[;1]←inst._PageData PrepareJSONTargets args[;1]
                  ⍎'inst._PageData.(',(⍕args[;1]),')←args[;2]'
              :EndIf
          :EndIf

          fn←cb←'Render'
          :If APLJax←REQ.isAPLJax>RESTful ⍝ if it's an APLJax (XmlHttpRequest) request (but not web service)
              REQ.Response.NoWrap←1
              fn←cb←'APLJax' ⍝ default callback function name
              :If MS3
                  inst._what←REQ.GetData'_what'
                  inst._event←REQ.GetData'_event'
                  inst._value←REQ.GetData'_value'
                  :If ~0∊⍴t←REQ.GetData'_callback' ⍝ does the request specify a callback function
                      fn←cb←t
                  :EndIf
              :EndIf
          :Else
              :If MS3
                  cb←cb inst.{3=⌊|⎕NC⊂⍵:⍵ ⋄ ⍺}fn←(1+RESTful)⊃'Compose' 'Respond' ⍝ default function to call
              :EndIf
          :EndIf

          :If 3≠⌊|inst.⎕NC⊂cb            ⍝ and is it a public method?
              1 Log'Method "',fn,'" not found (or not public) in page "',REQ.Page,'"'
              REQ.Fail 500
          :EndIf

          :If MS3
              :If (⊂cb)∊'Render' 'Compose'
                  inst._init ⍝ reset instance's content
              :ElseIf APLJax
                  inst._resetAjax
              :EndIf
          :EndIf

          :If (1=Config.TrapErrors)∧9=⎕NC'#.DrA' ⋄ ⎕TRAP←#.DrA.TrapServer
          :ElseIf (0=Config.Production) ⋄ ⎕TRAP←(800 'C' '→FAIL')(811 'E' '⎕SIGNAL 801')(813 'E' '⎕SIGNAL 803')(812 'S')(0 'E' '⍎#.Boot.Oops') ⍝ enable development debug framework
          :EndIf

          :Trap 85   ⍝ we use 85⌶ because "old" MiPages use REQ.Return internally (and don't return a result)...
              resp←I85'inst.',cb,(MS3⍱RESTful)/' REQ'  ⍝ ... whereas "new" MiPages return the HTML they generate
              resp←(#.JSON.toAPLJAX⍣APLJax)resp
              REQ.Return resp
          :Else
              :If APLJax
                  1 Log'No result returned by callback method "',cb,'" in page "',REQ.Page,'"'
                  REQ.Return''
              :EndIf
          :EndTrap

          :If ~REQ.Response.NoWrap
              :If MS3∨RESTful
                  inst.Wrap
              :Else
                  inst.Wrap REQ
              :EndIf
              :If Config.FormatHtml
                  :Trap 0
                      REQ.Response.HTML←('.'⎕R'&'⍠'NEOL' 1⍠'EOL' 'LF')((⎕XML⍠'Whitespace' 'Preserve')⍣2)REQ.Response.HTML
                  :Else
                      ⎕←'*** ⎕XML failed'
                  :EndTrap
              :EndIf
          :EndIf
      :EndHold
      →0

     FAIL:
      ⎕TRAP←0⍴⎕TRAP
      REQ.Fail 500 ⋄ →0

     RESUME: ⍝ RESUME is used by DrA
      ⎕TRAP←0/⎕TRAP ⍝ Let framework trapping take over

      :If #.DrA.UseHTTP ⋄ REQ.Fail 500 ⋄ →0 ⋄ :EndIf

      REQ.Title'Unhandled Execution Error'
      REQ.Style'Styles/error.css'
      html←'h1'#.HTMLInput.Enclose'Server Error in ''',REQ.Page,'''.
'
      html,←'
Unhandled Exception Error
'
      html,←'Description: An unhandled exception occurred during the execution of the current web request.'
      :If #.DrA.Mode=2 ⍝ Allows editing
          html,←'

Edit page: ',REQ.Page,'
'
      :EndIf
      html,←'

Exception Details:

'
      :If (#.DrA.Mode>0)∧0≠⍴#.DrA.LastFile ⋄ html,←#.DrA.(GenHTML LastFile)
      :Else ⋄ html,←'code'#.HTMLInput.Enclose'',(⊃,/#.DrA.LastError,¨⊂'
'),''
      :EndIf
      REQ.Return html
    ∇

    ∇ (req buffer)←MakeHTTPRequest req;x;v;s;p;l;m;n;i;c;h
⍝ kludge to get by ampersands in a POST - will be fixed when we build proper requests from MiServerCGI
      buffer←c←''
      :If (⍴req)≥i←1⍳⍨'>tsop<'⍷⌽req
          i←(⍴req)-i+5
          c←¯13↓(i+6)↓req
          req←(i↑req),'</env>'
      :EndIf

      :Trap 11
          x←⎕XML req
      :Else
          ∘∘∘
      :EndTrap
      v←'var'∘≡¨x[;2]
      v←{⎕ML←3 ⋄ (~<\'='=⍵)⊂⍵}¨v/x[;3]
      v←(∊2=⍴¨v)/v
      h←∊{0∊⍴⍵:'' ⋄ (#.Strings.lc{'HTTP_'≡5↑⍵:5↓⍵ ⋄ 'HTTPS_'≡6↑⍵:6↓⍵ ⋄ ⍵}⍺){('-',⍺)[('_',⍺)⍳⍺],': ',⍵,NL}⍵}/¨v
      ⍝ pull out special fields
      m p s n←(↑v)∘{3::2⊃⍵ ⋄ ⍺[;2]⊃⍨⍺[;1]⍳⊂1⊃⍵}¨↓'REQUEST_METHOD' 'PATH_INFO' 'SERVER_PROTOCOL' 'SERVER_NAME',[1.1]'GET' '' 'HTTP/1.0' 'localhost'
      (req buffer)←(m,' ',p,' ',s,NL,'Host: ',n,h,NL)c
    ∇

    :endsection

    :section Misc

    ∇ ConnectionMonitor server
    ⍝ Because AJAX calls don't send a "BlockLast" packet, we need to clean up connection namespaces that didn't get erased
      :While 1
          ⎕DL 5
          {}Common.{⎕EX(⎕NL ¯9)~'C',¨#.DRC.Names ⍵}server
      :EndWhile
    ∇

    ∇ r←SpaceName cmd
     ⍝ Generate namespace name from command name
      r←'Common.C',Subst(2⊃{1↓¨('.'=⍵)⊂⍵}'.',cmd)'-=' '_∆'
    ∇

    ∇ r←Subst arg;i;m;str;c;rep
      ⍝ Substitute character c in str with rep
      str c rep←arg
      i←c⍳str
      m←i≤⍴c
      (m/str)←rep[m/i]
      r←str
    ∇

    ∇ file←Config Virtual page;mask;f;ind;t;path;root
      :Access public shared
    ⍝ checks for virtual directory
      root←(-'/\'∊⍨¯1↑root)↓root←Config.Root
      page←('/\'∊⍨1↑page)↓page
      file←root,'/',page
      :If 0<⍴Config.Virtual
          ind←Config.Virtual.alias⍳⊂t←{(¯1+⍵⍳'/')⍴⍵}page
          :If ind≤⍴Config.Virtual.alias
              path←ind⊃Config.Virtual.path
              file←#.Files.unixfix path,('/\'∊⍨¯1↑path)↓(⍴t)↓page
          :EndIf
      :EndIf
    ∇

    ∇ r←isWin
      r←'Win'≡3↑1⊃'.'⎕WG'APLVersion'
    ∇

    :endsection

:EndClass


HtmlElement Allow simple numerics to be eis'ed

:class HtmlElement             ⍝ this is the most basic element of a page

⍝∇:require =\JSON.dyalog

    ⎕io←⎕ml←1

    :field public shared _version←1
    :field public NL←⎕ucs 13 ⍝ 10

    :field public Tag←''      ⍝ this is the element name
    :field public Content←⍬   ⍝ content of the element - a series of strings/instances/class+parms
    :field public Handlers←'' ⍝ array of event handlers
    :field public _PageRef←'' ⍝ reference back to the page instance containing this element
    :field public NoEndTag←0  ⍝ set to 1 if this singleton element (does not have a closing tag)
    :field public Position    ⍝ has position information for this element (if position is set)
    :field public Uses←''     ⍝ resources that will be used by this object (can be overridden by derived classes)

    :field public shared readonly _true←#.JSON.true     ⍝ same definition as in #.JSON
    :field public shared readonly _false←#.JSON.false   ⍝ same definition as in #.JSON

⍝ define shortcuts to namespaces (initialized later)
    :field public shared _html ⍝ reference to base HTML elements namespace
    :field public shared _JQ   ⍝ reference to JQuery/JQueryUI widgets namespace
    :field public shared _SF   ⍝ reference to Syncfusion widgets namespace
    :field public shared _JSS  ⍝ reference to JavaScript Snippets namespace
    :field public shared _DC   ⍝ reference to Dyalog Controls namespace
    :field public shared _     ⍝ reference to namespace that refers to all elements/widgets

   ⍝ make shortcuts for some common HTML attributes
    :field public shared readonly UNDEF←⎕NULL  ⍝ setting for undefined attributes
    :field public id←UNDEF                     ⍝ id attribute for the element
    :field public value←UNDEF                  ⍝ value attribute for the element
    :field public name←UNDEF                   ⍝ name attribute for the element
    :field public class←UNDEF                  ⍝ class attribute for the element
    :field public style←UNDEF                  ⍝ style attribute for the element
    :field public title←UNDEF                  ⍝ title attribute for the element
    :field public type←UNDEF                   ⍝ type attribute for the element

    :field public readonly CommonAttributes←'id' 'value' 'name' 'class' 'style' 'title' 'type' ⍝ element attributes that are directly accessible

    _names←_values←0⍴⊂'' ⍝ used for attributes

    :field public _styles←''

    rand←{?⍵⊣⎕RL←0}

    ∇ r←Version
      :Access public
      r←{⍵,[1.1]{0::¯1 ⋄ ⍵._version}¨⍵}⎕CLASS ⎕THIS
    ∇

    ∇ r←context name
      :Access public shared
      :If 326=⎕DR name ⍝ ref?
          r←⎕RSI{0∊⍴⍺:'' ⋄ 16::''
              ∨/∨/¨(⊂⍵)∊¨(⊃⍺).(⎕CLASS ⎕THIS):⊃⍺
              (1↓⍺)∇ ⍵}name
      :Else
          r←⎕RSI{0∊⍴⍺:''
              ⋄ (⊃⍺){0=⍺.⎕NC⊂⍵:0
                  ⋄ ''≡t←⍺⍎⍵:0
                  ⋄ 1}⍵:⊃⍺
              ⋄ (1↓⍺)∇ ⍵}name
      :EndIf
    ∇

    ∇ r←isChar w
      :Access public shared
      r←0 2∊⍨10|⎕DR w
    ∇

    ∇ r←isNum w
      :Access public shared
      r←2|⎕DR w
    ∇

    ∇ r←isString w
      :Access public shared
      :Select ≡w
      :Case 2
          :If 1=⍴,w
              r←{(isChar ⍵)∧1∊⍴⍴1/⍵}⊃w
          :Else
              r←0
          :EndIf
      :CaseList 0 1
          r←{(isChar ⍵)∧1∊⍴⍴1/⍵}w
      :Else
          r←0
      :EndSelect
    ∇

    ∇ r←quote w
      :Access public
      r←{'"'∊⍵:⍵ ⋄ '"',⍵,'"'}w
    ∇

    ∇ r←isTrue a
      :Access public shared
      →0⍴⍨r←(,1)≡,a       ⍝ boolean
      →0⍴⍨r←#.JSON.true≡a ⍝ namespace
      →0⍴⍨r←'true'≡a      ⍝ string
      →0⍴⍨r←a≡⊂'true'     ⍝ 7161⌶1
    ∇

    ∇ r←isFalse a
      :Access public shared
      →0⍴⍨r←(,0)≡,a        ⍝ boolean
      →0⍴⍨r←#.JSON.false≡a ⍝ namespace
      →0⍴⍨r←'false'≡a      ⍝ string
      →0⍴⍨r←a≡⊂'false'     ⍝ 7161⌶0
    ∇

    ∇ r←a ine w
      :Access public shared
      r←a{0∊⍴⍺:'' ⋄ ⍵}w ⍝ if not empty
    ∇
    errorIf←{⍺←⊢ ⋄ 0≠⍵:⍺ ⎕SIGNAL ⍵}

    :section Attribute Handling

    ∇ r←fixkeys w
      :Access public shared
      r←{2>|≡⍵:,⊂⍵ ⋄ ⍵}w ⍝ Enclose if simple
    ∇

    ∇ SyncAttrs arg
      :Implements Trigger id,name,class,style,title,type,value
      :If ⊃≢/arg.(NewValue OldValue)
          arg.Name Set arg.NewValue~UNDEF
      :EndIf
    ∇

    :property keyed Attrs       ⍝ element attributes
    :access public

        ∇ set ra;i;new;there;names;ind
          there←~new←(⍴_names)<i←_names⍳names←fixkeys⊃ra.Indexers
          (_values _names),←new∘/¨ra.NewValue names
          _values[there/i]←there/ra.NewValue
          :For i :In {⍵/⍳⍴⍵}7≥'id' 'class' 'style' 'title' 'value' 'type' 'name'⍳names
              ⍎(i⊃names),'←i⊃ra.NewValue'
          :EndFor
        ∇

        ∇ r←get ra;i;n
          ⎕SIGNAL(1<⍴i←ra.Indexers)⍴4 ⍝ RANK err
          :If 1↑ra.IndexersSpecified
              r←(_values,⊂'')[_names⍳n←fixkeys⊃⍣(2≤|≡i)+i]
          :Else
              r←↓_names,[1.1]_values
          :EndIf
        ∇
    :endproperty

    ∇ attr←{plain}ParseAttr arg;split;item;t;f;i;eq;nq;items;n
      :Access public shared

⍝ Parse html sttributes
⍝ {plain} - Boolean indicating whether to not interpret a plain first token as an if
⍝ args    - vector of tokens to parse
⍝
⍝     1)    In only the first token, a simple string (i.e. not in the form 'abc=def') without a leading '#' or '.' is treated as an id
⍝        'foo'  > id="foo"
⍝
⍝        In all other positions, a string of this type is treated as a singleton attribute
⍝        'foo' 'goo' 'moo' > id="foo" goo="goo" moo="moo"
⍝
⍝     2)    Single simple string beginning with '#' is an id
⍝        '#foo'  > id="foo"
⍝        'goo=moo' '#foo' > goo="moo" id="foo"
⍝
⍝     3)    Single simple string beginning with '.' is treated as a class
⍝        '.foo'  > class="foo"
⍝        'foo' '.goo' 'moo' > id="foo" class="goo" moo="moo"
⍝
⍝     4)    Attributes must be paired either as in 'foo=goo' or ('foo' 'goo'), if there is a single pair, it must be enclosed
⍝        ⊂'href' '#top'  > href="#top"
⍝
⍝        The value portion of an attribute pair may begin with '#' or '.' without special interpretation
⍝        ('href' '#top') '#foo' > href="#top" id="foo"

      :If 0=⎕NC'plain' ⋄ plain←0 ⋄ :EndIf
      arg←eis,arg
      attr←⍬
      split←{0=⊢/v←∨\(≠\'"'=⍵)<'='=⍵:⍵ ⋄ ((~v)/⍵)({'"'∧.=∊1 ¯1↑¨⊂⍵:¯1↓1↓⍵ ⋄ ⍵}1↓v/⍵)}
      :For i :In ⍳⍴arg
          :Select |≡item←,i⊃arg
          :Case 1
              :If ~0∊⍴item
                  :If ∨/eq←'='=item              ⍝ any '=' (i.e.
                  :AndIf 0≠n←eq+.∧nq←~≠\'"'=item
                      :If n=1
                          attr,←⊂split item
                      :Else
                          attr,←⊃,/1 ParseAttr¨item{⎕ML←3 ⋄ ⍵⊂⍺}nq⍲item=' '
                      :EndIf
                  :ElseIf 3>f←'#.'⍳1↑item
                      attr,←⊂((f⊃'id' 'class')(1↓item))
                  :ElseIf plain<i=1
                      attr,←⊂'id'item
                  :Else
                      attr,←⊂2⍴⊂item
                  :EndIf
              :EndIf
          :Case 2
              attr,←⊂item
          :Else
              ('Invalid attribute specification: ',⍕item)⎕SIGNAL 11
          :EndSelect
      :EndFor
    ∇

    ∇ {r}←{which}Set attr
      :Access public
      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr

          :If 2=⍴,attr  ⍝ 'attr' 'value' is never shorthanded (e.g. given special treatment for id/class)
          :AndIf 1∧.≥≡¨attr
          :AndIf ~∧/'='∊¨attr
              attr←,⊂attr
          :EndIf

          attr←1 ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttribute attr
    ⍝ set attributes, treating

      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr
          attr←ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttr attr
      :Access public
      :If 0=⎕NC'which' ⋄ r←SetAttribute attr
      :Else ⋄ r←which SetAttribute attr
      :EndIf
    ∇

    ∇ {r}←DelAttr attrname;mask
      :Access public
      attrname←eis attrname
      mask←~_names∊attrname ⋄ (_names _values)←mask∘/¨_names _values
      r←⎕THIS
    ∇

    ∇ r←{proto}GetAttr attrname
      :Access public
      :If 0=⎕NC'proto' ⋄ proto←'' ⋄ :EndIf
      attrname←eis attrname
      :If 1=⍴attrname
          :Trap 3 ⍝ index error
              r←_values⊃⍨_names⍳attrname
          :Else
              r←proto
          :EndTrap
      :Else
          proto∘GetAttr¨attrname
      :EndIf
    ∇

    ∇ r←AddClass c
      :Access public
      :If class≡UNDEF
          class←c
      :Else
          class,←' ',c
      :EndIf
    ∇

    ∇ r←AddStyle s;t
      :Access public
      :If style≡UNDEF
          style←s,(';'=¯1↑s)↓';'
      :Else
          style,←(';'=¯1↑style)↓';',s,(';'=¯1↑s)↓';'
      :EndIf
    ∇

    :EndSection

    :Section Styles

    ∇ {r}←{what}Style styles;msg
      :Access public
      msg←'Invalid style specification'
      :If 0≠⎕NC'what'
          _styles,←↓(eis what),⍪eis((⍕¨)⍣(2|⎕DR styles))styles
      :Else
          :Select ≡styles
          :Case 2
              msg errorIf 11×0≠2|⍴styles
              _styles,←↓(2,⍨0.5×⍴styles)⍴styles
          :Case 3
              msg errorIf 11×~∧/(,2)∘≡∘⍴¨styles
              _styles,←styles
          :Else
              msg ⎕SIGNAL 11
          :EndSelect
      :EndIf
      r←⎕THIS
    ∇

    ∇ r←RenderStyles;style
      r←''
      :If ~0∊⍴_styles
          :For style :In _styles
              r,←∊(⍕¨style),¨':;'
          :EndFor
          r←' style="',r,'" '
      :EndIf
    ∇

    :EndSection

  ⍝ The constructors

  ⍝ The first arg is the Tag, followed by its contents, then its attributes, if present
  ⍝ Note that attributes can be specified with the tag as in
  ⍝  button type="submit"

    :Section Constructors

    ∇ Make0
    ⍝ basic constructor
      :Implements constructor
      :Access public
      Init
    ∇

    ∇ Make1 t    ⍝ this can be any length
    ⍝ t - tag/element name (e.g. 'div' or 'table')
      :Implements constructor
      :Access public
      Tag←t
      Init
    ∇

    ∇ Make2(t arg)
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ arg - content or (content attrs)
      :Implements constructor
      :Access public
      Make2Code(t arg)
    ∇

    ∇ Make2Code(t arg);attr;content;ref
      :If 1=≡t arg                      ⍝ handle 2-character tag (e.g. 'ul' 'tr')
          Tag←t,arg
      :Else
        ⍝ If we have a couple of items, the second of which is
        ⍝ a string or VTV, then we are dealing with attributes:
          :If (1<|≡arg)∧(,2)≡⍴arg
          :AndIf isAttr 2⊃arg
              (content attr)←arg ⋄ SetAttr attr
          :Else
              content←arg
          :EndIf
          Add content
          Tag←t
      :EndIf
      Init
    ∇

    ∇ Make3(t content attr);ref
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ content - content
    ⍝ attr - attrs
      :Implements constructor
      :Access public
      :If 1=≡t content attr    ⍝ handle 3-character tag (e.g. 'pre')
          Tag←t,content,attr
      :ElseIf isClass content
          Make2Code t(content attr)
      :Else
          Tag←t
         ⍝ attr could be a ref. This means that it goes in the contents.
          Add content
          :If (0∊⍴attr)⍱ref←isRef attr
              SetAttr attr
          :ElseIf ref
              Add attr
          :EndIf
      :EndIf
      Init
    ∇

    ∇ Init
      (_html _JQ _SF _DC _JSS _)←#.(_html _JQ _SF _DC _JSS _)
      Position←⎕NS''
    ∇

    ∇ SetUse;c
      :Access public overridable
      :If ~0∊⍴Uses
          :Trap 0
              :If ''≡c←_PageRef
                  c←context'_PageRef'
                  :If ~0∊⍴c
                      c←c._PageRef
                  :EndIf
              :EndIf
              :If ~0∊⍴c
                  c.Use Uses
              :EndIf
          :EndTrap
      :EndIf
    ∇

    ∇ Use resource
      :Access public
      :If ~0∊⍴Uses ⋄ Uses←eis Uses ⋄ :EndIf
      Uses,←eis resource
    ∇

    :endsection

    :section Event Handling

    ∇ {handler}←On args;n;i
      :Access public
      args←eis args
      handler←⎕NEW #._JQ.Handler
      handler.(Events Callback ClientData JavaScript Delegates jQueryWrap ScriptWrap Cursor)←args defaultArgs'' 1 '' '' '' 1 1 ¯1
      handler.WidgetRef←⎕THIS
      handler.Page←_PageRef
      :If ¯1=handler.Hourglass ⋄ handler.Hourglass←(,0)≢,handler.Callback ⋄ :EndIf
      :If 0∊n←⍴Handlers
          Handlers,←handler
      :ElseIf n<i←Handlers.Events⍳⊂handler.Events
          Handlers,←handler
      :Else
          Handlers[i]←handler
      :EndIf
    ∇

    ∇ r←RenderHandlers;myid;h
      :Access public ⍝!!! remove this after testing
      r←''
      :If ~0∊⍴Handlers
          :If ∨/0∘∊∘⍴¨Handlers.Selector
              myid←SetId
          :EndIf
          :For h :In Handlers
              :If 0∊⍴h.Selector
                  h.Selector←'#',myid
              :EndIf
              r,←h.Render
          :EndFor
      :EndIf
    ∇
    :endsection

    :section Rendering

⍝ Elements with no End tag (<tag></tag>).

⍝ area base basefont br col frame hr img input isindex link meta param

    ∇ r←a FormatAttr w
      :Access public shared
      r←' ',a,'=',Quote HtmlSafeText,⍕w
    ∇

    ∇ r←Render;av;t;vs;e;h;c;p
      :Access public
    ⍝ Render by first constructing the Tag, complete with attributes, if any
      r←RenderCore Content
      :If ~0∊⍴av←Tag
          h←RenderHandlers
          p←RenderPosition
          :If 0<⍴vs←Attrs[]
              av,←∊FormatAttr/¨vs
          :EndIf
          av,←RenderStyles
          :If (⊂Tag)∊'html' 'body' 'head'
              r←av Enclose r,h,p
          :Else
              r←(av Enclose r),h,p
          :EndIf
      :EndIf
    ∇

    ∇ r←Postrender r
      :Access overridable
    ∇

    ∇ r←RenderCore list;e;t
      :Access public
    ⍝ do the bulk of the rendering work
      r←''
      :For e :In eis list
          :If isInstance⊃e
              r,←e.Render
          :ElseIf isClass⊃e
              r,←(New e).Render
          :Else
              :If 1<⍴⍴t←⍕e
                  t←∊(↓t),¨⊂'<br/>'
              :EndIf
              r,←t
          :EndIf
      :EndFor
    ∇

    ∇ r←HtmlSafeText txt;i;m;u;ucs
      :Access public shared
    ⍝ make text HTML "safe"
      r←,⎕FMT txt
      i←'&<>"#'⍳r
      i-←(i=1)∧1↓(i=5),0 ⍝ mark & that aren't &#
      m←i∊⍳4
      u←127<ucs←⎕UCS r
      (m/r)←('&' '<' '>' '"')[m/i]
      (u/r)←(~∘' ')¨↓'G<&#ZZZ9;>'⎕FMT u/ucs
      r←∊r
    ∇

    ∇ r←RenderPosition
      :Access public
      r←''
      :If ~0∊⍴Position.⎕NL-2
          Uses,←⊂'JQueryUI'
          r←#.JQ.JQueryfn'position'('#',SetId)Position
          SetUse
      :EndIf
    ∇

    :endsection

    :section Utilities

    Bracket←{'<',⍵,'>'}

    ∇ SetInputName
      :Access public
      ⍝ for input element widgets, this will set the name to the id if not already set
      ⍝ or the id to the name if not already set
      :If (⊂name)∊UNDEF''
          :If (⊂id)∊UNDEF''
              SetId
          :EndIf
          name←id
      :ElseIf UNDEF≡id
          id←name
      :EndIf
    ∇

    ∇ r←tag Enclose txt;nl
      :Access public shared
      tag←,tag
      r←(tag{NoEndTag∧0∊⍴⍵:Bracket ⍺,'/' ⋄ (Bracket ⍺),⍵,Bracket'/',⍺↑⍨¯1+⍺⍳' '}txt)
    ∇

    ∇ r←{a}eis w
      :Access public shared
      r←((,∘⊂)⍣(((isNum w)∨isString w)∧2>|≡w))w ⍝ enclose if simple character
      ⍝r← (,∘⊂)⍣((326∊⎕DR w)<2>|≡w)⊢w ⍝ Enclose if simple
    ∇

    ∇ da←args defaultArgs defaultvalues
      :Access public shared
      da←da,(⍴,da←eis args)↓defaultvalues
    ∇

    ∇ r←Quote a;b
      :Access public shared
      b←1↓<⌿¯1 0⌽'\"'∘.=';',a   ⍝ keep \" as is
      (b/a)←⊂'"'
      r←1⌽'""',∊a
    ∇

    ∇ r←attr ParseArgs args
      :Access public
      :If ~0∊⍴r←args
          :If isClass⊃args
              r←⎕NEW∘{2<⍴,⍵:(⊃⍵)({eis ⍵}(1↓⍵)) ⋄ ⍵}args
              :If 0≠⎕NC⊂'_PageRef'
                  r._PageRef←_PageRef
              :EndIf
              :If ~0∊⍴attr
                  r.SetAttr attr
              :EndIf
          :ElseIf isInstance⊃args
              :If ~0∊⍴attr
                  (⊃args).SetAttr attr
              :EndIf
              r←args
          :Else
              (r←⎕NEW HtmlElement).Content←args
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Push args;c;cl;attr;elm
      :Access public
      :If ~0∊⍴r←args
          c←Content
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :If isInstance r
              :Trap 4 5 ⍝ rank and length error
                  r.Content,←c
              :Else
                  r.Content,←⊂c
              :EndTrap
              Content←r
          :Else
              Content,⍨←r
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Add args;cl
    ⍝ add "something" to the Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,←r
          :Else
              Content,←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←{attr}New args;cl
    ⍝ create a new instance
    ⍝ args can be an instance, a class, or just html/text
      :Access public shared
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
      :EndIf
    ∇

    ∇ {r}←{attr}Insert args;cl
    ⍝ add "something" to the beginning of Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,⍨←r
          :Else
              Content,⍨←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←Last
      :Access public
      r←⊃⌽Content
    ∇

    ∇ r←{ref}isClass ao
      :Access public shared
      →0↓⍨r←9.4∊⎕NC⊂'ao'
      :If 0≠⎕NC'ref'
          r←ref∊∊⎕CLASS ao
      :EndIf
    ∇

    ∇ r←{ref}isInstance ao
      :Access public shared
      →0↓⍨r←9.2∊⎕NC⊂'ao'
      :If 0≠⎕NC'ref'
          r←ref∊∊⎕CLASS ao
      :EndIf
    ∇

    ∇ r←isRef obj
      :Access public shared
      r←9∊⎕NC'obj'
    ∇

    ∇ r←isWidget obj
      :Access public shared
      →0↓⍨r←9.2∊⎕NC⊂'obj'
      r←#._JQ._jqWidget∊∊⎕CLASS obj
    ∇

    isattr←{isString ⍵:1 ⋄ isRef ⍵:0 ⋄ ∧/∇¨⍵}

    ∇ r←isAttr obj
      :Access public shared
      r←isattr obj
    ∇

    ∇ r←renderIt It
      :Access public shared
      r←{
          0∊⍴⍵:''
          326=⎕DR ⍵:{
              isString ⍵:∊⍵
              2≤|≡⊃⍵:{
                  isClass⊃⊃⍵:((New⊃⍵).Render),renderIt 1↓⍵
                  ,⍕⍵
              }⍵
              isInstance⊃⍵:((⊃⍵).Render),renderIt 1↓⍵
              isClass⊃⍵:((⎕NEW(⊃⍵)).Render),renderIt 1↓⍵
              isChar⊃⍵:(⊃⍵),renderIt 1↓⍵
              (,⍕⊃⍵),renderIt 1↓⍵}⍵
          ,⍕⍵}It
    ∇

    ∇ r←isHtmlElement ao
      :Access public shared
      :Trap r←0
          r←⊃∨/#.HtmlElement=⎕CLASS ao
      :EndTrap
    ∇

    ∇ r←Parse string;b;s
    ⍝ Separate each section of name="..."
      :Access public
      string←(b⍲1⌽b←' '=s)/s←' ',string
      b←(' '=string)>≠\'"'=string
      r←1↓¨b⊂string ⍝ each pair
      s←r⍳¨'='      ⍝ each is separated by =
      r←s{(¯1↓⍺↑⍵)(1↓¯1↓⍺↓⍵)}¨r
    ∇

    ∇ r←GenId
      :Access public shared
      r←'id',⍕rand ¯1+2*31
    ∇

    ∇ {myid}←SetId
      :Access public
      :If UNDEF≡myid←id
          :If ''≡myid←⊃Attrs[⊂'id']
              id←myid←GenId
          :Else
              id←myid
          :EndIf
      :EndIf
    ∇

    dtlb←{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}

    ∇ r←ScriptFollows
      :Access public shared
      r←2↓∊(⎕UCS 13 10)∘,¨Follows
    ∇

    ∇ r←Follows;n
      :Access public shared
      n←⎕XSI{1++/∧\⍵∘≡¨(⊃⍴⍵)↑¨⍺}(⍕⎕THIS),'.'
      r←{⍵/⍨'⍝'≠⊃¨⍵}{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}¨(1+n⊃⎕LC)↓↓(180⌶)n⊃⎕XSI
    ∇

    ∇ r←MarkdownFollows
      :Access public shared
      r←⊃#.MarkAPL.Markdown2HTML Follows
    ∇

    ∇ r←CodeFollows;n
      :Access public shared
      n←⎕XSI{1++/∧\⍵∘≡¨(⊃⍴⍵)↑¨⍺}(⍕⎕THIS),'.'
      r←2↓∊(⎕UCS 13 10)∘,¨{¯1↓⍵/⍨∨\⌽<\∨/¨'⍝<<end>>'∘⍷¨⍵}(1+n⊃⎕LC)↓↓(180⌶)2⊃⎕XSI
      r←'<pre style="font-family:APL385 Unicode">',r,'</pre>'
    ∇

    ∇ r←WrapFollowing tag;text;SplitOnSpaceLines;Trim;FirstCommentBlock
      :Access public shared

     ⍝ USAGE:
     ⍝
     ⍝      Add WrapFollowing 'p class="bodytext"'
     ⍝      ⍝ paragraph may span
     ⍝      ⍝ several lines
     ⍝      ⍝
     ⍝      ⍝ they are separated by empty comment lines
     ⍝
     ⍝ RESULT:
     ⍝
     ⍝      <p class="bodytext">paragraph may span several lines</p>
     ⍝      <p class="bodytext">they are separated by empty comment lines</p>
     ⍝

      Trim←{(∨\' '≠⍵)/⍵}¨
      FirstCommentBlock←{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}
      SplitOnSpaceLines←{1↓¨⍵⊂⍨⍵∧.=¨' '}
      text←(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI

      r←tag∘#.HtmlUtils.Enclose¨∊¨SplitOnSpaceLines' ',¨⍨' ',⌽¨Trim⌽¨FirstCommentBlock Trim text
    ∇

    ∇ r←what Subst text;names;gv;i;repl;fixL;fixR
      :Access public shared
      r←text
      fixL←'[][{}()?*.+\\^$|]'⎕R'\\\0' ⍝ precede regex metacharacters by \
      fixR←'&' '%' '\\'⎕R'\\\0'        ⍝ add \ to & % \
      :Select ⎕NC⊂'what'
      :Case 9.1 ⍝ namespace
          gv←⍒∊⍴¨names←what.⎕NL ¯2 3 ⍝ variables and functions only, sort so that 'foo' matches before 'fo'
          r←(names[gv]⎕R(fixR¨⍕¨what⍎⍕names[gv]))r
      :Case 2.1 ⍝ substitution pairs
          :If 2=|≡what ⋄ what←,⊂what ⋄ :EndIf
          :If 2≠⍴⍴what ⋄ what←↑what ⋄ :EndIf
          what←,¨what
          r←(fixL¨what[;1])⎕R(fixR¨what[;2])⊢r
      :EndSelect
    ∇

    :endsection

:endclass  ⍝ HtmlElement

:class HtmlElement             ⍝ this is the most basic element of a page

⍝∇:require =\JSON.dyalog

    ⎕io←⎕ml←1

    :field public shared _version←1
    :field public NL←⎕ucs 13 ⍝ 10

    :field public Tag←''      ⍝ this is the element name
    :field public Content←⍬   ⍝ content of the element - a series of strings/instances/class+parms
    :field public Handlers←'' ⍝ array of event handlers
    :field public _PageRef←'' ⍝ reference back to the page instance containing this element
    :field public NoEndTag←0  ⍝ set to 1 if this singleton element (does not have a closing tag)
    :field public Position    ⍝ has position information for this element (if position is set)
    :field public Uses←''     ⍝ resources that will be used by this object (can be overridden by derived classes)

    :field public shared readonly _true←#.JSON.true     ⍝ same definition as in #.JSON
    :field public shared readonly _false←#.JSON.false   ⍝ same definition as in #.JSON

⍝ define shortcuts to namespaces (initialized later)
    :field public shared _html ⍝ reference to base HTML elements namespace
    :field public shared _JQ   ⍝ reference to JQuery/JQueryUI widgets namespace
    :field public shared _SF   ⍝ reference to Syncfusion widgets namespace
    :field public shared _JSS  ⍝ reference to JavaScript Snippets namespace
    :field public shared _DC   ⍝ reference to Dyalog Controls namespace
    :field public shared _     ⍝ reference to namespace that refers to all elements/widgets

   ⍝ make shortcuts for some common HTML attributes
    :field public shared readonly UNDEF←⎕NULL  ⍝ setting for undefined attributes
    :field public id←UNDEF                     ⍝ id attribute for the element
    :field public value←UNDEF                  ⍝ value attribute for the element
    :field public name←UNDEF                   ⍝ name attribute for the element
    :field public class←UNDEF                  ⍝ class attribute for the element
    :field public style←UNDEF                  ⍝ style attribute for the element
    :field public title←UNDEF                  ⍝ title attribute for the element
    :field public type←UNDEF                   ⍝ type attribute for the element

    :field public readonly CommonAttributes←'id' 'value' 'name' 'class' 'style' 'title' 'type' ⍝ element attributes that are directly accessible

    _names←_values←0⍴⊂'' ⍝ used for attributes

    :field public _styles←''

    rand←{?⍵⊣⎕RL←0}

    ∇ r←Version
      :Access public
      r←{⍵,[1.1]{0::¯1 ⋄ ⍵._version}¨⍵}⎕CLASS ⎕THIS
    ∇

    ∇ r←context name
      :Access public shared
      :If 326=⎕DR name ⍝ ref?
          r←⎕RSI{0∊⍴⍺:'' ⋄ 16::''
              ∨/∨/¨(⊂⍵)∊¨(⊃⍺).(⎕CLASS ⎕THIS):⊃⍺
              (1↓⍺)∇ ⍵}name
      :Else
          r←⎕RSI{0∊⍴⍺:''
              ⋄ (⊃⍺){0=⍺.⎕NC⊂⍵:0
                  ⋄ ''≡t←⍺⍎⍵:0
                  ⋄ 1}⍵:⊃⍺
              ⋄ (1↓⍺)∇ ⍵}name
      :EndIf
    ∇

    ∇ r←isChar w
      :Access public shared
      r←0 2∊⍨10|⎕DR w
    ∇

    ∇ r←isNum w
      :Access public shared
      r←2|⎕DR w
    ∇

    ∇ r←isString w
      :Access public shared
      :Select ≡w
      :Case 2
          :If 1=⍴,w
              r←{(isChar ⍵)∧1∊⍴⍴1/⍵}⊃w
          :Else
              r←0
          :EndIf
      :CaseList 0 1
          r←{(isChar ⍵)∧1∊⍴⍴1/⍵}w
      :Else
          r←0
      :EndSelect
    ∇

    ∇ r←quote w
      :Access public
      r←{'"'∊⍵:⍵ ⋄ '"',⍵,'"'}w
    ∇

    ∇ r←isTrue a
      :Access public shared
      →0⍴⍨r←(,1)≡,a       ⍝ boolean
      →0⍴⍨r←#.JSON.true≡a ⍝ namespace
      →0⍴⍨r←'true'≡a      ⍝ string
      →0⍴⍨r←a≡⊂'true'     ⍝ 7161⌶1
    ∇

    ∇ r←isFalse a
      :Access public shared
      →0⍴⍨r←(,0)≡,a        ⍝ boolean
      →0⍴⍨r←#.JSON.false≡a ⍝ namespace
      →0⍴⍨r←'false'≡a      ⍝ string
      →0⍴⍨r←a≡⊂'false'     ⍝ 7161⌶0
    ∇

    ∇ r←a ine w
      :Access public shared
      r←a{0∊⍴⍺:'' ⋄ ⍵}w ⍝ if not empty
    ∇
    errorIf←{⍺←⊢ ⋄ 0≠⍵:⍺ ⎕SIGNAL ⍵}

    :section Attribute Handling

    ∇ r←fixkeys w
      :Access public shared
      r←{2>|≡⍵:,⊂⍵ ⋄ ⍵}w ⍝ Enclose if simple
    ∇

    ∇ SyncAttrs arg
      :Implements Trigger id,name,class,style,title,type,value
      :If ⊃≢/arg.(NewValue OldValue)
          arg.Name Set arg.NewValue~UNDEF
      :EndIf
    ∇

    :property keyed Attrs       ⍝ element attributes
    :access public

        ∇ set ra;i;new;there;names;ind
          there←~new←(⍴_names)<i←_names⍳names←fixkeys⊃ra.Indexers
          (_values _names),←new∘/¨ra.NewValue names
          _values[there/i]←there/ra.NewValue
          :For i :In {⍵/⍳⍴⍵}7≥'id' 'class' 'style' 'title' 'value' 'type' 'name'⍳names
              ⍎(i⊃names),'←i⊃ra.NewValue'
          :EndFor
        ∇

        ∇ r←get ra;i;n
          ⎕SIGNAL(1<⍴i←ra.Indexers)⍴4 ⍝ RANK err
          :If 1↑ra.IndexersSpecified
              r←(_values,⊂'')[_names⍳n←fixkeys⊃⍣(2≤|≡i)+i]
          :Else
              r←↓_names,[1.1]_values
          :EndIf
        ∇
    :endproperty

    ∇ attr←{plain}ParseAttr arg;split;item;t;f;i;eq;nq;items;n
      :Access public shared

⍝ Parse html sttributes
⍝ {plain} - Boolean indicating whether to not interpret a plain first token as an if
⍝ args    - vector of tokens to parse
⍝
⍝     1)    In only the first token, a simple string (i.e. not in the form 'abc=def') without a leading '#' or '.' is treated as an id
⍝        'foo'  > id="foo"
⍝
⍝        In all other positions, a string of this type is treated as a singleton attribute
⍝        'foo' 'goo' 'moo' > id="foo" goo="goo" moo="moo"
⍝
⍝     2)    Single simple string beginning with '#' is an id
⍝        '#foo'  > id="foo"
⍝        'goo=moo' '#foo' > goo="moo" id="foo"
⍝
⍝     3)    Single simple string beginning with '.' is treated as a class
⍝        '.foo'  > class="foo"
⍝        'foo' '.goo' 'moo' > id="foo" class="goo" moo="moo"
⍝
⍝     4)    Attributes must be paired either as in 'foo=goo' or ('foo' 'goo'), if there is a single pair, it must be enclosed
⍝        ⊂'href' '#top'  > href="#top"
⍝
⍝        The value portion of an attribute pair may begin with '#' or '.' without special interpretation
⍝        ('href' '#top') '#foo' > href="#top" id="foo"

      :If 0=⎕NC'plain' ⋄ plain←0 ⋄ :EndIf
      arg←eis,arg
      attr←⍬
      split←{0=⊢/v←∨\(≠\'"'=⍵)<'='=⍵:⍵ ⋄ ((~v)/⍵)({'"'∧.=∊1 ¯1↑¨⊂⍵:¯1↓1↓⍵ ⋄ ⍵}1↓v/⍵)}
      :For i :In ⍳⍴arg
          :Select |≡item←,i⊃arg
          :Case 1
              :If ~0∊⍴item
                  :If ∨/eq←'='=item              ⍝ any '=' (i.e.
                  :AndIf 0≠n←eq+.∧nq←~≠\'"'=item
                      :If n=1
                          attr,←⊂split item
                      :Else
                          attr,←⊃,/1 ParseAttr¨item{⎕ML←3 ⋄ ⍵⊂⍺}nq⍲item=' '
                      :EndIf
                  :ElseIf 3>f←'#.'⍳1↑item
                      attr,←⊂((f⊃'id' 'class')(1↓item))
                  :ElseIf plain<i=1
                      attr,←⊂'id'item
                  :Else
                      attr,←⊂2⍴⊂item
                  :EndIf
              :EndIf
          :Case 2
              attr,←⊂item
          :Else
              ('Invalid attribute specification: ',⍕item)⎕SIGNAL 11
          :EndSelect
      :EndFor
    ∇

    ∇ {r}←{which}Set attr
      :Access public
      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr

          :If 2=⍴,attr  ⍝ 'attr' 'value' is never shorthanded (e.g. given special treatment for id/class)
          :AndIf 1∧.≥≡¨attr
          :AndIf ~∧/'='∊¨attr
              attr←,⊂attr
          :EndIf

          attr←1 ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttribute attr
    ⍝ set attributes, treating

      :If 0≠⎕NC'which' ⋄ attr←↓(eis which),[1.1]eis attr
      :Else
          'Set cannot be called with a scalar ref'⎕SIGNAL 11/⍨(0=≡attr)∧326∊⎕DR attr
          attr←ParseAttr attr
      :EndIf
      :If ~0∊⍴attr
          Attrs[1⊃¨attr]←2⊃¨attr
      :EndIf
      r←⎕THIS
    ∇

    ∇ {r}←{which}SetAttr attr
      :Access public
      :If 0=⎕NC'which' ⋄ r←SetAttribute attr
      :Else ⋄ r←which SetAttribute attr
      :EndIf
    ∇

    ∇ {r}←DelAttr attrname;mask
      :Access public
      attrname←eis attrname
      mask←~_names∊attrname ⋄ (_names _values)←mask∘/¨_names _values
      r←⎕THIS
    ∇

    ∇ r←{proto}GetAttr attrname
      :Access public
      :If 0=⎕NC'proto' ⋄ proto←'' ⋄ :EndIf
      attrname←eis attrname
      :If 1=⍴attrname
          :Trap 3 ⍝ index error
              r←_values⊃⍨_names⍳attrname
          :Else
              r←proto
          :EndTrap
      :Else
          proto∘GetAttr¨attrname
      :EndIf
    ∇

    ∇ r←AddClass c
      :Access public
      :If class≡UNDEF
          class←c
      :Else
          class,←' ',c
      :EndIf
    ∇

    ∇ r←AddStyle s;t
      :Access public
      :If style≡UNDEF
          style←s,(';'=¯1↑s)↓';'
      :Else
          style,←(';'=¯1↑style)↓';',s,(';'=¯1↑s)↓';'
      :EndIf
    ∇

    :EndSection

    :Section Styles

    ∇ {r}←{what}Style styles;msg
      :Access public
      msg←'Invalid style specification'
      :If 0≠⎕NC'what'
          _styles,←↓(eis what),⍪eis((⍕¨)⍣(2|⎕DR styles))styles
      :Else
          :Select ≡styles
          :Case 2
              msg errorIf 11×0≠2|⍴styles
              _styles,←↓(2,⍨0.5×⍴styles)⍴styles
          :Case 3
              msg errorIf 11×~∧/(,2)∘≡∘⍴¨styles
              _styles,←styles
          :Else
              msg ⎕SIGNAL 11
          :EndSelect
      :EndIf
      r←⎕THIS
    ∇

    ∇ r←RenderStyles;style
      r←''
      :If ~0∊⍴_styles
          :For style :In _styles
              r,←∊(⍕¨style),¨':;'
          :EndFor
          r←' style="',r,'" '
      :EndIf
    ∇

    :EndSection

  ⍝ The constructors

  ⍝ The first arg is the Tag, followed by its contents, then its attributes, if present
  ⍝ Note that attributes can be specified with the tag as in
  ⍝  button type="submit"

    :Section Constructors

    ∇ Make0
    ⍝ basic constructor
      :Implements constructor
      :Access public
      Init
    ∇

    ∇ Make1 t    ⍝ this can be any length
    ⍝ t - tag/element name (e.g. 'div' or 'table')
      :Implements constructor
      :Access public
      Tag←t
      Init
    ∇

    ∇ Make2(t arg)
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ arg - content or (content attrs)
      :Implements constructor
      :Access public
      Make2Code(t arg)
    ∇

    ∇ Make2Code(t arg);attr;content;ref
      :If 1=≡t arg                      ⍝ handle 2-character tag (e.g. 'ul' 'tr')
          Tag←t,arg
      :Else
        ⍝ If we have a couple of items, the second of which is
        ⍝ a string or VTV, then we are dealing with attributes:
          :If (1<|≡arg)∧(,2)≡⍴arg
          :AndIf isAttr 2⊃arg
              (content attr)←arg ⋄ SetAttr attr
          :Else
              content←arg
          :EndIf
          Add content
          Tag←t
      :EndIf
      Init
    ∇

    ∇ Make3(t content attr);ref
    ⍝ t - tag/element name (e.g. 'div' or 'table')
    ⍝ content - content
    ⍝ attr - attrs
      :Implements constructor
      :Access public
      :If 1=≡t content attr    ⍝ handle 3-character tag (e.g. 'pre')
          Tag←t,content,attr
      :ElseIf isClass content
          Make2Code t(content attr)
      :Else
          Tag←t
         ⍝ attr could be a ref. This means that it goes in the contents.
          Add content
          :If (0∊⍴attr)⍱ref←isRef attr
              SetAttr attr
          :ElseIf ref
              Add attr
          :EndIf
      :EndIf
      Init
    ∇

    ∇ Init
      (_html _JQ _SF _DC _JSS _)←#.(_html _JQ _SF _DC _JSS _)
      Position←⎕NS''
    ∇

    ∇ SetUse;c
      :Access public overridable
      :If ~0∊⍴Uses
          :Trap 0
              :If ''≡c←_PageRef
                  c←context'_PageRef'
                  :If ~0∊⍴c
                      c←c._PageRef
                  :EndIf
              :EndIf
              :If ~0∊⍴c
                  c.Use Uses
              :EndIf
          :EndTrap
      :EndIf
    ∇

    ∇ Use resource
      :Access public
      :If ~0∊⍴Uses ⋄ Uses←eis Uses ⋄ :EndIf
      Uses,←eis resource
    ∇

    :endsection

    :section Event Handling

    ∇ {handler}←On args;n;i
      :Access public
      args←eis args
      handler←⎕NEW #._JQ.Handler
      handler.(Events Callback ClientData JavaScript Delegates jQueryWrap ScriptWrap Cursor)←args defaultArgs'' 1 '' '' '' 1 1 ¯1
      handler.WidgetRef←⎕THIS
      handler.Page←_PageRef
      :If ¯1=handler.Hourglass ⋄ handler.Hourglass←(,0)≢,handler.Callback ⋄ :EndIf
      :If 0∊n←⍴Handlers
          Handlers,←handler
      :ElseIf n<i←Handlers.Events⍳⊂handler.Events
          Handlers,←handler
      :Else
          Handlers[i]←handler
      :EndIf
    ∇

    ∇ r←RenderHandlers;myid;h
      :Access public ⍝!!! remove this after testing
      r←''
      :If ~0∊⍴Handlers
          :If ∨/0∘∊∘⍴¨Handlers.Selector
              myid←SetId
          :EndIf
          :For h :In Handlers
              :If 0∊⍴h.Selector
                  h.Selector←'#',myid
              :EndIf
              r,←h.Render
          :EndFor
      :EndIf
    ∇
    :endsection

    :section Rendering

⍝ Elements with no End tag (<tag></tag>).

⍝ area base basefont br col frame hr img input isindex link meta param

    ∇ r←a FormatAttr w
      :Access public shared
      r←' ',a,'=',Quote HtmlSafeText,⍕w
    ∇

    ∇ r←Render;av;t;vs;e;h;c;p
      :Access public
    ⍝ Render by first constructing the Tag, complete with attributes, if any
      r←RenderCore Content
      :If ~0∊⍴av←Tag
          h←RenderHandlers
          p←RenderPosition
          :If 0<⍴vs←Attrs[]
              av,←∊FormatAttr/¨vs
          :EndIf
          av,←RenderStyles
          :If (⊂Tag)∊'html' 'body' 'head'
              r←av Enclose r,h,p
          :Else
              r←(av Enclose r),h,p
          :EndIf
      :EndIf
    ∇

    ∇ r←Postrender r
      :Access overridable
    ∇

    ∇ r←RenderCore list;e;t
      :Access public
    ⍝ do the bulk of the rendering work
      r←''
      :For e :In eis list
          :If isInstance⊃e
              r,←e.Render
          :ElseIf isClass⊃e
              r,←(New e).Render
          :Else
              :If 1<⍴⍴t←⍕e
                  t←∊(↓t),¨⊂'<br/>'
              :EndIf
              r,←t
          :EndIf
      :EndFor
    ∇

    ∇ r←HtmlSafeText txt;i;m;u;ucs
      :Access public shared
    ⍝ make text HTML "safe"
      r←,⎕FMT txt
      i←'&<>"#'⍳r
      i-←(i=1)∧1↓(i=5),0 ⍝ mark & that aren't &#
      m←i∊⍳4
      u←127<ucs←⎕UCS r
      (m/r)←('&' '<' '>' '"')[m/i]
      (u/r)←(~∘' ')¨↓'G<&#ZZZ9;>'⎕FMT u/ucs
      r←∊r
    ∇

    ∇ r←RenderPosition
      :Access public
      r←''
      :If ~0∊⍴Position.⎕NL-2
          Uses,←⊂'JQueryUI'
          r←#.JQ.JQueryfn'position'('#',SetId)Position
          SetUse
      :EndIf
    ∇

    :endsection

    :section Utilities

    Bracket←{'<',⍵,'>'}

    ∇ SetInputName
      :Access public
      ⍝ for input element widgets, this will set the name to the id if not already set
      ⍝ or the id to the name if not already set
      :If (⊂name)∊UNDEF''
          :If (⊂id)∊UNDEF''
              SetId
          :EndIf
          name←id
      :ElseIf UNDEF≡id
          id←name
      :EndIf
    ∇

    ∇ r←tag Enclose txt;nl
      :Access public shared
      tag←,tag
      r←(tag{NoEndTag∧0∊⍴⍵:Bracket ⍺,'/' ⋄ (Bracket ⍺),⍵,Bracket'/',⍺↑⍨¯1+⍺⍳' '}txt)
    ∇

    ∇ r←{a}eis w
      :Access public shared
      r←((,∘⊂)⍣((isString w)∧2>|≡w))w ⍝ enclose if simple character
      ⍝r← (,∘⊂)⍣((326∊⎕DR w)<2>|≡w)⊢w ⍝ Enclose if simple
    ∇

    ∇ da←args defaultArgs defaultvalues
      :Access public shared
      da←da,(⍴,da←eis args)↓defaultvalues
    ∇

    ∇ r←Quote a;b
      :Access public shared
      b←1↓<⌿¯1 0⌽'\"'∘.=';',a   ⍝ keep \" as is
      (b/a)←⊂'"'
      r←1⌽'""',∊a
    ∇

    ∇ r←attr ParseArgs args
      :Access public
      :If ~0∊⍴r←args
          :If isClass⊃args
              r←⎕NEW∘{2<⍴,⍵:(⊃⍵)({eis ⍵}(1↓⍵)) ⋄ ⍵}args
              :If 0≠⎕NC⊂'_PageRef'
                  r._PageRef←_PageRef
              :EndIf
              :If ~0∊⍴attr
                  r.SetAttr attr
              :EndIf
          :ElseIf isInstance⊃args
              :If ~0∊⍴attr
                  (⊃args).SetAttr attr
              :EndIf
              r←args
          :Else
              r←args
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Push args;c;cl;attr;elm
      :Access public
      :If ~0∊⍴r←args
          c←Content
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :If isInstance r
              :Trap 4 5 ⍝ rank and length error
                  r.Content,←c
              :Else
                  r.Content,←⊂c
              :EndTrap
              Content←r
          :Else
              Content,⍨←r
          :EndIf
      :EndIf
    ∇

    ∇ {r}←{attr}Add args;cl
    ⍝ add "something" to the Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,←r
          :Else
              Content,←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←{attr}New args;cl
    ⍝ create a new instance
    ⍝ args can be an instance, a class, or just html/text
      :Access public shared
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
      :EndIf
    ∇

    ∇ {r}←{attr}Insert args;cl
    ⍝ add "something" to the beginning of Content
    ⍝ args can be an instance, a class, or just html/text
      :Access public
      r←''
      :If ~0∊⍴∊args
          :If 0=⎕NC'attr' ⋄ attr←'' ⋄ :EndIf
          r←attr ParseArgs args
          :Trap 4 5 ⍝ rank and length error
              Content,⍨←r
          :Else
              Content,⍨←⊂r
          :EndTrap
      :EndIf
    ∇

    ∇ {r}←Last
      :Access public
      r←⊃⌽Content
    ∇

    ∇ r←{ref}isClass ao
      :Access public shared
      →0↓⍨r←9.4∊⎕NC⊂'ao'
      :If 0≠⎕NC'ref'
          r←ref∊∊⎕CLASS ao
      :EndIf
    ∇

    ∇ r←{ref}isInstance ao
      :Access public shared
      →0↓⍨r←9.2∊⎕NC⊂'ao'
      :If 0≠⎕NC'ref'
          r←ref∊∊⎕CLASS ao
      :EndIf
    ∇

    ∇ r←isRef obj
      :Access public shared
      r←9∊⎕NC'obj'
    ∇

    ∇ r←isWidget obj
      :Access public shared
      →0↓⍨r←9.2∊⎕NC⊂'obj'
      r←#._JQ._jqWidget∊∊⎕CLASS obj
    ∇

    isattr←{isString ⍵:1 ⋄ isRef ⍵:0 ⋄ ∧/∇¨⍵}

    ∇ r←isAttr obj
      :Access public shared
      r←isattr obj
    ∇

    ∇ r←renderIt It
      :Access public shared
      r←{
          0∊⍴⍵:''
          326=⎕DR ⍵:{
              isString ⍵:∊⍵
              2≤|≡⊃⍵:{
                  isClass⊃⊃⍵:((New⊃⍵).Render),renderIt 1↓⍵
                  ,⍕⍵
              }⍵
              isInstance⊃⍵:((⊃⍵).Render),renderIt 1↓⍵
              isClass⊃⍵:((⎕NEW(⊃⍵)).Render),renderIt 1↓⍵
              isChar⊃⍵:(⊃⍵),renderIt 1↓⍵
              (,⍕⊃⍵),renderIt 1↓⍵}⍵
          ,⍕⍵}It
    ∇

    ∇ r←isHtmlElement ao
      :Access public shared
      :Trap r←0
          r←⊃∨/#.HtmlElement=⎕CLASS ao
      :EndTrap
    ∇

    ∇ r←Parse string;b;s
    ⍝ Separate each section of name="..."
      :Access public
      string←(b⍲1⌽b←' '=s)/s←' ',string
      b←(' '=string)>≠\'"'=string
      r←1↓¨b⊂string ⍝ each pair
      s←r⍳¨'='      ⍝ each is separated by =
      r←s{(¯1↓⍺↑⍵)(1↓¯1↓⍺↓⍵)}¨r
    ∇

    ∇ r←GenId
      :Access public shared
      r←'id',⍕rand ¯1+2*31
    ∇

    ∇ {myid}←SetId
      :Access public
      :If UNDEF≡myid←id
          :If ''≡myid←⊃Attrs[⊂'id']
              id←myid←GenId
          :Else
              id←myid
          :EndIf
      :EndIf
    ∇

    dtlb←{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}

    ∇ r←ScriptFollows
      :Access public shared
      r←2↓∊(⎕UCS 13 10)∘,¨Follows
    ∇

    ∇ r←Follows;n
      :Access public shared
      n←⎕XSI{1++/∧\⍵∘≡¨(⊃⍴⍵)↑¨⍺}(⍕⎕THIS),'.'
      r←{⍵/⍨'⍝'≠⊃¨⍵}{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}{⍵{((∨\⍵)∧⌽∨\⌽⍵)/⍺}' '≠⍵}¨(1+n⊃⎕LC)↓↓(180⌶)n⊃⎕XSI
    ∇

    ∇ r←MarkdownFollows
      :Access public shared
      r←⊃#.MarkAPL.Markdown2HTML Follows
    ∇

    ∇ r←CodeFollows;n
      :Access public shared
      n←⎕XSI{1++/∧\⍵∘≡¨(⊃⍴⍵)↑¨⍺}(⍕⎕THIS),'.'
      r←2↓∊(⎕UCS 13 10)∘,¨{¯1↓⍵/⍨∨\⌽<\∨/¨'⍝<<end>>'∘⍷¨⍵}(1+n⊃⎕LC)↓↓(180⌶)2⊃⎕XSI
      r←'<pre style="font-family:APL385 Unicode">',r,'</pre>'
    ∇

    ∇ r←WrapFollowing tag;text;SplitOnSpaceLines;Trim;FirstCommentBlock
      :Access public shared

     ⍝ USAGE:
     ⍝
     ⍝      Add WrapFollowing 'p class="bodytext"'
     ⍝      ⍝ paragraph may span
     ⍝      ⍝ several lines
     ⍝      ⍝
     ⍝      ⍝ they are separated by empty comment lines
     ⍝
     ⍝ RESULT:
     ⍝
     ⍝      <p class="bodytext">paragraph may span several lines</p>
     ⍝      <p class="bodytext">they are separated by empty comment lines</p>
     ⍝

      Trim←{(∨\' '≠⍵)/⍵}¨
      FirstCommentBlock←{1↓¨⍵/⍨∧\'⍝'=⊃¨⍵}
      SplitOnSpaceLines←{1↓¨⍵⊂⍨⍵∧.=¨' '}
      text←(1+2⊃⎕LC)↓↓(⊃⊃⎕CLASS 1⊃⎕RSI).(180⌶)2⊃⎕SI

      r←tag∘#.HtmlUtils.Enclose¨∊¨SplitOnSpaceLines' ',¨⍨' ',⌽¨Trim⌽¨FirstCommentBlock Trim text
    ∇

    ∇ r←what Subst text;names;gv;i;repl;fixL;fixR
      :Access public shared
      r←text
      fixL←'[][{}()?*.+\\^$|]'⎕R'\\\0' ⍝ precede regex metacharacters by \
      fixR←'&' '%' '\\'⎕R'\\\0'        ⍝ add \ to & % \
      :Select ⎕NC⊂'what'
      :Case 9.1 ⍝ namespace
          gv←⍒∊⍴¨names←what.⎕NL ¯2 3 ⍝ variables and functions only, sort so that 'foo' matches before 'fo'
          r←(names[gv]⎕R(fixR¨⍕¨what⍎⍕names[gv]))r
      :Case 2.1 ⍝ substitution pairs
          :If 2=|≡what ⋄ what←,⊂what ⋄ :EndIf
          :If 2≠⍴⍴what ⋄ what←↑what ⋄ :EndIf
          what←,¨what
          r←(fixL¨what[;1])⎕R(fixR¨what[;2])⊢r
      :EndSelect
    ∇

    :endsection

:endclass  ⍝ HtmlElement