pwd module

1 files changed, 142 insertions, 0 deletions

diff --git a/modules/language/python/module/os/path.scm b/modules/language/python/module/os/path.scm
new file mode 100644
index 0000000..d9f2e3b
--- /dev/null
+++ b/modules/language/python/module/os/path.scm
@@ -0,0 +1,142 @@
+(define-module (language python module os path)
+  #:use-module (language python module os)
+  #:use-module (language python module pwd)
+  #:export (abspath basename commonpath commonprefix dirname exists
+                    lexists expanduser expandvars getatime getmtime
+                    getctime getsize isabs isfile isdir islink ismount
+                    normcase normpath realpath relpath samefile sameopenfile
+                    samestat split splitdrive splitext splitunc
+                    supports_unicode_filenames))
+
+            
+
+(define (abspath path)
+  (let ((path (path-it path)))
+    (if (eq? (string-ref path 0) #\/)
+        (normpath path)
+        (normpath (string-append (getcwd) "/" path)))))
+    
+(define (basename path) ((@ (guile) basename) (path-it path)))
+
+(define (commonprefix paths)
+  (letrec ((l (for ((p paths)) ((l '()))
+                   (cons (string->list (normpath p)) l)
+                   #:final l))
+           (f (lambda (l)
+                (let lp ((l l)) ((r #f) (d '()))
+                     (match l
+                       ((() . _) '())
+                       (((x . u) . l)
+                        (if r
+                            (if (equal? r x)
+                                (lp l r (cons u d))
+                                '())
+                            (lp l x (cons u d))))
+                       (()
+                        (if r (cons r (f d)) '())))))))
+    (list->string (f l))))
+
+(define (commonpath paths)
+  (define kind
+    (for ((p paths)) ((e #f))
+         (let ((x (if (isabs (path-it p)) 'abs 'rel)))
+           (if e
+               (if (eq? e x)
+                   e
+                   (raise ValueError "Not all paths of the same type"))
+               x))
+         #:final e))
+
+  (if (not kind) (raise ValueError "No paths"))
+  
+  (letrec ((l (for ((p paths)) ((l '()))
+                   (cons (string-split (normpath p) #\/) l)
+                   #:final l))
+           (f (lambda (l)
+                (let lp ((l l)) ((r #f) (d '()))
+                     (match l
+                       ((() . _) '())
+                       (((x . u) . l)
+                        (if r
+                            (if (equal? r x)
+                                (lp l r (cons u d))
+                                '())
+                            (lp l x (cons u d))))
+                       (()
+                        (if r (cons r (f d)) '())))))))
+    (if (equal? kind 'abs)
+        (string-append "/" (string-join (f l) "/"))
+        (string-join (f l) "/"))))
+
+                               
+(define (dirname p) ((@ (guile) dirname) (path-it p)))
+(define (exists p)
+  (if (number? p)
+      (catch #t
+        (lambda () ((@ (guile) readlink) (format #f "/proc/self/fd/~a" p)))
+        (lambda x #f))
+      (catch #t
+        (lambda () ((@ (guile) stat) (path-it p)) #t)
+        (lambda x #f))))
+      
+(define (lexists p)
+  (if (number? p)
+      (catch #t
+        (lambda () ((@ (guile) readlink) (format #f "/proc/self/fd/~a" p)))
+        (lambda x #f))
+      (catch #t
+        (lambda () ((@ (guile) lstat) (path-it p)) #t)
+        (lambda x #f))))
+
+
+(define (expanduser p)
+  (define (lookup-user u)
+    (ref (getpwnam u) 'pw_dir))
+
+  (define (lookup-self)
+    (ref (getpwuid (getuid)) 'pw_dir))
+
+  (define path (path-it p))
+  
+  (if (eq? (string-ref path 0) #\~)
+      (if (and (> (string-length path) 1) (not (eq? (string-ref path 1) #\/)))
+          (let* ((l (string-split path "/"))
+                 (a (car l))
+                 (u (list->string (cdr (string->list a)))))
+            (string-join (cons (lookup-user u) (cdr l)) "/"))
+          (let ((pw (getenv "PATH")))
+            (if pw
+                (string-join (append (string-split pw "/")
+                                     (cdr (string-split path #\/)))
+                             "/")
+                (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)
+
+
+
+
+