diff --git a/core/alsp_src/builtins/fsunix.pro b/core/alsp_src/builtins/fsunix.pro index 792d002b..8fa6f6e4 100644 --- a/core/alsp_src/builtins/fsunix.pro +++ b/core/alsp_src/builtins/fsunix.pro @@ -9,29 +9,219 @@ | Date: Begun 4/88 | Revision: Ken Bowen -- 11/88, 1/91 | -- library version: 11/91 + | + | Note: Depends on core/alsp_src/unix/unix_makefile & friends + | Note: Some examples below utilize ls/0 as defined in blt_sys.pro. *===========================================================================*/ module builtins. -export make_subdir/1. -export make_subdir/2. -export remove_subdir/1. -export kill_subdir/1. export file_status/2. export files/2. export files/3. +export move_file/2. +export make_subdir/1. +export make_subdir/2. export subdirs/1. export subdirs_red/1. +export remove_subdir/1. +export kill_subdir/1. export directory/3. +export recursive_dir_path/2. +export recursive_dir_paths/2. export get_current_drive/1. export change_current_drive/1. -export move_file/2. +/*!------------------------------------------------------------------ + | file_status/2 + | file_status(FileName, Status) + | file_status(+, -) + | + | - Returns OS information about a file named FileName + | + | If FileName is the name associated with an entry in the + | OS filesystem, returns OS information about that entry, + | as in the following two examples: + | + | Examples + | ?- file_status(alspro, Status). + | + | Status=[type = regular,permissions = [read,write,execute], + | mod_time = 1586731762.0,size = 462720] + | + | ?- file_status(alsdir, Status). + | + | Status=[type = directory,permissions = [read,write,execute], + | mod_time = 1586652989.0,size = 204] + *!-----------------------------------------------------------------*/ +file_status(FileName, Status) + :- + '$getFileStatus'(FileName, + fileStatus(FileTypeCode, ModTime, OwnerPermiss, + ByteSize,NBlocks)), + fileTypeCode(FileTypeCode,FileType), + ownerPermissionsCoding(OwnerPermiss, Permissions), + Status = [type=FileType, permissions=Permissions, + mod_time=ModTime, size=ByteSize]. + +/*--------------------------------------------------------------- + | File types/attributes -- at the abstract (Prolog) level: + | regular -- an ordinary file + | directory + *---------------------------------------------------------------*/ + +/*---------------------------------------------------------------- + | Unix file status/type codes: + | + | 0 = unknown + | 1 = directory + | 2 = character_special + | 3 = block_special + | 4 = regular + | 5 = symbolic_link + | 6 = socket + | 7 = fifo_pipe + *----------------------------------------------------------------*/ + +fileTypeCode(0, unknown). +fileTypeCode(1, directory). +fileTypeCode(2, character_special). +fileTypeCode(3, block_special). +fileTypeCode(4, regular). +fileTypeCode(5, symbolic_link). +fileTypeCode(6, socket). +fileTypeCode(7, fifo_pipe). + +ownerPermissionsCoding(0,[]). +ownerPermissionsCoding(1,[execute]). +ownerPermissionsCoding(2,[write]). +ownerPermissionsCoding(3,[write,execute]). +ownerPermissionsCoding(4,[read]). +ownerPermissionsCoding(5,[read,execute]). +ownerPermissionsCoding(6,[read,write]). +ownerPermissionsCoding(7,[read,write,execute]). + +/*!---------------------------------------------------------------- + | files/2 + | files(Pattern,FileList) + | files(+,-) + | + | - returns a list of regular files in the current directory matching a pattern + | + | Returns the list (FileList) of all ordinary (regular) files + | in the current directory which match Pattern, which can + | includethe usual '*' and '?' wildcard characters. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | ?- files('*.pst', F). + | + | F=['alsdev.pst','alspro.pst'] + | + | ?- files('*', F). + | + | F=['LICENSE.txt','README.txt','als-prolog-manual.pdf', + | 'als-ref-manual.pdf',alsdev,'alsdev.pst',alspro,'alspro.1', + | 'alspro.pst','libalspro.a','libalspro.dylib','test.pro'] + *!----------------------------------------------------------------*/ +files(Pattern, FileList) + :- + directory(Pattern, 4, FileList). + +/*!---------------------------------------------------------------- + | files/3 + | files(Directory, Pattern,FileList) + | files(+,+,-) + | + | - returns a list of regular files residing in Directory matching a pattern + | + | Returns the list (FileList) of all ordinary files in the + | directory Directory which match Pattern, which can include + | the usual '*' and '?' wildcard characters. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | ?- files('examples/more', '*', F). + | + | F=['concurrent_interrupts.pro','core_concurrent.pro', + | 'finger.pro','freeze.pro','interrupts_coroutine.pro', + | 'mathserv1.pro','mathserv2.pro','primes_coroutine.pro', + | 'simple_coroutine.pro'] + | + | ?- files('examples/more', 'p*', F). + | + | F=['primes_coroutine.pro'] + *!----------------------------------------------------------------*/ +files(Directory, Pattern, List) + :- + getDirEntries(Directory, Pattern, FirstResult), + !, + fixFileType(regular, InternalFileType), + filterForFileType(FirstResult, Directory, InternalFileType, List). + +/*!---------------------------------------------------------------- + | move_file/2 + | move_file(Source, Target) + | move_file(+, +) + | + | - Change the name of a file from Source to Target + | + | If both Source and Target are atoms which can be the + | names of a file, and if Source is the name of a file + | existing in the file system, then the name of that file + | will be changed from Source to Target. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | ls i* + | > ls i* + | ls: i*: No such file or directory + | ?- move_file('README.txt', 'intro-README.txt'). + | > ls i* + | intro-README.txt + *!----------------------------------------------------------------*/ +move_file(Source, Target) + :- + sprintf(atom(Cmd),'mv %t %t', [Source, Target]), + system(Cmd). /*!-------------------------------------------------------------- | make_subdir/1 | make_subdir(NewDir) | make_subdir(+) | + | - creates a subdirectory in the current working directory + | - with default permissions + | + | If NewDir is an atom, creates a subdirectory named NewDir in + | the current working directory, if possible. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + | ..... + | ?- make_subdir(myNewTestSubdir). + | + | yes. + | ?- halt. + | ls + | ALS_Prolog_Foreign_SDK/ alsdev.pst examples/ + | LICENSE.txt alsdir/ libalspro.a + | README.txt alspro* libalspro.dylib* + | als-prolog-manual.pdf alspro.1 myNewTestSubdir/ + | als-ref-manual.pdf alspro.pst + | alsdev* docs/ + *!--------------------------------------------------------------*/ +make_subdir(NewDir) + :- + %%[rwx,rwx,rwx] + make_subdir(NewDir,511). + +/*!-------------------------------------------------------------- | make_subdir/2 | make_subdir(NewDir,Permissions) | make_subdir(+,+) @@ -53,19 +243,39 @@ export move_file/2. | [[read,write,execute], | [read,write], | [execute] ] - *!--------------------------------------------------------------*/ - %% This may go away later: -make_subdir(NewDir) - :- - sys_env(unix,djgpp,_), - !, - mkdir(NewDir). - -make_subdir(NewDir) - :- - %%[rwx,rwx,rwx] - make_subdir(NewDir,511). - + | + | Examples + | Executed in the ALS Prolog distribution directory: + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + | ..... + | ?- make_subdir(myNewTestSubdir,457). + | + | yes. + | ?- halt. + | > ls -l + | total 26448 + | drwxr-xr-x 6 user staff 204 Apr 17 15:01 ALS_Prolog_Foreign_SDK/ + | -rw-r--r-- 1 user staff 1101 Apr 17 15:01 LICENSE.txt + | -rw-r--r-- 1 user staff 2738 Apr 9 09:33 README.txt + | -rw-r--r-- 1 user staff 1938443 Apr 9 09:33 als-prolog-manual.pdf + | -rw-r--r-- 1 user staff 1136668 Apr 9 09:33 als-ref-manual.pdf + | -rwxr-xr-x 1 user staff 482560 Apr 17 14:58 alsdev* + | -rw-r--r-- 1 user staff 4194488 Apr 17 14:58 alsdev.pst + | drwxr-xr-x 6 user staff 204 Apr 17 14:57 alsdir/ + | -rwxr-xr-x 1 user staff 462720 Apr 17 14:58 alspro* + | -rw-r--r-- 1 user staff 8181 Apr 9 09:33 alspro.1 + | -rw-r--r-- 1 user staff 4194488 Apr 17 14:58 alspro.pst + | drwxr-xr-x 7 user staff 238 Apr 17 14:58 docs/ + | drwxr-xr-x 9 user staff 306 Apr 17 15:01 examples/ + | -rw-r--r-- 1 user staff 634664 Apr 17 14:58 libalspro.a + | -rwxr-xr-x 1 user staff 463764 Apr 17 14:58 libalspro.dylib* + | drwx--x--x 2 user staff 68 Apr 19 19:03 myNewTestSubdir/ + *!----------------------------------------------------------------*/ make_subdir(NewDir,Permissions) :- integer(Permissions), @@ -111,58 +321,6 @@ indv_perm_code(read, 4). indv_perm_code(write, 2). indv_perm_code(execute, 1). -/*!-------------------------------------------------------------- - | remove_subdir/1 - | remove_subdir(SubDir) - | remove_subdir(+) - | - | - removes a subdirectory from the current working directory - | - | If SubDir is an atom, remove the subdirectory named SubDir from - | the current working directory, if it exists. - *!--------------------------------------------------------------*/ -remove_subdir(SubDir) - :- - rmdir(SubDir). - -kill_subdir(SubDir) - :- - sprintf(atom(Cmd),'rm -r %t',[SubDir]), - system(Cmd). - -/*!---------------------------------------------------------------- - | files/2 - | files(Pattern,FileList) - | files(+,-) - | - | - returns a list of files in the current directory matching a pattern - | - | Returns the list (FileList) of all ordinary files in the - | current directory which match Pattern, which can include - | the usual '*' and '?' wildcard characters. - *!----------------------------------------------------------------*/ -files(Pattern, FileList) - :- - directory(Pattern, 4, FileList). - -/*!---------------------------------------------------------------- - | files/3 - | files(Directory, Pattern,FileList) - | files(+,+,-) - | - | - returns a list of files residing in Directory matching a pattern - | - | Returns the list (FileList) of all ordinary files in the - | directory Directory which match Pattern, which can include - | the usual '*' and '?' wildcard characters. - *!----------------------------------------------------------------*/ -files(Directory, Pattern, List) - :- - getDirEntries(Directory, Pattern, FirstResult), - !, - fixFileType(regular, InternalFileType), - filterForFileType(FirstResult, Directory, InternalFileType, List). - /*!---------------------------------------------------------------- | subdirs/1 | subdirs(SubdirList) @@ -171,7 +329,24 @@ files(Directory, Pattern, List) | - returns a list of subdirectories | | Returns the list of all subdirectories of the current - | working directory. + | working directory. On unix, the system files '.' and '..' + | are removed from the list; on mswin32, they are included. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + | ..... + | ?- subdirs(SDs). + | + | SDs=['ALS_Prolog_Foreign_SDK',alsdir,docs,examples] + | + | yes. *!----------------------------------------------------------------*/ subdirs(SubdirList) :- @@ -186,6 +361,22 @@ subdirs(SubdirList) | | Returns the list of all subdirectories of the current | working directory, omitting '.' and '..' + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + | ..... + | ?- subdirs_red(SDs). + | + | SDs=['ALS_Prolog_Foreign_SDK',alsdir,docs,examples] + | + | yes. *!----------------------------------------------------------------*/ subdirs_red(SubdirList) :- @@ -193,59 +384,85 @@ subdirs_red(SubdirList) list_delete(SubdirList0, '.', SubdirList1), list_delete(SubdirList1, '..', SubdirList). -/*--------------------------------------------------------------- - | File types/attributes: - | -- at the abstract (Prolog) level: +/*!-------------------------------------------------------------- + | remove_subdir/1 + | remove_subdir(SubDir) + | remove_subdir(+) | - | regular -- an ordinary file - | directory - *---------------------------------------------------------------*/ - -/*---------------------------------------------------------------- - | Unix file status/type codes: + | - removes a subdirectory from the current working directory | - | 0 = unknown - | 1 = directory - | 2 = character_special - | 3 = block_special - | 4 = regular - | 5 = symbolic_link - | 6 = socket - | 7 = fifo_pipe - *----------------------------------------------------------------*/ - -fileTypeCode(0, unknown). -fileTypeCode(1, directory). -fileTypeCode(2, character_special). -fileTypeCode(3, block_special). -fileTypeCode(4, regular). -fileTypeCode(5, symbolic_link). -fileTypeCode(6, socket). -fileTypeCode(7, fifo_pipe). - -ownerPermissionsCoding(0,[]). -ownerPermissionsCoding(1,[execute]). -ownerPermissionsCoding(2,[write]). -ownerPermissionsCoding(3,[write,execute]). -ownerPermissionsCoding(4,[read]). -ownerPermissionsCoding(5,[read,execute]). -ownerPermissionsCoding(6,[read,write]). -ownerPermissionsCoding(7,[read,write,execute]). + | If SubDir is an atom, remove the subdirectory named SubDir from + | the current working directory, if it exists AND is empty. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | > mkdir funnyFolder + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev.pst examples/ + | LICENSE.txt alsdir/ funnyFolder/ + | README.txt alspro* libalspro.a + | als-prolog-manual.pdf alspro.1 libalspro.dylib* + | als-ref-manual.pdf alspro.pst + | alsdev* docs/ + | ..... + | ?- remove_subdir(funnyFolder). + | + | yes. + | ..... + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + *!--------------------------------------------------------------*/ +remove_subdir(SubDir) + :- + rmdir(SubDir). -/*!------------------------------------------------------------------ - | file_status/2 - | file_status(FileName, Status) - | file_status(+, -) - *!-----------------------------------------------------------------*/ -file_status(FileName, Status) +/*!-------------------------------------------------------------- + | kill_subdir/1 + | kill_subdir(SubDir) + | kill_subdir(+) + | + | - removes a subdirectory from the current working directory + | + | If SubDir is an atom, remove the subdirectory named SubDir from + | the current working directory, if it exists; SubDir may + | contain files and other subdirs. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | > mkdir funnyFolder + | > echo hiThere > funnyFolder/AFile + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev.pst examples/ + | LICENSE.txt alsdir/ funnyFolder/ + | README.txt alspro* libalspro.a + | als-prolog-manual.pdf alspro.1 libalspro.dylib* + | als-ref-manual.pdf alspro.pst + | alsdev* docs/ + | > cat funnyFolder/AFile + | hiThere + | ..... + | ?- kill_subdir(funnyFolder). + | + | yes. + | ..... + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + *!--------------------------------------------------------------*/ +kill_subdir(SubDir) :- - '$getFileStatus'(FileName, - fileStatus(FileTypeCode, ModTime, OwnerPermiss, - ByteSize,NBlocks)), - fileTypeCode(FileTypeCode,FileType), - ownerPermissionsCoding(OwnerPermiss, Permissions), - Status = [type=FileType, permissions=Permissions, - mod_time=ModTime, size=ByteSize]. + sprintf(atom(Cmd),'rm -r %t',[SubDir]), + system(Cmd). + /*!------------------------------------------------------------------ | directory/3 @@ -256,10 +473,32 @@ file_status(FileName, Status) | | If Pattern is a file name pattern, including possible '*' and | '?' wildcard characters, and FileType is a numeric (internal) - | file type or a symbolic (abstract) file type, directory/3 - | unifies List with a sorted list of atoms of names of file of - | type FileType, matching Pattern, and found in the + | file type or a symbolic (abstract) file type, (see fileTypeCode/2 + | and ownerPermissionsCoding/2 following fileStatus above), + | directory/3 unifies List with a sorted list of atoms of names + | of file of type FileType, matching Pattern, and found in the | current directory. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | > ls + | ALS_Prolog_Foreign_SDK/ alsdev* alspro.pst + | LICENSE.txt alsdev.pst docs/ + | README.txt alsdir/ examples/ + | als-prolog-manual.pdf alspro* libalspro.a + | als-ref-manual.pdf alspro.1 libalspro.dylib* + | ..... + | ?- directory('*', 1, X). + | + | X=['ALS_Prolog_Foreign_SDK',alsdir,darwin,docs,examples] + | + | yes. + | ?- directory('*.pst', 4, FL). + | + | FL=['alsdev.pst','alspro.pst'] + | + | yes. *!------------------------------------------------------------------*/ % If no pattern has been give, assume a complete wildcard is wanted: @@ -408,22 +647,145 @@ make_reg_exp([C | RestPattern],[C | RestRegex]) :- make_reg_exp(RestPattern,RestRegex). -/* - * The following are essentially no-ops on unix, but - * need to do something for portability. In accordance - * with the conventions in filepath.pro, the "drive" - * is taken to be: root. - */ +/*!---------------------------------------------------------------- + | recursive_dir_path/2 + | recursive_dir_path(Path_List, Path) + | recursive_dir_path(+, -) + | + | Creates a nested directories path + | + | If Path_List is a list of atoms which potentially describe + | a nested path of directories in the filesystem, (and which may + | need to be created), and if the last atom either describes a + | directory or a file, then: + | 1) Path is an atom describing the path described by Path_List + | (as created by join_path/2), and + | 2) That Path is created in the filesystem, if possible; + | 2a) Moreover, either Path is absolute, + | 2b) Or path is not absolute, and so is created relative to + | the current working directory. + | Fails if the mkdir command in the underlying filesystem (unix + | or mswin32) throws an error. + | If the underlying OS is mswin32, the first element of Path_List + | is permitted to be a drive letter atom (e.g., 'C:'). + | If the underlying OS is mswin32, enableextensions must be active. + | + | Examples + | + | ?- recursive_dir_path([dir1,dir2,dir3], PL). + | + | PL='dir1/dir2/dir3' + | + | yes. + | ..... + | > ls -d dir1 + | dir1/ + | + | > ls -R dir1 + | dir2/ + | + | dir1/dir2: + | dir3/ + | + | dir1/dir2/dir3: + *!----------------------------------------------------------------*/ +recursive_dir_path(Path_List, Path) + :- + join_path(Path_List, Path), + sprintf(atom(Cmd), 'mkdir -p -- %t\n', [Path]), + system(Cmd). +/*!---------------------------------------------------------------- + | recursive_dir_paths/2 + | recursive_dir_paths(List_of_Path_Lists, Paths) + | recursive_dir_paths(+, -) + | + | Creates multiple nested directory paths + | + | If List_of_Path_Lists is a list of lists of atoms each of which + | potentially describe a nested path of directories in the + | filesystem, (and which may need to be created), and if the + | last atom of each list either describes a directory or a file, + | then: + | 1) The length of Paths equals the length of List_of_Path_Lists, + | and each element of Paths is an atom; + | 2) For each list Path_List on List_of_Path_Lists, Path is the + | corresponding atom on Paths and + | recursive_dir_path(Path_List, Path) + | holds. + | + | Examples + | Multiple paths forming a tree: + | + | rr/ + | qq/ pp/ + | kk/ mm/ nn/ aa/ + | jj/ bb/ + | + | [[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]] + | + | ?- recursive_dir_paths([[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]], PL). + | + | PL=['rr/qq/kk','rr/qq/mm/jj','rr/qq/nn','rr/pp/aa/bb'] + | + | yes. + | ..... + | > ls -d rr + | rr/ + | + | > ls -R rr + | pp/ qq/ + | + | rr/pp: + | aa/ + | + | rr/pp/aa: + | bb/ + | + | rr/pp/aa/bb: + | + | rr/qq: + | kk/ mm/ nn/ + | + | rr/qq/kk: + | + | rr/qq/mm: + | jj/ + | + | rr/qq/mm/jj: + | + | rr/qq/nn: + | > + *!----------------------------------------------------------------*/ +recursive_dir_paths(List_of_Path_Lists, Paths) + :- + prepare_path_cmd_list(List_of_Path_Lists, Paths, Markers), + sys_env(OS, _, _), + (OS == unix -> + catenate(['mkdir -p -- ' | Markers], Pattern), + sprintf(atom(Cmd), Pattern, Paths) + ; + catenate(['mkdir ' | Markers], Pattern), + sprintf(atom(Cmd), Pattern, Paths) + ), + system(Cmd). + +prepare_path_cmd_list([], [], []). +prepare_path_cmd_list([Path_List | RestList_of_Path_Lists], + [Path | RestCmdList], ['%t ' | RestMarkers]) + :- + join_path(Path_List, Path), + prepare_path_cmd_list(RestList_of_Path_Lists, RestCmdList, RestMarkers). + + +/* ---- + * The following are essentially no-ops on unix, but + * need to do something for portability to mswin32. + * In accordance with the conventions in filepath.pro, + * the "drive" is taken to be: root. + *----*/ get_current_drive(root). change_current_drive(_). -/*!---------------------------------------------------------------- - *!----------------------------------------------------------------*/ -move_file(Source, Target) - :- - sprintf(atom(Cmd),'mv %t %t', [Source, Target]), - system(Cmd). - endmod. diff --git a/core/alsp_src/builtins/fswin32.pro b/core/alsp_src/builtins/fswin32.pro index 9ea3db88..b9ec7c9a 100644 --- a/core/alsp_src/builtins/fswin32.pro +++ b/core/alsp_src/builtins/fswin32.pro @@ -7,25 +7,180 @@ | | Authors: Chuck Hoput (based on other fs-xxx.pro files) | Date: 1/96 + | + | Note: Depends on core/alsp_src/win32/win32_makefile & friends + | Note: Some examples below utilize dir/0 as defined in blt_sys.pro. *====================================================================*/ - module builtins. -export make_subdir/1. -export make_subdir/2. -export remove_subdir/1. export file_status/2. - export files/2. export files/3. +export move_file/2. +export make_subdir/1. +export make_subdir/2. export subdirs/1. export subdirs_red/1. +export remove_subdir/1. +export kill_subdir/1. export directory/3. - +export recursive_dir_path/2. +export recursive_dir_paths/2. export get_current_drive/1. export change_current_drive/1. -export move_file/2. +/*!------------------------------------------------------------------ + | file_status/2 + | file_status(FileName, Status) + | file_status(+, -) + | + | - Returns OS information about a file named FileName + | + | If FileName is the name associated with an entry in the + | OS filesystem, returns OS information about that entry, + | as in the following two examples: + | + | Examples + | ?- file_status('alspro.exe', Status). + | + | Status=[type = regular,permissions = [read,write,execute], + | mod_time = 1524876154.0,size = 783127] + | + | ?- file_status(alsdir, Status). + | + | Status=[type = directory,permissions = [read,write,execute], + | mod_time = 1524503247.0,size = 0] + *!-----------------------------------------------------------------*/ +file_status(FileName,Status) :- + '$getFileStatus'(FileName, + fileStatus(FileTypeCode,ModTime,OwnerPermiss,ByteSize,NBlocks)), + fileTypeCode(FileTypeCode,FileType), + ownerPermissionsCoding(OwnerPermiss,Permissions), + Status = [type=FileType,permissions=Permissions,mod_time=ModTime,size=ByteSize]. + + /*--------------------------------------------------------------- + | File types/attributes -- at the abstract (Prolog) level: + | regular -- an ordinary file + | directory + *---------------------------------------------------------------*/ + +/* +fileTypeCode('????', unknown). +fileTypeCode('Fldr', directory). +fileTypeCode('TEXT', regular). +fileTypeCode(_,unknown). +*/ + +/* +ownerPermissionCoding(0,[]). +ownerPermissionCoding(4,[read]). +ownerPermissionCoding(6,[read,write]). +*/ + + +fileTypeCode(0, unknown). +fileTypeCode(1, directory). +fileTypeCode(4, regular). +fileTypeCode(5, symbolic_link). +fileTypeCode(5, alias). + +%fileTypeCode(30 , mac_type('TEXT')). + +ownerPermissionsCoding(0,[]). +ownerPermissionsCoding(1,[execute]). +ownerPermissionsCoding(2,[write]). +ownerPermissionsCoding(3,[write,execute]). +ownerPermissionsCoding(4,[read]). +ownerPermissionsCoding(5,[read,execute]). +ownerPermissionsCoding(6,[read,write]). +ownerPermissionsCoding(7,[read,write,execute]). + + /*!---------------------------------------------------------------- + | files/2 + | files(Pattern,FileList) + | files(+,-) + | + | - returns a list of files in the current directory matching a pattern + | + | Returns the list (FileList) of all ordinary (regular) files + | in the current directory which match Pattern, which can + | include the usual '*' and '?' wildcard characters. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | ?- files('*.pst', F). + | + | F = ['alsdev.exe.pst','alspro.exe.pst'] + | + | ?- files('*', F). + | + | F = ['als-prolog-manual.pdf','als-ref-manual.pdf','alsdev.exe', + | 'alsdev.exe.pst','alshelp.css','alspro.exe','alspro.exe.pst', + | 'als_help.html','libalspro.a','libalspro.dll','LICENSE.txt', + | 'README.txt','tcl86.dll','tk86.dll','zlib1.dll']. + *!----------------------------------------------------------------*/ +files(Pattern, FileList) + :- + directory(Pattern, regular, FileList). + +/*!---------------------------------------------------------------- + | files/3 + | files(Directory, Pattern,FileList) + | files(+,+,-) + | + | - returns a list of files residing in Directory matching a pattern + | + | Returns the list (FileList) of all ordinary files in the + | directory Directory which match Pattern, which can include + | the usual '*' and '?' wildcard characters. + | Examples + | Executed in the ALS Prolog distribution directory: + | ?- files('examples/more', '*', F). + | + | F=['concurrent_interrupts.pro','core_concurrent.pro', + | 'finger.pro','freeze.pro','interrupts_coroutine.pro', + | 'mathserv1.pro','mathserv2.pro','primes_coroutine.pro', + | 'simple_coroutine.pro'] + | + | ?- files('examples/more', 'p*', F). + | + | F=['primes_coroutine.pro'] + *!----------------------------------------------------------------*/ + + files(Directory, Pattern, List) + :- + getDirEntries(Directory, Pattern, FirstResult), + !, + fixFileType(regular, InternalFileType), + filterForFileType(FirstResult, Directory, InternalFileType, List). + +/*!---------------------------------------------------------------- + | move_file/2 + | move_file(Source, Target) + | move_file(+, +) + | + | - Change the name of a file from Source to Target + | + | If both Source and Target are atoms which can be the + | names of a file, and if Source is the name of a file + | existing in the file system, then the name of that file + | will be changed from Source to Target. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | ...\als-prolog> dir i* + | ...\als-prolog> + | ?- move_file('README.txt', 'intro-README.txt'). + | ...\als-prolog> dir i* + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | -a---- 4/13/2018 5:29 PM 3387 intro-README.txt + *!----------------------------------------------------------------*/ +move_file(Source, Target) + :- + sprintf(atom(Cmd),'rename %t %t', [Source, Target]), + system(Cmd). /*!-------------------------------------------------------------- | make_subdir/1 @@ -53,68 +208,118 @@ export move_file/2. | [[read,write,execute], | [read,write], | [execute] ] + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | + | ?- make_subdir(myNewTestSubdir). + | + | yes. + | ?- halt. + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/19/2020 7:35 PM myNewTestSubdir + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll *!--------------------------------------------------------------*/ make_subdir(NewDir) :- make_subdir(NewDir,511). -make_subdir(NewDir,Permissions) - :- - integer(Permissions), - !, - 0 =< Permissions, Permissions =< 512, - mkdir(NewDir,Permissions). - - /*!-------------------------------------------------------------- - | remove_subdir/1 - | remove_subdir(SubDir) - | remove_subdir(+) + | make_subdir/2 + | make_subdir(NewDir,Permissions) + | make_subdir(+,+) | - | - removes a subdirectory from the current working directory + | - creates a subdirectory in the current working directory + | - with the indicated permissions | - | If SubDir is an atom, remove the subdirectory named SubDir from - | the current working directory, if it exists. - *!--------------------------------------------------------------*/ - - remove_subdir(SubDir) - :- - rmdir(SubDir). - - /*!---------------------------------------------------------------- - | files/2 - | files(Pattern,FileList) - | files(+,-) + | If NewDir is an atom, creates a subdirectory named NewDir in + | the current working directory, if possible; if Permissions + | is an integer of appropriate value, assigns the indicated + | permissions to the directory. | - | - returns a list of files in the current directory matching a pattern + | Permissions can appear in one of three forms: | - | Returns the list (FileList) of all ordinary files in the - | current directory which match Pattern, which can include - | the usual '*' and '?' wildcard characters. - *!----------------------------------------------------------------*/ -files(Pattern, FileList) - :- - directory(Pattern, regular, FileList). - -/*!---------------------------------------------------------------- - | files/3 - | files(Directory, Pattern,FileList) - | files(+,+,-) + | * An appropriate integer: 0 =< N =< 511 + | * A list of approriate atoms, for example + | [rwx,rx,x] + | * A list of lists of appropriate atoms, for example: + | [[read,write,execute], + | [read,write], + | [execute] ] | - | - returns a list of files residing in Directory matching a pattern + | Examples + | Executed in the ALS Prolog distribution directory: | - | Returns the list (FileList) of all ordinary files in the - | directory Directory which match Pattern, which can include - | the usual '*' and '?' wildcard characters. + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | + | ?- make_subdir(myNewTestSubdir, 457). + | + | yes. + | ?- halt. + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/19/2020 7:35 PM myNewTestSubdir + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll *!----------------------------------------------------------------*/ - - files(Directory, Pattern, List) + +make_subdir(NewDir,Permissions) :- - getDirEntries(Directory, Pattern, FirstResult), + integer(Permissions), !, - fixFileType(regular, InternalFileType), - filterForFileType(FirstResult, Directory, InternalFileType, List). + 0 =< Permissions, Permissions =< 512, + mkdir(NewDir,Permissions). /*!---------------------------------------------------------------- | subdirs/1 @@ -124,7 +329,32 @@ files(Pattern, FileList) | - returns a list of subdirectories | | Returns the list of all subdirectories of the current - | working directory. + | working directory. On unix, the system files '.' and '..' + | are removed from the list; on mswin32, they are included. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | ..... + | ?- subdirs(SDs). + | + | SDs=['.','..',alsdir,alshelp,'ALS_Prolog_Foreign_SDK',docs,examples,lib]. + | + | yes. *!----------------------------------------------------------------*/ subdirs(SubdirList) :- @@ -139,6 +369,30 @@ subdirs(SubdirList) | | Returns the list of all subdirectories of the current | working directory, omitting '.' and '..' + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | ..... + | ?- subdirs_red(SDs). + | + | SDs=[alsdir,alshelp,'ALS_Prolog_Foreign_SDK',docs,examples,lib]. + | + | yes. *!----------------------------------------------------------------*/ subdirs_red(SubdirList) :- @@ -146,53 +400,113 @@ subdirs_red(SubdirList) list_delete(SubdirList0, '.', SubdirList1), list_delete(SubdirList1, '..', SubdirList). - /*--------------------------------------------------------------- - | File types/attributes: - | -- at the abstract (Prolog) level: +/*!-------------------------------------------------------------- + | remove_subdir/1 + | remove_subdir(SubDir) + | remove_subdir(+) | - | regular -- an ordinary file - | directory - *---------------------------------------------------------------*/ - -/* -fileTypeCode('????', unknown). -fileTypeCode('Fldr', directory). -fileTypeCode('TEXT', regular). -fileTypeCode(_,unknown). -*/ - -ownerPermissionCoding(0,[]). -ownerPermissionCoding(4,[read]). -ownerPermissionCoding(6,[read,write]). - - -fileTypeCode(0, unknown). -fileTypeCode(1, directory). -fileTypeCode(4, regular). -fileTypeCode(5, symbolic_link). -fileTypeCode(5, alias). - -fileTypeCode(30 , mac_type('TEXT')). - - -ownerPermissionsCoding(0,[]). -ownerPermissionsCoding(1,[execute]). -ownerPermissionsCoding(2,[write]). -ownerPermissionsCoding(3,[write,execute]). -ownerPermissionsCoding(4,[read]). -ownerPermissionsCoding(5,[read,execute]). -ownerPermissionsCoding(6,[read,write]). -ownerPermissionsCoding(7,[read,write,execute]). - -/*!------------------------------------------------------------------ - *!-----------------------------------------------------------------*/ -file_status(FileName,Status) :- - '$getFileStatus'(FileName, - fileStatus(FileTypeCode,ModTime,OwnerPermiss,ByteSize,NBlocks)), - fileTypeCode(FileTypeCode,FileType), -% ownerPermissionCoding(OwnerPermiss,Permissions), - ownerPermissionsCoding(OwnerPermiss,Permissions), - Status = [type=FileType,permissions=Permissions,mod_time=ModTime,size=ByteSize]. + | - removes a subdirectory from the current working directory + | + | If SubDir is an atom, remove the subdirectory named SubDir from + | the current working directory, if it exists AND is empty. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | mkdir funnyFolder + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/20/2020 5:29 PM funnyFolder + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | + | ?- remove_subdir(funnyFolder). + | + | yes. + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + *!--------------------------------------------------------------*/ + remove_subdir(SubDir) + :- + rmdir(SubDir). + +/*!-------------------------------------------------------------- + | kill_subdir/1 + | kill_subdir(SubDir) + | kill_subdir(+) + | + | - removes a subdirectory from the current working directory + | + | If SubDir is an atom, remove the subdirectory named SubDir from + | the current working directory, if it exists; SubDir may + | contain files and other subdirs. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | mkdir funnyFolder + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/20/2020 5:29 PM funnyFolder + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | + | ?- remove_subdir(funnyFolder). + | + | yes. + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + *!--------------------------------------------------------------*/ +kill_subdir(SubDir) + :- + sprintf(atom(Cmd),'rmdir %t',[SubDir]), + system(Cmd). /*!------------------------------------------------------------------ | directory/3 @@ -203,10 +517,40 @@ file_status(FileName,Status) :- | | If Pattern is a file name pattern, including possible '*' and | '?' wildcard characters, and FileType is a numeric (internal) - | file type or a symbolic (abstract) file type, directory/3 - | unifies List with a sorted list of atoms of names of file of - | type FileType, matching Pattern, and found in the + | file type or a symbolic (abstract) file type (see fileTypeCode/2 + | and ownerPermissionsCoding/2 following fileStatus above), + | directory/3 unifies List with a sorted list of atoms of names + | of files of type FileType, matching Pattern, and found in the | current directory. + | + | Examples + | Executed in the ALS Prolog distribution directory: + | + | C:Users\user\ALSProlog> dir + | + | Directory: C:\Users\user\ALSProlog + | + | Mode LastWriteTime Length Name + | ---- ------------- ------ ---- + | d----- 4/13/2018 5:29 PM alsdir + | d----- 4/13/2018 5:29 PM alshelp + | d----- 4/13/2018 5:29 PM ALS_Prolog_Foreign_SDK + | d----- 4/13/2018 5:29 PM examples + | d----- 4/13/2018 5:29 PM lib + | d----- 4/13/2018 5:29 PM 1938443 als-prolog-manual.pdf + | d----- ..... ..... ..... ..... + | d----- 4/13/2018 5:29 PM 84480 zlib1.dll + | + | ?- directory('*', 1, FL). + | + | FL=[alsdir,alshelp,'ALS_Prolog_Foreign_SDK',docs,examples,lib] + | + | yes. + | ?- directory('*.pst', 4, FL). + | + | FL=['alsdev.exe.pst','alspro.exe.pst','libalspro.dll.pst'] + | + | yes. *!------------------------------------------------------------------*/ % If no pattern has been give, assume a complete wildcard is wanted: @@ -316,23 +660,152 @@ make_reg_exp([C | RestPattern],[C | RestRegex]) :- make_reg_exp(RestPattern,RestRegex). -%-------------------------------------------------------------------- -% get_current_drive/1 -%-------------------------------------------------------------------- +/*!---------------------------------------------------------------- + | recursive_dir_path/2 + | recursive_dir_path(Path_List, Path) + | recursive_dir_path(+, -) + | + | Creates a nested directories path + | + | If Path_List is a list of atoms which potentially describe + | a nested path of directories in the filesystem, (and which may + | need to be created), and if the last atom either describes a + | directory or a file, then: + | 1) Path is an atom describing the path described by Path_List + | (as created by join_path/2), and + | 2) That Path is created in the filesystem, if possible; + | 2a) Moreover, either Path is absolute, + | 2b) Or path is not absolute, and so is created relative to + | the current working directory. + | Fails if the mkdir command in the underlying filesystem (unix + | or mswin32) throws an error. + | If the underlying OS is mswin32, the first element of Path_List + | is permitted to be a drive letter atom (e.g., 'C:'). + | If the underlying OS is mswin32, enableextensions must be active. + | + | Examples + | + | ?- recursive_dir_path([dir1,dir2,dir3], PL). + | + | PL='dir1\\dir2\\dir3' + | + | yes. + | + | Creates a tower of subfolders: dir1\\dir2\\dir3. + | Use dir to manually examine these folders. + *!----------------------------------------------------------------*/ +recursive_dir_path(Path_List, Path) + :- + join_path(Path_List, Path), + sprintf(atom(Cmd), 'mkdir -p -- %t\n', [Path]), + system(Cmd). +/*!---------------------------------------------------------------- + | recursive_dir_paths/2 + | recursive_dir_paths(List_of_Path_Lists, Paths) + | recursive_dir_paths(+, -) + | + | Creates multiple nested directory paths + | + | If List_of_Path_Lists is a list of lists of atoms each of which + | potentially describe a nested path of directories in the + | filesystem, (and which may need to be created), and if the + | last atom of each list either describes a directory or a file, + | then: + | 1) The length of Paths equals the length of List_of_Path_Lists, + | and each element of Paths is an atom; + | 2) For each list Path_List on List_of_Path_Lists, Path is the + | corresponding atom on Paths and + | recursive_dir_path(Path_List, Path) + | holds. + | + | Examples + | Multiple paths forming a tree: + | + | rr\\ + | qq\\ pp\\ + | kk\\ mm\\ nn\\ aa\\ + | jj\\ bb\\ + | + | [[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]] + | + | ?- recursive_dir_paths([[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]], PL). + | + | PL=['rr/qq/kk','rr/qq/mm/jj','rr/qq/nn','rr/pp/aa/bb'] + | + | Creates a tree of subfolders as illustrated above. + | Use dir to manually examine these folders. + *!----------------------------------------------------------------*/ +recursive_dir_paths(List_of_Path_Lists, Paths) + :- + prepare_path_cmd_list(List_of_Path_Lists, Paths, Markers), + sys_env(OS, _, _), + (OS == unix -> + catenate(['mkdir -p -- ' | Markers], Pattern), + sprintf(atom(Cmd), Pattern, Paths) + ; + catenate(['mkdir ' | Markers], Pattern), + sprintf(atom(Cmd), Pattern, Paths) + ), + system(Cmd). + +prepare_path_cmd_list([], [], []). +prepare_path_cmd_list([Path_List | RestList_of_Path_Lists], + [Path | RestCmdList], ['%t ' | RestMarkers]) + :- + join_path(Path_List, Path), + prepare_path_cmd_list(RestList_of_Path_Lists, RestCmdList, RestMarkers). + +/*!---------------------------------------------------------------- + | get_current_drive/1 + | get_current_drive(Drive) + | get_current_drive(-) + | + | - returns the descriptor for the current drive + | + | Returns the descriptor for the current drive in the form + | Drive = 'XYZ:\\', where 'XYZ:' is a proper Windows drive + | descriptor, and 'XYZ:\\' is an acceptable component for + | expressing file path names in Windows. Note that + | both 'C:' and 'C' are acceptable drive descriptors for + | change_current_drive/1 below, but that 'C:\\' is not. + | + | Examples (Drive is currently C): + | + | ?- get_current_drive(Drive). + | + | Drive = 'C:\\' + *!----------------------------------------------------------------*/ get_current_drive(Drive) :- getcwd(Path), -% rootPathFile(Drive,_,_,Path). split_path(Path, [Drive | _]). -%-------------------------------------------------------------------- -% change_current_drive/1. -% -% We check to make sure that the final character in the drive name -% is a colon, otherwise it is not a valid drive descriptor. -%-------------------------------------------------------------------- +/*!---------------------------------------------------------------- + | change_current_drive/1. + | change_current_drive(NewDrive) + | change_current_drive(+) + | + | - Changes the current drive to NewDrive if it is valid. + | + | If NewDrive is a valid drive descriptor, changes the + | current OS drive to NewDrive. + | + | Examples (Drive is currently C, and is the only drive): + | + | ?- change_current_drive('E:'). + | + | Error: System error: change_cwd('E:') + | - change_cwd: 'E:' + | - Throw pattern: error(system_error, [change_cwd('E:')]) + | + | ?- change_current_drive('C:'). + | + | yes. + *!----------------------------------------------------------------*/ + % We check to make sure that the final character in the drive name + % is a colon, otherwise it is not a valid drive descriptor. change_current_drive(DriveName) :- name(DriveName,DriveList), @@ -345,14 +818,6 @@ change_current_drive(DriveName) :- append(DriveList,[0':],ProperDriveList), name(ProperDriveName,ProperDriveList), change_cwd(ProperDriveName). - -/*!---------------------------------------------------------------- - *!----------------------------------------------------------------*/ -move_file(Source, Target) - :- - sprintf(atom(Cmd),'rename %t %t', [Source, Target]), - system(Cmd). - endmod. diff --git a/core/alsp_src/tests/atest_db.pro b/core/alsp_src/tests/atest_db.pro index 4f9d0c85..86298280 100644 --- a/core/alsp_src/tests/atest_db.pro +++ b/core/alsp_src/tests/atest_db.pro @@ -87,6 +87,8 @@ test_info(par4, par4, user, main, test_info(filepath_test, filepath_test, user, test_filepath, 'tests for file system paths.'). +test_info(fsunix_mswin32_test, fsunix_mswin32_test, user, test_fsunix_mswin32, 'tests for misc filesystem functions.'). + % test_info Format: % test_info(TestID, TestFile, TestMod, TestStartCall, TestDescrip), diff --git a/core/alsp_src/tests/tsuite/fsunix_mswin32_test.pro b/core/alsp_src/tests/tsuite/fsunix_mswin32_test.pro new file mode 100644 index 00000000..bb2bdcb5 --- /dev/null +++ b/core/alsp_src/tests/tsuite/fsunix_mswin32_test.pro @@ -0,0 +1,482 @@ +:-[test]. + +test_fsunix_mswin32 + :- + sys_env(OS,OSVar,_), + do_test_fs(OS,OSVar). + +do_test_fs(OS,OSVar) + :- + test([ + test_file_status(OS), + test_files2(OS), + test_files3(OS), + test_move_file(OS), + + test_make_subdir1(OS), + test_make_subdir2(OS), + test_subdirs(OS,OSVar), + test_subdirs_red(OS,OSVar), + + test_remove_subdir(OS), + test_kill_subdir(OS), + + test_directory(OS, OSVar), + test_get_current_drive(OS), + test_change_current_drive(OS), + + test_recursive_dir_path(OS), + test_recursive_dir_paths(OS), + true]). + +test_file_status(mswin32) + :- + test([ + (file_status('alspro.exe', Status), + member(type = regular, Status), + member(permissions = [read,write,execute], Status), + member(mod_time = _, Status), + member(size = _, Status), + all_eq(Status) ), + true]). + + + +test_file_status(unix) + :- + test([ + (file_status(alspro, Status), + member(type = regular, Status), + member(permissions = [read,write,execute], Status), + member(mod_time = _, Status), + member(size = _, Status), + all_eq(Status) ), + true]). + +all_eq([]). +all_eq([T | Status]) + :- + T = (G = B), + (G==type; G==permissions; G==mod_time; G==size), + all_eq(Status). + +test_files2(mswin32) + :- + test([ + (files('*.pst', Files), + member('alsdev.exe.pst', Files), + member('alspro.exe.pst', Files), + all_f2(Files, mswin32) ), + true]). + +test_files2(unix) + :- + test([ + (files('*.pst', Files), + member('alsdev.pst', Files), + member('alspro.pst', Files), + all_f2(Files, unix) ), + true]). + +all_f2([], _). +all_f2([F | Files], OS) + :- + (OS==mswin32 -> (F == 'alsdev.exe.pst' ; F == 'alspro.exe.pst'; + F == 'app_image0.exe.pst'; F == 'app_image1.exe.pst'; + F == 'app_image2.exe.pst'; F == 'libalspro.dll.pst') + ; + (F == 'alsdev.pst' ; F == 'alspro.pst'; + F == 'app_image0.pst'; F == 'app_image1.pst'; F == 'app_image2.pst'; + (F == 'libalspro.dylib.pst' ; F == 'libalspro.so.pst') ) + ), + all_f2(Files, OS). + +test_files3(mswin32) + :- + test([ + (files('alsdir\\builtins', 'c*', Files), + Files == ['comp_d10.pro', 'cutils.pro']), + true]). + +test_files3(unix) + :- + test([ + (files('examples/more', 'p*', Files), + Files == ['primes_coroutine.pro']), + true]). + +test_move_file(mswin32) + :- + system('del /f barFile-beer.txt'), + system('echo foo > barFile.txt'), + test([ + (move_file('barFile.txt', 'barFile-beer.txt'), + file_status('barFile-beer.txt', Status), + member(type = regular, Status)), + system('del /f barFile-beer.txt'), + true]). +test_move_file(unix) + :- + system('rm -rf barFile-beer.txt'), + system('echo foo > barFile.txt'), + test([ + (move_file('barFile.txt', 'barFile-beer.txt'), + file_status('barFile-beer.txt', Status), + member(type = regular, Status)), + system('rm -rf barFile-beer.txt'), + true]). + +test_make_subdir1(mswin32) + :- + system('RMDIR myNewTestSubdir'), + test([ + (get_cwd(TestDir), + make_subdir(myNewTestSubdir), + path_directory_tail(SubdirPath, TestDir, myNewTestSubdir), + change_cwd(myNewTestSubdir), + get_cwd(ThisPath), + SubdirPath == ThisPath, + change_cwd('..')), + %% next make_subdir fails because myNewTestSubdir exists: + (not(make_subdir(myNewTestSubdir))), + true]), + system('RMDIR myNewTestSubdir'). + +test_make_subdir1(unix) + :- + system('rm -rf myNewTestSubdir'), + test([ + (get_cwd(TestDir), + make_subdir(myNewTestSubdir), + path_directory_tail(SubdirPath, TestDir, myNewTestSubdir), + change_cwd(myNewTestSubdir), + get_cwd(ThisPath), + SubdirPath == ThisPath, + change_cwd('..')), + %% next make_subdir fails because myNewTestSubdir exists: + (not(make_subdir(myNewTestSubdir))), + true]), + system('rm -rf myNewTestSubdir'). + + + +test_make_subdir2(mswin32) + :- + system('RMDIR myNewTestSubdir'), + test([ + (get_cwd(TestDir), + make_subdir(myNewTestSubdir,457), + file_status(myNewTestSubdir, Status), + member(permissions=Permissions, Status), + Permissions = [read,write,execute], + path_directory_tail(SubdirPath, TestDir, myNewTestSubdir), + change_cwd(myNewTestSubdir), + get_cwd(ThisPath), + SubdirPath == ThisPath, + change_cwd('..')), + (not(make_subdir(myNewTestSubdir))), + true]), + system('RMDIR myNewTestSubdir'). + +test_make_subdir2(unix) + :- + system('rm -rf myNewTestSubdir'), + test([ + (get_cwd(TestDir), + make_subdir(myNewTestSubdir,457), + file_status(myNewTestSubdir, Status), + member(permissions=Permissions, Status), + Permissions = [read,write,execute], + path_directory_tail(SubdirPath, TestDir, myNewTestSubdir), + change_cwd(myNewTestSubdir), + get_cwd(ThisPath), + SubdirPath == ThisPath, + change_cwd('..')), + (not(make_subdir(myNewTestSubdir))), + true]), + system('rm -rf myNewTestSubdir'). + +test_subdirs(mswin32,_) + :- + test([ + (subdirs(SDList), + SDList == ['.','..',alsdir,mswinnt]), + true]). + +test_subdirs(unix,OSVar) + :- + test([ + (subdirs(SDList), + (OSVar == linux -> + SDList == [alsdir,examples,linux] + ; + SDList == [alsdir,darwin,examples]) ), + true]). + +test_subdirs_red(mswin32,_) + :- + test([ + (subdirs_red(SDList), + SDList == [alsdir,mswinnt]), + true]). + +test_subdirs_red(unix,OSVar) + :- + test([ + (subdirs_red(SDList), + (OSVar == linux -> + SDList == [alsdir,examples,linux] + ; + SDList == [alsdir,darwin,examples]) ), + true]). + +test_remove_subdir(mswin32) + :- + system('rmdir myNewTestSubdir'), + test([ + (make_subdir(myNewTestSubdir), + subdirs(List1), + member(myNewTestSubdir, List1), + remove_subdir(myNewTestSubdir), + subdirs(List2), + not(member(myNewTestSubdir, List2)) ), + true]), + system('rmdir myNewTestSubdir'). + +test_remove_subdir(unix) + :- + system('rm -rf myNewTestSubdir'), + test([ + (make_subdir(myNewTestSubdir), + subdirs(List1), + member(myNewTestSubdir, List1), + remove_subdir(myNewTestSubdir), + subdirs(List2), + not(member(myNewTestSubdir, List2)) ), + true]), + system('rm -rf myNewTestSubdir'). + +test_kill_subdir(mswin32) + :- + system('rmdir myNewTestSubdir'), + test([ + (make_subdir(myNewTestSubdir), + subdirs(List1), + member(myNewTestSubdir, List1), + kill_subdir(myNewTestSubdir), + subdirs(List2), + not(member(myNewTestSubdir, List2)) ), + true]), + system('rmdir myNewTestSubdir'). + +test_kill_subdir(unix) + :- + system('rm -rf myNewTestSubdir'), + test([ + (make_subdir(myNewTestSubdir), + subdirs(List1), + member(myNewTestSubdir, List1), + kill_subdir(myNewTestSubdir), + subdirs(List2), + not(member(myNewTestSubdir, List2)) ), + true]), + system('rm -rf myNewTestSubdir'). + +test_directory(mswin32,_) + :- + test([ + (directory('*', 1, FL0), + FL0 == ['.','..',alsdir,mswinnt], + directory('*.pst', 4, FL1), + FL1 == ['alsdev.exe.pst','alspro.exe.pst','app_image0.exe.pst','app_image1.exe.pst', + 'app_image2.exe.pst','libalspro.dll.pst']), + true]). + +test_directory(unix,OSVar) + :- + test([ + (directory('*', 1, FL0), + (OSVar == linux -> + FL0 == [alsdir,examples,linux] + ; + FL0 == [alsdir,darwin,examples]), + directory('*.pst', 4, FL1), + (OSVar == linux -> + FL1 == ['alsdev.pst','alspro.pst','app_image0.pst','app_image1.pst', + 'app_image2.pst','libalspro.so.pst'] + ; + FL1 == ['alsdev.pst','alspro.pst','app_image0.pst','app_image1.pst', + 'app_image2.pst','libalspro.dylib.pst'])), + true]). + +test_recursive_dir_path(OS) + :- + get_cwd(TestDir), + clean_dirs(TestDir, OS, [dir1,dir2,dir3], _), + + test([ + (Path_List = [dir1,dir2,dir3], + recursive_dir_path(Path_List, Path), + clean_dirs(TestDir, OS, [dir1,dir2,dir3], Status), + Status == ok, + change_cwd(TestDir)), + true ]). + +clean_dirs(TestDir, OS, DirsList, Status) :- + do_clean_dirs([TestDir | DirsList], [], OS, Status). + +do_clean_dirs([], Stack, OS, Status) :- + climb_and_clean(Stack, OS, Status). + +do_clean_dirs([Dir | DirsList], Stack, OS, Status) :- + (exists_file(Dir) -> + change_cwd(Dir), + do_clean_dirs(DirsList, [Dir | Stack], OS, Status) + ; + Status = fail + ). + +climb_and_clean([], OS, ok). +climb_and_clean([Top], OS, ok) :- !, + change_cwd('..'). +climb_and_clean([Dir | Stack], OS, Status) :- + change_cwd('..'), + (Dir == dir3 -> +/* + (OS == mswin32 -> + system('rmdir /f dir3') + ; + system('rm -rf dir3') + ) +*/ + kill_subdir(dir3) + ; +/* + (Dir == dir2 -> + (OS == mswin32 -> + system('rmdir /f dir2') + ; + system('rm -rf dir2') + ) +*/ + kill_subdir(dir2) + ; +/* + (Dir == dir1 -> + (OS == mswin32 -> + system('rmdir /f dir1') + ; + system('rm -rf dir1') + ) +*/ kill_subdir(dir1) + ; + true +% ) +% ) + ), + + (Dir == dir3 -> + kill_subdir(dir3) + ; + (Dir == dir2 -> + kill_subdir(dir2) + ; + (Dir == dir1 -> + kill_subdir(dir1) + ; + true + ) + ) + ), + + +% remove_subdir(Dir), + climb_and_clean(Stack, OS, Status). + + +climb_dirs([], TestDir, Status). +climb_dirs([Dir | Stack], TestDir, Status) :- + change_cwd('..'), + climb_dirs(Stack, TestDir, Status). + +/* Multiple paths forming a tree: + + rr/ + qq/ pp/ + kk/ mm/ nn/ aa/ + jj/ bb/ + + [[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]] + */ + +test_recursive_dir_paths(_) + :- + List_of_Path_Lists = [[rr,qq,kk],[rr,qq,mm,jj],[rr,qq,nn],[rr,pp,aa,bb]], + get_cwd(TestDir), + + test([ + (recursive_dir_paths(List_of_Path_Lists, Paths), + check_multi_dirs(List_of_Path_Lists, Tops, TestDir, Status), + Status == ok, + change_cwd(TestDir), + remove_list_dirs(Tops)), + true ]). + +check_multi_dirs([], [], TestDir, ok). +check_multi_dirs([Path_List], [Top], TestDir, Status) :- + Path_List = [Top | _], + check_list(Path_List, TestDir, [], Status), + Status = ok. +check_multi_dirs([Path_List | List_of_Path_Lists], [Top | Tops], TestDir, Status) :- + Path_List = [Top | _], + check_list(Path_List, TestDir, [], Status), + check_multi_dirs(List_of_Path_Lists, Tops, TestDir, Status). + +check_list([], TestDir, Stack, Status) :- + climb_dirs(Stack, TestDir, Status). + +check_list([Dir | DirsList], TestDir, Stack, Status) :- + (exists_file(Dir) -> + change_cwd(Dir), + check_list(DirsList, TestDir, [Dir | Stack], Status) + ; + Status = fail, + change_cwd(TestDir) + ). + +climb_dirs([], TestDir, Status). +climb_dirs([Dir | Stack], TestDir, Status) :- + change_cwd('..'), + climb_dirs(Stack, TestDir, Status). + +remove_list_dirs([]). +remove_list_dirs([Top | Tops]) :- + (exists_file(Top) -> + kill_subdir(Top) ; true), + remove_list_dirs(Tops). + + /* -----------------------------* + | Only meaningful for mwwin32 + * -----------------------------*/ + + %% Assumes we're running on drive C: (on Appveyor). +test_get_current_drive(mswin32) + :- + test([ + (get_current_drive(Drive), + atom_codes(Drive, DriveCs), + reverse(DriveCs, RevCs), + RevCs == "\\:C" ), + true]). + +test_get_current_drive(unix). + +etest(Goal, Error) + :- + catch((Goal, !, fail), error(Error, _), true). + +test_change_current_drive(mswin32) + :- + etest(change_current_drive('E'), system_error). + +test_change_current_drive(unix).