fpath.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>  <--------------


immutable class FILE_TYPES < $IS_EQ, $HASH

immutable class FILE_TYPES < $IS_EQ, $HASH is -- This class provides a mapping from 'name' to a temporary code for -- use in manipulating files whose contents are distinguished by a 'type' -- denotation. -- Version 1.4 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. -- 16 Apr 97 kh Modified for INT to CARD, etc -- 23 Jul 97 kh Higher level abstraction for diff OSs -- 22 Oct 98 kh Reverted to 'string' identification. include NUM_CODE create -> code_create ; private shared in_map : FMAP{STR,SAME} ; private shared out_map : FMAP{SAME,STR} ; private shared next : SAME ; private init is -- This routine creates the shared components of this class if -- necessary. Note that next starts at 1 so that void tests can be carried out. if void(in_map) then in_map := FMAP{STR,SAME}::create ; out_map := FMAP{SAME,STR}::create ; next := 1 end end ; create(str : STR) : SAME pre ~void(str) post out_map.test(result) is --This routine returns the file type which corresponds to the given -- string - if it exists - otherwise creates a new value which is returned. init ; if in_map.test(str) then return in_map.get(str) else me : SAME := next ; next := code_create((next.card + 1).binstr) ; in_map := in_map.insert(str,me) ; out_map := out_map.insert(me,str) ; return me end end ; kind(str : STR) : SAME pre ~void(str) post out_map.test(result) is --This routine returns the file type which corresponds to the given -- string - if it exists - otherwise creates a new value which is returned. -- It is merely a synonym for create above! return create(str) end ; private card : CARD pre ~void(self) post (result > 0) is --This private routine 'converts' self to cardinal for addition, etc. -- Note that the built-in code actually does nothing! builtin CARD_CARD end ; hash : CARD pre true -- irrespective of value of self post true -- irrespective of result is --This is a hash function for use when mapping by this key. It merely -- uses the library cardinal hash function. return card.hash end ; str : STR pre ~void(self) post (in_map.get(result) = self) is --This routine returns the text name of the enumeration for -- external representation, etc using the file system encoding and repertoire. return STR::create(out_map.get(self),LIBCHARS::default) end ; end ; -- FILE_TYPES

immutable class PATH_KINDS < $ENUMS{PATH_KINDS}

immutable class PATH_KINDS < $ENUMS{PATH_KINDS} is -- This class defines the identitities of the different kinds of file path component. -- Version 1.0 Dec 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 2 Dec 01 kh Original for FILE_PATH v2.0 include ENUM{PATH_KINDS} ; private const val_count : CARD := 6 ; -- The next routines provide the enumeration itself. Kind : SAME is return enum(1) end ; FS_Name : SAME is return enum(2) end ; Root : SAME is return enum(3) end ; Self : SAME is return enum(4) end ; Parent : SAME is return enum(5) end ; Ordinary : SAME is return enum(6) end ; end ; -- PATH_KINDS

class PATH_COMP

class PATH_COMP is -- This class defines the properties of a file path component. It is -- solely for use in the implementation of the FILE_PATH class. -- Version 1.0 Dec 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 2 Dec 01 kh Original for FILE_PATH v2.0 attr kind : PATH_KINDS ; readonly attr start : CARD ; readonly attr length : CARD ; create(sort : PATH_KINDS,start_idx : CARD,lgth : CARD) : SAME is -- This routine creates a path component descriptor for use in the -- FILE_PATH class. me : SAME := new ; me.kind := sort ; me.start := start_idx ; me.length := lgth ; return me end ; copy : SAME is -- This routine returns a copy of self. return create(kind,start,length) end ; end ; -- PATH_COMP

class FILE_PATH < $IS_EQ

