You are looking at historical revision 24081 of this page. It may differ significantly from its current revision.
TinyCLOS wrappers for some file operations, which are:
open-input-file open-output-file file-exists? delete-file rename-file
When this extension is used, all of the above procedures invoke user-defined generic functions implementing the actual file system operations. Since nearly all file operations (with the exception of those invoking operations from the posix library unit) most procedures working on files can take advantage of this facility.
To distinguish between different file-systems, a pathname may be preceded by an URI scheme of the form "<scheme>://". If no scheme is given the current default file system is used.
class vfs:file-system[class] <vfs:file-system>
Represents an object that can be accessed via file-system operations.
vfs:open-output-file[method] (vfs:open-file FILESYSTEM PATHNAME OUTPUT? MODES)
[method] (vfs:open-input-file FILESYSTEM PATHNAME MODES)
[method] (vfs:open-output-file FILESYSTEM PATHNAME MODES)
Called for FILESYSTEM (an instance of <vfs:file-system>) when a file should be opened for reading or writing. PATHNAME is a string representing the path to the desired file. MODES is a list of one or more keywords specifying extra attributes for the file to be opened which are:
#:append #:binary #:text
See the The User's Manual for a description of these modes. If the vfs:open-file method is not implemented for a given file system, then either vfs:open-input-file or vfs:open-output-file are called, depending on the boolean OUTPUT?.
All of these generic functions should return a port object.
vfs:file-exists?[method] (vfs:file-exists? FILESYSTEM PATHNAME)
Called for file-exists? when the given pathname refers to FILESYSTEM. Should return true when the designated file exists or #f if not.
vfs:delete-file[method] (vfs:delete-file FILESYSTEM PATHNAME)
Called for delete-file! and should delete the entity represented by PATHNAME in the given filesystem.
vfs:rename-file[method] (vfs:rename-file FILESYSTEM OLDPATHNAME NEWPATHNAME)
Called for rename-file.
vfs:register-file-system[procedure] (vfs:register-file-system SCHEME FILESYSTEM)
Registers a filesystem prefix named SCHEME (a string) for FILESYSTEM. Any of the above mentioned file operations that refer to a pathname prefixed with <SCHEME>:// will invoke the appropriate method implemented for FILESYSTEM or a default method that signals an error. The actual path passed to the file operation methods will receive the pathname with the prefix removed.
vfs:unregister-file-system[procedure] (vfs:unregister-file-system SCHEME)
Un-registers a filesystem prefix.
class vfs:local-file-system[class] <vfs:local-file-system>
A subclass of <vfs:file-system> representing the default local, native fileystem. Implements all methods and does the usual stuff.
Holds the current file system, which is used if a pathname has no filesystem prefix.
; hash-fs: a simple hash-table based file system (use vfs tinyclos) (define-class <hash-file-system> (<vfs:file-system>) (table)) (define-method (vfs:open-input-file (fs <hash-file-system>) name modes) (open-input-string (hash-table-ref (slot-ref fs 'table) name (cut error 'open-input-file "file not found" name fs)) ) ) (define-method (vfs:open-output-file (fs <hash-file-system>) name modes) (let ((o (open-output-string)) (t (slot-ref fs 'table))) (when (memq #:append modes) (display (hash-table-ref/default t name "") o) ) (make-output-port (cut display <> o) (cut hash-table-set! t name (get-output-string o)) ) ) ) (define-method (vfs:file-exists? (fs <hash-file-system>) name) (and (hash-table-exists? (slot-ref fs 'table) name) name) ) (define-method (vfs:delete-file (fs <hash-file-system>) name) (hash-table-delete! (slot-ref fs 'table) name) ) (define-method (vfs:rename-file (fs <hash-file-system>) old new) (let* ((t (slot-ref fs 'table)) (x (hash-table-ref t old (cut error 'rename-file "file not found" old fs)) ) ) (hash-table-delete! t old) (hash-table-set! t new x) ) ) (define-method (initialize (fs <hash-file-system>) initargs) (set! (slot-ref fs 'table) (make-hash-table string=?)) ) (vfs:register-file-system "hash" (make <hash-file-system>))
Copyright (c) 2007, Felix L. Winkelmann All rights reserved.
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. Neither the name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- Initial version