1. my class IO::CatHandle is IO::Handle {
2. has $!handles;
3. has $!active-handle is default(Nil);
5. has $.chomp is rw;
6. has $.nl-in;
7. has Str $.encoding;
8. has &.on-switch is rw;
10. multi method perl(::?CLASS:D:) {
11. my @handles =
12. ($!active-handle if $!active-handle),
13. |nqp::p6bindattrinvres((), List, '$!reified', $!handles);
15. my $parts = join ', ',
16. (@handles.List.perl if @handles),
17. (':!chomp' if not $!chomp),
18. (":nl-in({$!nl-in.list.perl})" if $!nl-in !eqv ["\x0A", "\r\n"]),
19. (nqp::isconcrete($!encoding)
20. ?? ":encoding({$!encoding.perl})"
21. !! ':bin'),
22. (':&.on-switch({;})' if &!on-switch); # can't .perl Callables :(
24. "{self.^name}.new($parts)"
25. }
27. method !SET-SELF (
28. @handles, &!on-switch, $!chomp, $!nl-in, $encoding, $bin
29. ) {
30. nqp::if(
31. $bin,
32. nqp::isconcrete($encoding) && X::IO::BinaryAndEncoding.new.throw,
33. $!encoding = $encoding || 'utf8');
35. @handles.elems; # reify
36. $!handles := nqp::getattr(@handles || [], List, '$!reified');
37. self.next-handle;
38. self
39. }
40. method new (
41. *@handles, :&on-switch,
42. :$chomp = True, :$nl-in = ["\x0A", "\r\n"], Str :$encoding, Bool :$bin
43. ) {
44. self.bless!SET-SELF:
45. @handles, &on-switch, $chomp, $nl-in, $encoding, $bin
46. }
47. method next-handle {
48. # Set $!active-handle to the next handle in line, opening it if necessary
49. nqp::stmts(
50. (my $old-handle is default(Nil) = $!active-handle),
51. nqp::if(
52. nqp::defined($!active-handle),
53. (my $ = $!active-handle.close)), # don't sink the result, since it might
54. # .. be an IO::Pipe that returns a Proc that might throw
55. nqp::if(
56. nqp::elems($!handles),
57. nqp::if(
58. nqp::istype(($_ := nqp::shift($!handles)), IO::Handle),
59. nqp::if(
60. .opened,
61. nqp::stmts(
62. (.encoding: $!encoding), # *Jedi wave*
63. (.nl-in = $!nl-in), # These aren't the attribute assignment
64. (.chomp = $!chomp), # inconsistencies you're looking for!
65. $!active-handle = $_),
66. nqp::if(
67. nqp::istype(
68. ($_ = .open: :r, :$!chomp, :$!nl-in, :enc($!encoding),
69. :bin(nqp::p6bool(nqp::isfalse($!encoding)))),
70. Failure),
71. .throw,
72. ($!active-handle = $_))),
73. nqp::if(
74. nqp::istype(
75. ($_ := .IO.open: :r, :$!chomp, :$!nl-in, :enc($!encoding),
76. :bin(nqp::p6bool(nqp::isfalse($!encoding)))),
77. Failure),
78. .throw,
79. ($!active-handle = $_))),
80. ($!active-handle = Nil)),
81. nqp::if(
82. &!on-switch,
83. nqp::stmts(
84. (my $c := &!on-switch.count),
85. nqp::if(
86. $c,
87. nqp::if(
88. nqp::istype($c, Num) || nqp::iseq_i($c, 2), # inf or 2
89. &!on-switch($!active-handle, $old-handle),
90. nqp::if(
91. nqp::iseq_i($c, 1),
92. &!on-switch($!active-handle),
93. die ':&on-switch must have .count 0, 1, 2, or Inf')),
94. &!on-switch()))),
95. $!active-handle)
96. }
98. method handles(IO::Handle:D: --> Seq:D) {
99. Seq.new: class :: does Iterator {
100. has $!cat;
101. has $!gave-active;
103. method !SET-SELF(\cat) { $!cat := cat; self }
104. method new(\cat) { nqp::create(self)!SET-SELF: cat }
106. method pull-one {
107. nqp::if(
108. $!gave-active,
109. nqp::if(
110. nqp::defined(my $h := $!cat.next-handle),
111. $h,
112. IterationEnd),
113. nqp::stmts(
114. ($!gave-active := True),
115. nqp::defined(my $ah := nqp::decont(
116. nqp::getattr($!cat, IO::CatHandle, '$!active-handle')))
117. ?? $ah !! IterationEnd))
118. }
119. }.new: self
120. }
122. method chomp (::?CLASS:D:) is rw {
123. Proxy.new:
124. :FETCH{ $!chomp },
125. :STORE( -> $, $chomp {
126. $!active-handle && $!active-handle.chomp = $chomp;
127. $!chomp = $chomp
128. })
129. }
131. # XXX TODO: Make these routine read handle lazily when we have Cat type
132. method comb (::?CLASS:D: |c) { self.slurp.comb: |c }
133. method split(::?CLASS:D: |c) { self.slurp.split: |c }
135. method !WORDS {
136. nqp::if(
137. nqp::defined($!active-handle),
138. (flat $!active-handle.words, gather {
139. nqp::while(
140. nqp::defined(self.next-handle),
141. take $!active-handle.words)}),
142. EmptySeq
143. )
144. }
145. multi method words(::?CLASS:D \SELF: $limit, :$close) {
146. nqp::istype($limit,Whatever) || $limit == Inf
147. ?? self.words(:$close)
148. !! $close
149. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
150. self!WORDS.iterator, $limit.Int, {SELF.close}))
151. !! self.words.head($limit.Int)
152. }
153. multi method words(::?CLASS:D \SELF: :$close!) {
154. $close # use -1 as N in FirstNThenSinkAllSeq to get all items
155. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
156. self!WORDS.iterator, -1, {SELF.close}))
157. !! self!WORDS
158. }
159. multi method words(::?CLASS:D:) { self!WORDS }
161. method !LINES {
162. nqp::if(
163. nqp::defined($!active-handle),
164. (flat $!active-handle.lines, gather {
165. nqp::while(
166. nqp::defined(self.next-handle),
167. take $!active-handle.lines)}),
168. EmptySeq
169. )
170. }
171. multi method lines(::?CLASS:D \SELF: $limit, :$close) {
172. nqp::istype($limit,Whatever) || $limit == Inf
173. ?? self.lines(:$close)
174. !! $close
175. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
176. self!LINES.iterator, $limit.Int, {SELF.close}))
177. !! self.lines.head($limit.Int)
178. }
179. multi method lines(::?CLASS:D \SELF: :$close!) {
180. $close # use -1 as N in FirstNThenSinkAllSeq to get all items
181. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
182. self!LINES.iterator, -1, {SELF.close}))
183. !! self!LINES
184. }
185. multi method lines(::?CLASS:D:) { self!LINES }
187. multi method Supply (::?CLASS:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) {
188. nqp::if(
189. nqp::isconcrete($!encoding),
190. (supply nqp::stmts(
191. (my str $str = self.readchars: $size),
192. nqp::while(
193. nqp::chars($str),
194. nqp::stmts(
195. (emit nqp::p6box_s($str)),
196. ($str = self.readchars: $size))),
197. done)),
198. (supply nqp::stmts(
199. (my $buf := self.read: $size),
200. nqp::while(
201. nqp::elems($buf),
202. nqp::stmts(
203. (emit $buf),
204. ($buf := self.read: $size))),
205. done)))
206. }
208. # Get a single result, going to the next handle on EOF
209. method get (::?CLASS:D:) {
210. nqp::if(
211. nqp::defined($!active-handle),
212. nqp::stmts(
213. nqp::while(
214. nqp::eqaddr(Nil, my $res := $!active-handle.get)
215. && nqp::defined(self.next-handle),
216. nqp::null),
217. $res),
218. Nil)
219. }
220. method getc (::?CLASS:D:) {
221. nqp::if(
222. nqp::defined($!active-handle),
223. nqp::stmts(
224. nqp::while(
225. nqp::eqaddr(Nil, my $res := $!active-handle.getc)
226. && nqp::defined(self.next-handle),
227. nqp::null),
228. $res),
229. Nil)
230. }
231. method read (::?CLASS:D: Int(Cool:D) $bytes = $*DEFAULT-READ-ELEMS) {
232. # The logic is:
233. # read some stuff
234. # do we have enough stuff?
235. # -> [yes] -> return stuff
236. # -> [no]
237. # is current handle EOF or did we read zero stuff on last chunk?
238. # -> [yes] -> switch handle -> repeat from start
239. # -> [no] return stuff
240. # The extra gymnastics are due to:
241. # (a) possibility of TTY handles returning
242. # fewer than requested number of bytes without being entirely
243. # exhausted. This means when we read fewer than $bytes bytes, we
244. # don't yet know whether we should switch the handle and thus,
245. # if we read at least some bytes in a chunk and don't have EOF,
246. # we gotta return whatever we managed to read
247. # (b) XXX TODO: (this actually seems to be a bug)
248. # possibility of .seek being used on current handle. In such a
249. # case we can read a zero-sized chunk and EOF would still be false
250. nqp::unless(
251. nqp::defined($!active-handle),
252. buf8.new,
253. nqp::stmts(
254. (my $ret := buf8.new),
255. (my int $stop = 0),
256. nqp::until(
257. $stop,
258. nqp::stmts(
259. (my $chunk := buf8.new: $!active-handle.read:
260. nqp::sub_i($bytes,nqp::elems($ret))),
261. $ret.append($chunk),
262. nqp::if(
263. nqp::isge_i(nqp::elems($ret),$bytes),
264. ($stop = 1),
265. nqp::if(
266. $!active-handle.eof || nqp::isfalse(nqp::elems($chunk)),
267. nqp::unless(
268. nqp::defined(self.next-handle),
269. $stop = 1),
270. $stop = 1)))),
271. $ret))
272. }
273. method readchars (::?CLASS:D: Int(Cool:D) $chars = $*DEFAULT-READ-ELEMS) {
274. nqp::if(
275. nqp::defined($!active-handle),
276. nqp::stmts(
277. (my $ret := $!active-handle.readchars: $chars),
278. nqp::while(
279. nqp::islt_i(nqp::chars($ret), $chars)
280. && nqp::defined(self.next-handle),
281. $ret := nqp::concat($ret, $!active-handle.readchars:
282. nqp::sub_i($chars, nqp::chars($ret)))),
283. $ret
284. ),
285. '')
286. }
288. method slurp (::?CLASS:D:) {
289. # we don't take a :close arg, because we close exhausted handles
290. # and .slurp isn't lazy, so all handles will get exhausted
291. nqp::if(
292. nqp::defined($!active-handle),
293. ([~] gather nqp::stmts( # the [~] takes care of both Str and Blobs
294. (take $!active-handle.slurp),
295. nqp::while(
296. nqp::defined(self.next-handle),
297. take $!active-handle.slurp))),
298. Nil)
299. }
300. method slurp-rest (|) {
301. # We inherit deprecated .slurp-rest from IO::Handle. Pull the
302. # plug on it in this class, since no one is using this yet.
303. # The old IO::ArgFiles used .slurp
304. die X::Obsolete.new: :old<slurp-rest>, :replacement<slurp>,
305. :when('with IO::CatHandle')
306. }
307. method DESTROY { self.close }
309. method close (::?CLASS:D: --> True) {
310. # Note: our IO::Handles might be IO::Pipes, whose .close
311. # method returns the Proc object, which will explode when sunk if the
312. # process exited unsuccessfully. So here, we ensure we never sink it.
313. nqp::stmts(
314. nqp::if(
315. nqp::defined($!active-handle),
316. my $ = $!active-handle.close),
317. (my int $i = -1),
318. (my int $els = nqp::elems($!handles)),
319. nqp::while(
320. nqp::isgt_i($els, $i = nqp::add_i($i, 1)),
321. nqp::if(
322. nqp::istype(($_ := nqp::atpos($!handles, $i)), IO::Handle),
323. my $ = .close)),
324. ($!handles := nqp::list),
325. ($!active-handle = Nil))
326. }
328. proto method encoding(|) {*}
329. multi method encoding(::?CLASS:D:) { $!encoding || Nil }
330. multi method encoding(::?CLASS:D: $enc is copy) {
331. $!encoding = nqp::if(
332. nqp::defined($!active-handle),
333. $!active-handle.encoding($enc),
334. nqp::if(
335. nqp::isfalse($enc.defined) || nqp::iseq_s($enc.Str, 'bin'),
336. Nil,
337. Encoding::Registry.find($enc.Str).name))
338. }
340. method eof (::?CLASS:D: --> Bool:D) {
341. nqp::p6bool(
342. nqp::stmts(
343. nqp::while(
344. $!active-handle
345. && $!active-handle.eof
346. && self.next-handle,
347. nqp::null),
348. nqp::isfalse($!active-handle)
349. || False))
350. }
351. multi method gist (::?CLASS:D:) {
352. "{self.^name}({self.opened ?? "opened on {$.path.gist}" !! 'closed'})"
353. }
354. multi method Str (::?CLASS:D:) {
355. nqp::if($!active-handle, $.path.Str, '<closed IO::CatHandle>')
356. }
357. method IO (::?CLASS:D:) {
358. nqp::if($!active-handle, $!active-handle.IO, Nil)
359. }
360. method path (::?CLASS:D:) {
361. nqp::if($!active-handle, $!active-handle.path, Nil)
362. }
363. method opened(::?CLASS:D: --> Bool:D) { nqp::p6bool($!active-handle) }
364. method lock(::?CLASS:D: |c) {
365. nqp::if($!active-handle, $!active-handle.lock(|c), Nil)
366. }
367. method nl-in (::?CLASS:D:) is rw {
368. Proxy.new:
369. :FETCH{ $!nl-in },
370. :STORE( -> $, $nl-in {
371. $!active-handle && $!active-handle.nl-in = $nl-in;
372. $!nl-in = $nl-in
373. })
374. }
375. method seek(::?CLASS:D: |c) {
376. nqp::if($!active-handle, $!active-handle.seek(|c), Nil)
377. }
378. method tell(::?CLASS:D: --> Int:D) {
379. nqp::if($!active-handle, $!active-handle.tell, Nil)
380. }
381. method t (::?CLASS:D: --> Bool:D) {
382. nqp::if($!active-handle, $!active-handle.t, False)
383. }
384. method unlock(::?CLASS:D:) {
385. nqp::if($!active-handle, $!active-handle.unlock, Nil)
386. }
387. method native-descriptor (::?CLASS:D: --> Int:D) {
388. nqp::if($!active-handle, $!active-handle.native-descriptor, Nil)
389. }
390. method open (::?CLASS:D: --> ::?CLASS:D) {
391. # The idea behind cat handle's open is to fake .open in code that
392. # doesn't know it's dealing with a cat handle, so we accept any args
393. # IO::Handle.open accepts and then just return self. Since that .open
394. # takes only named args methods have `*%_` in sigs, we don't put any
395. # args in our sig. If that ever changes, then ensure cat handle's .open
396. # can be called with any of the IO::Handle.open's args
397. self
398. }
400. # __________________________________________
401. # / I don't know what the write methods \
402. # | should do in a CatHandle, so I'll mark |
403. # | these as NYI, for now.... Has anyone |
404. # \ seen my cocoon? I always lose that thing! /
405. # | -----------------------------------------
406. # | /
407. # |/
408. # (⛣)
409. proto method flush (|) {*}
410. multi method flush (|) { die X::NYI.new: :feature<flush> }
411. proto method out-buffer (|) {*}
412. multi method out-buffer (|) { die X::NYI.new: :feature<out-buffer> }
413. proto method print (|) {*}
414. multi method print (|) { die X::NYI.new: :feature<print> }
415. proto method printf (|) {*}
416. multi method printf (|) { die X::NYI.new: :feature<printf> }
417. proto method print-nl (|) {*}
418. multi method print-nl (|) { die X::NYI.new: :feature<print-nl> }
419. proto method put (|) {*}
420. multi method put (|) { die X::NYI.new: :feature<put> }
421. proto method say (|) {*}
422. multi method say (|) { die X::NYI.new: :feature<say> }
423. proto method write (|) {*}
424. multi method write (|) { die X::NYI.new: :feature<write> }
425. # /|\
427. # Don't die on this one, as doing so breaks .Capture
428. # proto method nl-out (|) {*}
429. # multi method nl-out (|) {
430. # die X::NYI.new: :feature<nl-out>
431. # }
432. }