class FILE_PATH < $IS_EQ is -- This abstraction is used for checking, breaking up and creating a -- file name which is valid in the operating system concerned. -- -- The file name string is deemed to consist of a sequence with the -- following structure -- dependent in detail upon the operating system! -- -- Note that the file kind may or may not be used by a file path to -- form part of a string used to identify the file. This may be used -- as a file type indicator where an operating system supports typed files. -- Version 2.0 Dec 2001. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 2 Dec 01 kh Original because of unfixable bugs in 1.5 include COMPARABLE ; private attr fname : FSTR ; private attr comps : FLIST{PATH_COMP} ; private attr kind_index : CARD ; -- in the last component (or nil) inspect is if void(self) then #OUT+"FILE_PATH void\n"; return; end; #OUT+"FILE_PATH fname:"+fname.str+"\n"; #OUT+"comps (kind,start,length):"; loop c::=comps.elt!; #OUT+"("+c.kind.str+","+c.start.str+","+c.length.str+")"; end; #OUT+"\n"; end; private find(str : STR,start : CARD,buff : FSTR) : CARD is -- This routine returns the index of the first appearance of the entire -- string str in buff starting from the index start. CARD::nil is -- returned if no such position is found. This is a specialised version -- of the normal string search operation since it needs to operate with exact -- code patterns as known to the underlying system rather than characters. -- It must also work before all cultural data has been read in! if buff.size < str.size then -- cannot be there! return CARD::nil end ; limit : CARD := buff.size - str.size ; loop index : CARD := start.upto!(limit) ; match : BOOL := true ; loop if buff.elt!(index).code /= str.elt!.code then -- code match! match := false ; break! end end ; if match then return index end end ; return CARD::nil end ; is_valid_leaf(str : STR) : BOOL is -- This predicate returns true if and only if the given string is -- suitable to form a leaf name, otherwise false. loop loc_code : CHAR_CODE := str.elt!.code ; loop if loc_code = str.index_lib.Component_Separator.elt! then return false end end end ; return true end ; private is_valid_token(str : STR) : BOOL is -- This predicate returns true if and only if str is neither void -- nor has the NUL character code as the first character. return ~(void(str) or (str[0] = CHAR::null)) end; private optional_starter(start : CARD,sort : PATH_KINDS,sep : STR) : CARD pre ~void(self) and (start < fname.size) post (result <= fname.size) is --This private routine returns the next index to search from if is_valid_token(sep) then index : CARD := find(sep,start,fname) ; if index.is_nil then return start else loc_comp : PATH_COMP := PATH_COMP::create(sort,start,(index - start)) ; comps := comps.push(loc_comp) ; return index + sep.size end end ; return start end ; private find_element(start : CARD) : CARD pre ~void(self) and (start < fname.size) is --This routine looks for an ordinary path component. It returns the -- index in the string at which a search for a following component should be made. sep : STR := fname.index_lib.Component_Separator.tgt_str ; if is_valid_token(sep) then index : CARD := find(sep,start,fname) ; if index.is_nil then index := fname.size end ; loc_val : STR := fname.substring(start,index - start).str ; loc_kind : PATH_KINDS ; if loc_val = fname.index_lib.Self_Name.tgt_str then loc_kind := PATH_KINDS::Self elsif loc_val = fname.index_lib.Parent_Name.tgt_str then loc_kind := PATH_KINDS::Parent else loc_kind := PATH_KINDS::Ordinary end ; loc_comp : PATH_COMP := PATH_COMP::create(loc_kind,start,(index - start)) ; comps := comps.push(loc_comp) ; return index + sep.size end ; return start end ; private find_root(start : CARD) : CARD pre ~void(self) and (start < fname.size) post (result <= fname.size) is -- This routine takes special action if - as in some systems - the root -- 'name' and a component separator are identical, otherwise, because the -- root separator cannot be null (because of parsing ambiguities), it sets -- the 'kind' of the next path component to be Root - providing it is not -- the first component. loc_lib : LIBCHARS := fname.index_lib ; loc_comp : PATH_COMP ; if loc_lib.Root_Name = loc_lib.Component_Separator then -- this might be a root name if fname[start] = loc_lib.Root_Name.tgt_str[0] then loc_comp := PATH_COMP::create(PATH_KINDS::Root,start,0) ; comps := comps.push(loc_comp) ; return start + loc_lib.Root_Name.size else return start end else count : CARD := comps.size ; next : CARD := find_element(start) ; if (comps.size > count) and (comps.size > 1) then -- one there loc_comp := comps.top ; loc_str : STR := fname.substring(loc_comp.start,loc_comp.length).str ; if loc_str = loc_lib.Root_Name.tgt_str then loc_comp.kind := PATH_KINDS::Root end ; return next else -- bad path return CARD::nil end end end ; private find_leaf is -- This routine looks for the index of the file 'kind' separator - if -- there is one - but before doing so it discards any trailing component -- separator! last_comp : PATH_COMP := comps.top ; fname.loc := last_comp.start + last_comp.length ; -- set path end! sep : STR := fname.index_lib.Kind_Separator.tgt_str ; kind_index : CARD := CARD::nil ; -- assume there is none! start : CARD := last_comp.start ; if is_valid_token(sep) then -- there might be one! loop -- only the LAST one is kind sep index : CARD := find(sep,start,fname) ; if index.is_nil then break! else start := index + sep.size ; kind_index := start end end end end ; private create(str : FSTR) : SAME pre (str.size > 0) post true is --This routine returns a file path constructed from the given -- string (which may either be absolute or relative to some current working directory). me : SAME := new ; me.fname := str ; me.comps:=#; me.kind_index:=CARD::nil; loc_lib : LIBCHARS := me.fname.index_lib ; str_index : CARD := 0 ; str_index := me.optional_starter(str_index, PATH_KINDS::Kind,loc_lib.System_Separator.tgt_str) ; str_index := me.optional_starter(str_index, PATH_KINDS::FS_Name,loc_lib.Root_Separator.tgt_str) ; str_index := me.find_root(str_index) ; -- not found if relative! loop -- over remaining path elements if str_index < me.fname.size then str_index := me.find_element(str_index) else break! end end ; if str_index.is_nil then return void else me.find_leaf ; -- removes trailing sep if there! return me end end ; create( str : STR) : SAME pre (str.size > 0) post true is --This routine returns a file path constructed from the given -- string (which may either be absolute or relative to some current working -- directory). return create(FSTR::create(str)) end ; append( str : STR) : SAME pre void(self) or (fname.index_lib = str.index_lib) post true is --This routine appends str to the current name -- providing that it is -- a valid leaf name -- preceded by a Component_Separator. if void(self) then return create(str) end ; res : FSTR := fname.copy + fname.index_lib.Component_Separator.tgt_str ; return create(res + str) end ; append(other : SAME) : SAME pre ~void(other) post true is -- This routine appends other to the current name preceded by a -- Component_Separator. loc_lib : LIBCHARS := fname.index_lib ; if void(self) then return other else return create(fname.copy + loc_lib.Component_Separator.tgt_str + other.fname.copy) end end ; is_eq(other : SAME) : BOOL is -- This predicate returns true if and only if other and self identify -- the same file system object (if it were to exist). Note that the -- definition implemented here requires that both be the same relative name -- or the same absolute name, since while a relative name MAY indicate the -- same entity as an absolute one, this is only valid while the current -- directory happens to be the right one for that to be true! return fname = other.fname end ; is_relative : BOOL is -- This predicate returns true if and only if self is a relative path, -- otherwise it is absolute and false is returned. loop if comps.elt!.kind = PATH_KINDS::Root then return false end end ; return true end ; absolute : SAME pre ~void(self) post ~result.is_relative is --This routine converts self into the absolute path by appending self -- to the current directory. All 'parent' and 'self' components are replaced -- by actual path component names where necessary. res : SAME := create(FILE_SYS::current_dir) ; -- the starting point! loop loc_idx : CARD := 0.upto!(comps.size - 1) ; loc_comp : PATH_COMP := comps.elt! ; if (loc_comp.kind = PATH_KINDS::Root) then res := create(root_name) -- Mmm! might have '.' or '..'? elsif (loc_comp.kind = PATH_KINDS::Parent) then res := res.head -- see head - never beyond root! elsif (loc_comp.kind = PATH_KINDS::Self) then -- nothing to do! else res := res.append(fname.substring(loc_comp.start,loc_comp.length).str) end end ; return res end ; leaf : STR pre ~void(self) post ~void(result) is --This routine returns the leaf name component of self. last : PATH_COMP := comps.top ; return fname.substring(last.start,last.length).str end ; private current : SAME is -- This routine returns the file path for the current directory. loc_lib : LIBCHARS := fname.index_lib ; return create(loc_lib.Self_Name.tgt_str) end ; private do_head : SAME is -- This private routine carries out the actual leaf 'removal' to produce -- the head of the path. res : SAME := new ; res.kind_index := CARD::nil ; res.fname := fname.copy ; res.comps:=#; loop (comps.size - 1).times! ; res.comps := res.comps.push(comps.elt!.copy) end ; elem : PATH_COMP := res.comps.top ; res.fname.loc := elem.start + elem.length ; return res end ; head : SAME pre ~void(self) post true is -- This routine returns the full path except for the leaf name and its -- preceding separator - unless :- -- -- a. The full path is merely the root name when self is returned. -- -- b. The path is relative and has only one path component, when -- the current directory is returned. if comps.top.kind = PATH_KINDS::Root then if fname.loc = 0 then -- 'invisible' root name! return create(fname.index_lib.Root_Name.tgt_str) else return create(fname) end elsif comps.size = 1 then -- just a leaf return create(fname) else -- more than one component return do_head end end ; fs_kind : STR pre ~void(self) post true is -- The string which is contained in the full path which represents the -- kind of the file system. This may, of course, be void. if comps[0].kind = PATH_KINDS::Kind then return fname.substring(comps[0].start,comps[0].length).str else return void end end ; kind : STR pre ~void(self) post true is --This routine returns the sub-string at the end of a leaf name (if -- any) which conventionally identifies the type of contents in the -- file. There is, of course, no necessary relationship between this -- 'type' string and the actual file contents. If the string -- returned is void, then no 'type' information is available. Note that -- the OS-dependent type mechanism is allowed to produce the actual string. if kind_index.is_nil then return STR::create -- nothing there! else return FILE_SYS::file_type(fname.str,leaf) end end ; kind(str : STR) : SAME pre ~void(self) and ~void(str) and (fname.index_lib = str.index_lib) post true is --This routine returns a new file path, the leaf component of which -- has the specified 'type'. This replaces any kind string which may -- have been present in self! Note that the actual type setting is done in -- FILE_SYS, so that the OS-dependent mechanism of file 'typing' is used. loc_label : FILE_LABEL := FILE_LABEL::create(fname.str) ; if void(loc_label) then -- doesn't exist?? return void elsif ~loc_label.is_file then return self end ; return head.append(FILE_SYS::set_type(fname.str,leaf,str)) end ; root_name : STR pre ~void(self) post true is --The string which is contained in the full path name representing the -- name of the file-system or device (which may be merely 'anonymous'). elem : PATH_COMP ; loop loc_elem : PATH_COMP := comps.elt! ; if loc_elem.kind = PATH_KINDS::Root then elem := loc_elem ; break! end end ; if void(elem) -- this name is relative or elem.length = 0 then -- no fs kind/name return fname.index_lib.Root_Name.tgt_str else return fname.substring(0,(elem.start + elem.length)).str end end ; fs_name : STR pre ~void(self) post true is --This is just another name for root_name! return root_name end ; elt! : STR pre ~void(self) post true is --This iter yields a sequence of the component strings of fname, -- ignoring any void file system or root name. loop loc_comp : PATH_COMP := comps.elt! ; if loc_comp.length = 0 then if loc_comp.kind = PATH_KINDS::Root then yield fname.index_lib.Root_Name.tgt_str else -- should never happen! quit end else yield fname.substring(loc_comp.start,loc_comp.length).str end end end ; separators! : STR pre ~void(self) post true is --This iter yields the sequence of separators in the path string, -- ignoring any separator corresponding to a void entry. if comps.size < 2 then quit end ; loop loc_idx : CARD := 0.upto!(comps.size - 2) ; this : PATH_COMP := comps[loc_idx] ; next : PATH_COMP := comps[loc_idx + 1] ; start : CARD := this.start + this.length ; yield fname.substring(start,next.start - start).str end end ; str : STR pre ~void(self) post true -- result = fname is -- This routine provides a string representation of a file path. The -- special case of an 'empty' root element only occurs where the root name -- and a component separator are the same (ie the root name is effectively -- invisible)! if fname.loc = 0 then -- 'invisible' root name! return fname.index_lib.Root_Name.tgt_str else return fname.str end end ; end ; -- FILE_PATH

