1. my class IO::Spec::Unix is IO::Spec {
  2. method canonpath( $patharg, :$parent --> Str:D) {
  3. nqp::if(
  4. (my str $path = $patharg.Str),
  5. nqp::stmts(
  6. nqp::while( # // -> /
  7. nqp::isne_i(nqp::index($path,'//'),-1),
  8. $path = nqp::join('/',nqp::split('//',$path))
  9. ),
  10. nqp::while( # /./ -> /
  11. nqp::isne_i(nqp::index($path,'/./'),-1),
  12. $path = nqp::join('/',nqp::split('/./',$path))
  13. ),
  14. nqp::if( # /. $ -> /
  15. nqp::eqat($path,'/.',nqp::sub_i(nqp::chars($path),2)),
  16. $path = nqp::substr($path,0,nqp::sub_i(nqp::chars($path),1))
  17. ),
  18. nqp::if( # ^ ./ ->
  19. nqp::eqat($path,'./',0) && nqp::isgt_i(nqp::chars($path),2),
  20. $path = nqp::substr($path,2)
  21. ),
  22. nqp::if(
  23. $parent,
  24. nqp::stmts(
  25. nqp::while( # ^ /.. -> /
  26. ($path ~~ s:g { [^ | <?after '/'>] <!before '../'> <-[/]>+ '/..' ['/' | $ ] } = ''),
  27. nqp::null
  28. ),
  29. nqp::unless(
  30. $path,
  31. $path = '.'
  32. )
  33. )
  34. ),
  35. nqp::if( # ^ /
  36. nqp::eqat($path,'/',0),
  37. nqp::stmts(
  38. nqp::while( # ^ /../ -> /
  39. nqp::eqat($path,'/../',0),
  40. $path = nqp::substr($path,3)
  41. ),
  42. nqp::if( # ^ /.. $ -> /
  43. nqp::iseq_s($path,'/..'),
  44. $path = '/'
  45. )
  46. )
  47. ),
  48. nqp::if( # .+/ -> .+
  49. nqp::isgt_i(nqp::chars($path),1)
  50. && nqp::eqat($path,'/',nqp::sub_i(nqp::chars($path),1)),
  51. nqp::substr($path,0,nqp::sub_i(nqp::chars($path),1)),
  52. $path
  53. )
  54. ),
  55. ''
  56. )
  57. }
  58. method dir-sep { '/' } # NOTE: IO::Path.resolve assumes dir sep is 1 char
  59. method curdir { '.' }
  60. method updir { '..' }
  61. method curupdir { none('.','..') }
  62. method rootdir { '/' }
  63. method devnull { '/dev/null' }
  64. method basename(\path) {
  65. my str $str = nqp::unbox_s(path);
  66. my int $index = nqp::rindex($str,'/');
  67. nqp::p6bool($index == -1)
  68. ?? path
  69. !! substr(path,nqp::box_i($index + 1,Int) );
  70. }
  71. method extension(\path) {
  72. my str $str = nqp::unbox_s(path);
  73. my int $index = nqp::rindex($str,'.');
  74. nqp::p6bool($index == -1)
  75. ?? ''
  76. !! substr(path,nqp::box_i($index + 1,Int) );
  77. }
  78. method tmpdir {
  79. my $io;
  80. first( {
  81. if .defined {
  82. $io = .IO;
  83. $io.d && $io.rwx;
  84. }
  85. },
  86. %*ENV<TMPDIR>,
  87. '/tmp',
  88. ) ?? $io !! IO::Path.new(".");
  89. }
  90. method is-absolute( Str() \path ) {
  91. nqp::p6bool(nqp::iseq_i(nqp::ord(path), 47)) # '/'
  92. }
  93. method path {
  94. (my $p := %*ENV<PATH>) ?? gather {
  95. my int $els = nqp::elems(my $parts := nqp::split(':', $p));
  96. my int $i = -1;
  97. nqp::until(
  98. nqp::iseq_i($els, $i = nqp::add_i($i, 1)),
  99. take nqp::atpos($parts, $i) || '.')
  100. } !! Seq.new: Rakudo::Iterator.Empty
  101. }
  102. method splitpath( $path, :$nofile = False ) {
  103. if $nofile {
  104. ( '', $path, '' );
  105. }
  106. else {
  107. $path ~~ m/^ ( [ .* \/ [ '.'**1..2 $ ]? ]? ) (<-[\/]>*) /;
  108. ( '', ~$0, ~$1 );
  109. }
  110. }
  111. method split(IO::Spec::Unix: Cool:D $path) {
  112. my str $p = $path.Str;
  113. my int $chars = nqp::chars($p);
  114. nqp::while(
  115. nqp::if(
  116. ($chars = nqp::sub_i(nqp::chars($p), 1)),
  117. nqp::eqat($p, '/', $chars),
  118. ),
  119. $p = nqp::substr($p, 0, $chars),
  120. );
  121. my str $dirname;
  122. my str $basename;
  123. my int $slash-at = nqp::rindex($p, '/');
  124. nqp::if(
  125. $slash-at,
  126. nqp::if(
  127. nqp::iseq_i($slash-at, -1),
  128. nqp::stmts(
  129. ($dirname = ''),
  130. $basename = $p,
  131. ),
  132. nqp::stmts(
  133. ($dirname = nqp::substr($p, 0, $slash-at)),
  134. $basename = nqp::substr($p, nqp::add_i($slash-at, 1)),
  135. ),
  136. ),
  137. nqp::stmts(
  138. ($dirname = '/'),
  139. $basename = nqp::substr($p, 1),
  140. ),
  141. );
  142. nqp::while(
  143. nqp::if(
  144. ($chars = nqp::sub_i(nqp::chars($dirname), 1)),
  145. nqp::eqat($dirname, '/', $chars),
  146. ),
  147. $dirname = nqp::substr($dirname, 0, $chars),
  148. );
  149. nqp::if(
  150. $basename,
  151. nqp::unless($dirname, $dirname = '.'),
  152. nqp::if(
  153. nqp::iseq_s($dirname, '/'),
  154. $basename = '/',
  155. ),
  156. );
  157. # shell dirname '' produces '.', but we don't because it's probably user error
  158. (:volume(''), :$dirname, :$basename);
  159. }
  160. method join ($, \dir, \file) {
  161. nqp::if(
  162. (nqp::iseq_s(dir, '/') && nqp::iseq_s(file, '/'))
  163. || (nqp::iseq_s(dir, '.') && file),
  164. file,
  165. nqp::concat(dir,
  166. nqp::if(
  167. dir && file
  168. && nqp::isfalse(
  169. nqp::eqat(dir, '/', nqp::sub_i(nqp::chars(dir), 1)))
  170. && nqp::isne_i(nqp::ord(file), 47), # '/'
  171. nqp::concat('/', file),
  172. file)))
  173. }
  174. method catpath( $, \dirname, \file ) {
  175. nqp::concat(dirname,
  176. nqp::if(
  177. dirname && file
  178. && nqp::isfalse(
  179. nqp::eqat(dirname, '/',
  180. nqp::sub_i(nqp::chars(dirname), 1)))
  181. && nqp::isne_i(nqp::ord(file), 47), # '/'
  182. nqp::concat('/', file),
  183. file))
  184. }
  185. method catdir (*@parts) {
  186. self.canonpath: nqp::concat(
  187. @parts.join('/'),
  188. nqp::if(@parts, '/', ''),
  189. )
  190. }
  191. method splitdir(Cool:D $path) {
  192. nqp::p6bindattrinvres((), List, '$!reified', nqp::split('/', $path.Str))
  193. || ('',)
  194. }
  195. method catfile( |c ) { self.catdir(|c) }
  196. method abs2rel( $path is copy, $base is copy = $*CWD ) {
  197. if self.is-absolute($path) || self.is-absolute($base) {
  198. $path = self.rel2abs( $path );
  199. $base = self.rel2abs( $base );
  200. }
  201. else {
  202. # save a couple of cwd()s if both paths are relative
  203. $path = self.catdir( self.rootdir, $path );
  204. $base = self.catdir( self.rootdir, $base );
  205. }
  206. my ($path_volume, $path_directories) = self.splitpath( $path, :nofile );
  207. my ($base_volume, $base_directories) = self.splitpath( $base, :nofile );
  208. # Can't relativize across volumes
  209. return $path unless $path_volume eq $base_volume;
  210. # For UNC paths, the user might give a volume like //foo/bar that
  211. # strictly speaking has no directory portion. Treat it as if it
  212. # had the root directory for that volume.
  213. if !$base_directories && self.is-absolute( $base ) {
  214. $base_directories = self.rootdir;
  215. }
  216. # Now, remove all leading components that are the same
  217. my @pathchunks = self.splitdir( $path_directories );
  218. my @basechunks = self.splitdir( $base_directories );
  219. if $base_directories eq self.rootdir {
  220. @pathchunks.shift;
  221. return self.canonpath( self.catpath('', self.catdir( @pathchunks ), '') );
  222. }
  223. while @pathchunks && @basechunks && @pathchunks[0] eq @basechunks[0] {
  224. @pathchunks.shift;
  225. @basechunks.shift;
  226. }
  227. return self.curdir unless @pathchunks || @basechunks;
  228. # $base now contains the directories the resulting relative path
  229. # must ascend out of before it can descend to $path_directory.
  230. my $result_dirs = self.catdir( self.updir() xx @basechunks.elems, @pathchunks );
  231. return self.canonpath( self.catpath('', $result_dirs, '') );
  232. }
  233. method rel2abs(Str() \path, $base? is copy) {
  234. self.canonpath:
  235. nqp::if(
  236. nqp::iseq_i(nqp::ord(path), 47), # .starts-with: '/'
  237. path,
  238. nqp::concat(
  239. nqp::if(
  240. nqp::defined($base),
  241. nqp::if(
  242. nqp::iseq_i(nqp::ord(($base = $base.Str)), 47), # /^ '/'/
  243. $base,
  244. nqp::if(
  245. nqp::iseq_s($base, (my $cwd := $*CWD.Str)),
  246. $base, self.rel2abs($base, $cwd))),
  247. $*CWD.Str),
  248. nqp::concat('/', path)))
  249. }
  250. }