basis/io/files/links/links.factor

   1 ! Copyright (C) 2008 Slava Pestov, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors io.backend io.files.info io.files.types
   4 io.pathnames kernel math namespaces system vocabs.loader ;
   5 IN: io.files.links
   6
   7 HOOK: make-link os ( target symlink -- )
   8
   9 HOOK: make-hard-link os ( target link -- )
  10
  11 HOOK: read-link os ( symlink -- path )
  12
  13 : copy-link ( target symlink -- )
  14     [ read-link ] dip make-link ;
  15
  16 os unix? [ "io.files.links.unix" require ] when
  17
  18 : follow-link ( path -- path' )
  19     [ parent-directory ] [ read-link ] bi append-path ;
  20
  21 SYMBOL: symlink-depth
  22 10 symlink-depth set-global
  23
  24 ERROR: too-many-symlinks path n ;
  25
  26 <PRIVATE
  27
  28 : (follow-links) ( n path -- path' )
  29     over 0 = [ symlink-depth get too-many-symlinks ] when
  30     dup link-info type>> +symbolic-link+ =
  31     [ [ 1 - ] [ follow-link ] bi* (follow-links) ]
  32     [ nip ] if ; inline recursive
  33
  34 PRIVATE>
  35
  36 : follow-links ( path -- path' )
  37     [ symlink-depth get ] dip normalize-path (follow-links) ;