1. my class IO::ArgFiles { ... }
  2. proto sub print(|) {*}
  3. multi sub print(--> True) { } # nothing to do
  4. multi sub print(Junction:D \j) { j.THREAD(&print) }
  5. multi sub print(Str:D \x) { $*OUT.print(x) }
  6. multi sub print(\x) { $*OUT.print(x.Str) }
  7. multi sub print(**@args is raw) { $*OUT.print: @args.join }
  8. proto sub say(|) {*}
  9. multi sub say() { $*OUT.print-nl }
  10. multi sub say(\x) {
  11. my $out := $*OUT;
  12. $out.print(nqp::concat(nqp::unbox_s(x.gist),$out.nl-out));
  13. }
  14. multi sub say(**@args is raw) {
  15. my str $str;
  16. my $iter := @args.iterator;
  17. nqp::until(
  18. nqp::eqaddr(($_ := $iter.pull-one), IterationEnd),
  19. $str = nqp::concat($str, nqp::unbox_s(.gist)));
  20. my $out := $*OUT;
  21. $out.print(nqp::concat($str,$out.nl-out));
  22. }
  23. proto sub put(|) {*}
  24. multi sub put() { $*OUT.print-nl }
  25. multi sub put(Junction:D \j) {
  26. j.THREAD(&put)
  27. }
  28. multi sub put(Str:D \x) {
  29. my $out := $*OUT;
  30. $out.print(nqp::concat(nqp::unbox_s(x),$out.nl-out));
  31. }
  32. multi sub put(\x) {
  33. my $out := $*OUT;
  34. $out.print(nqp::concat(nqp::unbox_s(x.Str),$out.nl-out));
  35. }
  36. multi sub put(**@args is raw) {
  37. my $out := $*OUT;
  38. $out.print: @args.join ~ $out.nl-out
  39. }
  40. proto sub note(|) {*}
  41. multi sub note() {
  42. my $err := $*ERR;
  43. $err.print(nqp::concat("Noted",$err.nl-out));
  44. }
  45. multi sub note(**@args is raw) {
  46. my $err := $*ERR;
  47. my str $str;
  48. $str = nqp::concat($str,nqp::unbox_s(.gist)) for @args;
  49. $err.print(nqp::concat($str,$err.nl-out));
  50. }
  51. proto sub gist(|) {*}
  52. multi sub gist(|) {
  53. my \args := nqp::p6argvmarray();
  54. nqp::elems(args) == 1
  55. ?? nqp::atpos(args, 0).gist
  56. !! nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', args).gist
  57. }
  58. multi sub prompt() {
  59. $*IN.get
  60. }
  61. multi sub prompt($msg) {
  62. my $out := $*OUT;
  63. $out.print($msg);
  64. $out.flush();
  65. $*IN.get;
  66. }
  67. proto sub dir(|) {*}
  68. multi sub dir(*%_) { $*SPEC.curdir.IO.dir(:!absolute, |%_) }
  69. multi sub dir(IO::Path:D $path, |c) { $path.dir(|c) }
  70. multi sub dir(IO() $path, |c) { $path.dir(|c) }
  71. proto sub open(|) {*}
  72. multi sub open(IO() $path, |c) { IO::Handle.new(:$path).open(|c) }
  73. proto sub lines(|) {*}
  74. multi sub lines($what = $*ARGFILES, |c) { $what.lines(|c) }
  75. proto sub words(|) {*}
  76. multi sub words($what = $*ARGFILES, |c) { $what.words(|c) }
  77. proto sub get (|) {*}
  78. multi sub get (IO::Handle:D $fh = $*ARGFILES) { $fh.get }
  79. proto sub getc (|) {*}
  80. multi sub getc (IO::Handle:D $fh = $*ARGFILES) { $fh.getc }
  81. proto sub close(|) {*}
  82. multi sub close(IO::Handle:D $fh) { $fh.close }
  83. multi sub close(Channel:D $channel) { $channel.close }
  84. proto sub slurp(|) {*}
  85. multi sub slurp(IO::Handle:D $fh = $*ARGFILES, |c) { $fh.slurp(|c) }
  86. multi sub slurp(IO() $path, |c) { $path.slurp(|c) }
  87. proto sub spurt(|) {*}
  88. multi sub spurt(IO::Handle:D $fh, |c) { $fh .spurt(|c) }
  89. multi sub spurt(IO() $path, |c) { $path.spurt(|c) }
  90. {
  91. sub chdir(IO() $path) {
  92. CATCH {
  93. default {
  94. return Failure.new: X::IO::Chdir.new: :$path, :os-error(.Str);
  95. }
  96. }
  97. nqp::chdir(nqp::unbox_s($path.absolute));
  98. $*CWD = IO::Path.new(nqp::cwd());
  99. }
  100. PROCESS::<&chdir> := &chdir;
  101. }
  102. proto sub chdir(|) {*}
  103. multi sub chdir(|c) {
  104. nqp::if(nqp::istype(($_ := $*CWD.chdir(|c)), Failure), $_, $*CWD = $_)
  105. }
  106. proto sub indir(|) {*}
  107. multi sub indir(IO() $path, &what, :$test!) {
  108. DEPRECATED(
  109. :what<:$test argument>,
  110. 'individual named parameters (e.g. :r, :w, :x)',
  111. "v2017.03.101.ga.5800.a.1", "v6.d", :up(*),
  112. );
  113. indir $path, &what, |$test.words.map(* => True).Hash;
  114. }
  115. multi sub indir(IO() $path, &what, :$d = True, :$r, :$w, :$x) {
  116. { # NOTE: we need this extra block so that the IO() coercer doesn't
  117. # use our (empty at the time) $*CWD when making the IO::Path object
  118. nqp::stmts(
  119. $d && nqp::isfalse($path.d) && X::IO::Chdir.new(
  120. :$path, :os-error(
  121. $path.e ?? 'is not a directory' !! 'does not exist')).fail,
  122. $r && nqp::isfalse($path.r) && X::IO::Chdir.new(
  123. :$path, :os-error("did not pass :r test")).fail,
  124. $w && nqp::isfalse($path.w) && X::IO::Chdir.new(
  125. :$path, :os-error("did not pass :w test")).fail,
  126. $x && nqp::isfalse($path.x) && X::IO::Chdir.new(
  127. :$path, :os-error("did not pass :x test")).fail,
  128. # $*CWD gets stringified with .Str in IO::Path.new, so we need to
  129. # ensure it's set to an absolute path
  130. my $*CWD = $path.WHAT.new: $path.absolute,
  131. :SPEC($path.SPEC), :CWD($path.SPEC.rootdir))
  132. && what
  133. }
  134. }
  135. # Set up the standard STDIN/STDOUT/STDERR by first setting up the skeletons
  136. # of the IO::Handle objects that can be setup at compile time. Then, when
  137. # running the mainline of the setting at startup, plug in the low level
  138. # handles and set up the encoder and decoders. This shaves off about 1.5%
  139. # of bare startup.
  140. {
  141. my constant NL-IN = ["\x0A", "\r\n"];
  142. my constant NL-OUT = "\n";
  143. my constant ENCODING = "utf8";
  144. my sub setup-handle(str $what) {
  145. my $handle := nqp::p6bindattrinvres(
  146. nqp::create(IO::Handle),IO::Handle,'$!path',nqp::p6bindattrinvres(
  147. nqp::create(IO::Special),IO::Special,'$!what',$what
  148. )
  149. );
  150. nqp::getattr($handle,IO::Handle,'$!chomp') = True;
  151. nqp::getattr($handle,IO::Handle,'$!nl-in') = NL-IN;
  152. nqp::getattr($handle,IO::Handle,'$!nl-out') = NL-OUT;
  153. nqp::getattr($handle,IO::Handle,'$!encoding') = ENCODING;
  154. $handle
  155. }
  156. # Set up the skeletons at compile time
  157. my constant STDIN = setup-handle('<STDIN>');
  158. my constant STDOUT = setup-handle('<STDOUT>');
  159. my constant STDERR = setup-handle('<STDERR>');
  160. my sub activate-handle(Mu \HANDLE, Mu \PIO) {
  161. nqp::setbuffersizefh(PIO,8192) unless nqp::isttyfh(PIO);
  162. my $encoding = Encoding::Registry.find(ENCODING);
  163. nqp::bindattr(
  164. HANDLE,IO::Handle,'$!decoder',$encoding.decoder(:translate-nl)
  165. ).set-line-separators(NL-IN);
  166. nqp::bindattr(
  167. HANDLE,IO::Handle,'$!encoder',$encoding.encoder(:translate-nl)
  168. );
  169. nqp::p6bindattrinvres(HANDLE,IO::Handle,'$!PIO',PIO)
  170. }
  171. # Activate the skeletons at runtime
  172. PROCESS::<$IN> = activate-handle(STDIN, nqp::getstdin);
  173. PROCESS::<$OUT> = activate-handle(STDOUT, nqp::getstdout);
  174. PROCESS::<$ERR> = activate-handle(STDERR, nqp::getstderr);
  175. }
  176. proto sub chmod(|) {*}
  177. multi sub chmod($mode, *@filenames) {
  178. my @ok;
  179. for @filenames -> $file { @ok.push($file) if $file.IO.chmod($mode) }
  180. @ok;
  181. }
  182. proto sub unlink(|) {*}
  183. multi sub unlink(*@filenames) {
  184. my @ok;
  185. for @filenames -> $file { @ok.push($file) if $file.IO.unlink }
  186. @ok;
  187. }
  188. proto sub rmdir(|) {*}
  189. multi sub rmdir(*@filenames) {
  190. my @ok;
  191. for @filenames -> $file { @ok.push($file) if $file.IO.rmdir }
  192. @ok;
  193. }
  194. proto sub mkdir(|) {*}
  195. multi sub mkdir(IO() $path, Int() $mode = 0o777) { $path.mkdir($mode) }
  196. proto sub rename(|) {*}
  197. multi sub rename(IO() $from, IO() $to, :$createonly) {
  198. $from.rename($to, :$createonly)
  199. }
  200. proto sub copy(|) {*}
  201. multi sub copy(IO() $from, IO() $to, :$createonly) {
  202. $from.copy($to, :$createonly)
  203. }
  204. proto sub move(|) {*}
  205. multi sub move(IO() $from, IO() $to, :$createonly) {
  206. $from.move($to, :$createonly)
  207. }
  208. proto sub symlink(|) {*}
  209. multi sub symlink(IO() $target, IO() $name) { $target.symlink($name) }
  210. proto sub link(|) {*}
  211. multi sub link(IO() $target, IO() $name) { $target.link($name) }