dirs.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
class DIRECTORY < $STR, $IS_EQ
class DIRECTORY < $STR, $IS_EQ is
-- This class provides the directory services of the underlying
-- operating system for the given directory.
--
-- An object of this class can only be created if there is an operating
-- system file system directory of the name given. The value returned by
-- the str routine is therefore always valid for path creation (see the
-- FILE_PATH class).
-- Version 1.3 Oct 98. Copyright K Hopper,U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 Jun 96 kh Original
-- 19 Feb 97 kh Additions for string/char portability.
-- 10 Apr 97 kh Modified for INT to CARD, etc
-- 28 Oct 98 kh Refined, added pre/post conditions
include COMPARABLE ;
private attr priv_dirname : FILE_PATH ;
private attr handle : REFERENCE ;
create(name : STR,access : ACCESS_SET) : SAME
pre (name.size > 0)
post void(result) -- couldn't do it
or void(result.handle) -- created successfully but closed
is
--This creation routine attempts to create a new directory in the
-- indicated (by name) location before creating an instance of a directory
-- object. If the given name is incorrect or access to the parent directory
-- is denied then object creation does not occur and void is returned.
-- The directory returned is NOT open.
loc_path : FILE_PATH := FILE_PATH::create(name) ;
if void(loc_path) then -- can't do it!
return void
end ;
if loc_path.is_relative then
loc_path := loc_path.absolute
end ;
if ~FILE_SYS::make_dir(loc_path.str,access) then
return void
else
me : SAME := new ;
me.priv_dirname := loc_path ;
me.handle := void ;
return me
end
end ;
existent(path : FILE_PATH) : SAME
pre ~void(path)
and ~path.is_relative
post true
is
-- This routine attempts to find the indicated directory. Providing
-- that the object is found and is a directory it is returned closed,
-- otherwise void is returned.
label : FILE_LABEL := FILE_LABEL::create(path.str) ;
if void(label)
or ~label.is_directory then
return void
else
me : SAME := new ;
me.priv_dirname := path ;
me.handle := void ;
return me
end
end ;
dirname : FILE_PATH
pre ~void(self)
post void(existent(priv_dirname))
or (result = priv_dirname)
is
--This routine has to check that the existing path has not been changed
-- by a renaming operation, returning void if it has been changed, otherwise
-- priv_dirname.
if void(existent(priv_dirname.absolute)) then
return void
else
return priv_dirname
end
end ;
existent(name : STR) : SAME
pre (name.size > 0)
post void(result)
or ~void(result.priv_dirname)
is
--This routine first attempts to create a file path from the name string.
-- It then invokes the path version of this routine.
loc_path : FILE_PATH := FILE_PATH::create(name) ;
if void(loc_path) then
return void
else
return existent(loc_path.absolute)
end
end ;
root : SAME
pre true
post ~void(result)
and void(result.handle) -- still closed but the directory exists
is
--This returns the directory object corresponding to the root
-- directory of the current file system.
me : SAME := new ;
loc_path : FILE_PATH := FILE_PATH::create(FILE_SYS::current_dir) ;
loop
path_head : FILE_PATH := loc_path.head ;
if path_head = loc_path then
break!
else
loc_path := path_head
end
end ;
me.priv_dirname := loc_path ;
me.handle := void ;
return me
end ;
current( path : FILE_PATH) : SAME
pre ~void(path)
post void(result)
or void(result.handle) -- but the directory exists.
is
--This routine sets the current working directory to be the one
-- identified by path and returns the associated directory object if
-- successful, otherwise void! Subsequent calls of the following routine
-- will yield the same directory until a further call of this routine
-- changes it.
if FILE_SYS::current_dir(path.str) then
me : SAME := new ;
me.priv_dirname := path ;
me.handle := void ;
return me
else
return void
end
end ;
current : SAME
pre true
post void(result.handle) -- there is always a current directory!
is
--This returns the directory object corresponding to the program's
-- current directory.
me : SAME := new ;
me.priv_dirname := FILE_PATH::create(FILE_SYS::current_dir) ;
me.handle := void ;
return me
end ;
parent : SAME
pre true
post void(result)
or void(result.handle)
is
--If the parent directory of this one exists then that directory
-- object is returned, otherwise void.
my_name : FILE_PATH ;
if void(self) then -- Don't know who I am
return void
else
my_name := priv_dirname.absolute ;
if void(existent(my_name)) then -- Eek! I've been renamed!
return void
end
end ;
loc_path : FILE_PATH := my_name.head ; -- returns 'self' if root!!!
me : SAME := new ;
me.priv_dirname := loc_path ;
me.handle := void ;
return me
end ;
is_eq(other : SAME) : BOOL is
--This predicate returns true if and only if other and self refer to
-- the same file system directory. They may therefore be different objects
-- while having a common external identity!!
return other.dirname = dirname
end ;
is_open : BOOL is
--This predicate returns true if and only if self is a directory which
-- has been successfully opened.
return ~void(self)
and ~void(handle)
end ;
is_empty : BOOL is
-- This predicate returns true if and only if self is a directory which
-- has no contents other than self and parent.
loc_dir : SAME := open ;
loc_lib : LIBCHARS := LIBCHARS::default ;
loop
loc_elt : FILE_PATH := elt! ;
if (loc_elt.str /= loc_lib.Self_Name.tgt_str)
and (loc_elt.str /= loc_lib.Parent_Name.tgt_str) then
-- Not special!
return false
end
end ;
return true
end ;
open : SAME
pre ~void(self)
post ~void(result.handle) -- or an exception has been raised!
is
--This routine opens this directory for reading.
res : REFERENCE := FILE_SYS::open_dir(dirname.str) ;
if void(res) then -- Ouch! Drastic failure!
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Name,dirname.str) ;
return void -- to keep compiler happy!
else
self.handle := res ;
return self
end
end ;
close
pre ~void(self)
and ~void(handle)
post void(handle) -- or an exception has been raised!
is
--This routine closes the external directory corresponding to this
-- object -- which then no longer refers to it!
if FILE_SYS::close_dir(handle) then
handle := void
else
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Value,dirname.str)
end
end ;
delete : SAME
pre ~void(self)
post void(result) -- or an exception has been raised.
is
--This operation deletes this directory, providing it is empty and
-- that access to its parent is possible - and returns void.
if void(dirname) then -- Oops! We,ve been renamed!!!!
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Name,priv_dirname.str) ;
return void -- to keep compiler happy!
elsif FILE_SYS::delete_dir(priv_dirname.str) then
return void
else
SYS_ERROR::create.error(self,SYS_EXCEPT::Access_Error,priv_dirname.str) ;
return void -- to keep compiler happy
end
end ;
delete( fname : STR)
-- pre ~void(self)
-- and void(handle) -- must not be open!
-- post true
is
--This operation deletes the named object (which must only be a leaf name) from this directory.
loc_path : FILE_PATH := FILE_PATH::create(fname) ;
loc_name : STR := dirname.append(fname).str ;
if (fname = loc_path.leaf) then -- name leaf only
if exists(fname) then -- it is here!
res : BOOL ;
if void(existent(loc_name)) then -- it is a file
res := FILE_SYS::delete_file(loc_name)
else -- it is a directory!
res := FILE_SYS::delete_dir(loc_name)
end
end
else
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Name,loc_name)
end
end ;
exists(leaf : STR) : BOOL is
-- This predicate returns true iff the object with the given leaf name
-- is in this directory, otherwise false.
--
-- NOTE Should true be returned from this routine call this may NOT be
-- taken to imply that anything may be done with the object queried.
-- This reports only the EXISTENCE or otherwise of the named object,
-- providing that the program has permission to know this!
if void(self) then
return false
end ;
loc_path : FILE_PATH := FILE_PATH::create(leaf) ;
if leaf = loc_path.leaf then -- it is a leaf name!
loc_name : STR := dirname.append(leaf).str ;
return FILE_SYS::exists(loc_name)
else
return false
end
end ;
error : BOOL is
-- This predicate returns true if and only if an error occurred in
-- the most recently tried operation on the directory - since the last clear
-- operation.
return ~void(handle)
and FILE_SYS::error(handle)
end ;
error_message : STR
pre ~void(self)
and ~void(handle)
and error
post ~void(str)
is
--This routine provides a string message which gives some indication
-- of the reason for the error.
return FILE_SYS::error_msg(handle)
end ;
clear
pre ~void(self)
and ~void(handle)
post ~error
is
--This routine provides a facility to clear the error condition for
-- this directory.
FILE_SYS::clearerr(handle)
end ;
rename( old_name, new_name : STR)
pre (old_name.size > 0)
and exists(old_name)
and (new_name.size > 0)
and (old_name /= new_name)
post true
is
--This routine provides for renaming the old_name object from
-- this directory to new_name.
loc_path : FILE_PATH := FILE_PATH::create(old_name) ;
if void(loc_path) then
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Name,old_name)
else
if loc_path.is_relative then
loc_path := dirname.append(loc_path)
end ;
loc_old : FILE_PATH := loc_path ;
loc_path := FILE_PATH::create(new_name) ;
if void(loc_path) then
SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Name,old_name)
else
if loc_path.is_relative then
loc_path := dirname.append(loc_path)
end ;
if exists(loc_old.leaf) then -- this object must exist!
res : BOOL ;
if void(existent(loc_old)) then -- it is a file
res := FILE_SYS::rename_file(loc_old.str,loc_path.str)
else -- it is a directory!
res := FILE_SYS::rename_dir(loc_old.str,loc_path.str)
end ;
if ~res then
SYS_ERROR::create.error(self,SYS_EXCEPT::Access_Error,priv_dirname.str)
end
end
end
end
end ;
elt! : FILE_PATH
pre ~void(self)
and ~void(handle) -- the directory is open!
post ~void(result) -- or quit
is
--This iter returns the file paths of all of the objects in this
-- directory in a system dependent order.
offset : CARD ;
if FILE_SYS::rewind_dir(handle,out offset) then
loop
res : STR := FILE_SYS::read_dir(handle,inout offset) ;
if void(res) then
close ;
quit
else
yield FILE_PATH::create(res)
end
end
else
quit
end
end ;
matching!( once exp : REG_EXP) : FILE_PATH
pre ~void(self)
and ~void(handle) -- the directory is open!
and ~void(exp)
post ~void(result) -- or quit
is
--This iter yields a sequence of names of the objects in this
-- directory which match the given regular expression, closing the
-- directory before quitting.
offset : CARD ;
if FILE_SYS::rewind_dir(handle, out offset) then
loop
res : STR := FILE_SYS::read_dir(handle, inout offset) ;
if void(res) then
close ;
quit
else
if exp.matches(res) then
yield FILE_PATH::create(res)
end
end
end
else
quit
end
end ;
str(lib : LIBCHARS) : STR is
--This routine returns the name by which this directory object was
-- known at the time of creation or later renaming. It is provided to
-- conform to the $STR interface.
return priv_dirname.str
end ;
str : STR is
--This routine returns the name by which this directory object was
-- known at the time of creation or later renaming in the default repertoire
-- and encoding.
return str(LIBCHARS::default)
end ;
end ; -- DIRECTORY