Полищук, Семериков. Системное программирование в UNIX средствами Free Pascal / examples / 4 / ftw

uses linux,stdio,strings;

const
FTW_NS =100; (* Something stat(2) failed on *)
FTW_DNR=200; (* Something opendir(3) failed on *)
FTW_F =300; (* A normal file *)
FTW_D =400; (* A directory *)
MAXNAMLEN=4000;


(* Handy shorthand. *)
function EQ(a,b:pchar):boolean;
begin
EQ:=(strcomp(a, b) = 0);
end;

type
func=function(name:pchar; var status:tstat; _type:integer):integer;


function ftw(directory:pchar; funcptr:func; depth:integer):integer;
var
dp:pdir;
p,fullpath:pchar;
i:integer;
e:pdirent;
sb:tstat;
seekpoint:longint;
begin
(* If can't stat, tell the user so. *)
if not fstat(directory, Sb) then
begin
ftw:=funcptr(directory, Sb, FTW_NS);
exit;
end;

(* If it's not a directory, call the user's function. *)
if ((Sb.mode and STAT_IFMT) <> STAT_IFDIR) then
(* Saying "FTW_F" here is lying, what if this is a symlink? *)
begin
ftw:=funcptr(directory, Sb, FTW_F);
exit;
end;

(* Open directory; and if we can't tell the user so. *)
Dp := opendir(directory);
if dp = nil then
begin
ftw:=funcptr(directory, Sb, FTW_DNR);
exit;
end;

(* See if user wants to go further. *)
i := funcptr(directory, Sb, FTW_D);

if i <> 0 then
begin
closedir(Dp);
ftw:=i;
exit;
end;

(* Get ready to hold the full paths. *)
i := strlen(directory);
fullpath := stralloc(i + 1 + MAXNAMLEN + 1);
if fullpath = nil then
begin
closedir(Dp);
ftw:=-1;
exit;
end;
strcopy(fullpath, directory);
p := @fullpath[i];
if (i<>0) and (p[-1] <> '/') then
begin
p^:='/';
inc(p);
end;

(* Read all entries in the directory.. *)
E := readdir(Dp);
while E <> nil do
begin
if not EQ(E^.name, '.') and not EQ(E^.name, '..') then
begin
if depth <= 1 then
begin
(* Going too deep; checkpoint and close this directory. *)
seekpoint := telldir(Dp);
closedir(Dp);
Dp := nil;
end;

(* Process the file. *)
strcopy(p, E^.name);
i := ftw(fullpath, funcptr, depth - 1);
if i<>0 then
begin
(* User's finished; clean up. *)
strdispose(fullpath);
if Dp<>nil then
closedir(Dp);
ftw:=i;
exit;
end;

(* Reopen the directory if necessary. *)
if Dp = nil then
begin
Dp := opendir(directory);
if Dp = nil then
begin
(* WTF? *)
strdispose(fullpath);
ftw:=-1;
exit;
end;
seekdir(Dp, seekpoint);
end;
end;
E := readdir(Dp);
end;

(* Clean up. *)
strdispose(fullpath);
closedir(Dp);
ftw:=0;
end;


function list(name:pchar; var status:tstat; _type:integer):integer;
begin
(* еУМЙ ЧЩЪПЧ stat ЪБЧЕТЫЙМУС ОЕХДБЮЕК, РТПУФП ЧЕТОХФШУС *)
if (_type = FTW_NS) then
begin
list:=0;
exit;
end;

(*
* йОБЮЕ, ЧЩЧЕУФЙ ЙНС ПВЯЕЛФБ,
* РТБЧБ ДПУФХРБ Л ОЕНХ Й РПУФЖЙЛУ "*",
* ЕУМЙ ПВЯЕЛФ СЧМСЕФУС ЛБФБМПЗПН ЙМЙ УЙНЧПМШОПК УУЩМЛПК.
*)
if (_type = FTW_F) then
printf ('%-30s'#9'0%3o'#$a, [name, status.mode and octal(0777)])
else
printf ('%-30s*'#9'0%3o'#$a, [name, status.mode and octal(0777)]);

list:=0;
end;

var
path:array [0..255] of char;
l:func;
begin
if paramcount=0 then
ftw ('.', @list, 1)
else
begin
strpcopy(path,paramstr(1));
ftw (path, @list, 1);
end;
halt(0);
end.