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 { '/' }
  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.r && $io.w && $io.x;
  84. }
  85. },
  86. %*ENV<TMPDIR>,
  87. '/tmp',
  88. ) ?? $io !! IO::Path.new(".");
  89. }
  90. method is-absolute( Str() \path ) {
  91. nqp::p6bool(nqp::eqat(path, '/', 0));
  92. }
  93. method path {
  94. if %*ENV<PATH> -> $PATH {
  95. $PATH.split( ':' ).map: { $_ || '.' };
  96. }
  97. else {
  98. ();
  99. }
  100. }
  101. method splitpath( $path, :$nofile = False ) {
  102. if $nofile {
  103. ( '', $path, '' );
  104. }
  105. else {
  106. $path ~~ m/^ ( [ .* \/ [ '.'**1..2 $ ]? ]? ) (<-[\/]>*) /;
  107. ( '', ~$0, ~$1 );
  108. }
  109. }
  110. multi method split(IO::Spec::Unix: Cool:D $path) {
  111. my str $p = $path.Str;
  112. my int $chars = nqp::chars($p);
  113. nqp::while(
  114. nqp::if(
  115. ($chars = nqp::sub_i(nqp::chars($p), 1)),
  116. nqp::eqat($p, '/', $chars),
  117. ),
  118. $p = nqp::substr($p, 0, $chars),
  119. );
  120. my str $dirname;
  121. my str $basename;
  122. my int $slash-at = nqp::rindex($p, '/');
  123. nqp::if(
  124. $slash-at,
  125. nqp::if(
  126. nqp::iseq_i($slash-at, -1),
  127. nqp::stmts(
  128. ($dirname = ''),
  129. $basename = $p,
  130. ),
  131. nqp::stmts(
  132. ($dirname = nqp::substr($p, 0, $slash-at)),
  133. $basename = nqp::substr($p, nqp::add_i($slash-at, 1)),
  134. ),
  135. ),
  136. nqp::stmts(
  137. ($dirname = '/'),
  138. $basename = nqp::substr($p, 1),
  139. ),
  140. );
  141. nqp::while(
  142. nqp::if(
  143. ($chars = nqp::sub_i(nqp::chars($dirname), 1)),
  144. nqp::eqat($dirname, '/', $chars),
  145. ),
  146. $dirname = nqp::substr($dirname, 0, $chars),
  147. );
  148. nqp::if(
  149. $basename,
  150. nqp::unless($dirname, $dirname = '.'),
  151. nqp::if(
  152. nqp::iseq_s($dirname, '/'),
  153. $basename = '/',
  154. ),
  155. );
  156. # shell dirname '' produces '.', but we don't because it's probably user error
  157. # temporary, for the transition period
  158. (:volume(''), :$dirname, :$basename, :directory($dirname));
  159. # (:volume(''), :$dirname, :$basename);
  160. }
  161. method join ($, \dir, \file) {
  162. self.catpath(
  163. '',
  164. nqp::if(
  165. nqp::unless(
  166. nqp::if( nqp::iseq_s(dir, '/'), nqp::iseq_s(file, '/'), ),
  167. nqp::if( nqp::iseq_s(dir, '.'), file ),
  168. ),
  169. '',
  170. dir,
  171. ),
  172. file,
  173. );
  174. }
  175. method catpath( $, \dirname, \file ) {
  176. nqp::if(
  177. nqp::if(
  178. nqp::isne_s(dirname, ''),
  179. nqp::if(
  180. nqp::isne_s(file, ''),
  181. nqp::if(
  182. nqp::isfalse(nqp::eqat(
  183. dirname, '/', nqp::sub_i(nqp::chars(dirname), 1)
  184. )),
  185. nqp::isfalse(nqp::eqat(file, '/', 0)),
  186. ),
  187. ),
  188. ),
  189. nqp::concat(dirname, nqp::concat('/', file)),
  190. nqp::concat(dirname, file),
  191. )
  192. }
  193. method catdir (*@parts) {
  194. self.canonpath: nqp::concat(
  195. @parts.join('/'),
  196. nqp::if(@parts, '/', ''),
  197. )
  198. }
  199. method splitdir( $path ) { $path.split( '/' ) }
  200. method catfile( |c ) { self.catdir(|c) }
  201. method abs2rel( $path is copy, $base is copy = Str ) {
  202. $base = $*CWD unless $base;
  203. if self.is-absolute($path) || self.is-absolute($base) {
  204. $path = self.rel2abs( $path );
  205. $base = self.rel2abs( $base );
  206. }
  207. else {
  208. # save a couple of cwd()s if both paths are relative
  209. $path = self.catdir( self.rootdir, $path );
  210. $base = self.catdir( self.rootdir, $base );
  211. }
  212. my ($path_volume, $path_directories) = self.splitpath( $path, :nofile );
  213. my ($base_volume, $base_directories) = self.splitpath( $base, :nofile );
  214. # Can't relativize across volumes
  215. return $path unless $path_volume eq $base_volume;
  216. # For UNC paths, the user might give a volume like //foo/bar that
  217. # strictly speaking has no directory portion. Treat it as if it
  218. # had the root directory for that volume.
  219. if !$base_directories && self.is-absolute( $base ) {
  220. $base_directories = self.rootdir;
  221. }
  222. # Now, remove all leading components that are the same
  223. my @pathchunks = self.splitdir( $path_directories );
  224. my @basechunks = self.splitdir( $base_directories );
  225. if $base_directories eq self.rootdir {
  226. @pathchunks.shift;
  227. return self.canonpath( self.catpath('', self.catdir( @pathchunks ), '') );
  228. }
  229. while @pathchunks && @basechunks && @pathchunks[0] eq @basechunks[0] {
  230. @pathchunks.shift;
  231. @basechunks.shift;
  232. }
  233. return self.curdir unless @pathchunks || @basechunks;
  234. # $base now contains the directories the resulting relative path
  235. # must ascend out of before it can descend to $path_directory.
  236. my $result_dirs = self.catdir( self.updir() xx @basechunks.elems, @pathchunks );
  237. return self.canonpath( self.catpath('', $result_dirs, '') );
  238. }
  239. method rel2abs(Str() \path, $base? is copy) {
  240. nqp::if(
  241. nqp::eqat(path, '/', 0),
  242. self.canonpath(path),
  243. self.catdir(
  244. self.canonpath(
  245. nqp::if(
  246. $base.defined,
  247. nqp::if(
  248. nqp::eqat(($base = $base.Str), '/', 0),
  249. $base,
  250. nqp::if(
  251. nqp::iseq_s($base, (my $cwd = $*CWD.Str)),
  252. $base, self.rel2abs($base, $cwd),
  253. ),
  254. ),
  255. $*CWD.Str,
  256. ),
  257. ),
  258. path,
  259. ),
  260. )
  261. }
  262. }