├── README.md
├── LICENSE
├── Parallel
    ├── README.md
    ├── IIX.dyalog
    └── IIPageStats.dyalog
└── HTMLRenderer
    └── WebSocketSample.dyalog


/README.md:
--------------------------------------------------------------------------------
1 | Samples
2 | =======
3 | 
4 | This repository contains code samples and templates that are referenced by Dyalog documentation, web pages and blogs, etc.
5 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | MIT License
 2 | 
 3 | Copyright (c) 2020 Dyalog Ltd.
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.
22 | 


--------------------------------------------------------------------------------
/Parallel/README.md:
--------------------------------------------------------------------------------
 1 | Dyalog/Samples/Parallel
 2 | =======================
 3 | 
 4 | This folder contains code samples which illustrate the use of Futures and Isolates.
 5 | 
 6 | File              |Fn/Op/etc  |Comments             |
 7 | ------------------|-----------|---------------------|
 8 | IIX.dyalog        |PEACH      |Cover for IÏX which optimises use of isolates and optionally displays a progress bar|
 9 | IIPageStats.Dyalog|Report     |Example which uses IIX.PEACH to analyse a large number of web pages|
10 | 
11 | IIX.PEACH
12 | ---------
13 | `[left] (function[[callback][cblarg]] IIX.PEACH isolates) right`
14 | 
15 | Compared to the standard `IÏX` operator, `IIX.PEACH` provides functionality similar to that provided by the old `PEACH` operator from the experimental "parallel" workspace:
16 | 
17 | 1. Instead of creating a new isolate for each function call, `IIX.PEACH` [re]uses a set of isolates, feeding each one another function call when it completes the preceeding one.
18 | 2. An optional callback function can be provided, it will be called each time a new function call is dispatched.
19 | 3. A default callback mechanism is provided, which displays a form with progress bars.
20 | 
21 | Arg/Operand   | Example      | Description          |
22 | --------------|--------------|----------------------|
23 | left, right   |              | operand arguments.    |
24 | function      | 'foo'        | Must be a quoted character vector.
25 | callback      | 'cb'         | Right argument will be a count of calls completed per isolate, plus the total number of calls started. Pass an empty vector ('') to get the progress form. The callback function should return 0 if all is OK, or 1 to abort the current process. The default version returns 1 if the progress form is closed.|
26 | cblarg        | 'Hello'   | Optional left argument to the callback function. If you use the default progress form, the value will be used as the caption.|
27 | isolates      | ''<br>ns<br>isolates           | Empty vector to create (≢processors) empty isolates<br>Scalar namespace to create (≢processors) clones of ns<br>or: a Vector of pre-created isolates|
28 | 
29 | IIPageStats.Report
30 | ------------------
31 | The "Report" function is intended as a simple but realistic example of the use of isolates via IIX.PEACH: The function takes a 2-letter US state code as the right argument, and returns a 2-column matrix with letter frequency counts from the front page of all major newspapers in that state. For example:
32 | ```
33 |       IIPageStats.Report 'al'
34 |  E 94540   
35 |  T 73232   
36 |  A 66385   
37 | ...down to...
38 |  J  4225   
39 |  Q  2216   
40 |  Z  1143   
41 | ```
42 | 
43 | The function uses The US Newspaper List (http://USNPL-com) to find a list of major newspapers in the state named in the right argument. It then uses IIX.PEACH to process the the newspapers in parallel, using the default progress dialog so that you can track the progress visually.
44 | 
45 | An optional left argument allows you to set the number of isolates to use. Since these tasks ar highly I/O bound, it can be advantageous to run with a much higher number of isolates than the number of cores that is available on the machine - try 10 or 20, for example.
46 | 
47 | > Written with [StackEdit](https://stackedit.io/).
48 | 


--------------------------------------------------------------------------------
/Parallel/IIX.dyalog:
--------------------------------------------------------------------------------
 1 | :Namespace IIX
 2 | ⍝ Parallel Extensions.
 3 |         
 4 |     ∇ r←{left}(fns PEACH iss)right;dyadic;fn;cb;n;counts;shape;ni;i;count;done;failed;next;run1iso;callbk;expr;z;PF;cblarg;cancelled
 5 |     ⍝ IÏ using persistent Isolates:
 6 |     ⍝
 7 |     ⍝ iss is a list of refs to pre-existing isolates to use
 8 |     ⍝     or if scalar, processors×processes clones will be made
 9 |     ⍝
10 |     ⍝ fns is either:
11 |     ⍝     a simple char vec name of function expected to be in supplied isolates
12 |     ⍝     a nested vec of two fn names, in which case 2nd name is a progress callback
13 |     ⍝     use empty callback fn for default display
14 |      
15 |       :If dyadic←2=⎕NC'left' ⍝ Scalar extension
16 |           :If 1=×/⍴left ⋄ left←(⍴right)⍴left
17 |           :ElseIf 1=×/⍴right ⋄ right←(⍴left)⍴right
18 |           :EndIf
19 |       :EndIf
20 |      
21 |       :If 0=≢iss ⋄ iss←⊂'' ⋄ :EndIf
22 |       :If 0=⍴⍴iss ⍝ If scalar, clone
23 |           iss←#.isolate.{New¨(×/Config¨'processors' 'processes')⍴⍵}iss
24 |       :EndIf
25 |      
26 |       :If 2=≡fns ⍝ We have a callback function
27 |           (fn cb cblarg)←3↑fns,'' ''
28 |           cblarg,←(0=≢cblarg)/'IIX.PEACH Progress - ',fn,' (',(⍕×/⍴right),')'
29 |           :If 0=⍴cb  ⍝ Default Progress Form
30 |               :If PEACHForm cblarg(≢iss)(×/⍴right)
31 |                   cb←'PEACHUpdate'
32 |               :EndIf
33 |           :EndIf ⍝ Default
34 |       :Else ⋄ fn←fns ⋄ cb←'⊣' ⋄ :EndIf
35 |      
36 |       callbk←⍎cb
37 |      
38 |       ni←≢iss
39 |       shape←⍴right
40 |       n←⍴right←,right ⋄ :If dyadic ⋄ left←,left ⋄ :EndIf
41 |       counts←ni⍴0 ⋄ done←failed←n⍴count←0
42 |       r←n⍴⎕NULL
43 |      
44 |       run1iso←{⍝ drive isolate ⍵ until we are done
45 |           n<next←⎕THIS.(count←count+1):0 ⍝ no more to do
46 |           r[next]←⊂⍎expr
47 |           counts[⍺]+←1
48 |           z←{0::failed[⍵]←1 ⋄ done[⍵]←1⊣+r[⍵]}next ⍝ Reference it
49 |           cblarg callbk counts,count⌊n:''⊣⎕THIS.cancelled←1
50 |           ⍺ ∇ ⍵    ⍝ loop until done
51 |       }
52 |      
53 |       expr←(dyadic/'(next⊃left) '),'⍵.{',(dyadic/'⍺ '),fn,'⍵} next⊃right'
54 |       cancelled←0
55 |       :If 1=≢iss ⍝ Only one: do it in main thread
56 |           z←1 run1iso⊃iss
57 |       :Else
58 |           z←⎕TSYNC(⍳ni)run1iso&¨iss
59 |       :EndIf
60 |       ⎕SIGNAL cancelled/6
61 |     ∇
62 |               
63 |     ∇ r←PEACHForm(caption nprocs nitems);p;labels;pos;pb;n
64 |     ⍝ Make a progress form with a progress bar per process and one for the total
65 |      
66 |       :Trap 0
67 |           r←1⊣'PF'⎕WC'Form'caption('Coord' 'Pixel')('Size'((40+25×nprocs)800))('Border' 3)
68 |       :Else ⋄ →r←0 ⍝ Unable to create a form
69 |       :EndTrap
70 |       PF.texts←PF.bars←(1+nprocs)⍴PF
71 |       labels←({'Isolate ',⍕⍵}¨⍳nprocs),⊂'Started'
72 |      
73 |       :For p :In ⍳1+nprocs
74 |           pos←10+25×p-1
75 |           ('PF.L',⍕p)⎕WC'Label'(p⊃labels)(pos 20)(⍬ 60)
76 |           (n←'PF.T',⍕p)⎕WC'Label' '0'(pos 70)(⍬ 30)('justify' 'right')
77 |           PF.texts[p]←⍎n
78 |           (n←'PF.PB',⍕p)⎕WC'ProgressBar'((pos+3)110)(⍬ 655)('Limits'(0 nitems))
79 |           PF.bars[p]←⍎n
80 |       :EndFor
81 |       2 ⎕NQ'.' 'Flush'
82 |     ∇
83 | 
84 |     ∇ {abort}←cap PEACHUpdate arg
85 |       :Trap abort←0
86 |           PF.texts.Caption←⍕¨arg
87 |           PF.bars.Thumb←arg
88 |       :Else
89 |           abort←1 ⍝ User killed the GUI
90 |       :EndTrap
91 |     ∇
92 | 
93 | :EndNamespace


--------------------------------------------------------------------------------
/HTMLRenderer/WebSocketSample.dyalog:
--------------------------------------------------------------------------------
  1 |  resp←WebSocketSample args;title;html;obj;ev;wsid;url;data;type;fin;reason;code;fn;show;⎕ML;⎕IO
  2 |      ⍝ general websocket test framework
  3 |      ⍝ use this function in conjunction with ∇Send
  4 |  ⎕ML←⎕IO←1
  5 |  show←{n←' '(≠⊆⊢)⍺ ⋄ n,⍪{len←≢⍵ ⋄ ↑⍕{⍵⊆⍨~⍵∊⎕UCS 13 10}{(⍕len),'⍴',(200↑⍵),'...'}⍣(200<len)⊢⍵}∘⍕¨(≢n)↑⍵}
  6 | StartHTML:→EndHTML
  7 |      ⍝  <!DOCTYPE html>
  8 |      ⍝  <html>
  9 |      ⍝  <head>
 10 |      ⍝  <meta charset="utf-8" />
 11 |      ⍝  <title>WebSocket Sample</title>
 12 |      ⍝  <script>
 13 |      ⍝
 14 |      ⍝  var wsroot = "ws://dyalog_root/";
 15 |      ⍝  var ws1;
 16 |      ⍝
 17 |      ⍝  function init()
 18 |      ⍝  {
 19 |      ⍝    output = document.getElementById("output");
 20 |      ⍝    instructions = document.getElementById("instructions");
 21 |      ⍝    doOpen(wsroot);
 22 |      ⍝  }
 23 |      ⍝
 24 |      ⍝  function doOpen(root){
 25 |      ⍝    ws1 = new WebSocket(root);
 26 |      ⍝    ws1.onopen = function(evt) { onOpen(evt) };
 27 |      ⍝    ws1.onclose = function(evt) { onClose(evt) };
 28 |      ⍝    ws1.onmessage = function(evt) { onMessage(evt) };
 29 |      ⍝    ws1.onerror = function(evt) { onError(evt) };
 30 |      ⍝  }
 31 |      ⍝
 32 |      ⍝  function doRecycle(){
 33 |      ⍝    try {
 34 |      ⍝      doClose();
 35 |      ⍝    }
 36 |      ⍝    catch(err) {
 37 |      ⍝      writeToScreen(err.message);
 38 |      ⍝    }
 39 |      ⍝    doOpen(wsroot);
 40 |      ⍝  }
 41 |      ⍝
 42 |      ⍝  function onOpen(evt)
 43 |      ⍝  {
 44 |      ⍝    writeToScreen("Opening websocket");
 45 |      ⍝  }
 46 |      ⍝
 47 |      ⍝  function onClose(evt)
 48 |      ⍝  {
 49 |      ⍝    writeToScreen("Websocket closed");
 50 |      ⍝  }
 51 |      ⍝
 52 |      ⍝  function doClose()
 53 |      ⍝  {
 54 |      ⍝    writeToScreen("Closing websocket");
 55 |      ⍝    ws1.close(1000, "Bye Bye");
 56 |      ⍝  }
 57 |      ⍝
 58 |      ⍝  function onMessage(evt)
 59 |      ⍝  {
 60 |      ⍝    writeToScreen('<span style="color: blue;">Received: </span>' + evt.data);
 61 |      ⍝  }
 62 |      ⍝
 63 |      ⍝  function onError(evt)
 64 |      ⍝  {
 65 |      ⍝    writeToScreen('<span style="color: red;">ERROR: </span>' + evt.data);
 66 |      ⍝  }
 67 |      ⍝
 68 |      ⍝  function doSend(message)
 69 |      ⍝  {
 70 |      ⍝    if (ws1===undefined){
 71 |      ⍝      alert("Open the WebSocket first please");
 72 |      ⍝    }
 73 |      ⍝    else {
 74 |      ⍝      ws1.send(message);
 75 |      ⍝      writeToScreen('<span style="color: green;">Sent: </span>' + message);
 76 |      ⍝    }
 77 |      ⍝  }
 78 |      ⍝
 79 |      ⍝  function writeToScreen(message){
 80 |      ⍝    var pre = document.createElement("div");
 81 |      ⍝    pre.innerHTML = now() + " " +message;
 82 |      ⍝    output.appendChild(pre);
 83 |      ⍝    pre.scrollIntoView();
 84 |      ⍝  }
 85 |      ⍝
 86 |      ⍝  function sendChar()
 87 |      ⍝  {
 88 |      ⍝    var msg = document.getElementById("inp").value;
 89 |      ⍝    doSend(msg);
 90 |      ⍝  }
 91 |      ⍝
 92 |      ⍝  toggle = () => {
 93 |      ⍝    instructions.style.display = (instructions.style.display !=="none") ? "none" : "block";
 94 |      ⍝    output.style.display = (output.style.display ==="none") ? "block" : "none";
 95 |      ⍝  }
 96 |      ⍝
 97 |      ⍝  now = () =>{
 98 |      ⍝    var d = new Date();
 99 |      ⍝    return d.getUTCFullYear()+'-'+zpad(2,1+d.getUTCMonth())+'-'+zpad(2,d.getUTCDate())+' '+zpad(2,d.getUTCHours())+':'+zpad(2,d.getUTCMinutes())+':'+zpad(2,d.getUTCSeconds())+'.'+zpad(3,d.getUTCMilliseconds());
100 |      ⍝  }
101 |      ⍝
102 |      ⍝  zpad = (n,str) =>{ return ("0".repeat(n)+str).substr(-n,n) }
103 |      ⍝
104 |      ⍝  // window.addEventListener("load", init, false);
105 |      ⍝
106 |      ⍝  </script>
107 |      ⍝  <style>
108 |      ⍝  body,html{padding:0px 10px;margin:0;}
109 |      ⍝  #outer{display:flex;flex-direction:column;height:95vh;}
110 |      ⍝  .div{padding:2px 10px;border:solid 1px;margin-top:5px;}
111 |      ⍝  #output{flex:1;overflow:auto;min-height:0px;}
112 |      ⍝  .lbutt{margin-right:5px;}
113 |      ⍝  .rbutt{float:right;margin-right:5px;}
114 |      ⍝  a{margin-right:5px;}
115 |      ⍝  </style>
116 |      ⍝  </head>
117 |      ⍝
118 |      ⍝  <body>
119 |      ⍝  <div id="outer">
120 |      ⍝  <h2>WebSocket Sample</h2>
121 |      ⍝
122 |      ⍝  <div>
123 |      ⍝  <button class='lbutt' type="button" onclick="doOpen(wsroot)">Open</button>
124 |      ⍝  <button class='lbutt' type="button" onclick="sendChar()">Send</button>
125 |      ⍝  <button class='lbutt' type="button" onclick="doClose()">Close</button>
126 |      ⍝  <button class='rbutt' type="button" onclick="output.innerHTML='';">Clear Log</button>&nbsp;&nbsp;
127 |      ⍝  <button class='rbutt' type="button" onclick="toggle('instructions')">Toggle Instructions</button>&nbsp;&nbsp;
128 |      ⍝  </div>
129 |      ⍝  <div><input type="text" style="width:100%;" id="inp"/></div>
130 |      ⍝  <div id="instructions" class="div" style="display:none;">
131 |      ⍝  <pre>
132 |      ⍝
133 |      ⍝  Click "Open" to create the WebSocket.
134 |      ⍝  To send to APL, type something in the input area and click "Send"
135 |      ⍝  To send from APL, in the APL session, use the "Send" function
136 |      ⍝       Send 'this is a test!'
137 |      ⍝
138 |      ⍝  </pre>
139 |      ⍝  </div>
140 |      ⍝
141 |      ⍝  <div id="output" class="flex div"></div>
142 |      ⍝  </div>
143 |      ⍝  </body>
144 |      ⍝  </html>
145 | EndHTML:
146 |  html←'HTML'(1↓∊(⎕UCS 13),¨{⍵↓⍨⍵⍳'⍝'}¨StartHTML↓EndHTML↑⎕NR fn←⊃⎕XSI)
147 |  :If 0∊⍴args
148 |      'hr'⎕WC'HTMLRenderer'html('Event' 'All'fn)('InterceptedURLs'(1 2⍴'ws://dyalog_root/' 1))
149 |      hr.ShowDevTools 1
150 |  :Else
151 |      :Select 2⊃args
152 |      :Case 'WebSocketUpgrade'
153 |          ⎕←'obj ev wsid url hdr auto'show args
154 |          (obj ev wsid url)←4↑args
155 |          resp←args
156 | StartCode:→EndCode
157 |      ⍝         Send parms;msg;type;segs
158 |      ⍝         ⍝ send data to currently open HTMLRenderer/websocket
159 |      ⍝         ⍝ parms [1] msg [2] datatype (1-text, 2-bin)
160 |      ⍝         (msg type)←''  0{(≢⍺)↑⍵,(≢⍵)↓⍺},⊆parms
161 |      ⍝         2 ⎕NQ _hr 'WebSocketSend' _wsid msg 1 ((1+type=0)⊃type,1+(⎕DR'')≠⎕DR msg)
162 | EndCode: ' function defined',⍨⎕FX('_hr' '_wsid'⎕R('''',obj,'''')('''',wsid,'''')){⍵↓⍨⍵⍳'⍝'}¨(1+StartCode)↓EndCode↑⎕NR fn
163 | 
164 |      :Case 'WebSocketReceive'
165 |          ⎕←'obj ev wsid data type fin'show args
166 |          (obj ev wsid data type fin)←args
167 | 
168 |      :Case 'WebSocketClose'
169 |          ⎕←'obj ev wsid code reason'show args
170 |          (obj ev wsid code reason)←args
171 | 
172 |      :Case 'WebSocketError'
173 |          ⎕←'obj ev wsid'show args
174 |      :EndSelect
175 |  :EndIf
176 | 


--------------------------------------------------------------------------------
/Parallel/IIPageStats.dyalog:
--------------------------------------------------------------------------------
  1 | :Namespace IIPageStats
  2 | ⍝ Future/Isolate code sample, using #.IIX.PEACH    
  3 | ⍝   Report 'al' 
  4 | ⍝   ... to get a letter frequency count for home pages of newspapers in Alabama
  5 | 
  6 |     (⎕IO ⎕ML)←1
  7 |     alphabet←'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'  
  8 |     
  9 |     ∇ freq←{nprocs}Report state;pages;html;cap;PF;AI3;iss
 10 |       AI3←⎕AI[3]
 11 |      
 12 |       :If 0=⎕NC'nprocs' ⋄ nprocs←#.isolate.Config'processors' ⋄ :EndIf ⍝ Default to use all processors
 13 |       iss←#.ø¨nprocs⍴⎕THIS ⍝ Make isolates
 14 |      
 15 |       pages←PapersInState state
 16 |       cap←'Processing ',(⍕≢pages),' major papers in state "',state,'"'
 17 |       freq←('CountPageChars' ''cap #.IIX.PEACH iss)pages
 18 |       freq←⊃+/freq
 19 |       freq←(26↑alphabet),⍪+⌿2 26⍴freq
 20 |       freq←freq[⍒freq[;2];]
 21 |      
 22 |       ⎕←'Elapsed seconds for ',state,': ',1⍕⎕AI[3]-AI3
 23 |     ∇
 24 | 
 25 |     ∇ pages←PapersInState state;text;ignore;txt
 26 |      ⍝ Retrieve list of home pages of major newspapers in named state
 27 |      ⍝ Thanks to USNPL.com - the US NewsPaper List
 28 |      
 29 |       text←GetPage'http://www.usnpl.com/',state,'news.php'
 30 |      
 31 |       ⍝ ↓↓↓ extract the body containing newpaper page links
 32 |       txt←(('for address downloads.'⍷text)⍳1)↓text
 33 |       txt←(5+('</div>'⍷txt)⍳1)↓txt
 34 |       txt←(¯1+('</body>'⍷txt)⍳1)↑txt
 35 |      
 36 |       pages←('(<a href=")(.*?)(.com/">)'⎕S'\2.com/')txt      ⍝ All href's to a .com
 37 |     ∇
 38 | 
 39 |     ∇ r←CountPageChars url;text;html
 40 |       ⍝ Return letter frequency count for a URL
 41 |      
 42 |       html←{0::'' ⋄ GetPage ⍵}url
 43 |       text←('<.*?>'⎕R'')html     ⍝ Remove all (well, lots of) HTML tags
 44 |       text←(text∊alphabet)/text  ⍝ Remove all irrelevant chars
 45 |       r←¯1+{≢⍵}⌸alphabet,text    ⍝ Frequency count
 46 |     ∇
 47 | 
 48 |     :Section HTTP Tools
 49 | 
 50 |     ∇ r←GetPage url;headers;rc;z
 51 |     ⍝ Get an HTTP page - throw any errors using ⎕SIGNAL
 52 |       →(0=1⊃(rc headers r)←3↑z←HTTPGet url)⍴0
 53 |       (⍕z)⎕SIGNAL 11
 54 |     ∇
 55 | 
 56 |     ∇ r←{certs}HTTPGet url;U;DRC;protocol;wr;key;flags;pars;secure;data;z;header;datalen;host;port;done;cmd;b;page;auth;p;x509;priority;err;req;fromutf8;chunked;chunk;h2d;buffer;chunklength;len;getchunklen;m;split;NL;ws
 57 |      ⍝ Copied from CONGA workspace Samples namespace
 58 |      ⍝ Get an HTTP page, format [HTTP[S]://][user:pass@]url[:port][/page]
 59 |      ⍝ Opional Left argument: PublicCert PrivateKey SSLValidation
 60 |      ⍝ Makes secure connection if left arg provided or URL begins with https:
 61 |      
 62 |      ⍝ Result: (return code) (HTTP headers) (HTTP body) [PeerCert if secure]
 63 |      
 64 |       ⍝ ↓↓↓ This is not in the original CONGA sample
 65 |       ⍝ ↓↓↓ Replace when CONGA sample updated
 66 |       :If 0∊m←#.⎕NC z←'HTTPUtils' 'DRC'
 67 |           ws←(2 ⎕NQ'.' 'GetEnvironment' 'dyalog'),'/WS/conga'
 68 |           (↑(m=0)/z)#.⎕CY ws
 69 |       :EndIf
 70 |      
 71 |       (U DRC)←#.(HTTPUtils DRC) ⍝ Uses utils from here
 72 |       fromutf8←{0::(⎕AV,'?')[⎕AVU⍳⍵] ⋄ 'UTF-8'⎕UCS ⍵} ⍝ Turn raw UTF-8 input into text
 73 |       h2d←{⎕IO←0 ⋄ 16⊥'0123456789abcdef'⍳U.lc ⍵} ⍝ hex to decimal
 74 |       getchunklen←{¯1=len←¯1+⊃(NL⍷⍵)/⍳⍴⍵:¯1 ¯1 ⋄ chunklen←h2d len↑⍵ ⋄ (⍴⍵)<len+chunklen+4:¯1 ¯1 ⋄ len chunklen}
 75 |       split←{(p↑⍵)((p←¯1+⍵⍳⍺)↓⍵)}
 76 |       NL←⎕UCS 13 10
 77 |      
 78 |       {}DRC.Init''
 79 |      
 80 |      GET:
 81 |       p←(∨/b)×1+(b←'//'⍷url)⍳1
 82 |       secure←{6::⍵ ⋄ ⍵∨0<⍴certs}(U.lc(p-2)↑url)≡'https:'
 83 |       port←(1+secure)⊃80 443 ⍝ Default HTTP/HTTPS port
 84 |       url←p↓url              ⍝ Remove HTTP[s]:// if present
 85 |       host page←'/'split url,(~'/'∊url)/'/'    ⍝ Extract host and page from url
 86 |      
 87 |       :If 0=⎕NC'certs' ⋄ certs←'' ⋄ :EndIf
 88 |      
 89 |       :If secure
 90 |           x509 flags priority←3↑certs,(⍴,certs)↓(⎕NEW ##.DRC.X509Cert)32 'NORMAL:!CTYPE-OPENPGP'  ⍝ 32=Do not validate Certs
 91 |           pars←('x509'x509)('SSLValidation'flags)('Priority'priority)
 92 |       :Else ⋄ pars←''
 93 |       :EndIf
 94 |      
 95 |       :If '@'∊host ⍝ Handle user:password@host...
 96 |           auth←NL,'Authorization: Basic ',(U.Encode(¯1+p←host⍳'@')↑host)
 97 |           host←p↓host
 98 |       :Else ⋄ auth←''
 99 |       :EndIf
100 |      
101 |       host port←port U.HostPort host ⍝ Check for override of port number
102 |      
103 |       req←'GET ',page,' HTTP/1.1',NL,'Host: ',host,NL,'User-Agent: Dyalog/Conga',NL,'Accept: */*',auth,NL ⍝ build the request
104 |      
105 |       :If DRC.flate.IsAvailable ⍝ if compression is available
106 |           req,←'Accept-Encoding: deflate',NL ⍝ indicate we can accept it
107 |       :EndIf
108 |      
109 |       :If 0=⊃(err cmd)←2↑r←DRC.Clt''host port'Text' 100000,pars ⍝ 100,000 is max receive buffer size
110 |       :AndIf 0=⊃r←DRC.Send cmd(req,NL)
111 |      
112 |           chunked chunk buffer chunklength←0 '' '' 0
113 |           done data datalen header←0 ⍬ 0(0 ⍬)
114 |           :Repeat
115 |               :If ~done←0≠1⊃wr←DRC.Wait cmd 5000            ⍝ Wait up to 5 secs
116 |                   :If wr[3]∊'Block' 'BlockLast'             ⍝ If we got some data
117 |                       :If chunked
118 |                           chunk←4⊃wr
119 |                       :ElseIf 0<⍴data,←4⊃wr
120 |                       :AndIf 0=1⊃header
121 |                           header←U.DecodeHeader data
122 |                           :If 0<1⊃header
123 |                               data←(1⊃header)↓data
124 |                               :If chunked←∨/'chunked'⍷(2⊃header)U.GetValue'Transfer-Encoding' ''
125 |                                   chunk←data
126 |                                   data←''
127 |                               :Else
128 |                                   datalen←⊃((2⊃header)U.GetValue'Content-Length' 'Numeric'),¯1 ⍝ ¯1 if no content length not specified
129 |                               :EndIf
130 |                           :EndIf
131 |                       :EndIf
132 |                   :Else
133 |                       ⎕←wr ⍝ Error?
134 |                       ∘∘∘
135 |                   :EndIf
136 |                   :If chunked
137 |                       buffer,←chunk
138 |                       :While done<¯1≠⊃(len chunklength)←getchunklen buffer
139 |                           :If (⍴buffer)≥4+len+chunklength
140 |                               data,←chunklength↑(len+2)↓buffer
141 |                               buffer←(chunklength+len+4)↓buffer
142 |                               :If done←0=chunklength ⍝ chunked transfer can add headers at the end of the transmission
143 |                                   header[2]←⊂(2⊃header)⍪2⊃U.DecodeHeader buffer
144 |                               :EndIf
145 |                           :EndIf
146 |                       :EndWhile
147 |                   :Else
148 |                       done←done∨'BlockLast'≡3⊃wr                        ⍝ Done if socket was closed
149 |                       :If datalen>0
150 |                           done←done∨datalen≤⍴data ⍝ ... or if declared amount of data rcvd
151 |                       :Else
152 |                           done←done∨(∨/'</html>'⍷data)∨(∨/'</HTML>'⍷data)
153 |                       :EndIf
154 |                   :EndIf
155 |               :EndIf
156 |           :Until done
157 |      
158 |           :Trap 0 ⍝ If any errors occur, abandon conversion
159 |               :If ∨/'deflate'⍷(2⊃header)U.GetValue'content-encoding' '' ⍝ was the response compressed?
160 |                   data←fromutf8 DRC.flate.Inflate 120 156,256|83 ⎕DR data ⍝ append 120 156 signature because web servers strip it out due to IE
161 |               :ElseIf ∨/'charset=utf-8'⍷(2⊃header)U.GetValue'content-type' ''
162 |                   data←'UTF-8'⎕UCS ⎕UCS data ⍝ Convert from UTF-8
163 |               :EndIf
164 |           :EndTrap
165 |      
166 |           :If {(⍵[3]∊'12357')∧'30 '≡⍵[1 2 4]}4↑{⍵↓⍨⍵⍳' '}(⊂1 1)⊃2⊃header ⍝ redirected? (HTTP status codes 301, 302, 303, 305, 307)
167 |               →GET⍴⍨0<⍴url←'location'{(⍵[;1]⍳⊂⍺)⊃⍵[;2],⊂''}2⊃header ⍝ use the "location" header field for the URL
168 |           :EndIf
169 |      
170 |           r←(1⊃wr)(2⊃header)data
171 |      
172 |           :If secure ⋄ r←r,⊂DRC.GetProp cmd'PeerCert' ⋄ :EndIf
173 |       :Else
174 |           'Connection failed ',,⍕r
175 |       :EndIf
176 |      
177 |       z←DRC.Close cmd
178 |     ∇
179 | 
180 |     :EndSection ⍝ HTTP Tools
181 | 
182 | :EndNamespace 


--------------------------------------------------------------------------------