english version "1.0" identify "xyz" #: Copyright (c) 1992-2005 by Wayne C. Gramlich. #, All rights reserved. module system #: The system module provides access to operating system supplied services. import character file_system format in_stream out_stream string vector unsigned define system external procedure standard@system takes_nothing returns system external system__standard #: This procedure returns the standard system object. procedure arguments_get@system takes system system returns vector[string] external system__arguments_get #: This procedure returns the command line arguments passed into the #, application as a vector of permanent read only strings. procedure current_time@system takes system system returns unsigned external system__current_time #: This procedure will return the current time measured as the number #, of seconds 00:00:00 UTC, January 1, 1970. procedure current_working_directory@system takes_nothing returns string external system__current_working_directory #: This procedure will return the current working directory. procedure directory_create@system takes system system directory string returns logical external system__directory_create #: This procedure will create {directory} as a file directory. #, {true@logical} is returned {directory} is not successfully created. procedure directory_scan@system takes directory_name string returns vector[string] #: This procedure will return the unsorted list of file names in #, {directory_name}. If {directory_name} does not exist, the #, returned file name list is empty. Remember: on UNIX, every #, directory has a "." and ".." file in it. file_names :@= allocate@vector[string]() directory_scan_open@system(directory_name) loop file_name :@= directory_scan_next@system() until file_name = "" append@(file_names, file_name) return file_names procedure directory_scan_open@system takes directory_name string returns_nothing external system__directory_scan_open #: This procedure will do a directory open of {directory_name}. procedure directory_scan_next@system takes_nothing returns string external system__directory_scan_next #: This procedure will return the next file name from the open directory. #, The empty string is returned if there are no more file names and the #, directory is closed. procedure environment_get@system takes system system returns vector[string] external system__enviroment_get #: This procedure will return environment variable vector. procedure environment_variable_exists@system takes system system name system returns logical external system__environment_vairable_exists #: This procedure will return {true}@{logical} if the environment #, variable named "variable} exists in {system}'s environment; #, otherwise, {false}@{logical} is returned. procedure environment_variable_get@system takes system system name string returns string external system__environment_variable_get #: This procedure will return the value of the enironment variable #, named {name} associated with {system}'s environment. The empty #, string is returned if the environment variable does not exist. procedure error_out_stream_get@system takes system system returns out_stream external system__error_out_stream_get #: This procedure will return the error output stream associated with #, {system}. procedure executable_directory@system takes system system returns string #: This procedure will return the directory in which the currently #, executing executable resides. This code basically scans the #, PATH environment variable to find the executable and then #, expands out any symbolic links. It is possible to trick this #, routine with hard links and extremely funky exec(2) code. The #, empty string is returned if any errors occur. #debug_stream :@= system.error_out_stream #put@("=>executable_directory()\n\", debug_stream) windows_system :@= is_windows@(system) unix_system :@= is_unix@(system) program_name :@= system.program_name if program_name = "" return "" #format@format1[string](debug_stream, # "program_name=%ds%\n\", program_name) directory_separator :@= "/"[0] colon :@= ":"[0] path_separator :@= colon if windows_system directory_separator := "\\"[0] path_separator := ";"[0] # Figure out if we have a full path or not: program_name_size :@= program_name.size assert program_name_size != 0 if unix_system && program_name_size >= 1 && program_name[0] = directory_separator || windows_system && program_name_size >= 3 && program_name[1] = colon && program_name[2] = directory_separator # We appear to have a full path to the program: #put@("Program name appears to be fully qualified\n\", debug_stream) program_name := file_real_path@(system, program_name) else # A relative path: #put@("Program name appears to depend on PATH\n\", debug_stream) path_list :@= environment_variable_get@(system, "PATH") # Windows always looks in the current directory first: path :@= allocate@string() if windows_system string_append@(path, current_working_directory@system()) character_append@(path, directory_separator) string_append@(path, program_name) #format@format1[string](debug_stream, # "try: %ds%\n\", path) if file_exists@(system, path) # Found it! program_name := file_real_path@(system, path) else string_append@(path, ".exe") #format@format1[string](debug_stream, # "try: %ds%\n\", path) if file_exists@(system, path) program_name := file_real_path@(system, path) else # No joy: trim@(path, 0) if path.size = 0 # Start hunting down the path until it is found (or not): #format@format1[string](debug_stream, # "PATH=%ds%\n\", path_list) size :@= path_list.size index :@= 0 loop while index < size chr :@= path_list[index] if chr != path_separator character_append@(path, chr) index :+= 1 if chr = path_separator || index = size # Try current path in buffer: character_append@(path, directory_separator) string_append@(path, program_name) #format@format1[string](debug_stream, # "try: %ds%\n\", path) if file_exists@(system, path) # Found it! program_name := file_real_path@(system, path) break if windows_system string_append@(path, ".exe") #format@format1[string](debug_stream, # "try: %ds%\n\", path) if file_exists@(system, path) program_name := file_real_path@(system, path) break trim@(path, 0) if path.size = 0 #put@("Unable to resolve executable directory\n\", # debug_stream) return "" # Now strip off the program name to get the directory. result :@= writable_copy@(program_name) size :@= program_name.size index :@= size loop index :-= 1 if program_name[index] = directory_separator && index != 0 break while index != 0 if index != 0 trim@(result, index) #put@("<=executable_directory()\n\", debug_stream) return result procedure execute@system takes command string returns unsigned external system__execute #: This procedure will execute {command}. The exit status for #, the command is returned. If no exit status is available, #, 0xffffffff is returned. procedure exit@system takes exit_code unsigned returns_nothing # Should be "returns_never" external system__exit #: This procedure will cause the application to terminate immediately #, with a return code of {exit_code}. procedure file_delete@system takes system system file_name string returns logical external system__file_delete #: This procedure will delete the file named {file_name}. {true} is #, if either the file could not be deleted or if the file does not #, exist; otherwise, {false} is returned if the file is successfully #, deleted. procedure file_mode_change@system takes system system file_name string mode unsigned returns logical external system__file_mode_change #: This procedure will change the mode of {file_name} to {mode}. #, {true} is returned if the operation fails and {false} otherwise. procedure file_exists@system takes system system file_name string returns logical external system__file_exists #: This procedure will return {true}@{logical} if {file_name} #, is a file, directory, symbolic link, etc.; otherwise, #, {false}@{logica} is returned. procedure file_system_get@system takes system system returns file_system external system__file_system_get #: This procedure will return the {file_system} object associated #, {system}. procedure file_real_path@system takes system system file_name string returns string external system__file_real_path #: This procedure will return the real path for {file_name} using {system}. #, The empty string is returned if an error occurs. procedure file_rename@system takes system system old_file_name string new_file_name string returns logical external system__file_rename #: This procedure will rename {old_file_name] to {new_file_name} using #, {system}. {true} is returned if the rename fails and {false} #, otherwise. procedure is_directory@system takes system system directory string returns logical external system__is_directory #: This procedure will return {true@logical} if {directory} is #, a directory and {false@logical} otherwise. procedure is_file@system takes system system file_name string returns logical external system__is_directory #: This procedure will return {true@logical} if {file_name} is #, a regular file and {false@logical} otherwise. procedure is_symbolic_link@system takes system system symbolic_link string returns logical external system__is_symbolic_link #: This procedure will return {true@logical} if {symbolic_link} is #, a symbolic link and {false@logical} otherwise. procedure is_unix@system takes system system returns logical external system__is_unix #: This procedure will return {true}@{logical} if {system} #, running under a unix style of operating system and {false}@{logical} #, otherwise. procedure is_windows@system takes system system returns logical external system__is_unix #: This procedure will return {true}@{logical} if {system} #, running under a microsoft style of operating system and # {false}@{logical} otherwise. procedure print@system takes system system out_stream out_stream returns_nothing #: This procedure will print {system} to {out_stream}. put@("{arguments:", out_stream) print@(system.arguments, out_stream) put@(", error_out_stream:", out_stream) print@(system.error_out_stream, out_stream) put@(", program_name:", out_stream) print@(system.program_name, out_stream) put@(", standard_out_stream:", out_stream) print@(system.standard_out_stream, out_stream) put@("}", out_stream) procedure program_name_get@system takes system system returns string external system__program_name_get #: This procedure will return the program name associated with {system}. procedure standard_in_stream_get@system takes system system returns in_stream external system__standard_in_stream_get #: This procedure will return the standard input stream associated with #, {system}. procedure standard_out_stream_get@system takes system system returns out_stream external system__standard_out_stream_get #: This procedure will return the standard output stream associated with #, {system}. procedure user_number_get@system takes system system returns unsigned external system__user_number_get #: This procedure will return the current user number (uid).