1. my class IO::Path { ... }
  2. my class Proc { ... }
  3. my class IO::Handle {
  4. has $.path;
  5. has $!PIO;
  6. has $.chomp is rw = Bool::True;
  7. has $.nl-in = ["\x0A", "\r\n"];
  8. has Str:D $.nl-out is rw = "\n";
  9. has Str $.encoding;
  10. has Encoding::Decoder $!decoder;
  11. has Encoding::Encoder $!encoder;
  12. has int $!out-buffer;
  13. submethod TWEAK (:$encoding, :$bin, IO() :$!path = Nil) {
  14. nqp::if(
  15. $bin,
  16. nqp::isconcrete($encoding) && X::IO::BinaryAndEncoding.new.throw,
  17. $!encoding = $encoding || 'utf8')
  18. }
  19. # Make sure we close any open files on exit
  20. my $opened := nqp::list;
  21. my $opened-locker = Lock.new;
  22. method !remember-to-close(--> Nil) {
  23. $opened-locker.protect: {
  24. nqp::stmts(
  25. nqp::if(
  26. nqp::isge_i(
  27. (my int $fileno = nqp::filenofh($!PIO)),
  28. (my int $elems = nqp::elems($opened))
  29. ),
  30. nqp::setelems($opened,nqp::add_i($elems,1024))
  31. ),
  32. nqp::bindpos($opened,$fileno,$!PIO)
  33. )
  34. }
  35. }
  36. method !forget-about-closing(int $fileno --> Nil) {
  37. $opened-locker.protect: {
  38. nqp::bindpos($opened,$fileno,nqp::null)
  39. }
  40. }
  41. method !close-all-open-handles() {
  42. my int $i = 2;
  43. my int $elems = nqp::elems($opened);
  44. nqp::while(
  45. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  46. nqp::unless(
  47. nqp::isnull(my $PIO := nqp::atpos($opened,$i)),
  48. nqp::closefh($PIO)
  49. )
  50. )
  51. }
  52. method open(IO::Handle:D:
  53. :$r, :$w, :$x, :$a, :$update,
  54. :$rw, :$rx, :$ra,
  55. :$mode is copy,
  56. :$create is copy,
  57. :$append is copy,
  58. :$truncate is copy,
  59. :$exclusive is copy,
  60. :$bin,
  61. :$enc is copy,
  62. :$chomp = $!chomp,
  63. :$nl-in is copy = $!nl-in,
  64. Str:D :$nl-out is copy = $!nl-out,
  65. :$out-buffer is copy,
  66. ) {
  67. nqp::if(
  68. $bin,
  69. nqp::stmts(
  70. nqp::isconcrete($enc) && X::IO::BinaryAndEncoding.new.throw,
  71. $!encoding = Nil),
  72. nqp::unless(
  73. nqp::isconcrete($enc),
  74. $enc = $!encoding));
  75. $mode = nqp::if(
  76. $mode, nqp::if(nqp::istype($mode, Str), $mode, $mode.Str),
  77. nqp::if($w && $r || $rw, nqp::stmts(($create = True), 'rw'),
  78. nqp::if($x && $r || $rx, nqp::stmts(($create = $exclusive = True), 'rw'),
  79. nqp::if($a && $r || $ra, nqp::stmts(($create = $append = True), 'rw'),
  80. nqp::if($r, 'ro',
  81. nqp::if($w, nqp::stmts(($create = $truncate = True), 'wo'),
  82. nqp::if($x, nqp::stmts(($create = $exclusive = True), 'wo'),
  83. nqp::if($a, nqp::stmts(($create = $append = True), 'wo'),
  84. nqp::if($update, 'rw',
  85. 'ro')))))))));
  86. nqp::if(
  87. nqp::iseq_s($!path.Str, '-'),
  88. nqp::if(
  89. nqp::iseq_s($mode, 'ro'),
  90. nqp::if(
  91. $*IN.opened,
  92. nqp::stmts(
  93. $*IN.encoding($enc),
  94. return $*IN),
  95. nqp::stmts(
  96. nqp::if(
  97. nqp::iseq_s($*IN.path.Str, '-'),
  98. $*IN = IO::Handle.new: :path(IO::Special.new: '<STDIN>')),
  99. return $*IN.open: :$enc,
  100. :bin(nqp::isfalse(nqp::isconcrete($enc))))),
  101. nqp::if(
  102. nqp::iseq_s($mode, 'wo'),
  103. nqp::if(
  104. $*OUT.opened,
  105. nqp::stmts(
  106. $*OUT.encoding($enc),
  107. return $*OUT),
  108. nqp::stmts(
  109. nqp::if(
  110. nqp::iseq_s($*OUT.path.Str, '-'),
  111. $*OUT = IO::Handle.new: :path(IO::Special.new: '<STDOUT>')),
  112. return $*OUT.open: :w, :$enc,
  113. :bin(nqp::isfalse(nqp::isconcrete($enc))))),
  114. die("Cannot open standard stream in mode '$mode'"))));
  115. if nqp::istype($!path, IO::Special) {
  116. my $what := $!path.what;
  117. if $what eq '<STDIN>' {
  118. $!PIO := nqp::getstdin();
  119. }
  120. elsif $what eq '<STDOUT>' {
  121. $!PIO := nqp::getstdout();
  122. }
  123. elsif $what eq '<STDERR>' {
  124. $!PIO := nqp::getstderr();
  125. }
  126. else {
  127. die "Don't know how to open '$_' especially";
  128. }
  129. $!chomp = $chomp;
  130. $!nl-out = $nl-out;
  131. if nqp::isconcrete($enc) {
  132. my $encoding = Encoding::Registry.find($enc);
  133. $!decoder := $encoding.decoder(:translate-nl);
  134. $!decoder.set-line-separators(($!nl-in = $nl-in).list);
  135. $!encoder := $encoding.encoder(:translate-nl);
  136. $!encoding = $encoding.name;
  137. }
  138. self!set-out-buffer-size($out-buffer);
  139. return self;
  140. }
  141. fail X::IO::Directory.new(:$!path, :trying<open>) if $!path.d;
  142. {
  143. CATCH { .fail }
  144. $!PIO := nqp::open(
  145. $!path.absolute,
  146. nqp::concat(
  147. nqp::if(nqp::iseq_s($mode, 'ro'), 'r',
  148. nqp::if(nqp::iseq_s($mode, 'wo'), '-',
  149. nqp::if(nqp::iseq_s($mode, 'rw'), '+',
  150. die "Unknown mode '$mode'"))),
  151. nqp::concat(nqp::if($create, 'c', ''),
  152. nqp::concat(nqp::if($append, 'a', ''),
  153. nqp::concat(nqp::if($truncate, 't', ''),
  154. nqp::if($exclusive, 'x', ''))))));
  155. self!remember-to-close;
  156. }
  157. $!chomp = $chomp;
  158. $!nl-out = $nl-out;
  159. if nqp::isconcrete($enc) {
  160. my $encoding = Encoding::Registry.find($enc);
  161. $!decoder := $encoding.decoder(:translate-nl);
  162. $!decoder.set-line-separators(($!nl-in = $nl-in).list);
  163. $!encoder := $encoding.encoder(:translate-nl);
  164. $!encoding = $encoding.name;
  165. }
  166. self!set-out-buffer-size($out-buffer);
  167. self;
  168. }
  169. method out-buffer is rw {
  170. Proxy.new: :FETCH{ $!out-buffer }, STORE => -> $, \buffer {
  171. self!set-out-buffer-size: buffer;
  172. }
  173. }
  174. method !set-out-buffer-size($buffer is copy) {
  175. $buffer //= !nqp::isttyfh($!PIO);
  176. $!out-buffer = nqp::istype($buffer, Bool)
  177. ?? ($buffer ?? 8192 !! 0)
  178. !! $buffer.Int;
  179. nqp::setbuffersizefh($!PIO, $!out-buffer);
  180. $!out-buffer
  181. }
  182. method nl-in is rw {
  183. Proxy.new(
  184. FETCH => {
  185. $!nl-in
  186. },
  187. STORE => -> $, $nl-in {
  188. $!nl-in = $nl-in;
  189. $!decoder && $!decoder.set-line-separators($nl-in.list);
  190. $nl-in
  191. }
  192. );
  193. }
  194. method close(IO::Handle:D: --> True) {
  195. nqp::if(
  196. nqp::defined($!PIO),
  197. nqp::stmts(
  198. (my int $fileno = nqp::filenofh($!PIO)),
  199. nqp::closefh($!PIO), # TODO: catch errors
  200. ($!PIO := nqp::null),
  201. self!forget-about-closing($fileno)
  202. )
  203. )
  204. }
  205. method eof(IO::Handle:D:) {
  206. nqp::p6bool($!decoder
  207. ?? $!decoder.is-empty && self.eof-internal
  208. !! self.eof-internal)
  209. }
  210. method eof-internal() {
  211. nqp::eoffh($!PIO)
  212. }
  213. method read-internal(Int:D $bytes) {
  214. nqp::readfh($!PIO,buf8.new,nqp::unbox_i($bytes))
  215. }
  216. method get(IO::Handle:D:) {
  217. $!decoder or die X::IO::BinaryMode.new(:trying<get>);
  218. $!decoder.consume-line-chars(:$!chomp) // self!get-line-slow-path()
  219. }
  220. method !get-line-slow-path() {
  221. my $line := Nil;
  222. unless self.eof-internal && $!decoder.is-empty {
  223. loop {
  224. my $buf := self.read-internal(0x100000);
  225. if $buf.elems {
  226. $!decoder.add-bytes($buf);
  227. $line := $!decoder.consume-line-chars(:$!chomp);
  228. last if nqp::isconcrete($line);
  229. }
  230. else {
  231. $line := $!decoder.consume-line-chars(:$!chomp, :eof)
  232. unless self.eof-internal && $!decoder.is-empty;
  233. last;
  234. }
  235. }
  236. }
  237. $line
  238. }
  239. method getc(IO::Handle:D:) {
  240. $!decoder or die X::IO::BinaryMode.new(:trying<getc>);
  241. $!decoder.consume-exactly-chars(1) || (self!readchars-slow-path(1) || Nil)
  242. }
  243. # XXX TODO: Make these routine read handle lazily when we have Cat type
  244. method comb (IO::Handle:D: :$close, |c) {
  245. $!decoder or die X::IO::BinaryMode.new(:trying<comb>);
  246. self.slurp(:$close).comb: |c
  247. }
  248. method split(IO::Handle:D: :$close, |c) {
  249. $!decoder or die X::IO::BinaryMode.new(:trying<split>);
  250. self.slurp(:$close).split: |c
  251. }
  252. proto method words (|) {*}
  253. multi method words(IO::Handle:D \SELF: $limit, :$close) {
  254. $!decoder or die X::IO::BinaryMode.new(:trying<words>);
  255. nqp::istype($limit,Whatever) || $limit == Inf
  256. ?? self.words(:$close)
  257. !! $close
  258. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  259. self.words.iterator, $limit.Int, {SELF.close}))
  260. !! self.words.head($limit.Int)
  261. }
  262. multi method words(IO::Handle:D: :$close) {
  263. $!decoder or die X::IO::BinaryMode.new(:trying<words>);
  264. Seq.new(class :: does Iterator {
  265. has $!handle;
  266. has $!close;
  267. has str $!str;
  268. has int $!pos;
  269. has int $!searching;
  270. method !SET-SELF(\handle, $!close) {
  271. $!handle := handle;
  272. $!searching = 1;
  273. $!str = ""; # RT #126492
  274. self!next-chunk;
  275. self
  276. }
  277. method new(\handle, \close) {
  278. nqp::create(self)!SET-SELF(handle, close);
  279. }
  280. method !next-chunk() {
  281. my int $chars = nqp::chars($!str);
  282. $!str = $!pos < $chars ?? nqp::substr($!str,$!pos) !! "";
  283. $chars = nqp::chars($!str);
  284. while $!searching {
  285. $!str = nqp::concat($!str,$!handle.readchars);
  286. my int $new = nqp::chars($!str);
  287. $!searching = 0 if $new == $chars; # end
  288. $!pos = ($chars = $new)
  289. ?? nqp::findnotcclass(
  290. nqp::const::CCLASS_WHITESPACE, $!str, 0, $chars)
  291. !! 0;
  292. last if $!pos < $chars;
  293. }
  294. }
  295. method pull-one() {
  296. my int $chars;
  297. my int $left;
  298. my int $nextpos;
  299. while ($chars = nqp::chars($!str)) && $!searching {
  300. while ($left = $chars - $!pos) > 0 {
  301. $nextpos = nqp::findcclass(
  302. nqp::const::CCLASS_WHITESPACE,$!str,$!pos,$left);
  303. last unless $left = $chars - $nextpos; # broken word
  304. my str $found =
  305. nqp::substr($!str, $!pos, $nextpos - $!pos);
  306. $!pos = nqp::findnotcclass(
  307. nqp::const::CCLASS_WHITESPACE,$!str,$nextpos,$left);
  308. return nqp::p6box_s($found);
  309. }
  310. self!next-chunk;
  311. }
  312. if $!pos < $chars {
  313. my str $found = nqp::substr($!str,$!pos);
  314. $!pos = $chars;
  315. nqp::p6box_s($found)
  316. }
  317. else {
  318. $!handle.close if $!close;
  319. IterationEnd
  320. }
  321. }
  322. method push-all($target --> IterationEnd) {
  323. my int $chars;
  324. my int $left;
  325. my int $nextpos;
  326. while ($chars = nqp::chars($!str)) && $!searching {
  327. while ($left = $chars - $!pos) > 0 {
  328. $nextpos = nqp::findcclass(
  329. nqp::const::CCLASS_WHITESPACE,$!str,$!pos,$left);
  330. last unless $left = $chars - $nextpos; # broken word
  331. $target.push(nqp::p6box_s(
  332. nqp::substr($!str, $!pos, $nextpos - $!pos)
  333. ));
  334. $!pos = nqp::findnotcclass(
  335. nqp::const::CCLASS_WHITESPACE,$!str,$nextpos,$left);
  336. }
  337. self!next-chunk;
  338. }
  339. $target.push(nqp::p6box_s(nqp::substr($!str,$!pos)))
  340. if $!pos < $chars;
  341. $!handle.close if $close;
  342. }
  343. }.new(self, $close));
  344. }
  345. my role PIOIterator does Iterator {
  346. has $!handle;
  347. has $!chomp;
  348. has $!decoder;
  349. method new(\handle) {
  350. my \res = nqp::create(self);
  351. nqp::bindattr(res, self.WHAT, '$!handle', handle);
  352. nqp::bindattr(res, self.WHAT, '$!chomp',
  353. nqp::getattr(handle, IO::Handle, '$!chomp'));
  354. nqp::p6bindattrinvres(res, self.WHAT, '$!decoder',
  355. nqp::getattr(handle, IO::Handle, '$!decoder'))
  356. }
  357. method sink-all(--> IterationEnd) {
  358. nqp::seekfh(nqp::getattr($!handle, IO::Handle, '$!PIO'), 0, 2) # seek to end
  359. }
  360. }
  361. method !LINES-ITERATOR (IO::Handle:D:) {
  362. $!decoder or die X::IO::BinaryMode.new(:trying<lines>);
  363. (nqp::eqaddr(self.WHAT,IO::Handle)
  364. ?? (class :: does PIOIterator { # exact type, can shortcircuit get
  365. method pull-one() {
  366. # Slow path falls back to .get on the handle, which will
  367. # replenish the buffer once we exhaust it.
  368. $!decoder.consume-line-chars(:$!chomp) // ($!handle.get // IterationEnd)
  369. }
  370. method push-all($target --> IterationEnd) {
  371. nqp::while(
  372. nqp::isconcrete(my $line :=
  373. $!decoder.consume-line-chars(:$!chomp) // $!handle.get),
  374. $target.push($line)
  375. )
  376. }
  377. })
  378. !! (class :: does Iterator { # can *NOT* shortcircuit .get
  379. has $!handle;
  380. method new(\handle) {
  381. nqp::p6bindattrinvres(
  382. nqp::create(self),self.WHAT,'$!handle',handle)
  383. }
  384. method pull-one() {
  385. nqp::if(
  386. (my $line := $!handle.get).DEFINITE,
  387. $line,
  388. IterationEnd
  389. )
  390. }
  391. method push-all($target --> IterationEnd) {
  392. nqp::while(
  393. (my $line := $!handle.get).DEFINITE,
  394. $target.push($line)
  395. )
  396. }
  397. method sink-all(--> IterationEnd) {
  398. # can't seek pipes, so need the `try`
  399. try $!handle.seek(0,SeekFromEnd) # seek to end
  400. }
  401. })
  402. ).new(self)
  403. }
  404. proto method lines (|) {*}
  405. multi method lines(IO::Handle:D \SELF: $limit, :$close) {
  406. nqp::istype($limit,Whatever) || $limit == Inf
  407. ?? self.lines(:$close)
  408. !! $close
  409. ?? Seq.new(Rakudo::Iterator.FirstNThenSinkAll(
  410. self!LINES-ITERATOR, $limit.Int, {SELF.close}))
  411. !! self.lines.head($limit.Int)
  412. }
  413. multi method lines(IO::Handle:D \SELF: :$close!) {
  414. Seq.new(
  415. $close # use -1 as N in FirstNThenSinkAllSeq to get all items
  416. ?? Rakudo::Iterator.FirstNThenSinkAll(
  417. self!LINES-ITERATOR, -1, {SELF.close})
  418. !! self!LINES-ITERATOR
  419. )
  420. }
  421. multi method lines(IO::Handle:D:) { Seq.new(self!LINES-ITERATOR) }
  422. method read(IO::Handle:D: Int(Cool:D) $bytes = $*DEFAULT-READ-ELEMS) {
  423. # If we have one, read bytes via. the decoder to support mixed-mode I/O.
  424. $!decoder
  425. ?? ($!decoder.consume-exactly-bytes($bytes) // self!read-slow-path($bytes))
  426. !! self.read-internal($bytes)
  427. }
  428. method !read-slow-path($bytes) {
  429. if self.eof-internal && $!decoder.is-empty {
  430. buf8.new
  431. }
  432. else {
  433. $!decoder.add-bytes(self.read-internal($bytes max 0x100000));
  434. $!decoder.consume-exactly-bytes($bytes)
  435. // $!decoder.consume-exactly-bytes($!decoder.bytes-available)
  436. // buf8.new
  437. }
  438. }
  439. method readchars(Int(Cool:D) $chars = $*DEFAULT-READ-ELEMS) {
  440. $!decoder or die X::IO::BinaryMode.new(:trying<readchars>);
  441. $!decoder.consume-exactly-chars($chars) // self!readchars-slow-path($chars)
  442. }
  443. method !readchars-slow-path($chars) {
  444. my $result := '';
  445. unless self.eof-internal && $!decoder.is-empty {
  446. loop {
  447. my $buf := self.read-internal(0x100000);
  448. if $buf.elems {
  449. $!decoder.add-bytes($buf);
  450. $result := $!decoder.consume-exactly-chars($chars);
  451. last if nqp::isconcrete($result);
  452. }
  453. else {
  454. $result := $!decoder.consume-exactly-chars($chars, :eof);
  455. last;
  456. }
  457. }
  458. }
  459. $result
  460. }
  461. multi method Supply(IO::Handle:D: :$size = $*DEFAULT-READ-ELEMS --> Supply:D) {
  462. if $!decoder { # handle is in character mode
  463. supply {
  464. my int $chars = $size;
  465. my str $str = self.readchars($chars);
  466. nqp::while(
  467. nqp::chars($str),
  468. nqp::stmts(
  469. (emit nqp::p6box_s($str)),
  470. ($str = self.readchars($chars))
  471. )
  472. );
  473. done;
  474. }
  475. }
  476. else {
  477. supply {
  478. my $buf := self.read($size);
  479. nqp::while(
  480. nqp::elems($buf),
  481. nqp::stmts(
  482. (emit $buf),
  483. ($buf := self.read($size))
  484. )
  485. );
  486. done;
  487. }
  488. }
  489. }
  490. proto method seek(|) {*}
  491. multi method seek(IO::Handle:D: Int:D $offset, SeekType:D $whence = SeekFromBeginning) {
  492. my int $rewind = 0;
  493. if $!decoder {
  494. # consider bytes we pre-read, when seeking from current position:
  495. $rewind = $!decoder.bytes-available if
  496. nqp::eqaddr(nqp::decont($whence), SeekFromCurrent);
  497. # Freshen decoder, so we won't have stuff left over from earlier reads
  498. # that were in the wrong place.
  499. $!decoder := Encoding::Registry.find($!encoding).decoder(:translate-nl);
  500. $!decoder.set-line-separators($!nl-in.list);
  501. }
  502. nqp::seekfh($!PIO, $offset - $rewind, +$whence);
  503. }
  504. method tell(IO::Handle:D: --> Int:D) {
  505. nqp::tellfh($!PIO) - ($!decoder ?? $!decoder.bytes-available !! 0)
  506. }
  507. method write(IO::Handle:D: Blob:D $buf --> True) {
  508. self.write-internal($buf)
  509. }
  510. method write-internal(IO::Handle:D: Blob:D $buf --> True) {
  511. nqp::writefh($!PIO, nqp::decont($buf));
  512. }
  513. method opened(IO::Handle:D:) {
  514. nqp::p6bool(nqp::istrue($!PIO));
  515. }
  516. method t(IO::Handle:D:) {
  517. self.opened && nqp::p6bool(nqp::isttyfh($!PIO))
  518. }
  519. method lock(IO::Handle:D:
  520. Bool:D :$non-blocking = False, Bool:D :$shared = False --> True
  521. ) {
  522. self!forget-about-closing(nqp::filenofh($!PIO));
  523. nqp::lockfh($!PIO, 0x10*$non-blocking + $shared);
  524. CATCH { default {
  525. self!remember-to-close;
  526. fail X::IO::Lock.new: :os-error(.Str),
  527. :lock-type( 'non-' x $non-blocking ~ 'blocking, '
  528. ~ ($shared ?? 'shared' !! 'exclusive') );
  529. }}
  530. }
  531. method unlock(IO::Handle:D: --> True) {
  532. self!remember-to-close;
  533. nqp::unlockfh($!PIO);
  534. }
  535. method printf(IO::Handle:D: |c) {
  536. self.print(sprintf |c);
  537. }
  538. proto method print(|) {*}
  539. multi method print(IO::Handle:D: Str:D \x --> True) {
  540. $!decoder or die X::IO::BinaryMode.new(:trying<print>);
  541. self.write-internal($!encoder.encode-chars(x));
  542. }
  543. multi method print(IO::Handle:D: **@list is raw --> True) { # is raw gives List, which is cheaper
  544. self.print(@list.join);
  545. }
  546. multi method print(Junction:D \j) { j.THREAD: {self.print: $_} }
  547. proto method put(|) {*}
  548. multi method put(IO::Handle:D: Str:D \x --> True) {
  549. $!decoder or die X::IO::BinaryMode.new(:trying<put>);
  550. self.write-internal($!encoder.encode-chars(
  551. nqp::concat(nqp::unbox_s(x), nqp::unbox_s($!nl-out))))
  552. }
  553. multi method put(IO::Handle:D: **@list is raw --> True) { # is raw gives List, which is cheaper
  554. self.put(@list.join);
  555. }
  556. multi method put(Junction:D \j) { j.THREAD: {self.put: $_} }
  557. multi method say(IO::Handle:D: Str:D $x --> True) {
  558. $!decoder or die X::IO::BinaryMode.new(:trying<say>);
  559. self.write-internal($!encoder.encode-chars(
  560. nqp::concat(nqp::unbox_s($x), nqp::unbox_s($!nl-out))));
  561. }
  562. multi method say(IO::Handle:D: \x --> True) {
  563. $!decoder or die X::IO::BinaryMode.new(:trying<say>);
  564. self.write-internal($!encoder.encode-chars(
  565. nqp::concat(nqp::unbox_s(x.gist), nqp::unbox_s($!nl-out))))
  566. }
  567. multi method say(IO::Handle:D: |) {
  568. $!decoder or die X::IO::BinaryMode.new(:trying<say>);
  569. my Mu $args := nqp::p6argvmarray();
  570. nqp::shift($args);
  571. my str $conc = '';
  572. $conc = nqp::concat($conc, nqp::shift($args).gist) while $args;
  573. self.print(nqp::concat($conc, $!nl-out));
  574. }
  575. method print-nl(IO::Handle:D: --> True) {
  576. $!decoder or die X::IO::BinaryMode.new(:trying<print-nl>);
  577. self.write-internal($!encoder.encode-chars($!nl-out));
  578. }
  579. proto method slurp-rest(|) {*}
  580. multi method slurp-rest(IO::Handle:D: :$bin! where *.so, :$close --> Buf:D) {
  581. # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp()
  582. # Testing of it in roast master has been removed and only kept in 6.c
  583. # If you're changing this code for whatever reason, test with 6.c-errata
  584. LEAVE self.close if $close;
  585. my $res := buf8.new;
  586. loop {
  587. my $buf := self.read(0x100000);
  588. nqp::elems($buf)
  589. ?? $res.append($buf)
  590. !! return $res
  591. }
  592. }
  593. multi method slurp-rest(IO::Handle:D: :$enc, :$bin, :$close --> Str:D) {
  594. # NOTE: THIS METHOD WILL BE DEPRECATED IN 6.d in favour of .slurp()
  595. # Testing of it in roast master has been removed and only kept in 6.c
  596. # If you're changing this code for whatever reason, test with 6.c-errata
  597. $!decoder or die X::IO::BinaryMode.new(:trying<slurp-rest>);
  598. LEAVE self.close if $close;
  599. self.encoding($enc) if $enc.defined;
  600. self!slurp-all-chars()
  601. }
  602. method slurp(IO::Handle:D: :$close, :$bin) {
  603. nqp::stmts(
  604. (my $res),
  605. nqp::if(
  606. $!decoder,
  607. nqp::if(
  608. $bin,
  609. nqp::stmts(
  610. ($res := buf8.new),
  611. nqp::if(
  612. $!decoder.bytes-available,
  613. $res.append($!decoder.consume-exactly-bytes(
  614. $!decoder.bytes-available)))),
  615. ($res := self!slurp-all-chars())),
  616. ($res := buf8.new)),
  617. nqp::if(
  618. nqp::isfalse($!decoder) || $bin,
  619. nqp::while(
  620. nqp::elems(my $buf := self.read-internal(0x100000)),
  621. $res.append($buf))),
  622. # don't sink result of .close; it might be a failed Proc
  623. nqp::if($close, my $ = self.close),
  624. $res)
  625. }
  626. method !slurp-all-chars() {
  627. while nqp::elems(my $buf := self.read-internal(0x100000)) {
  628. $!decoder.add-bytes($buf);
  629. }
  630. $!decoder.consume-all-chars()
  631. }
  632. proto method spurt(|) {*}
  633. multi method spurt(IO::Handle:D: Blob $data, :$close) {
  634. LEAVE self.close if $close;
  635. self.write-internal($data);
  636. }
  637. multi method spurt(IO::Handle:D: Cool $data, :$close) {
  638. LEAVE self.close if $close;
  639. self.print($data);
  640. }
  641. method path(IO::Handle:D:) { $!path.IO }
  642. method IO(IO::Handle:D:) { $!path.IO }
  643. # use $.path, so IO::Pipe picks it up
  644. multi method Str(IO::Handle:D:) { $.path.Str }
  645. multi method gist(IO::Handle:D:) {
  646. "{self.^name}<$!path.gist()>({self.opened ?? 'opened' !! 'closed'})"
  647. }
  648. method flush(IO::Handle:D: --> True) {
  649. CATCH { default { fail X::IO::Flush.new: :os-error(.Str) } }
  650. nqp::defined($!PIO) or die 'File handle not open, so cannot flush';
  651. nqp::flushfh($!PIO);
  652. }
  653. proto method encoding(|) {*}
  654. multi method encoding(IO::Handle:D:) { $!encoding // Nil }
  655. multi method encoding(IO::Handle:D: $new-encoding is copy, :$replacement, :$strict, Bool:D :$translate-nl = True) {
  656. with $new-encoding {
  657. if $_ eq 'bin' {
  658. $_ = Nil;
  659. }
  660. else {
  661. return $!encoding if $!encoding && $!encoding eq $_;
  662. }
  663. }
  664. with $!decoder {
  665. # We're switching encoding, or back to binary mode. First grab any
  666. # bytes the current decoder is holding on to but has not yet done
  667. # decoding of.
  668. my $available = $!decoder.bytes-available;
  669. with $new-encoding {
  670. my $prev-decoder := $!decoder;
  671. my $encoding = Encoding::Registry.find($new-encoding);
  672. $!decoder := $encoding.decoder(:$translate-nl, :$replacement, :$strict);
  673. $!decoder.set-line-separators($!nl-in.list);
  674. $!decoder.add-bytes($prev-decoder.consume-exactly-bytes($available))
  675. if $available;
  676. $!encoder := $encoding.encoder(:$translate-nl, :$replacement, :$strict);
  677. $!encoding = $encoding.name;
  678. }
  679. else {
  680. nqp::seekfh($!PIO, -$available, SeekFromCurrent) if $available;
  681. $!decoder := Encoding::Decoder;
  682. $!encoder := Encoding::Encoder;
  683. $!encoding = Nil;
  684. Nil
  685. }
  686. }
  687. else {
  688. # No previous decoder; make a new one if needed, otherwise no change.
  689. with $new-encoding {
  690. my $encoding = Encoding::Registry.find($new-encoding);
  691. $!decoder := $encoding.decoder(:$translate-nl, :$replacement, :$strict);
  692. $!decoder.set-line-separators($!nl-in.list);
  693. $!encoder := $encoding.encoder(:$translate-nl, :$replacement, :$strict);
  694. $!encoding = $encoding.name;
  695. }
  696. else {
  697. Nil
  698. }
  699. }
  700. }
  701. submethod DESTROY(IO::Handle:D:) {
  702. # Close handles with any file descriptor larger than 2. Those below
  703. # are our $*IN, $*OUT, and $*ERR, and we don't want them closed
  704. # implicitly via DESTROY, since you can't get them back again.
  705. nqp::if(
  706. nqp::defined($!PIO)
  707. && nqp::isgt_i((my int $fileno = nqp::filenofh($!PIO)), 2),
  708. nqp::stmts(
  709. nqp::closefh($!PIO), # don't bother checking for errors
  710. ($!PIO := nqp::null),
  711. self!forget-about-closing($fileno)
  712. )
  713. )
  714. }
  715. method native-descriptor(IO::Handle:D:) {
  716. nqp::filenofh($!PIO)
  717. }
  718. }
  719. Rakudo::Internals.REGISTER-DYNAMIC: '$*DEFAULT-READ-ELEMS', {
  720. PROCESS::<$DEFAULT-READ-ELEMS> := %*ENV<RAKUDO_DEFAULT_READ_ELEMS> // 65536;
  721. }