[mercury-users] io.m, directory listing

[Paul Massey]

Hello,

Don't know if this will help, but here's something similar I knocked
up quite a while ago ...

Paul.

%------------------------------------------------------------------
% Author : P.A, Massey (MC)
% Date   : 1999
% Purpose: An incomplete set of routines for listing directories, 
%          file properties, etc.

:- module files.
:- interface.
:- import_module io.
:- import_module string.
:- import_module list.
:- import_module bool.

:- type files__res(T) --->
		  ok(T)
		; error(string).

:- type files__dir.

:- type files__properties.

:- type files__sortform --->
             modification
           ; access
           ; name
           ; size.

:- type files__sort --->
             sort(files__sortform)
           ; unsorted.

	% returns a list of all the files found in directory Arg1 (unsorted).
:- pred files__dirlist(string,files__res(list(string)),io__state,io__state).
:- mode files__dirlist(in,out,di,uo) is det.

	% as above except that the resulting list can be sorted in some
        % way or other.
:- pred files__dirlist(string,files__sort,files__res(list(string)),
                       io__state,io__state).
:- mode files__dirlist(in,in,out,di,uo) is det.

	% As above except that the properties list is returned.
:- pred files__dirlist_properties(string,files__sort,files__res(list(properties)),
                       io__state,io__state).
:- mode files__dirlist_properties(in,in,out,di,uo) is det.

	% recovers the property list for a list of files.
:- pred files__properties(list(string),list(properties),io__state,io__state).
:- mode files__properties(in,out,di,uo) is det.

	% Same as above except that the directory name is provided.
:- pred files__properties(string,list(string),list(properties),
		          io__state,io__state).
:- mode files__properties(in,in,out,di,uo) is det.

	% Recovers the various file properties associated with 
        % each file entry.

:- pred files__properties_get_access(files__properties::in,string::out)is det.
:- pred files__properties_get_mod(files__properties::in,string::out)is det.
:- pred files__properties_get_filename(files__properties::in,
				       string::out)is det.
:- pred files__properties_get_size(files__properties::in,int::out)is det.

	% Create a directory.
:- pred files__mkdir(string,files__res(bool),io__state,io__state).
:- mode files__mkdir(in,out,di,uo) is det.

%---------------------------------------------------------------------
:- implementation.
%---------------------------------------------------------------------

:- type files__properties --->
		property(string,string,string,string,int).

:- type files__dir == c_pointer.

