/[meta-cvs]/meta-cvs/F-123D61C8FE941733281D2B08C15CD438
ViewVC logotype

Contents of /meta-cvs/F-123D61C8FE941733281D2B08C15CD438

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Sat Jan 26 01:38:37 2002 UTC (12 years, 2 months ago) by kaz
Branch: MAIN
Changes since 1.3: +8 -6 lines
Moving closer toward delivery.
1 (require "split")
2 (provide "posix")
3
4 (eval-when (:compile-toplevel :load-toplevel :execute)
5 (defconstant *up-dir* "..")
6 (defconstant *this-dir* ".")
7 (defconstant *path-sep* "/"))
8
9 (defun canonicalize-path (path)
10 "Simplifies a POSIX path by eliminating . components, splicing out as many ..
11 components as possible, and condensing multiple slashes. A trailing slash is
12 guaranteed to be preserved, if it follows something that could be a file or
13 directory. Two values are returned, the simplified path and a boolean value
14 which is true if there are any .. components that could not be spliced out."
15 (let ((split-path (split-fields path "/"))
16 uncanceled-up)
17
18 ;; First, if the path has at least two components,
19 ;; replace the first empty one with the symbol :root
20 ;; and the last empty one with :dir. These indicate a
21 ;; leading and trailing /
22 (when (and (> (length split-path) 1))
23 (when (string= (first split-path) "")
24 (setf (first split-path) :root))
25 (when (string= (first (last split-path)) "")
26 (setf (first (last split-path)) :dir)))
27
28 ;; Next, squash out all of the . and empty components,
29 ;; and replace .. components with :up symbol.
30 (setf split-path (mapcan #'(lambda (item)
31 (cond
32 ((string= item "") nil)
33 ((string= item ".") nil)
34 ((string= item "..") (list :up))
35 (t (list item))))
36 split-path))
37 (let (folded-path)
38 ;; Now, we use a pushdown automaton to reduce the .. paths
39 ;; The remaining stack is the reversed path.
40 (dolist (item split-path)
41 (case item
42 ((:up)
43 (case (first folded-path)
44 ((:root)) ;; do nothing
45 ((:up nil) (push item folded-path) (setf uncanceled-up t))
46 (otherwise (pop folded-path))))
47 ((:dir)
48 (case (first folded-path)
49 ((:root :up nil))
50 (otherwise (push (format nil "~a/" (pop folded-path))
51 folded-path))))
52 (otherwise
53 (push item folded-path))))
54 (setf split-path (nreverse folded-path)))
55
56 ;; If there are at least two components, remove a leading :root
57 ;; and add a / to the first component. If there are 0 components
58 ;; add a "." component.
59 (if (zerop (length split-path))
60 (push "." split-path)
61 (when (eq (first split-path) :root)
62 (pop split-path)
63 (push (format nil "/~a" (or (pop split-path) "")) split-path)))
64
65 ;; Map remaining symbols back to strings
66 (setf split-path (mapcar #'(lambda (item)
67 (case item
68 ((:up) "..")
69 (otherwise item))) split-path))
70
71 ;; Convert back to text
72 (values (reduce #'(lambda (x y) (format nil "~a/~a" x y)) split-path)
73 uncanceled-up)))
74
75 (defun basename (path)
76 "First, this filters the input path through the canonicalize-path function.
77 Then it splits the path into base name and directory, returned as two values.
78 If the path is / then . and / are returned. The rightmost slash is
79 used to determine the split between the path and the base name. If there
80 is a rightmost slash, then everything up to but not including that slash is
81 returned as the directory (second) value, and everything to the right is
82 returned as the base name (first) value. If there is no rightmost slash,
83 then the directory is returned as NIL, and the path is the entire base name.
84 If the path has a trailing slash, then that trailing slash is part of the base
85 name, and does not count as the rightmost slash."
86 (setf path (canonicalize-path path))
87 (let* ((pos1 (position #\/ path :from-end t))
88 (pos2 (position #\/ path :end pos1 :from-end t)))
89 (cond
90 ((string= path "/")
91 (values "." "/"))
92 ((null pos1)
93 (values path nil))
94 ((= (1+ pos1) (length path))
95 (if (null pos2)
96 (values path nil)
97 (values (subseq path (1+ pos2)) (subseq path 0 pos2))))
98 (t
99 (values (subseq path (1+ pos1)) (subseq path 0 pos1))))))
100
101 (defun path-equal (p1 p2)
102 (string= p1 p2))
103 (declaim (inline path-equal))
104
105 (defun path-prefix-equal (shorter longer)
106 (let ((ls (length shorter)) (ll (length longer)))
107 (cond
108 ((> ls ll) nil)
109 ((not (string= shorter longer :end2 ls)) nil)
110 ((= ls ll) t)
111 ((and (> ls 0)
112 (char-equal (char shorter (1- ls)) #\/)
113 (char-equal (char longer (1- ls))) #\/) t)
114 ((char-equal (char longer ls) #\/) t)
115 (t nil))))
116
117 (eval-when (:compile-toplevel :load-toplevel :execute)
118 (defun path-cat (first-component &rest components)
119 (reduce #'(lambda (x y) (format nil "~a/~a" x y)) components
120 :initial-value first-component)))

  ViewVC Help
Powered by ViewVC 1.1.5