diff options
Diffstat (limited to 'modules/language/python')
-rw-r--r-- | modules/language/python/module/errno.scm | 146 | ||||
-rw-r--r-- | modules/language/python/module/os.scm | 49 | ||||
-rw-r--r-- | modules/language/python/module/os/path.scm | 182 |
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) |