os.path finished

3 files changed, 348 insertions, 29 deletions

diff --git a/modules/language/python/module/errno.scm b/modules/language/python/module/errno.scm
index fd2f7c9..6bcc02a 100644
--- a/modules/language/python/module/errno.scm
+++ b/modules/language/python/module/errno.scm
@@ -1,9 +1,153 @@
 (define-module (language python module errno)
   #:use-module (system foreign)
-  #:export (errno))
+  #:use-module (language python dict)
+  #:use-module (language python list)                          
+  #:export (errno errorcode))
 
 
 (define errno
   (let ((f (dynamic-pointer "errno" (dynamic-link))))
     (lambda ()
       (pointer-address (dereference-pointer f)))))
+
+(define errorcode (dict))
+
+(define-syntax-rule (mk x n)
+  (begin
+    (define x n)
+    (export x)
+    (pylist-set! errorcode n "x")))
+
+(mk EPERM    1)
+(mk ENOENT   2)
+(mk ESRCH    3)
+(mk EINTR    4)
+(mk EIO      5)
+(mk ENXIO    6)
+(mk E2BIG    7)
+(mk ENOEXEC  8)
+(mk EBADF    9)
+(mk ECHILD   10)
+(mk EAGAIN   11)
+(mk ENOMEM   12)
+(mk EACCES   13)
+(mk EFAULT   14)
+(mk ENOTBLK  15)
+(mk EBUSY    16)
+(mk EEXIST   17)
+(mk EXDEV    18)
+(mk ENODEV   19)
+(mk ENOTDIR  20)
+(mk EISDIR   21)
+(mk EINVAL   22)
+(mk ENFILE   23)
+(mk EMFILE   24)
+(mk ENOTTY   25)
+(mk ETXTBSY  26)
+(mk EFBIG    27)
+(mk ENOSPC   28)
+(mk ESPIPE   29)
+(mk EROFS    30)
+(mk EMLINK   31)
+(mk EPIPE    32)
+(mk EDOM     33)
+(mk ERANGE   34)
+(mk EDEADLK  35)
+(mk ENAMETOOLONG 36)
+(mk ENOLCK   37)
+(mk ENOSYS   38)
+(mk ENOTEMPTY 39)
+(mk ELOOP    40)
+(mk EWOULDBLOCK 41)
+(mk ENOMSG   42)
+(mk EIDRM    43)
+(mk ECHRNG   44)
+(mk EL2NSYNC 45)
+(mk EL3HLT   46)
+(mk EL3RST   47)
+(mk ELNRNG   48)
+(mk EUNATCH  49)
+(mk ENOCSI   50)
+(mk EL2HLT   51)
+(mk EBADE    52)
+(mk EBADR    53)
+(mk EXFULL   54)
+(mk ENOANO   55)
+(mk EBADRQC  56)
+(mk EBADSLT  57)
+(mk EDEADLOCK EDEADLK)
+(mk EBFONT   59)
+(mk ENOSTR   60)
+(mk ENODATA  61)
+(mk ETIME    62)
+(mk ENOSR    63)
+(mk ENONET   64)
+(mk ENOPKG   65)
+(mk EREMOTE  66)
+(mk ENOLINK  67)
+(mk EADV     68)
+(mk ESRMNT   69)
+(mk ECOMM    70)
+(mk EPROTO   71)
+(mk EMULTIHOP 72)
+(mk EDOTDOT  73)
+(mk EBADMSG  74)
+(mk EOVERFLOW 75)
+(mk ENOTUNIQ 76)
+(mk EBADFD   77)
+(mk EREMCHG  78)
+(mk ELIBACC  79)
+(mk ELIBBAD  80)
+(mk ELIBSCN  81)
+(mk ELIBMAX  82)
+(mk ELIBEXEC 83)
+(mk EILSEQ   84)
+(mk ERESTART 85)
+(mk ESTRPIPE 86)
+(mk EUSERS   87)
+(mk ENOTSOCK 88)
+(mk EDESTADDRREQ 89)
+(mk EMSGSIZE 90)
+(mk EPROTOTYPE 91)
+(mk ENOPROTOOPT 92)
+(mk EPROTONOSUPPORT 93)
+(mk ESOCKTNOSUPPORT 94)
+(mk EOPNOTSUPP 95)
+(mk EPFNOSUPPORT 96)
+(mk EAFNOSUPPORT 97)
+(mk EADDRINUSE 98)
+(mk EADDRNOTAVAIL 99)
+(mk ENETDOWN 100)
+(mk ENETUNREACH 101)
+(mk ENETRESET 102)
+(mk ECONNABORTED 103)
+(mk ECONNRESET 104)
+(mk ENOBUFS  105)
+(mk EISCONN  106)
+(mk ENOTCONN 107)
+(mk ESHUTDOWN 108)
+(mk ETOOMANYREFS 109)
+(mk ETIMEDOUT 110)
+(mk ECONNREFUSED 111)
+(mk EHOSTDOWN 112)
+(mk EHOSTUNREACH 113)
+(mk EALREADY  114)
+(mk EINPROGRESS 115)
+(mk ESTALE    116)
+(mk EUCLEAN   117)
+(mk ENOTNAM   118)
+(mk ENAVAIL   119)
+(mk EISNAM    120)
+(mk EREMOTEIO 121)
+(mk EDQUOT    122)
+(mk ENOMEDIUM 123)
+(mk EMEDIUMTYPE 124)
+(mk ECANCELED 125)
+(mk ENOKEY 126)
+(mk EKEYEXPIRED 127)
+(mk EKEYREVOKED 128)
+(mk EKEYREJECTED 129)
+(mk EOWNERDEAD 130)
+(mk ENOTRECOVERABLE 131)
+(mk ERFKILL 132)
+(mk EHWPOISON 133)
diff --git a/modules/language/python/module/os.scm b/modules/language/python/module/os.scm
index e5b2b79..6d00d27 100644
--- a/modules/language/python/module/os.scm
+++ b/modules/language/python/module/os.scm
@@ -23,6 +23,9 @@
                   setgid setgroups setpgrp setpgid setpriority setregid
                   setresgid setreuid setresuid getsid setsid setuid strerr
                   umask  uname  unsetenv
+                  
+                  path curdir pardir sep extsep altsep pathsep linesep defpath
+                  devnull
 
                   dopen close closerange device_encoding dup dup2 fchmod fchown
                   fdatasync fpathconf fstat fstatvfs fsynch ftruncate isatty
@@ -66,7 +69,19 @@
     ((_ code) (guile code code))
     ((_ code1 code2)
      (define code1 (lambda x (ca (apply (@ (guile) code2 x))))))))
