stat module finished and walkings
[software/python-on-guile.git] / modules / language / python / module / os.scm
index ad4d2e3eb5aef9b6584d0cb8d5a17a65ae22e619..1dbe30e767be3f7daebe96b54bed97b1071deff9 100644 (file)
          (bytevector-u64-ref bv 8  (native-endianness))
          (bytevector-u64-ref bv 9  (native-endianness))
          (bytevector-u64-ref bv 10 (native-endianness)))))))
+
+(define symlink
+  (let ((fat (pointer->procedure int
+                                 (dynamic-func "symlinkat" (dynamic-link))
+                                 (list '* int '*))))
+
+    (lambda* (src dst #:key (target_is_directory #f) (dir_fd None))
+      (rm (fat ((string->pointer (path-it dst))
+                (if (eq? dir_fd None) AT_FDCWD dir_fd)
+                (string->pointer (path-it src))))))))
+
+(define truncate
+  (let ((ff (pointer->procedure int
+                                (dynamic-func "ftruncate" (dynamic-link))
+                                (list int long)))
+        (f  (pointer->procedure int
+                                (dynamic-func "truncate" (dynamic-link))
+                                (list '*  long))))
+
+    (lambda (path length)
+      (rm (if (number? path)
+              (ff path length)
+              (f (string->pointer (path-it path))
+                 length))))))
+
+(define UTIME_NOW (- (ash 1 30) 1))
+(define utime
+  (let ((ff  (pointer->procedure int
+                                 (dynamic-func "futimens" (dynamic-link))
+                                 (int '*)))
+        (fat (pointer->procedure int
+                                 (dynamic-func "futimensat" (dynamic-link))
+                                 (int '* '* int)))
+
+    (lambda* (path #:optional (times None) (ns #f) #:key (dir_fd None)
+                   (follow_symlinks #t))
+      (let* ((bv  (make-bytevector 32))
+             (bvp (byteector->pointer bv)))
+        (if (eq? ns None)
+            (if (eq? times None)
+                (let ()
+                  (bytevector-s64-set! bv 0 0
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 1 0 UTIME_NOW
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 2 0
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 3 UTIME_NOW
+                                       (native-endianness)))
+                (let ((x1 (pylist-ref ns 0))
+                      (x2 (pylist-ref ns 1)))
+                  (bytevector-s64-set! bv 0 (floor-quotient x1 1000000000)
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 1 (modulo  x1 1000000000)
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 2 (floor-quotient x2 1000000000)
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 3 (modulo  x2 1000000000)
+                                       (native-endianness))))
+            (if (eq? times None)
+                (begin
+                  (bytevector-s64-set! bv 0 (pylist-ref times 0)
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 1 0
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 2 (pylist-ref times 1)
+                                       (native-endianness))
+                  (bytevector-s64-set! bv 3 0
+                                       (native-endianness)))
+                (raise error "utime cannot set both s and ns")))
+        (rm (if (number? path)
+                (ff path bvp)
+                (fat (if (eq? dir_fd AT_FDCWD None) dir_fd) bvp
+                     (string->pointer (path-it path))
+                     (if follow_symlinks
+                         0
+                         AT_SYMLINK_NOFOLLOW)))))))))
+
+
+(define* (walk top #:key (topdown #t) (onerror None) (followlinks #f))
+  ((make-generator ()
+    (lambda (yield)
+      (let/ec ret
+        (define dirs    (py-list))
+        (define nondirs (py-list))
+        (define entries #f)
+    
+        (try
+         (lambda ()
+           (set! entries (py-list (scandir top))))
+         (#except error =>
+                  (lambda (x . _)
+                    (if onerror (onerror x) (ret)))))
+       
+        (for ((entry : entries)) ()
+             (define is_dir (try
+                             (lambda ((ref entry 'is_dir)))
+                             (#:except error => (lambda x #f))))
+             (if is_dir
+                 (pylist-append! dirs    (ref entry 'name))
+                 (pylist-append! nondirs (ref entry 'name)))
+
+             (if (and (not topdown) is_dir)
+                 (let ((walk-into
+                        (if followlinks
+                            #t
+                            (not
+                             (try
+                              (lambda () ((ref entry 'is_symlink)))
+                              (#:except error => (lambda x #f)))))))
+                   (if walk_into
+                       (for ((a b c : (walk (ref entry 'path) topdown
+                                            onerror followlinks))) ()
+                           (yield a b c)))))
+        
+             (if topdown
+                 (begin
+                   (yield top dirs nondirs)
+
+                   (let ((islink  (ref path 'islink))
+                         (join    (ref path 'join)))
+                     (for ((dirname : dirs)) ()
+                          (let ((new_path (join top dirname)))
+                            (if (or followlinks (not (islink new_path)))
+                                (for ((a b c : (walk new_path topdown onerror
+                                                     followlinks))) ()
+                                   (yield a b c)))))))
+                 (yield top dirs nondirs))))))))
+            
+
+(define (_fwalk topfd toppath topdown onerror follow_symlinks)
+  ((make-generator ()
+   (lambda (yield)
+     (define names   (listdir topfd))
+     (define dir     (py-list))
+     (define nondirs (py-list))
+
+     (for ((name : names)) ()
+          (try
+           (lambda ()
+             (if (S_ISDIR (ref (stat name #:dir_fd topfd) 'st_mode))
+                 (pylist-append! dirs    name)
+                 (pylist-append! nondirs name)))
+           (#:except error =>
+             (lambda x
+               (try
+                (lambda ()
+                  (if (S_ISLNK (ref (stat name #:dir_fd topfd
+                                          #:follow_symlinks #f)
+                                    'st_mode))
+                      (pylist-append! nondirs name)))
+                (#:except error => (lambda x (values))))))))
+      
+     (if topdown
+         (yield toppath dirs nondirs topfd))
+     
+     (for continue ((name : dirs)) ()
+          (call-with-values
+              (lambda ()
+                (try
+                 (lambda ()
+                   (values (stat name #:dir_fd topfd
+                                 #:follow_symlinks follow_symlinks))
+                   (open name O_RDONLY #:dir_fd topfd))
+                 (#:except errpr =>
+                  (lambda (err . l)
+                    (if (not (eq? onerror None))
+                        (onerror err)
+                        (continue))))))
+            (lambda (orig_st dirfd)
+              (try
+               (lambda ()
+                 (if (or follow_symlinks (path:samestat orig_st (stat dirfd)))
+                     (let ((dirpath (path:join toppath name)))
+                       (for ((a b c d :
+                                (_fwalk dirfd dirpath topdown onerror
+                                        follow_symlinks))) ()
+                         (yield a b c d)))))
+               (#:finally
+                (close dirfd))))))
+
+     (if not topdown
+         (yield toppath dirs nondirs topfd))))))
+
+(define* (fwalk #:optinal (top ".") (topdown #t) (onerror #t)
+                #:key     (follow_symlinks #f) (dir_fd None))
+  ((make-generator ()
+   (lambda (yield)
+     (define orig_st (stat top #:follow_symlinks #f #:dir_fd dir_fd))
+     (define topfd   (open top O_RDONLY #:dir_fd dir_fd))
+
+     (try
+      (if (or follow_symlinks or (and (S_ISDIR (ref orig_st 'st_mode))
+                                      (path:samestat orig_st (stat topfd))))
+          (for ((a b c d : (_fwalk topfd top topdown onerror follow_symlinks)))
+               ()
+            (yield a b c d)))
+      (#:finally:
+       (close topfd)))))))
+
+      
+(define supprts_dir_fs
+  (set '()))
+
+(define support_effective_ids
+  (set '()))
+
+(define supports_fd
+  (set '()))
+
+