:- pragma(c_header_code, "
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <errno.h>
#include <fcntl.h>
#include <sys/types.h>
#ifdef UNIX
#include <sys/socket.h>
#else
#endif
#include <sys/stat.h>
#include <sys/dirent.h>
#include <time.h>

struct dirent *dp;

#define update_io(r_src, r_dest)	((r_dest) = (r_src))
").

files__dirlist(Directory, SortedForm, Results) -->
	files__dirlist_properties(Directory, SortedForm, PropertiesOk),
	( { PropertiesOk = ok(In) } ->
	      { list__map(files__properties_get_filename,In,Out) },
	      { Results = ok(Out) }
        ; { PropertiesOk = error(Msg) } ->
	      { Results = error(Msg) }
	;     { Results = error("files__dirlist/5: unknown return type") } ).

files__dirlist(Directory, Results) -->
       files__dirlist(Directory, unsorted, Results).

files__dirlist_properties(Directory, SortedForm, Results) -->
	opendir(Directory, DirPointer),
	( { is_null(DirPointer) } ->
		{Results = error("couldn't open file")}
	;	readfiles(Directory,DirPointer,FileProperties),
	        { files__sort(SortedForm,FileProperties,ResultsList) },
		{ Results = ok(ResultsList) },
		closedir(DirPointer)).

%--------------------------------------------------------
% Sorts the resulting file list as required.

:- pred files__sort(files__sort,list(properties),list(properties)).
:- mode files__sort(in,in,out) is det.

files__sort(unsorted, In, In).
files__sort(sort(_), In, Out):-
       list__sort(lambda([X::in,Y::in,CR::out] is det,
		     (files__properties_get_mod(X,M1),
		      files__properties_get_mod(Y,M2),
		      compare(CR,M1,M2))),In,Out0),
       list__reverse(Out0,Out).

%--------------------------------------------------------
% convert the list of filenames, into a list of property 
% structures.

files__properties(Files,Properties) -->
	files__properties(".",Files,Properties).

files__properties(_DirName,[], [], I, I).
files__properties(DirName,[FileName|Rest],[Property|Rem]) -->
	files__get_properties(DirName,FileName,Property),
	files__properties(DirName,Rest, Rem).

:- pred files__get_properties(string,string,properties,io__state,io__state). 
:- mode files__get_properties(in,in,out,di,uo) is det.

files__get_properties(DirName,FileName,Properties) -->
%	io__format("files__get_properties(%s,%s)\n",[s(DirName),s(FileName)]),
        { string__append_list([DirName,"/",FileName],FFileName) },
        get_times(FFileName,Acc,Mod,Size),
	{ Properties = property(DirName,FileName,Acc,Mod,Size) }.
	
:- pred get_times(string,string,string,int,io__state,io__state).
:- mode get_times(in,out,out,out,di,uo) is det.

:- pragma(c_code, get_times(File::in,Acc::out,Mod::out,Size::out,
                            II0::di,IO::uo),"
	Word tmp;
	struct stat sb;
	if (stat(File,&sb) == 0) {
	    int sz;
	    sz = (21+sizeof(Word))/sizeof(Word);
	    incr_hp_atomic(tmp,sz);
	    strftime((char *)tmp,21,\"%Y:%m:%d %H:%M:%S\",gmtime(&(sb.st_atime)));
	    Acc = (char *) tmp;
	    incr_hp_atomic(tmp,sz);
	    strftime((char *)tmp,21,\"%Y:%m:%d %H:%M:%S\",gmtime(&(sb.st_mtime)));
	    Mod = (char *) tmp;
            Size = (Word) sb.st_size;
            }
	else { Mod = NULL; Acc = NULL; Size = 0;};
	update_io(II0, IO);
	").

files__properties_get_access(property(_D,_,A,_,_),A).
files__properties_get_mod(property(_D,_,_,M,_),M).
files__properties_get_filename(property(_D,F,_,_,_),F).
files__properties_get_size(property(_,_,_,_,Size),Size).

:- pred readfiles(string,files__dir,list(properties),io__state,io__state).
:- mode readfiles(in,in,out,di,uo) is det.

readfiles(Directory,DirPointer, List) -->
	readdir_filename(DirPointer, Entry),
	( { Entry = "" } ->
		{ List = [] }
	; { Entry = "." } ->
		readfiles(Directory,DirPointer, List) 
	; { Entry = ".." } ->
		readfiles(Directory,DirPointer,List) 
	; 	files__get_properties(Directory,Entry,Properties),
	        { List = [Properties|Next] },
		readfiles(Directory, DirPointer, Next) ).

:- pred readdir_filename(files__dir,string,io__state,io__state).
:- mode readdir_filename(in,out,di,uo) is det.
:- pragma(c_code, readdir_filename(DirP::in,FileName::out,II0::di,IO::uo),"
	Word tmp;
	dp = readdir((DIR *)DirP);
	if (dp == (struct dirent *)NULL) {
	    incr_hp_atomic(tmp,(1+sizeof(Word))/sizeof(Word));
	    strcpy((char *)tmp,\"\");
	    FileName = (char *)tmp; }
	else {
	    incr_hp_atomic(tmp,(strlen(dp->d_name)+sizeof(Word))/sizeof(Word));
	    strcpy((char *)tmp,dp->d_name);
	    FileName = (char *)tmp;
	};
	update_io(II0, IO);
	").

:- pred opendir(string::in,files__dir::out,io__state::di,io__state::uo)is det.
:- pragma(c_code, opendir(DirName::in,Dirp::out,IO0::di,IO::uo),"
	Dirp = opendir(DirName);
	update_io(IO0,IO);").

:- pred closedir(files__dir::in,io__state::di,io__state::uo) is det.
:- pragma(c_code, closedir(Dir::in,IO0::di,IO::uo), "{
	(void)closedir((DIR *)Dir);
	update_io(IO0, IO);};").

:- pred is_null(c_pointer::in) is semidet.
:- pragma(c_code, is_null(Cpointer::in), "
	SUCCESS_INDICATOR = (Cpointer == (Word *)0);").

files__mkdir(Dir,Result) -->
	cmkdir(Dir,Res),
	( { Res = 0 } ->
	     { Result = ok(yes) }
	;    { Result = error("mkdir: failed") }).

:- pred cmkdir(string::in,int::out,io__state::di,io__state::uo) is det.
:- pragma(c_code, cmkdir(Dir::in,Res::out,IO0::di,IO::uo), "{
        Res = (Word) mkdir(Dir,S_IWGRP|S_IWOTH);
        if (Res != (Word) 0) Res = (Word) errno;
	update_io(IO0, IO); }").

:- end_module files.
+--------------------------------------------------------------

--------------------------------------------------------------------------
mercury-users mailing list
post:  mercury-users at cs.mu.oz.au
administrative address: owner-mercury-users at cs.mu.oz.au
unsubscribe: Address: mercury-users-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-users-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------