-    
+
+
+(define path   "posixpath")
+(define curdir ".")
+(define pardir "..")
+(define sep    "/")
+(define extsep ".")
+(define altsep  None)
+(define pathsep ":")
+(define linesep "\n")
+(define defpath "/usr/bin")
+(define devnull "/dev/null")
+
 (define name  "posix")
 (guile ctermid)
 
@@ -1210,7 +1225,37 @@
                                                      followlinks))) ()
                                    (yield a b c)))))))
                  (yield top dirs nondirs))))))))
-            
+
+(define (path:samestat s1 s2)
+  (and (equal? (ref s1 'st_dev) (ref s2 'st_dev))
+       (equal? (ref s1 'st_ino) (ref s2 'st_ino))))
+
+(define (path:normpath p)
+  (let lp ((l (string-split (path-it p) #\/)) (r '()) (first? #t))
+    (match l
+      (("") (lp '() (cons "" r) #f))
+      (("." . l)
+       (lp l r #f))
+      ((""  . l)
+       (if first?
+           (lp l (cons "" r) #f)           
+           (lp l r #f)))
+      ((".." . l)
+       (match r
+         (("")
+          (raise ValueError "normpath .. beond /"))
+         ((".." . u)
+          (lp l (cons ".." r) #f))
+         ((_ . u)
+          (lp l u #f))
+         (()
+          (lp l (cons ".." r) #f))))
+      ((x . l)
+       (lp l (cons x r) #f))
+      (() (string-join (reverse r) "/")))))
+
+(define (path:join . l)
+  (normpath (string-join (map path-it l) "/")))
 
 (define (_fwalk topfd toppath topdown onerror follow_symlinks)
   ((make-generator ()
diff --git a/modules/language/python/module/os/path.scm b/modules/language/python/module/os/path.scm
index d9f2e3b..8846bd5 100644
--- a/modules/language/python/module/os/path.scm
+++ b/modules/language/python/module/os/path.scm
@@ -1,6 +1,10 @@
 (define-module (language python module os path)
   #:use-module (language python module os)
   #:use-module (language python module pwd)
+  #:use-module (language python module errno)
+  #:use-module (language python for)
+  #:use-module (language python exceptions)
+  #:use-module (oop pg-objects)
   #:export (abspath basename commonpath commonprefix dirname exists
                     lexists expanduser expandvars getatime getmtime
                     getctime getsize isabs isfile isdir islink ismount
@@ -8,7 +12,18 @@
                     samestat split splitdrive splitext splitunc
                     supports_unicode_filenames))
 
-            
+(define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
+
+(define-syntax-rule (ca code)
+  (catch #t
+    (lambda () code)
+    (lambda x (raise OSError x))))
+
+(define (path-it path)
+  (aif it (ref path '__fspath__)
+       (it)
+       path))
+
 
 (define (abspath path)
   (let ((path (path-it path)))
@@ -16,7 +31,7 @@
         (normpath path)
         (normpath (string-append (getcwd) "/" path)))))
     
-(define (basename path) ((@ (guile) basename) (path-it path)))
+(define (basename path) (ca ((@ (guile) basename) (path-it path))))
 
 (define (commonprefix paths)
   (letrec ((l (for ((p paths)) ((l '()))
@@ -69,7 +84,7 @@
         (string-join (f l) "/"))))
 
                                
-(define (dirname p) ((@ (guile) dirname) (path-it p)))
+(define (dirname p) (ca ((@ (guile) dirname) (path-it p))))
 (define (exists p)
   (if (number? p)
       (catch #t
@@ -112,29 +127,144 @@
                 (string-join (append (string-split (lookup-self) "/")
                                      (cdr (string-split path #\/)))))))))
 
-                
-(define expandvars)
-(define getatime)
-(define getmtime)
-(define getctime)
-(define getsize)
-(define isabs)
-(define isfile)
-(define isdir)
-(define islink)
-(define ismount)
-(define normcase)
-(define normpath)
-(define realpath)
-(define relpath)
-(define samefile)
-(define sameopenfile)
-(define samestat)
-(define split)
-(define splitdrive)
-(define splitext)
-(define splitunc)
-(define supports_unicode_filenames)
+(define f-var (f-mk (f-or!
+                     (f-seq (f-tag! "$") (f+ (f-reg! "[a-zA-Z0-9]")))
+                     (f-seq (f-tag! "$") (f-tag "{") (f+ (f-not! (f-tag "}")))
+                            (f-tag "}")))))
+(define (expandvars p)
+  (let lp ((l (f-split (path-it p) f-var)) (r '()))
+    (match l
+      ((a b . l)
+       (lp l (cons* (getenv b) a r)))
+      ((a)
+       (apply string-append (reverse (cons a r))))
+      (()
+       (apply string-append (reverse r))))))
+    
+
+(define (getatime p)
+  (ca (stat:atime ((@ (guile) stat) (path-it p)))))
+
+(define (getmtime p)
+  (ca (stat:mtime ((@ (guile) stat) (path-it p)))))
+
+(define (getctime p)
+  (ca (stat:ctime ((@ (guile) stat) (path-it p)))))
+
+(define (getsize p)
+  (ca (stat:size ((@ (guile) stat) (path-it p)))))
+
+(define (isabs p)
+  (eq? (string-ref (path-it p) 0) #\/))
+
+  
+(define (isfile p)
+  (ca (S_ISREG (stat:mode ((@ (guile) stat) (path-it p))))))
+
+(define (isdir p)
+  (ca (S_ISDIR (stat:mode ((@ (guile) stat) (path-it p))))))
+
+(define (islink p)
+  (ca (S_ISLNK (stat:mode ((@ (guile) stat) (path-it p))))))
+
+(define (ismount p)
+  (ca 
+   (let* ((p (path-it p))
+          (q (string-append p "/..")))
+     (not (= (stat:dev ((@ (guile) stat) p))
+             (stat:dev ((@ (guile) stat) q)))))))
+
+
+  (normpath (string-join (map path-it l) "/")))
+
+(define (normcase x) x)
+
+(define join     (@@ (language python module os) path:join))
+(define normpath (@@ (language python module os) path:normpath))
+(define samestat (@@ (language python module os) path:samestat))
+
+(define realpath
+  (let ((free (pointer->procedure void
+                                  (dynamic-func "free" (dynamic-link))
+                                  (list '*)))
+        (f    (pointer->procedure '*
+                                  (dynamic-func "realpath" (dynamic-link))
+                                  (list '* long))))
+    (lambda (p)
+      (let ((s (ca (f (string->pointer (path-it p)) 0))))
+        (if (eq? (pointer-address s) 0)
+            (raise OSError (format #f "realpath fails with errnp ~a" (errno)))
+            (let ((ret (pointer->string s)))
+              (free s)
+              ret))))))
+
+(define* (relpath p #:optional (start curpath))
+  (define l1 (string-aplit (realpath (path-it p)) #\/))
+  (define l2 (string-split (realpath start)) #\/)
+  (define red (lambda (x s) (cons ".." s)))
+  (let lp ((l1 l1) (l2 l2))
+    (match (cons l1 l2)
+      (((x . l1) . (y . l2))
+       (if (equal? x y)
+           (lp l1 l2)
+           (string-join
+            (append 
+             (reduce red '() (cons y l2))
+             l1)
+            "/")))
+      ((() . l)
+       (string-join (reduce red '() l) "/"))
+      ((l)
+       (string-join l "/")))))
+
+(define (samefile p1 p2)
+  (samestat (stat p1) (stat p2)))
+
+(define (sameopenfile p1 p2)
+  (samestat (stat p1) (stat p2)))
+
+(define (split p)
+  (let ((l (string-split (path-it p) #\/)))
+    (match l
+      ((_ ... "")
+       (list (path-it p) ""))
+      ((x)
+       (list "" x))
+      ((l ... x)
+       (list (string-join (append l (list "")) "/") x)))))
+
+(define (splitdrive p)
+  (let* ((l  (string-split (path-it p) #\/)))         
+    (let lp ((l l) (r '()))
+      (let ((p1 (string-join (reverse r) "/")))
+        (if (ismount p1)
+            (list p1 (string-join (cons "" l) "/"))
+            (if (pair? l)
+                (lp (cdr l) (cons (car l) r))
+                (list "" (string-join (reverse r) "/"))))))))
+          
+(define (splitext p)
+  (let ((x (string-split (path-it p) #\.)))
+    (match x
+      (("" y . l)
+       (if (pair? l)
+           (let* ((r (reverse l))
+                  (e (car r))
+                  (l (cons* "" y (reverse (cdr l)))))
+             (list (string-join l ".") (string-append "." e)))
+           (list x "")))
+      ((y . l)
+       (if (pair? l)
+           (let* ((r (reverse l))
+                  (e (car r))
+                  (l (cons* y (reverse (cdr l)))))
+             (list (string-join l ".") (string-append "." e)))
+           (list x ""))))))
+
+           
+(define (splitunc p) (splitdrive p))
+
+(define supports_unicode_filenames #t)