1. my class IO::CatHandle is IO::Handle {
  2. has $!handles;
  3. has $!active-handle is default(Nil) = 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. ($ = $!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::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::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 chomp (::?CLASS:D:) is rw {
  92. Proxy.new:
  93. :FETCH{ $!chomp },
  94. :STORE( -> $, $chomp {
  95. $!active-handle && $!active-handle.chomp = $chomp;
  96. $!chomp = $chomp
  97. })
  98. }
  99. # XXX TODO: Make these routine read handle lazily when we have Cat type
  100. method comb (::?CLASS:D: |c) { self.slurp.comb: |c }
  101. method split(::?CLASS:D: |c) { self.slurp.split: |c }
  102. method !WORDS {
  103. nqp::if(
  104. nqp::defined($!active-handle),
  105. (flat $!active-handle.words, gather {
  106. nqp::while(
  107. nqp::defined(self.next-handle),
  108. take $!active-handle.words)}),
  109. Seq.new: Rakudo::Iterator.Empty)
  110. }
  111. multi method words(::?CLASS:D \SELF: $limit, :$close) {
  112. nqp::istype($limit,Whatever) || $limit == Inf
  113. ?? self.words(:$close)
  114. !! $close
  115. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  116. self!WORDS.iterator, $limit.Int, {SELF.close}))
  117. !! self.words.head($limit.Int)
  118. }
  119. multi method words(::?CLASS:D \SELF: :$close!) {
  120. $close # use -1 as N in FirstNThenSinkAllSeq to get all items
  121. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  122. self!WORDS.iterator, -1, {SELF.close}))
  123. !! self!WORDS
  124. }
  125. multi method words(::?CLASS:D:) { self!WORDS }
  126. method !LINES {
  127. nqp::if(
  128. nqp::defined($!active-handle),
  129. (flat $!active-handle.lines, gather {
  130. nqp::while(
  131. nqp::defined(self.next-handle),
  132. take $!active-handle.lines)}),
  133. Seq.new: Rakudo::Iterator.Empty)
  134. }
  135. multi method lines(::?CLASS:D \SELF: $limit, :$close) {
  136. nqp::istype($limit,Whatever) || $limit == Inf
  137. ?? self.lines(:$close)
  138. !! $close
  139. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  140. self!LINES.iterator, $limit.Int, {SELF.close}))
  141. !! self.lines.head($limit.Int)
  142. }
  143. multi method lines(::?CLASS:D \SELF: :$close!) {
  144. $close # use -1 as N in FirstNThenSinkAllSeq to get all items
  145. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  146. self!LINES.iterator, -1, {SELF.close}))
  147. !! self!LINES
  148. }
  149. multi method lines(::?CLASS:D:) { self!LINES }
  150. method Supply (::?CLASS:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) {
  151. nqp::if(
  152. nqp::isconcrete($!encoding),
  153. (supply nqp::stmts(
  154. (my str $str = self.readchars: $size),
  155. nqp::while(
  156. nqp::chars($str),
  157. nqp::stmts(
  158. (emit nqp::p6box_s($str)),
  159. ($str = self.readchars: $size))),
  160. done)),
  161. (supply nqp::stmts(
  162. (my $buf := self.read: $size),
  163. nqp::while(
  164. nqp::elems($buf),
  165. nqp::stmts(
  166. (emit $buf),
  167. ($buf := self.read: $size))),
  168. done)))
  169. }
  170. # Get a single result, going to the next handle on EOF
  171. method get (::?CLASS:D:) {
  172. nqp::if(
  173. nqp::defined($!active-handle),
  174. nqp::stmts(
  175. nqp::while(
  176. nqp::eqaddr(Nil, my $res := $!active-handle.get)
  177. && nqp::defined(self.next-handle),
  178. nqp::null),
  179. $res),
  180. Nil)
  181. }
  182. method getc (::?CLASS:D:) {
  183. nqp::if(
  184. nqp::defined($!active-handle),
  185. nqp::stmts(
  186. nqp::while(
  187. nqp::eqaddr(Nil, my $res := $!active-handle.getc)
  188. && nqp::defined(self.next-handle),
  189. nqp::null),
  190. $res),
  191. Nil)
  192. }
  193. method read (::?CLASS:D: Int(Cool:D) $bytes) {
  194. nqp::if(
  195. nqp::defined($!active-handle),
  196. nqp::stmts(
  197. (my $ret := buf8.new: $!active-handle.read: $bytes),
  198. nqp::while(
  199. nqp::islt_i(nqp::elems($ret), $bytes)
  200. && nqp::defined(self.next-handle),
  201. $ret.append: $!active-handle.read:
  202. nqp::sub_i($bytes, nqp::elems($ret))),
  203. $ret
  204. ),
  205. buf8.new)
  206. }
  207. method readchars (::?CLASS:D: Int(Cool:D) $chars = $*DEFAULT-READ-ELEMS) {
  208. nqp::if(
  209. nqp::defined($!active-handle),
  210. nqp::stmts(
  211. (my $ret := $!active-handle.readchars: $chars),
  212. nqp::while(
  213. nqp::islt_i(nqp::chars($ret), $chars)
  214. && nqp::defined(self.next-handle),
  215. $ret := nqp::concat($ret, $!active-handle.readchars:
  216. nqp::sub_i($chars, nqp::chars($ret)))),
  217. $ret
  218. ),
  219. '')
  220. }
  221. method slurp (::?CLASS:D:) {
  222. # we don't take a :close arg, because we close exhausted handles
  223. # and .slurp isn't lazy, so all handles will get exhausted
  224. nqp::if(
  225. nqp::defined($!active-handle),
  226. ([~] gather nqp::stmts( # the [~] takes care of both Str and Blobs
  227. (take $!active-handle.slurp),
  228. nqp::while(
  229. nqp::defined(self.next-handle),
  230. take $!active-handle.slurp))),
  231. Nil)
  232. }
  233. method slurp-rest (|) {
  234. # We inherit deprecated .slurp-rest from IO::Handle. Pull the
  235. # plug on it in this class, since no one is using this yet.
  236. # The old IO::ArgFiles used .slurp
  237. die X::Obsolete.new: :old<slurp-rest>, :replacement<slurp>,
  238. :when('with IO::CatHandle')
  239. }
  240. method DESTROY { self.close }
  241. method close (::?CLASS:D: --> True) {
  242. # Note: our IO::Handles might be IO::Pipes, whose .close
  243. # method returns the Proc object, which will explode when sunk if the
  244. # process exited unsuccessfully. So here, we ensure we never sink it.
  245. nqp::stmts(
  246. nqp::if(
  247. nqp::defined($!active-handle),
  248. $ = $!active-handle.close),
  249. (my int $i = -1),
  250. (my int $els = nqp::elems($!handles)),
  251. nqp::while(
  252. nqp::isgt_i($els, $i = nqp::add_i($i, 1)),
  253. nqp::if(
  254. nqp::istype(($_ := nqp::atpos($!handles, $i)), IO::Handle),
  255. $ = .close)),
  256. ($!handles := nqp::list),
  257. ($!active-handle = Nil))
  258. }
  259. proto method encoding(|) { * }
  260. multi method encoding(::?CLASS:D:) { $!encoding || Nil }
  261. multi method encoding(::?CLASS:D: $enc is copy) {
  262. $!encoding = nqp::if(
  263. nqp::defined($!active-handle),
  264. $!active-handle.encoding($enc),
  265. nqp::if(
  266. nqp::isfalse($enc.defined) || nqp::iseq_s($enc.Str, 'bin'),
  267. Nil,
  268. Rakudo::Internals.NORMALIZE_ENCODING: $enc.Str))
  269. }
  270. method eof (::?CLASS:D: --> Bool:D) {
  271. nqp::p6bool(
  272. nqp::stmts(
  273. nqp::while(
  274. $!active-handle
  275. && $!active-handle.eof
  276. && self.next-handle,
  277. nqp::null),
  278. nqp::isfalse($!active-handle)
  279. || False))
  280. }
  281. multi method gist (::?CLASS:D:) {
  282. "{self.^name}({self.opened ?? "opened on {$.path.gist}" !! 'closed'})"
  283. }
  284. multi method Str (::?CLASS:D:) {
  285. nqp::if($!active-handle, $.path.Str, '<closed IO::CatHandle>')
  286. }
  287. method IO (::?CLASS:D:) {
  288. nqp::if($!active-handle, $!active-handle.IO, Nil)
  289. }
  290. method path (::?CLASS:D:) {
  291. nqp::if($!active-handle, $!active-handle.path, Nil)
  292. }
  293. method opened(::?CLASS:D: --> Bool:D) { nqp::p6bool($!active-handle) }
  294. method lock(::?CLASS:D: |c) {
  295. nqp::if($!active-handle, $!active-handle.lock(|c), Nil)
  296. }
  297. method nl-in (::?CLASS:D:) is rw {
  298. Proxy.new:
  299. :FETCH{ $!nl-in },
  300. :STORE( -> $, $nl-in {
  301. $!active-handle && $!active-handle.nl-in = $nl-in;
  302. $!nl-in = $nl-in
  303. })
  304. }
  305. method seek(::?CLASS:D: |c) {
  306. nqp::if($!active-handle, $!active-handle.seek(|c), Nil)
  307. }
  308. method tell(::?CLASS:D: --> Int:D) {
  309. nqp::if($!active-handle, $!active-handle.tell, Nil)
  310. }
  311. method t (::?CLASS:D: --> Bool:D) {
  312. nqp::if($!active-handle, $!active-handle.t, False)
  313. }
  314. method unlock(::?CLASS:D:) {
  315. nqp::if($!active-handle, $!active-handle.unlock, Nil)
  316. }
  317. method native-descriptor (::?CLASS:D: --> Int:D) {
  318. nqp::if($!active-handle, $!active-handle.native-descriptor, Nil)
  319. }
  320. method open (::?CLASS:D: --> ::?CLASS:D) {
  321. # The idea behind cat handle's open is to fake .open in code that
  322. # doesn't know it's dealing with a cat handle, so we accept any args
  323. # IO::Handle.open accepts and then just return self. Since that .open
  324. # takes only named args methods have `*%_` in sigs, we don't put any
  325. # args in our sig. If that ever changes, then ensure cat handle's .open
  326. # can be called with any of the IO::Handle.open's args
  327. self
  328. }
  329. # __________________________________________
  330. # / I don't know what the write methods \
  331. # | should do in a CatHandle, so I'll mark |
  332. # | these as NYI, for now.... Has anyone |
  333. # \ seen my cocoon? I always lose that thing! /
  334. # | -----------------------------------------
  335. # | /
  336. # |/
  337. # (⛣)
  338. proto method flush (|) { * }
  339. multi method flush (|) { die X::NYI.new: :feature<flush> }
  340. proto method nl-out (|) { * }
  341. multi method nl-out (|) { die X::NYI.new: :feature<nl-out> }
  342. proto method print (|) { * }
  343. multi method print (|) { die X::NYI.new: :feature<print> }
  344. proto method printf (|) { * }
  345. multi method printf (|) { die X::NYI.new: :feature<printf> }
  346. proto method print-nl(|) { * }
  347. multi method print-nl(|) { die X::NYI.new: :feature<print-nl> }
  348. proto method put (|) { * }
  349. multi method put (|) { die X::NYI.new: :feature<put> }
  350. proto method say (|) { * }
  351. multi method say (|) { die X::NYI.new: :feature<say> }
  352. proto method write (|) { * }
  353. multi method write (|) { die X::NYI.new: :feature<write> }
  354. # /|\
  355. }