Описание

uses sysutils;

Function GetCurrentDir:String;

Эта короткая программа имитирует команду pwd:

(* Программа my_pwd - вывод рабочего каталога *)

uses sysutils;

procedure my_pwd;

begin

writeln(GetCurrentDir);

end;

begin

my_pwd;

end.

4.4.7. Обход дерева каталогов

Иногда необходимо выполнить операцию над иерархией каталогов, начав от стартового каталога, и обойти все лежащие ниже файлы и подкаталоги. Для этого определим процедуру ftw, выполняющую обход дерева каталогов, начиная с заданного, и вызывающая процедуру, определенную пользователем для каждой встретившейся записи в каталоге.

Описание

uses linux,stdio,strings;

const

FTW_NS =100; (* При ошибке stat(2) *)

FTW_DNR=200; (* При ошибке opendir(3) *)

FTW_F =300; (* Обычный файл *)

FTW_D =400; (* Каталог *)

MAXNAMLEN=4000;

(* Удобное сокращение *)

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

(* При невозможности выполнения fstat, сообщаем пользователю об этом *)

if not fstat(directory, Sb) then

begin

ftw:=funcptr(directory, Sb, FTW_NS);

exit;

end;

(* Если не каталог, вызываем пользовательскую функцию. *)

if ((Sb.mode and STAT_IFMT) <> STAT_IFDIR) then

(* Сообщение "FTW_F" может быть некорректным (вдруг это символическая ссылка? *)

begin

ftw:=funcptr(directory, Sb, FTW_F);

exit;

end;

(* Открываем каталог; при невозможности - сообщаем пользователю. *)

Dp := opendir(directory);

if dp = nil then

begin

ftw:=funcptr(directory, Sb, FTW_DNR);

exit;

end;

(* Определяем, желает ли пользователь продолжать. *)

i := funcptr(directory, Sb, FTW_D);

if i <> 0 then

begin

closedir(Dp);

ftw:=i;

exit;

end;

(* Готовим место для хранения поного пути. *)

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;

(* Читаем все элементы каталога. *)

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

(* Слишком углубились - закрываем этот каталог. *)

seekpoint := telldir(Dp);

closedir(Dp);

Dp := nil;

end;

(* Обработка файла. *)

strcopy(p, E^.name);

i := ftw(fullpath, funcptr, depth - 1);

if i<>0 then

begin

(* Пользователь завершил; оканчиваем работу. *)

strdispose(fullpath);

if Dp<>nil then

closedir(Dp);

ftw:=i;

exit;

end;

(* Повторно отрываем каталог в случае необходимости. *)

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;

(* Завершающие действия. *)

strdispose(fullpath);

closedir(Dp);

ftw:=0;

end;

Первый параметр path определяет имя каталога, с которого должен начаться рекурсивный обход дерева. Параметр depth управляет числом используемых функцией ftw различных дескрипторов файлов. Чем больше значение depth, тем меньше будет случаев повторного открытия каталогов, что сократит общее время отработки вызова. Хотя на каждом уровне дерева будет использоваться только один дескриптор, следует быть уверенным, что значение переменной depth не больше числа свободных дескрипторов файлов. Для определения максимально возможного числа дескрипторов, которые может задействовать процесс, рекомендуется использовать системный вызов getrlimit, обсуждаемый в главе 12.

Второй параметр funcptr – это определенная пользователем функция, вызываемая для каждого файла или каталога, найденного в поддереве каталога path. Как можно увидеть из описания, параметр funcptr передается процедуре ftw как указатель на функцию, поэтому функция должна быть объявлена до вызова процедуры ftw. При каждом вызове функции funcptr будут передаваться три аргумента: заканчивающаяся нулевым символом строка с именем объекта, ссылка на структуру tstat с данными об объекте и целочисленный код. Функция funcptr, следовательно, должна быть построена следующим образом:

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

begin

(* Тело функции *)

end;

Целочисленный аргумент _type может принимать одно из нескольких возможных значений, описывающих тип встретившегося объекта. Вот эти значения:

FTW_F	Объект является файлом
FTW_D	Объект является каталогом
FTW_DNR	Объект является каталогом, который нельзя прочесть
FTW_SL	Объект является символьной ссылкой
FTW_NS	Объект не является символьной ссылкой, и для него нельзя успешно выполнить вызов fstat

Если объект является каталогом, который нельзя прочесть (_type = FTW_DNR), то его потомки не будут обрабатываться. Если нельзя успешно выполнить функцию fstat (_type = FTW_NS), то передаваемая для объекта структура tstat будет иметь неопределенные значения.

Работа вызова будет продолжаться до тех пор, пока не будет завершен обход дерева или не возникнет ошибка внутри функции ftw. Обход также закончится, если определенная пользователем функция возвратит ненулевое значение. Тогда функция ftw прекратит работу и вернет значение, возвращенное функций пользователя. Ошибки внутри функции ftw приведут к возврату значения -1, тогда в переменной linuxerror будет выставлен соответствующий код ошибки.

Следующий пример использует функцию ftw для обхода поддерева каталогов, выводящего имена всех встретившихся файлов (каталогов) и права доступа к ним. Каталоги и символьные ссылки при выводе будут обозначаться дополнительной звездочкой.

Сначала рассмотрим функцию list, которая будет передаваться в качестве аргумента функции ftw.

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;

begin

if paramcount=0 then

ftw ('.', @list, 1)

else

begin

strpcopy(path,paramstr(1));

ftw (path, @list, 1);

end;

halt(0);

end.

Вывод программы list для простой иерархии каталогов будет выглядеть так:

$ list

. * 0755

./list * 0755

./filel 0644

./subdir * 0777

./subdir/another 0644

./subdir/subdir2 * 0755

./subdir/yetanother 0644

Обратите внимание на порядок обхода каталогов.

В модуле linux определен ряд специализированных функций для обхода дерева каталогов.