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