class SEARCH_PATH

class SEARCH_PATH is -- This class of objects is the implementation of an operating system -- search path. This is a list of directory paths to be searched for -- some named entity. -- 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. -- 16 Apr 97 kh Modified for INT to CARD, etc -- 22 Oct 98 kh Added pre/post conditions private attr directories : FLIST{FILE_PATH} ; create(str : STR) : SAME pre (str.size > 0) post true is --This is the search path creation routine. It assumes that the string -- passed is the Search_Separator separated list of strings to be separated -- into the directory path list. me : SAME := new ; index : CARD := 0 ; loc_path : FILE_PATH ; sep_index : CARD ; loc_lib : LIBCHARS := str.index_lib ; sep : STR := loc_lib.Search_Separator.tgt_str ; loop sep_index := str.search(sep,index) ; if sep_index.is_nil then -- this is the last one sep_index := str.size end ; loc_str : STR := str.substring(index,sep_index - index) ; loc_path := FILE_PATH::create(loc_str) ; if void(loc_path) then -- this component is illegal! return void elsif loc_path.is_relative then loc_path := loc_path.absolute end ; me.directories := me.directories.push(loc_path) ; index := sep_index + sep.size ; if index >= str.size then -- finished return me end end end ; env_path(str : STR) : SAME pre (str.size > 0) post true is --This version of creation assumes that the string passed is the name of -- some operating system environment variable whose value is the list of -- strings forming the search path. If any element is not a valid file path -- then void is returned. loc : STR := OPSYS::get_env(str) ; if loc.size = 0 then return void end ; return create(loc) end ; elt! : FILE_PATH pre true post (void(self) and (result = DIRECTORY::current.dirname)) or ~void(result) is --This iter yields the succession of directory names contained in -- the list. In the special case where self is void, it yields the current -- directory if void(self) then yield DIRECTORY::current.dirname ; quit end ; loop yield directories.elt! end end ; end ; -- SEARCH_PATH