Анализируем модули

Хранение информации о проектах имеет далеко идущие цели: анализ исходного кода и архитектуры с выдачей рекомендаций по их оптимизации.

А начнем с простой задачи: извлечение информации о содержимом модуля, в частности – поиск и отображение процедур и функций.

Скрипты

За основу анализатора я взял алгоритм, используемый в модуле подсветки синтаксиса CodeHL.pas, что наводит на мысль о необходимости создания универсальной процедуры для парсинга. Но пока, к моему огорчению, я прибегнул к копипасту, чтобы получить рабочий код процедуры UpdateProjectList_UpdateUnitProcList().

procedure UpdateProjectList_UpdateUnitProcList(AIDUnit: integer; AShowProgress: boolean);
// обновление информации по процедурам модулям
// AIDUnit - ID модуля
// AShowProgress - флаг отображения прогресса
// в работе используются настройки модуля CodeHL
var
  tmpFileName: string;
  tmpStrings: TStringList;
  i: integer;
  j: integer;
  tmpWord: string;
  tmpChar: string;
  s1, s2: string;
  tmpIndex: integer;
  tmpText: string;
  tmpBeginCount: integer;
  tmpProcDetected: boolean;
  tmpProcCount: integer;
  tmpDataSet: TDataSet;
begin
  if AShowProgress then
    Progress(0, 0, R('UAPP_MODULE_DATA_UPDATE',UAPP_MODULE_DATA_UPDATE) );
  try
    tmpFileName := Trim( SQLExecute('SELECT project.path || "\script\" || unit.path FROM unit LEFT JOIN project ON project.id = unit.id_project WHERE unit.id=' + IntToStr(AIDUnit)) );
    // файла может не быть, это не совсем нормально, но обрабатывается не здесь
    if not FileExists(tmpFileName) then
      exit;
    tmpStrings := TStringList.Create;
    // фишка MVDB - главный файл должен быть в кодировке UTF-8, а все остальные - ANSI
    if UpperCase( ExtractFileName(tmpFileName) ) = 'SCRIPT.PAS' then
      tmpStrings.LoadFromFile(tmpFileName)
    else
      tmpStrings.LoadFromFileANSI(tmpFileName);
    //
    tmpText := tmpStrings.Text;
    tmpStrings.Clear;
    // создаём список процедур и функций
    tmpBeginCount := 0;
    tmpProcCount := 0;
    tmpProcDetected := False;
    tmpIndex := -1;
    tmpWord := '';
    for i := 1 to Length(tmpText) do
    begin
      tmpChar := tmpText[i];
      if Ord(tmpChar) = 0 then // в конце строки может оказаться символ завершения строки.
        break;
      // линейный режим - это отключение посимвольного анализа до обнаружения триггерной последовательности
      if tmpIndex <> -1 then
      begin
        s1 := CHL_LM_End[tmpIndex];
        // обнаружена завершающая последовательность?
        if copy(tmpText, i, Length(s1)) = s1 then
        begin
          // если завершающая последовательность больше одного символа, то делаем корректировку
          if Length(s1) > 1 then
            delete(tmpText, i + 1, Length(s1) - 1);
          //
          tmpIndex := -1;
          tmpWord := '';
        end
        else
          tmpWord := tmpWord + tmpChar;
        continue;
      end;
      // конец слова
      if tmpText[i] in [' ', '{', '}', '/', '\', ')', '(', ';', ':', '"', '''', '.', ',', chr(13)] then
      begin
        // проверка начала линейного режима
        for j := 0 to Length(CHL_LM_Begin) - 1 do
        begin
          if copy(tmpText, i, Length(CHL_LM_Begin[j])) = CHL_LM_Begin[j] then
          begin
            tmpIndex := j;
            continue;
          end;
        end;
        // проверка слов
        tmpWord := Trim(tmpWord);
        if tmpWord <> '' then
        begin
          if tmpProcDetected then
          begin
            tmpStrings.Add(tmpWord);
            tmpProcDetected := False;
          end
          else
          if (UpperCase(tmpWord) = 'BEGIN') or (UpperCase(tmpWord) = 'CASE')  or (UpperCase(tmpWord) = 'TRY') then
            inc(tmpBeginCount)
          else
          if UpperCase(tmpWord) = 'END' then
          begin
            dec(tmpBeginCount);
            if tmpBeginCount = 0 then
              dec(tmpProcCount);
          end
          else
          if  ( UpperCase(tmpWord) = 'PROCEDURE' ) or ( UpperCase(tmpWord) = 'FUNCTION' ) then
          begin
            if tmpProcCount = 0 then
              tmpProcDetected := True;
            inc( tmpProcCount );
          end;
          //
          tmpWord := '';
        end;
      end
      else
        tmpWord := tmpWord + tmpChar;
    end;
    // смотрим, не удалили ли чего...
    Application.ProcessMessages;
    SQLQuery('SELECT id, name FROM unitProc WHERE id_unit = '+IntToStr(AIDUnit),tmpDataSet);
    while not tmpDataSet.EOF do
    begin
      if tmpStrings.IndexOf( tmpDataSet.FieldByName('name').asString ) < 0 then
      begin
        SQLExecute('UPDATE unitProc SET status = "Не найдена" WHERE id = '+tmpDataSet.FieldByName('id').asString  );
        Application.ProcessMessages;
      end;
      tmpDataSet.Next;
    end;
    // смотрим, не надо ли добавить...
    for i:=0 to tmpStrings.Count - 1 do
    begin
      if AShowProgress then
        Progress(i, tmpStrings.Count - 1, 'Добавление процедур' )
      else
        Application.ProcessMessages;
      tmpDataSet.First;
      tmpProcDetected := False;
      while not tmpDataSet.EOF do
      begin
        if tmpStrings.strings(i) = tmpDataSet.FieldByName('name').asString then
        begin
          tmpProcDetected := True;
          Break;
        end;
        tmpDataSet.Next;
      end;
      if not tmpProcDetected then
      begin // добавляем...
        SQLExecute('INSERT INTO unitProc (id_unit,name,status) VALUES ('+IntToStr(AIDUnit)+','+StrToSQL( tmpStrings.strings(i) )+','+StrToSQL('Новая ')+')');
        Application.ProcessMessages;
      end;
    end;
    tmpDataSet.Free;
    tmpStrings.Free;
  finally
    if AShowProgress then
      Progress();
  end;
end;
Code language: Delphi (delphi)

В отличии от других процедур заполнения и проверок, для извлечения данных используется только один запрос к базе, а проверки осуществляются с использованием компонентов TDataSet и TStringList, в которых загружаются сведения об имеющихся записях и информация о процедурах и функциях модуля.

Ещё одна особенность My Visual Database состоит в том, что кодировка главного модуля script.pas должна быть UTF-8, а кодировки остальных модулей – ANSY, и это необходимо учитывать при парсинге файлов модулей.

Для получения текста процедуры по имени используется функция UserApp_GetProcBody(), в основе которой лежит тот же парсер, что и в процедурах UpdateProjectList_UpdateUnitProcList() и CodeHL_TextToHTML(). (Обязуюсь к следующей версии придумать, как избавиться от копипаста в этих трёх процедурах).

function UserApp_GetProcBody( AText:string; AProcName:string ):string;
var
  i: integer;
  j: integer;
  tmpWord: string;
  tmpChar: string;
  s1, s2: string;
  tmpIndex: integer;
  tmpBeginCount: integer;
  tmpProcDetected: boolean;
  tmpProcCount: integer;
  tmpProcStartPos: integer;
  tmpProcEndPos: integer;
  tmpStartPos: integer;
  tmpBody: boolean;
  tmpText:string;
  s: string;
begin
  tmpText := AText;
  tmpBeginCount := 0;
  tmpProcCount := 0;
  tmpProcDetected := False;
  tmpIndex := -1;
  tmpWord := '';
  tmpBody := False;
  for i := 1 to Length(tmpText) do
  begin
    tmpChar := tmpText[i];
    if Ord(tmpChar) = 0 then // в конце строки может оказаться символ завершения строки.
      break;
    if tmpBody then
      Result := Result + tmpChar;
    // линейный режим - это отключение посимвольного анализа до обнаружения триггерной последовательности
    if tmpIndex <> -1 then
    begin
      s1 := CHL_LM_End[tmpIndex];
      // обнаружена завершающая последовательность?
      if copy(tmpText, i, Length(s1)) = s1 then
      begin
        // если завершающая последовательность больше одного символа, то делаем коректировку
        if Length(s1) > 1 then
          delete(tmpText, i + 1, Length(s1) - 1);
        //
        tmpIndex := -1;
        tmpWord := '';
      end
      else
        tmpWord := tmpWord + tmpChar;
      continue;
    end;
    // конец слова
    if tmpText[i] in [' ', '{', '}', '/', '\', ')', '(', ';', ':', '"', '''', '.', ',', chr(13)] then
    begin
      // проверка начала линейного режима
      for j := 0 to Length(CHL_LM_Begin) - 1 do
      begin
        if copy(tmpText, i, Length(CHL_LM_Begin[j])) = CHL_LM_Begin[j] then
        begin
          tmpIndex := j;
          continue;
        end;
      end;
      // проверка слов
      tmpWord := Trim(tmpWord);
      if tmpWord <> '' then
      begin
        if tmpProcDetected then
        begin
          if UpperCase(tmpWord) = UpperCase(AProcName) then
          begin
            for j := i-Length(tmpWord)-9 downto 0 do
            begin
              s := copy(tmpText,j,i-j+1);
              if ( UpperCase(copy(s,1,9)) = 'PROCEDURE') or ( UpperCase(copy(s,1,8 )) = 'FUNCTION') then
              begin
                Result := s;
                break;
              end;
            end;
            tmpBody := True;
          end;
          tmpProcDetected := False;
        end
        else
        if (UpperCase(tmpWord) = 'BEGIN') or (UpperCase(tmpWord) = 'CASE')  or (UpperCase(tmpWord) = 'TRY') then
          inc(tmpBeginCount)
        else
        if UpperCase(tmpWord) = 'END' then
        begin
          dec(tmpBeginCount);
          if tmpBeginCount = 0 then
          begin
            dec(tmpProcCount);
            if (tmpProcCount = 0) and tmpBody then
              tmpBody := False;
          end;
        end
        else
        if  ( UpperCase(tmpWord) = 'PROCEDURE' ) or ( UpperCase(tmpWord) = 'FUNCTION' ) then
        begin
          if tmpProcCount = 0 then
            tmpProcDetected := True;
          inc( tmpProcCount );
        end;
        //
        tmpWord := '';
      end;
    end
    else
      tmpWord := tmpWord + tmpChar;
  end;
end;
Code language: Delphi (delphi)

Другие доработки

• UserApp_LoadExample() – добавлена обработка случая, когда источником примера является таблица отображения процедур модуля: для извлечения текста вызывается UserApp_GetProcBody().
• Splash_Create() – добавлена строка для отображения статуса инициализации приложения.
• Splash_ShowProgress() – добавлена процедура отображения статуса инициализации приложения. Актуально для приложений с большим временем запуска.
• UserApp_InitForm() – добавлены вызовы Splash_ShowProgress() для пояснения этапов инициализации
• UserApp_UpdateDD() – добавлена обработка для формы dtfUnit_Tree, у которой теперь есть дочерняя форма dtfUnitProc
• frmMain_btnProc_Update_OnClick() – добавлена процедура обработки нажатия кнопки, по которой производится анализ выбранного модуля.
• english.txt, русский.txt – в файлы локализации ресурсов добавлены новые данные

Результат

Заменил картинку на заставке, чтобы надписи были более читабельными.

Добавил многостраничник для отображения процедур и функций (в перспективе планирую собирать сведения о константах и глобальных переменных).

При выборе процедуры можно просмотреть её код.

В базу данных добавлены описания для встроенных в My Visual Database процедур.

Планы

• Отображать информацию о статических формах приложения (формах, созданных в редакторе форм My Visual Database).
• Отображать информацию о структуре базы данных
• Отображать зависимости между модулями и формами
• Извлекать описательные данные из исходников для создания автоматической документации проекта.
• Добавить в поисковую систему поиск по проектам, модулям и процедурам модулей
• Синхронизация версий модулей.
• Создание эталонных модулей (репозиторий модулей).

Ссылки

• Проект “Руководство разработчика” с исходными кодами