1. my class IO::ArgFiles { ... }
  2. proto sub print(|) { * }
  3. multi sub print(Str:D \x) {
  4. $*OUT.print(x);
  5. }
  6. multi sub print(\x) {
  7. $*OUT.print(x.Str);
  8. }
  9. multi sub print(**@args is raw) {
  10. my str $str;
  11. $str = nqp::concat($str,nqp::unbox_s(.Str)) for @args;
  12. $*OUT.print($str);
  13. }
  14. # Once we have an nqp::say that looks at the *output* line separator of the
  15. # PIO, then we can stop concatenating .nl-out to each string before .print, but
  16. # instead call nqp::say directly.
  17. proto sub say(|) { * }
  18. multi sub say() { $*OUT.print-nl }
  19. multi sub say(Str:D \x) {
  20. my $out := $*OUT;
  21. $out.print(nqp::concat(nqp::unbox_s(x),$out.nl-out));
  22. }
  23. multi sub say(\x) {
  24. my $out := $*OUT;
  25. $out.print(nqp::concat(nqp::unbox_s(x.gist),$out.nl-out));
  26. }
  27. multi sub say(**@args is raw) {
  28. my $out := $*OUT;
  29. my str $str;
  30. $str = nqp::concat($str,nqp::unbox_s(.gist)) for @args;
  31. $out.print(nqp::concat($str,$out.nl-out));
  32. }
  33. proto sub put(|) { * }
  34. multi sub put() { $*OUT.print-nl }
  35. multi sub put(Str:D \x) {
  36. my $out := $*OUT;
  37. $out.print(nqp::concat(nqp::unbox_s(x),$out.nl-out));
  38. }
  39. multi sub put(\x) {
  40. my $out := $*OUT;
  41. $out.print(nqp::concat(nqp::unbox_s(x.Str),$out.nl-out));
  42. }
  43. multi sub put(**@args is raw) {
  44. my $out := $*OUT;
  45. my str $str;
  46. $str = nqp::concat($str,nqp::unbox_s(.Str)) for @args;
  47. $out.print(nqp::concat($str,$out.nl-out));
  48. }
  49. proto sub note(|) { * }
  50. multi sub note() {
  51. my $err := $*ERR;
  52. $err.print(nqp::concat("Noted",$err.nl-out));
  53. }
  54. multi sub note(Str:D \x) {
  55. my $err := $*ERR;
  56. $err.print(nqp::concat(nqp::unbox_s(x),$err.nl-out));
  57. }
  58. multi sub note(**@args is raw) {
  59. my $err := $*ERR;
  60. my str $str;
  61. $str = nqp::concat($str,nqp::unbox_s(.gist)) for @args;
  62. $err.print(nqp::concat($str,$err.nl-out));
  63. }
  64. sub gist(|) {
  65. my \args := nqp::p6argvmarray();
  66. nqp::elems(args) == 1
  67. ?? nqp::atpos(args, 0).gist
  68. !! nqp::p6bindattrinvres(nqp::create(List), List, '$!reified', args).gist
  69. }
  70. sub prompt($msg) {
  71. my $out := $*OUT;
  72. $out.print($msg);
  73. $out.flush();
  74. $*IN.get;
  75. }
  76. proto sub dir(|) { * }
  77. multi sub dir(*%_) {
  78. $*SPEC.curdir.IO.dir(:!absolute, |%_)
  79. }
  80. multi sub dir(IO::Path:D $path, |c) {
  81. $path.dir(|c)
  82. }
  83. multi sub dir(Cool $path, |c) {
  84. $path.IO.dir(|c)
  85. }
  86. proto sub open(|) { * }
  87. multi sub open($path, :$chomp = True, :$enc = 'utf8', |c) {
  88. my $handle = IO::Handle.new(:path($path.IO));
  89. $handle // $handle.throw;
  90. $handle.open(:$chomp,:$enc,|c);
  91. }
  92. proto sub lines(|) { * }
  93. multi sub lines($what = $*ARGFILES, $limit = Inf, *%named) {
  94. nqp::istype($limit,Whatever) || $limit == Inf
  95. ?? $what.lines(|%named)
  96. !! $what.lines($limit, |%named);
  97. }
  98. proto sub words(|) { * }
  99. multi sub words($what, $limit = Inf, *%named) {
  100. nqp::istype($limit,Whatever) || $limit == Inf
  101. ?? $what.words(|%named)
  102. !! $what.words($limit, |%named);
  103. }
  104. proto sub get(|) { * }
  105. multi sub get($fh = $*ARGFILES) {
  106. $fh.get()
  107. }
  108. proto sub getc(|) { * }
  109. multi sub getc($fh = $*ARGFILES) {
  110. $fh.getc()
  111. }
  112. proto sub close(|) { * }
  113. multi sub close($fh) {
  114. $fh.close()
  115. }
  116. proto sub slurp(|) { * }
  117. multi sub slurp(IO::ArgFiles:D $io = $*ARGFILES, :$bin, :$enc = 'utf8', |c) {
  118. my $result := $io.slurp(:$bin, :$enc, |c);
  119. $result // $result.throw;
  120. }
  121. multi sub slurp(Cool:D $path, :$bin = False, :$enc = 'utf8', |c) {
  122. my $result := $path.IO.slurp(:$bin, :$enc, |c);
  123. $result // $result.throw;
  124. }
  125. proto sub spurt(|) { * }
  126. multi sub spurt(Cool $path, $contents, |c) {
  127. my $result := $path.IO.spurt($contents,|c);
  128. $result // $result.throw;
  129. }
  130. {
  131. sub chdir(Str() $path) {
  132. nqp::chdir(nqp::unbox_s($path));
  133. $*CWD = IO::Path.new(nqp::cwd());
  134. return True;
  135. CATCH {
  136. default {
  137. X::IO::Chdir.new(
  138. :$path,
  139. os-error => .Str,
  140. ).throw;
  141. }
  142. }
  143. }
  144. PROCESS::<&chdir> := &chdir;
  145. }
  146. sub chdir(Str() $path, :$test = 'r') {
  147. my $newCWD := $*CWD.chdir($path,:$test);
  148. $newCWD // $newCWD.throw;
  149. $*CWD = $newCWD;
  150. }
  151. sub indir(Str() $path, $what, :$test = <r w>) {
  152. my $newCWD := $*CWD.chdir($path,:$test);
  153. $newCWD // $newCWD.throw;
  154. {
  155. my $*CWD = $newCWD; # temp doesn't work in core settings :-(
  156. $what();
  157. }
  158. }
  159. sub tmpdir(Str() $path, :$test = <r w x>) {
  160. my $newTMPDIR := $*TMPDIR.chdir($path,:$test);
  161. $newTMPDIR // $newTMPDIR.throw;
  162. $*TMPDIR = $newTMPDIR;
  163. }
  164. sub homedir(Str() $path, :$test = <r w x>) {
  165. my $newHOME := $*HOME.chdir($path,:$test);
  166. $newHOME // $newHOME.throw;
  167. $*HOME = $newHOME;
  168. }
  169. PROCESS::<$IN> =
  170. IO::Handle.new(:path(IO::Special.new('<STDIN>'))).open;
  171. PROCESS::<$OUT> =
  172. IO::Handle.new(:path(IO::Special.new('<STDOUT>'))).open;
  173. PROCESS::<$ERR> =
  174. IO::Handle.new(:path(IO::Special.new('<STDERR>'))).open;
  175. sub chmod($mode, *@filenames, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  176. my @ok;
  177. for @filenames -> $file {
  178. @ok.push($file) if $file.IO(:$SPEC,:$CWD).chmod($mode);
  179. }
  180. @ok;
  181. # @filenames.grep( *.IO(:$SPEC,:$CWD).chmod($mode) ).eager;
  182. }
  183. sub unlink(*@filenames, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  184. my @ok;
  185. for @filenames -> $file {
  186. @ok.push($file) if $file.IO(:$SPEC,:$CWD).unlink;
  187. }
  188. @ok;
  189. # @filenames.grep( *.IO(:$SPEC,:$CWD).unlink ).eager;
  190. }
  191. sub rmdir(*@filenames, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  192. my @ok;
  193. for @filenames -> $file {
  194. @ok.push($file) if $file.IO(:$SPEC,:$CWD).rmdir;
  195. }
  196. @ok;
  197. # @filenames.grep( *.IO(:$SPEC,:$CWD).rmdir ).eager;
  198. }
  199. proto sub mkdir(|) { * }
  200. multi sub mkdir(Int $mode, *@dirnames, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  201. @dirnames.grep( *.IO(:$SPEC,:$CWD).mkdir($mode) ).eager;
  202. }
  203. multi sub mkdir($path, $mode = 0o777, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  204. $path.IO(:$SPEC,:$CWD).mkdir($mode) ?? ($path,) !! ();
  205. }
  206. sub rename($from, $to, :$SPEC = $*SPEC, :$CWD = $*CWD, :$createonly) {
  207. my $result := $from.IO(:$SPEC,:$CWD).rename($to,:$SPEC,:$CWD,:$createonly);
  208. $result // $result.throw;
  209. }
  210. sub copy($from, $to, :$SPEC = $*SPEC, :$CWD = $*CWD, :$createonly) {
  211. my $result := $from.IO(:$SPEC,:$CWD).copy($to,:$SPEC,:$CWD, :$createonly);
  212. $result // $result.throw;
  213. }
  214. sub move($from, $to, :$createonly) {
  215. try {
  216. copy($from, $to, :$createonly);
  217. unlink($from);
  218. return True;
  219. CATCH {
  220. when X::IO::Copy|X::IO::Unlink {
  221. fail X::IO::Move.new(
  222. :from(.from),
  223. :to(.to),
  224. :os-error(.os-error),
  225. );
  226. }
  227. }
  228. }
  229. }
  230. sub symlink($target, $name, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  231. my $result := $target.IO(:$SPEC,:$CWD).symlink($name,:$SPEC,:$CWD);
  232. $result // $result.throw;
  233. }
  234. sub link($target, $name, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  235. my $result := $target.IO(:$SPEC,:$CWD).link($name,:$SPEC,:$CWD);
  236. $result // $result.throw;
  237. }