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