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