1. my class IO::Path is Cool does IO {
  2. has IO::Spec $.SPEC;
  3. has Str $.CWD;
  4. has Str $.path;
  5. has Bool $!is-absolute;
  6. has Str $!abspath;
  7. has %!parts;
  8. multi method ACCEPTS(IO::Path:D: Cool:D \other) {
  9. nqp::p6bool(nqp::iseq_s($.absolute, nqp::unbox_s(other.IO.absolute)));
  10. }
  11. submethod BUILD(:$!path!, :$!SPEC!, :$!CWD! --> Nil) {
  12. nqp::unless(nqp::chars($!path), # could be an IntStr, so check chars
  13. die "Must specify something as a path: did you mean '.' for the current directory?"
  14. );
  15. nqp::if(
  16. nqp::isne_i(nqp::index($!path, "\0"), -1)
  17. || nqp::isne_i(nqp::index($!CWD, "\0"), -1),
  18. X::IO::Null.new.throw
  19. );
  20. }
  21. method !new-from-absolute-path($path, :$SPEC = $*SPEC, Str() :$CWD = $*CWD) {
  22. self.bless(:$path, :$SPEC, :$CWD)!set-absolute($path);
  23. }
  24. method !set-absolute($path) {
  25. $!is-absolute = True;
  26. $!abspath := $path;
  27. self;
  28. }
  29. proto method new(|) {*}
  30. multi method new(IO::Path: Str $path, :$SPEC = $*SPEC, Str:D :$CWD) {
  31. self.bless(:$path, :$SPEC, :$CWD);
  32. }
  33. multi method new(IO::Path: Str $path, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  34. self.bless(:$path, :$SPEC, :CWD($CWD.Str));
  35. }
  36. multi method new(IO::Path: Cool $path, :$SPEC = $*SPEC, :$CWD = $*CWD) {
  37. self.bless(:path($path.Str), :$SPEC, :CWD($CWD.Str));
  38. }
  39. multi method new(IO::Path:
  40. :$basename!,
  41. :$dirname = '',
  42. :$volume = '',
  43. :$SPEC = $*SPEC,
  44. Str() :$CWD = $*CWD,
  45. ) {
  46. self.bless(:path($SPEC.join($volume,$dirname,$basename)),:$SPEC,:$CWD);
  47. }
  48. multi method new(IO::Path:) {
  49. die "Must specify something as a path: did you mean '.' for the current directory?";
  50. }
  51. method is-absolute() {
  52. nqp::if(
  53. nqp::isconcrete($!is-absolute),
  54. $!is-absolute,
  55. $!is-absolute = nqp::p6bool($!SPEC.is-absolute: $!path))
  56. }
  57. method is-relative() {
  58. nqp::p6bool(
  59. nqp::not_i(
  60. nqp::if(
  61. nqp::isconcrete($!is-absolute),
  62. $!is-absolute,
  63. $!is-absolute = nqp::p6bool($!SPEC.is-absolute: $!path))))
  64. }
  65. method parts {
  66. %!parts || (%!parts := nqp::create(Map).STORE: $!SPEC.split: $!path)
  67. }
  68. method volume(IO::Path:D:) { %.parts<volume> }
  69. method dirname(IO::Path:D:) { %.parts<dirname> }
  70. method basename(IO::Path:D:) { %.parts<basename> }
  71. my sub EXTENSION-MK-EXTENSION (
  72. str $name, $no-ext, int $part-min, int $part-max = $part-min
  73. ) is pure {
  74. my int $offset = nqp::chars($name);
  75. my int $next-offset;
  76. my int $parts;
  77. nqp::while(
  78. nqp::if(
  79. nqp::isne_i( -1,
  80. ($next-offset = nqp::rindex($name, '.', nqp::sub_i($offset, 1)))),
  81. nqp::if($offset, nqp::islt_i($parts, $part-max))
  82. ),
  83. nqp::stmts(
  84. ($offset = $next-offset),
  85. ($parts = nqp::add_i($parts, 1))
  86. ),
  87. );
  88. nqp::if(
  89. nqp::if(nqp::isle_i($part-min, $parts), nqp::isle_i($parts, $part-max)),
  90. nqp::substr($name, nqp::add_i($offset, 1)),
  91. $no-ext,
  92. )
  93. }
  94. my sub EXTENSION-SUBST ($ext, $base, $subst, $joiner) is pure {
  95. nqp::if(
  96. nqp::defined($ext),
  97. nqp::unless(
  98. nqp::concat(
  99. nqp::if(
  100. nqp::unless( # if extension is empty, check $base to find out if...
  101. nqp::chars($ext), #... it's a missing ext. or empty string ext.
  102. nqp::eqat($base, '.', nqp::sub_i(nqp::chars($base), 1))
  103. ),
  104. nqp::substr($base, 0,
  105. nqp::sub_i(nqp::chars($base), nqp::add_i(nqp::chars($ext), 1))
  106. ),
  107. $base,
  108. ),
  109. nqp::concat($joiner, $subst)
  110. ), '.' # use `.` as basename if we ended up with it being empty
  111. ),
  112. $base,
  113. )
  114. }
  115. proto method extension(|) {*}
  116. multi method extension(IO::Path:D:) {
  117. nqp::if(
  118. nqp::iseq_i(-1, (my int $offset = nqp::rindex(
  119. (my str $basename = nqp::unbox_s(self.basename)),'.'))),
  120. '', nqp::substr($basename, nqp::add_i($offset, 1))
  121. )
  122. }
  123. multi method extension(IO::Path:D: Int :$parts!) {
  124. EXTENSION-MK-EXTENSION self.basename, '',
  125. nqp::if(
  126. nqp::islt_I(nqp::decont($parts), -2**63), -2**63,
  127. nqp::if( nqp::isgt_I(nqp::decont($parts), 2**63-1), 2**63-1,
  128. nqp::unbox_i($parts),
  129. ),
  130. )
  131. }
  132. multi method extension(IO::Path:D: Range :$parts!) {
  133. my ($min, $max) := Rakudo::Internals.RANGE-AS-ints:
  134. $parts, "Can only use numeric, non-NaN Ranges as :parts";
  135. EXTENSION-MK-EXTENSION self.basename, '', $min, $max
  136. }
  137. multi method extension(IO::Path:D:
  138. Str $subst,
  139. Int :$parts = 1, Str :$joiner = nqp::if(nqp::chars($subst), '.', '')
  140. ) {
  141. self.new: :dirname(self.dirname), :volume(self.volume),
  142. :$!SPEC, :$!CWD, basename => EXTENSION-SUBST
  143. EXTENSION-MK-EXTENSION(
  144. (my str $base = nqp::unbox_s(self.basename)),
  145. Any, nqp::if(
  146. nqp::islt_I(nqp::decont($parts), -2**63), -2**63,
  147. nqp::if( nqp::isgt_I(nqp::decont($parts), 2**63-1), 2**63-1,
  148. nqp::unbox_i($parts),
  149. ),
  150. )
  151. ), $base, $subst, $joiner;
  152. }
  153. multi method extension(
  154. Str $subst,
  155. Range :$parts, Str :$joiner = nqp::if(nqp::chars($subst), '.', '')
  156. ) {
  157. my ($min, $max) := Rakudo::Internals.RANGE-AS-ints:
  158. $parts, "Can only use numeric, non-NaN Ranges as :parts";
  159. self.new: :dirname(self.dirname), :volume(self.volume),
  160. :$!SPEC, :$!CWD, basename => EXTENSION-SUBST
  161. EXTENSION-MK-EXTENSION(
  162. (my str $base = nqp::unbox_s(self.basename)), Any, $min, $max
  163. ), $base, $subst, $joiner
  164. }
  165. method Numeric(IO::Path:D:) { self.basename.Numeric }
  166. multi method Str (IO::Path:D:) { $!path }
  167. multi method gist(IO::Path:D:) {
  168. $!is-absolute
  169. ?? qq|"$.absolute".IO|
  170. !! qq|"$.path".IO|
  171. }
  172. multi method perl(IO::Path:D:) {
  173. self.^name ~ ".new({$.path.perl}, {:$!SPEC.perl}, {:$!CWD.perl})"
  174. }
  175. method sibling(IO::Path:D: Str() \sibling) {
  176. $_ := self.parts;
  177. self.bless: :path($!SPEC.join: .<volume>, .<dirname>, sibling),
  178. :$!SPEC, :$!CWD;
  179. }
  180. method succ(IO::Path:D:) {
  181. self.bless(
  182. :path($!SPEC.join($.volume,$.dirname,$.basename.succ)),
  183. :$!SPEC,
  184. :$!CWD,
  185. );
  186. }
  187. method pred(IO::Path:D:) {
  188. self.bless(
  189. :path($!SPEC.join($.volume,$.dirname,$.basename.pred)),
  190. :$!SPEC,
  191. :$!CWD,
  192. );
  193. }
  194. multi method IO { self }
  195. method open(IO::Path:D: |c) { IO::Handle.new(:path(self)).open(|c) }
  196. method watch(IO::Path:D:) {
  197. IO::Notification.watch-path($.absolute);
  198. }
  199. proto method absolute(|) {*}
  200. multi method absolute (IO::Path:D:) {
  201. $!abspath //= $!SPEC.rel2abs($!path,$!CWD)
  202. }
  203. multi method absolute (IO::Path:D: $CWD) {
  204. self.is-absolute
  205. ?? self.absolute
  206. !! $!SPEC.rel2abs($!path, $CWD);
  207. }
  208. method relative (IO::Path:D: $CWD = $*CWD) {
  209. $!SPEC.abs2rel($.absolute, $CWD);
  210. }
  211. method cleanup (IO::Path:D:) {
  212. self.bless(:path($!SPEC.canonpath($!path)), :$!SPEC, :$!CWD);
  213. }
  214. method resolve (IO::Path:D: :$completely) {
  215. # XXXX: Not portable yet; assumes POSIX semantics
  216. my int $max-depth = 256;
  217. my str $sep = $!SPEC.dir-sep;
  218. my str $cur = $!SPEC.curdir;
  219. my str $up = $!SPEC.updir;
  220. my str $empty = '';
  221. my Mu $res-list := nqp::list_s();
  222. my %parts = $!SPEC.split: self.absolute;
  223. my str $volume = %parts<volume>;
  224. my str $resolved = $volume;
  225. my $path = $!SPEC.catpath: '', |%parts<dirname basename>;
  226. # In this bit, we work with bytes, converting $sep (and assuming it's
  227. # 1-char long) in the path to nul bytes and then splitting the path
  228. # on nul bytes. This way, even if we get some weird paths like
  229. # "/\x[308]", we still split on the /, leaving the lone combiner as
  230. # part of the path part.
  231. nqp::stmts(
  232. (my $p := nqp::encode(
  233. nqp::unbox_s($path), 'utf8-c8', buf8.new)),
  234. (my int $ord-sep = nqp::ord($sep)),
  235. (my int $els = nqp::elems($p)),
  236. (my int $i = -1),
  237. nqp::while(
  238. nqp::isne_i($els, $i = nqp::add_i($i, 1)),
  239. nqp::if(
  240. nqp::iseq_i(nqp::atpos_i($p, $i), $ord-sep),
  241. nqp::atposref_i($p, $i) = 0)),
  242. my $parts := nqp::split("\0", nqp::decode($p, 'utf8-c8')));
  243. while $parts {
  244. fail "Resolved path too deep!"
  245. if $max-depth < nqp::elems($res-list) + nqp::elems($parts);
  246. # Grab next unprocessed part, check for '', '.', '..'
  247. my str $part = nqp::shift($parts);
  248. next if nqp::iseq_s($part, $empty) || nqp::iseq_s($part, $cur);
  249. if nqp::iseq_s($part, $up) {
  250. next unless $res-list;
  251. nqp::pop_s($res-list);
  252. $resolved = $res-list ?? $sep ~ nqp::join($sep, $res-list)
  253. !! $empty;
  254. next;
  255. }
  256. # Normal part, set as next path to test
  257. my str $next = nqp::concat($resolved, nqp::concat($sep, $part));
  258. # Path part doesn't exist...
  259. if !nqp::stat($next, nqp::const::STAT_EXISTS) {
  260. # fail() if we were asked for complete resolution and we still
  261. # have further parts to resolve. If it's the last part,
  262. # don't fail; it can be a yet-to-be-created file or dir
  263. $completely
  264. && nqp::elems($parts)
  265. && X::IO::Resolve.new(:path(self)).fail;
  266. # ...or handle rest in non-resolving mode if not
  267. $resolved = $next;
  268. while $parts {
  269. $part = nqp::shift($parts);
  270. next if nqp::iseq_s($part, $empty) || nqp::iseq_s($part, $cur);
  271. $resolved = nqp::concat($resolved, nqp::concat($sep, $part));
  272. }
  273. }
  274. # Symlink; read it and act on absolute or relative link
  275. elsif nqp::fileislink($next) {
  276. my str $link = nqp::readlink($next);
  277. my Mu $link-parts := nqp::split($sep, $link);
  278. next unless $link-parts;
  279. # Symlink to absolute path
  280. if nqp::iseq_s($link-parts[0], $empty) {
  281. $resolved = nqp::shift($link-parts);
  282. $res-list := nqp::list_s();
  283. }
  284. nqp::unshift($parts, nqp::pop($link-parts))
  285. while $link-parts;
  286. }
  287. # Just a plain old path part, so append it and go on
  288. else {
  289. $resolved = $next;
  290. nqp::push_s($res-list, $part);
  291. }
  292. }
  293. $resolved = $volume ~ $sep if $resolved eq $volume;
  294. IO::Path!new-from-absolute-path($resolved,:$!SPEC,:CWD($volume ~ $sep));
  295. }
  296. proto method parent(|) {*}
  297. multi method parent(IO::Path:D: UInt:D $depth) {
  298. my $io = self;
  299. $io .= parent xx $depth;
  300. $io;
  301. }
  302. multi method parent(IO::Path:D:) { # XXX needs work
  303. my $curdir := $!SPEC.curdir;
  304. my $updir := $!SPEC.updir;
  305. if self.is-absolute {
  306. return self.bless(
  307. :path($!SPEC.join($.volume, $.dirname, '')),
  308. :$!SPEC,
  309. :$!CWD,
  310. );
  311. }
  312. elsif $.dirname eq $curdir and $.basename eq $curdir {
  313. return self.bless(
  314. :path($!SPEC.join($.volume,$curdir,$updir)),
  315. :$!SPEC,
  316. :$!CWD,
  317. );
  318. }
  319. elsif $.dirname eq $curdir && $.basename eq $updir
  320. or !grep({$_ ne $updir}, $!SPEC.splitdir($.dirname)) {
  321. return self.bless( # If all updirs, then add one more
  322. :path($!SPEC.join($.volume,$!SPEC.catdir($.dirname,$updir),$.basename)),
  323. :$!SPEC,
  324. :$!CWD,
  325. );
  326. }
  327. else {
  328. return self.bless(
  329. :path($!SPEC.join($.volume, $.dirname, '')),
  330. :$!SPEC,
  331. :$!CWD,
  332. );
  333. }
  334. }
  335. method child (IO::Path:D: Str() \child) {
  336. self.bless: :path($!SPEC.join: '', $!path, child), :$!SPEC, :$!CWD
  337. }
  338. # XXX TODO: swap .child to .child-secure sometime close to 6.d
  339. # Discussion: https://irclog.perlgeek.de/perl6-dev/2017-04-17#i_14439386
  340. #
  341. # method child-secure (IO::Path:D: \child) {
  342. # # The goal of this method is to guarantee the resultant child path is
  343. # # inside the invocant. We resolve the path completely, so for that to
  344. # # happen, the kid cannot be inside some currently non-existent dirs, so
  345. # # this method will fail with X::IO::Resolve in those cases. To find out
  346. # # if the kid is in fact a kid, we fully-resolve the kid and the
  347. # # invocant. Then, we append a dir separator to invocant's .absolute and
  348. # # check if the kid's .absolute starts with that string.
  349. # nqp::if(
  350. # nqp::istype((my $kid := self.child(child).resolve: :completely),
  351. # Failure),
  352. # $kid, # we failed to resolve the kid, return the Failure
  353. # nqp::if(
  354. # nqp::istype((my $res-self := self.resolve: :completely), Failure),
  355. # $res-self, # failed to resolve invocant, return the Failure
  356. # nqp::if(
  357. # nqp::iseq_s(
  358. # ($_ := nqp::concat($res-self.absolute, $!SPEC.dir-sep)),
  359. # nqp::substr($kid.absolute, 0, nqp::chars($_))),
  360. # $kid, # kid appears to be kid-proper; return it. Otherwise fail
  361. # fail X::IO::NotAChild.new:
  362. # :path($res-self.absolute), :child($kid.absolute))))
  363. # }
  364. method add (IO::Path:D: Str() \what) {
  365. self.bless: :path($!SPEC.join: '', $!path, what), :$!SPEC, :$!CWD;
  366. }
  367. proto method chdir(|) {*}
  368. multi method chdir(IO::Path:D: Str() $path, :$test!) {
  369. DEPRECATED(
  370. :what<:$test argument>,
  371. 'individual named parameters (e.g. :r, :w, :x)',
  372. "v2017.03.101.ga.5800.a.1", "v6.d", :up(*),
  373. );
  374. self.chdir: $path, |$test.words.map(* => True).Hash;
  375. }
  376. multi method chdir(IO::Path:D: IO $path, |c) {
  377. self.chdir: $path.absolute, |c
  378. }
  379. multi method chdir(
  380. IO::Path:D: Str() $path is copy, :$d = True, :$r, :$w, :$x,
  381. ) {
  382. unless $!SPEC.is-absolute($path) {
  383. my ($volume,$dirs) = $!SPEC.splitpath(self.absolute, :nofile);
  384. my @dirs = $!SPEC.splitdir($dirs);
  385. @dirs.shift; # the first is always empty for absolute dirs
  386. for $!SPEC.splitdir($path) -> $dir {
  387. if $dir eq '..' {
  388. @dirs.pop if @dirs;
  389. }
  390. elsif $dir ne '.' {
  391. @dirs.push: $dir;
  392. }
  393. }
  394. @dirs.push('') if !@dirs; # need at least the rootdir
  395. $path = join($!SPEC.dir-sep, $volume, @dirs);
  396. }
  397. my $dir = IO::Path!new-from-absolute-path($path,:$!SPEC,:CWD(self));
  398. nqp::stmts(
  399. nqp::unless(
  400. nqp::unless(nqp::isfalse($d), $dir.d),
  401. fail X::IO::Chdir.new: :$path, :os-error(
  402. nqp::if($dir.e, 'is not a directory', 'does not exist')
  403. )
  404. ),
  405. nqp::unless(
  406. nqp::unless(nqp::isfalse($r), $dir.r),
  407. fail X::IO::Chdir.new: :$path, :os-error("did not pass :r test")
  408. ),
  409. nqp::unless(
  410. nqp::unless(nqp::isfalse($w), $dir.w),
  411. fail X::IO::Chdir.new: :$path, :os-error("did not pass :w test")
  412. ),
  413. nqp::unless(
  414. nqp::unless(nqp::isfalse($x), $dir.x),
  415. fail X::IO::Chdir.new: :$path, :os-error("did not pass :x test")
  416. ),
  417. $dir
  418. )
  419. }
  420. method rename(IO::Path:D: IO() $to, :$createonly --> True) {
  421. $createonly and $to.e and fail X::IO::Rename.new:
  422. :from($.absolute),
  423. :to($to.absolute),
  424. :os-error(':createonly specified and destination exists');
  425. nqp::rename($.absolute, nqp::unbox_s($to.absolute));
  426. CATCH { default {
  427. fail X::IO::Rename.new:
  428. :from($!abspath), :to($to.absolute), :os-error(.Str);
  429. }}
  430. }
  431. method copy(IO::Path:D: IO() $to, :$createonly --> True) {
  432. $createonly and $to.e and fail X::IO::Copy.new:
  433. :from($.absolute),
  434. :to($to.absolute),
  435. :os-error(':createonly specified and destination exists');
  436. # XXX TODO: maybe move the sameness check to the nqp OP/VM
  437. nqp::if(
  438. nqp::iseq_s(
  439. (my $from-abs := $.absolute),
  440. (my $to-abs := $to.absolute)),
  441. X::IO::Copy.new(:from($from-abs), :to($to-abs),
  442. :os-error('source and target are the same')).fail,
  443. nqp::copy($from-abs, $to-abs));
  444. CATCH { default {
  445. fail X::IO::Copy.new:
  446. :from($!abspath), :to($to.absolute), :os-error(.Str)
  447. }}
  448. }
  449. method move(IO::Path:D: |c --> True) {
  450. self.copy(|c) orelse fail X::IO::Move.new: :from(.exception.from),
  451. :to(.exception.to), :os-error(.exception.os-error);
  452. self.unlink orelse fail X::IO::Move.new: :from(.exception.from),
  453. :to(.exception.to), :os-error(.exception.os-error);
  454. }
  455. method chmod(IO::Path:D: Int() $mode --> True) {
  456. nqp::chmod($.absolute, nqp::unbox_i($mode));
  457. CATCH { default {
  458. fail X::IO::Chmod.new(
  459. :path($!abspath), :$mode, :os-error(.Str) );
  460. }}
  461. }
  462. method unlink(IO::Path:D: --> True) {
  463. nqp::unlink($.absolute);
  464. CATCH { default {
  465. fail X::IO::Unlink.new( :path($!abspath), os-error => .Str );
  466. }}
  467. }
  468. method symlink(IO::Path:D: IO() $name --> True) {
  469. nqp::symlink($.absolute, nqp::unbox_s($name.absolute));
  470. CATCH { default {
  471. fail X::IO::Symlink.new:
  472. :target($!abspath), :name($name.absolute), :os-error(.Str);
  473. }}
  474. }
  475. method link(IO::Path:D: IO() $name --> True) {
  476. nqp::link($.absolute, $name.absolute);
  477. CATCH { default {
  478. fail X::IO::Link.new:
  479. :target($!abspath), :name($name.absolute), :os-error(.Str);
  480. }}
  481. }
  482. method mkdir(IO::Path:D: Int() $mode = 0o777) {
  483. nqp::mkdir($.absolute, $mode);
  484. CATCH { default {
  485. fail X::IO::Mkdir.new(:path($!abspath), :$mode, os-error => .Str);
  486. }}
  487. self
  488. }
  489. method rmdir(IO::Path:D: --> True) {
  490. nqp::rmdir($.absolute);
  491. CATCH { default {
  492. fail X::IO::Rmdir.new(:path($!abspath), os-error => .Str);
  493. }}
  494. }
  495. proto method dir(|) {*} # make it possible to augment with multies from modulespace
  496. multi method dir(IO::Path:D: Mu :$test = $*SPEC.curupdir) {
  497. CATCH { default {
  498. fail X::IO::Dir.new(
  499. :path($.absolute), :os-error(.Str) );
  500. } }
  501. my str $dir-sep = $!SPEC.dir-sep;
  502. my int $absolute = $.is-absolute;
  503. my str $abspath;
  504. $absolute && nqp::unless( # calculate $abspath only when we'll need it
  505. nqp::eqat(($abspath = $.absolute), $dir-sep,
  506. nqp::sub_i(nqp::chars($abspath), 1)),
  507. ($abspath = nqp::concat($abspath, $dir-sep)));
  508. my str $path = nqp::iseq_s($!path, '.') || nqp::iseq_s($!path, $dir-sep)
  509. ?? ''
  510. !! nqp::eqat($!path, $dir-sep, nqp::sub_i(nqp::chars($!path), 1))
  511. ?? $!path
  512. !! nqp::concat($!path, $dir-sep);
  513. my Mu $dirh := nqp::opendir(nqp::unbox_s($.absolute));
  514. gather {
  515. # set $*CWD inside gather for $test.ACCEPTS to use correct
  516. # $*CWD the user gave us, instead of whatever $*CWD is
  517. # when the gather is actually evaluated. We use a temp var
  518. # so that .IO coercer doesn't use the nulled `$*CWD` for
  519. # $!CWD attribute and we don't use `temp` for this, because
  520. # it's about 2x slower than using a temp var.
  521. my $cwd = $!CWD.IO;
  522. { my $*CWD = $cwd;
  523. nqp::until(
  524. nqp::isnull_s(my str $str-elem = nqp::nextfiledir($dirh))
  525. || nqp::iseq_i(nqp::chars($str-elem),0),
  526. nqp::if(
  527. $test.ACCEPTS($str-elem),
  528. nqp::if(
  529. $absolute,
  530. (take IO::Path!new-from-absolute-path(
  531. nqp::concat($abspath,$str-elem),:$!SPEC,:$!CWD)),
  532. (take IO::Path.new(
  533. nqp::concat($path,$str-elem),:$!SPEC,:$!CWD)),)));
  534. nqp::closedir($dirh);
  535. }
  536. }
  537. }
  538. proto method slurp() {*}
  539. multi method slurp(IO::Path:D: :$enc, :$bin) {
  540. # We use an IO::Handle in binary mode, and then decode the string
  541. # all in one go, which avoids the overhead of setting up streaming
  542. # decoding.
  543. nqp::if(
  544. nqp::istype((my $handle := IO::Handle.new(:path(self)).open(:bin)), Failure),
  545. $handle,
  546. nqp::stmts(
  547. (my $blob := $handle.slurp(:close)),
  548. nqp::if($bin, $blob, nqp::join("\n",
  549. nqp::split("\r\n", $blob.decode: $enc || 'utf-8')))
  550. ))
  551. }
  552. method spurt(IO::Path:D: $data, :$enc, :$append, :$createonly) {
  553. my $fh := self.open:
  554. :$enc, :bin(nqp::istype($data, Blob)),
  555. :mode<wo>, :create, :exclusive($createonly),
  556. :$append, :truncate(
  557. nqp::if(nqp::isfalse($append), nqp::isfalse($createonly))
  558. );
  559. nqp::if( nqp::istype($fh, Failure), $fh, $fh.spurt($data, :close) )
  560. }
  561. # XXX TODO: when we get definedness-based defaults in core, use them in
  562. # IO::Handle.open and get rid of duplication of default values here
  563. method lines(IO::Path:D:
  564. :$chomp = True, :$enc = 'utf8', :$nl-in = ["\x0A", "\r\n"], |c
  565. ) {
  566. self.open(:$chomp, :$enc, :$nl-in).lines: |c, :close
  567. }
  568. method comb(IO::Path:D:
  569. :$chomp = True, :$enc = 'utf8', :$nl-in = ["\x0A", "\r\n"], |c
  570. ) {
  571. self.open(:$chomp, :$enc, :$nl-in).comb: |c, :close
  572. }
  573. method split(IO::Path:D:
  574. :$chomp = True, :$enc = 'utf8', :$nl-in = ["\x0A", "\r\n"], |c
  575. ) {
  576. self.open(:$chomp, :$enc, :$nl-in).split: |c, :close
  577. }
  578. method words(IO::Path:D:
  579. :$chomp = True, :$enc = 'utf8', :$nl-in = ["\x0A", "\r\n"], |c
  580. ) {
  581. self.open(:$chomp, :$enc, :$nl-in).words: |c, :close
  582. }
  583. method e(IO::Path:D: --> Bool:D) {
  584. ?Rakudo::Internals.FILETEST-E($.absolute) # must be $.absolute
  585. }
  586. method d(IO::Path:D: --> Bool:D) {
  587. $.e
  588. ?? ?Rakudo::Internals.FILETEST-D($!abspath)
  589. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<d>))
  590. }
  591. method f(IO::Path:D: --> Bool:D) {
  592. $.e
  593. ?? ?Rakudo::Internals.FILETEST-F($!abspath)
  594. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<f>))
  595. }
  596. method s(IO::Path:D: --> Int:D) {
  597. $.e
  598. ?? Rakudo::Internals.FILETEST-S($!abspath)
  599. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<s>))
  600. }
  601. method l(IO::Path:D: --> Bool:D) {
  602. ?Rakudo::Internals.FILETEST-LE($.absolute)
  603. ?? ?Rakudo::Internals.FILETEST-L($!abspath)
  604. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<l>))
  605. }
  606. method r(IO::Path:D: --> Bool:D) {
  607. $.e
  608. ?? ?Rakudo::Internals.FILETEST-R($!abspath)
  609. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<r>))
  610. }
  611. method w(IO::Path:D: --> Bool:D) {
  612. $.e
  613. ?? ?Rakudo::Internals.FILETEST-W($!abspath)
  614. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<w>))
  615. }
  616. method rw(IO::Path:D: --> Bool:D) {
  617. $.e
  618. ?? ?Rakudo::Internals.FILETEST-RW($!abspath)
  619. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<rw>))
  620. }
  621. method x(IO::Path:D: --> Bool:D) {
  622. $.e
  623. ?? ?Rakudo::Internals.FILETEST-X($!abspath)
  624. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<x>))
  625. }
  626. method rwx(IO::Path:D: --> Bool:D) {
  627. $.e
  628. ?? ?Rakudo::Internals.FILETEST-RWX($!abspath)
  629. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<rwx>))
  630. }
  631. method z(IO::Path:D: --> Bool:D) {
  632. $.e
  633. ?? ?Rakudo::Internals.FILETEST-Z($!abspath)
  634. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<z>))
  635. }
  636. method modified(IO::Path:D: --> Instant:D) {
  637. $.e
  638. ?? Instant.from-posix(Rakudo::Internals.FILETEST-MODIFIED($!abspath))
  639. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<modified>))
  640. }
  641. method accessed(IO::Path:D: --> Instant:D) {
  642. $.e
  643. ?? Instant.from-posix(Rakudo::Internals.FILETEST-ACCESSED($!abspath))
  644. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<accessed>))
  645. }
  646. method changed(IO::Path:D: --> Instant:D) {
  647. $.e
  648. ?? Instant.from-posix(Rakudo::Internals.FILETEST-CHANGED($!abspath))
  649. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<changed>))
  650. }
  651. method mode(IO::Path:D: --> IntStr:D) {
  652. $.e
  653. ?? nqp::stmts(
  654. (my int $mode = nqp::stat($!abspath, nqp::const::STAT_PLATFORM_MODE) +& 0o7777),
  655. IntStr.new($mode, sprintf('%04o', $mode))
  656. )
  657. !! Failure.new(X::IO::DoesNotExist.new(:path($!abspath),:trying<mode>))
  658. }
  659. }
  660. my class IO::Path::Cygwin is IO::Path {
  661. method new(|c) { self.IO::Path::new(|c, :SPEC(IO::Spec::Cygwin) ) }
  662. multi method perl(::?CLASS:D:) {
  663. self.^name ~ ".new({$.path.perl}, {:$.CWD.perl})"
  664. }
  665. }
  666. my class IO::Path::QNX is IO::Path {
  667. method new(|c) { self.IO::Path::new(|c, :SPEC(IO::Spec::QNX) ) }
  668. multi method perl(::?CLASS:D:) {
  669. self.^name ~ ".new({$.path.perl}, {:$.CWD.perl})"
  670. }
  671. }
  672. my class IO::Path::Unix is IO::Path {
  673. method new(|c) { self.IO::Path::new(|c, :SPEC(IO::Spec::Unix) ) }
  674. multi method perl(::?CLASS:D:) {
  675. self.^name ~ ".new({$.path.perl}, {:$.CWD.perl})"
  676. }
  677. }
  678. my class IO::Path::Win32 is IO::Path {
  679. method new(|c) { self.IO::Path::new(|c, :SPEC(IO::Spec::Win32) ) }
  680. multi method perl(::?CLASS:D:) {
  681. self.^name ~ ".new({$.path.perl}, {:$.CWD.perl})"
  682. }
  683. }