Системное программирование в UNIX средствами Free Pascal

       

При невозможности выполнения fstat, сообщаем


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


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)])


uses linux;
Function FNMatch(const Pattern, Name:string):Boolean;
Function FSearch(Path:pathstr; DirList:string):Pathstr;
Function Glob(Const Path:Pathstr):PGlob;
Procedure GlobFree(Var P:Pglob);
FNMatch возвращает True, если имя файла в Name совпадает с шаблоном в Pattern. Шаблон может содержать знаки *
(совпадение с нулем или более символов) или ?
(совпадение с одиночными символом).
FSearch ищет в DirList, списке каталогов, разделенных двоеточием, файл, указанный в Path, возвращаю путь к найденному файлу или пустую строку.
Glob возвращает указатель на структуру tglob, содержащую имена всех файлов, отвечающих шаблону в Path. Возвращает nil при ошибке, устанавливая LinuxError.
GlobFree освобождает память, занятую структурой tglob.
Например:
Uses linux;
Var G1,G2 : PGlob;
begin
  G1:=Glob ('*');
  if LinuxError=0 then
    begin
    G2:=G1;
    Writeln ('Files in this directory : ');
    While g2<>Nil do
      begin
      Writeln (g2^.name);
      g2:=g2^.next;
      end;
    GlobFree (g1);
    end;
end.

Содержание раздела