///////////////////////////////////////////////////////////
//                     GGBuildTools                      //
//    Набор утилит для сборки проектов Gipat Group       //
//             Copyright (C) 2007 Gipat Group            //
//              Распространяется на условиях             //
//    Gipat Group's opened EI-editor-utility license     //
//                      версии 1.0                       //
//                                                       //
//                  www.gipatgroup.org                   //
///////////////////////////////////////////////////////////

//К работе над данным файлом приложили руки, ноги.... короче аффтары:
// 1) Immortal (ImmortalGAD@rambler.ru)
// 2) Sagrer (sagrer@yandex.ru)

////////////////////////////////////////////////////////////////////////
//
//   Unit SourcePackService выполняет руководящую часть процесса упаковки.
//
////////////////////////////////////////////////////////////////////////
unit SourcePackService;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, SconfFormat, Archiver, GGConsUtilServiceClass, ExtraFileUtilsLCL,
  Forms, VerInfoTxtFormat, GGBuildToolsShared, TranslManager;
  
const
  GGBT_PackServiceName = 'Source Pack Builder';

type

  // Сервис архивации
  TPackService = class(TGGConsUtilServiceClass)
    protected
      PathToProject :AnsiString;  // Путь к файлу проекта
      SourcePath    :AnsiString;  // Путь, что архивировать
      OutputPath    :AnsiString;  // Путь, куда ложить архив
      PackageName   :AnsiString;  // Имя пакета
      ArchiverType  :AnsiString;  // Тип архиватора
      ProjectVer    :AnsiString;  // Версия
      ProjectRoot   :AnsiString;
      TempFolder    :AnsiString;
      
      
      // Загружаем настройки проекта
      function LoadProjectConfiguration(const path :String) : Boolean;
      //вывести дополнительные опции в хелпе
      procedure ShowOptions; override;
      //Получаем версию из .vit файла, если нужно...
      procedure ResolveProjectVersion;
      
    public
      // Конструктор
      constructor Create; override;
      procedure ProcessParameters; override; // Достать параметры из командной строки
      procedure DoWork; override;            // Работать...
      procedure ProcessExtraSconfParams;     // Прочитать параметры, перекрывающие настройки sconf.
    end;

var
  PackService :TPackService;

implementation

// Конструктор
constructor TPackService.Create;
begin
  inherited;
  GGConsAppName := GGBT_PackServiceName;
  // параметризируем вывод хелпа
end;


//вывести дополнительные опции в хелпе
procedure TPackService.ShowOptions;
begin
  inherited;
  Writeln(_('          --filepath=<value> : sets path to the project configuration file.'));
  Writeln('          ');
  Writeln(_('Options to redeclare [SourcePackBuilder] section''s elements from project''s'));
  Writeln(_('configuration file:'));
  Writeln('          ');
  Writeln(_('          --FilesDir=<value> : path (relative to project''s root or absolute)'));
  Writeln(_('            to directory with source''s files. All paths may be relative'));
  Writeln(_('            to project''s root or they may be absolute.'));
  Writeln(_('          --OutputDir=<value> : directory, where to put archive with a source.'));
  Writeln(_('          --ArchiveFormart=<value> : format of an archive with a source.'));
  Writeln(_('            Variants: 7z.'));
end;

//Получаем версию из .vit файла, если нужно...
procedure TPackService.ResolveProjectVersion;
var
  verFile :TVerInfoTxtFormat;
begin
  // Здесь мы выясним надо ли искать версию во внешнем vit файле
  // Поидее это должна делать какая-ниюудь общая функ. т.к. поидее это может понадобится в других утилах
  // Добавляю пока сюда + специфичные для пакера действия , типа замены '.' на '_';
  
  // означает что версия хранится во внешнем файле
  // можно, кстати, добвить сюда еще, что бы можно было задавать путь к файлу,
  // тогда например, можно будет шарить файл с версией если понадобится
  if ProjectVer = 'Project' then begin
    verFile := TVerInfoTxtFormat.Create;
    // читаем и формируем версию. Считаем, что файл с версией лежит там же где и .sconf, и с тем же именем
    if verFile.Load(ChangeFileExt(PathToProject, '.vit')) then begin
      //ProjectVer := Format('%d_%d_%d_%d', [verFile.Ver1, verFile.Ver2, verFile.Ver3, verFile.Ver4]);
      //Поменял на встроенную в vit генерацию имени.
      ProjectVer := verFile.GenerateFNVersionString();
    end
    else begin
      // не нашли файл скорее всего, или он поврежденн.
      // как реагировать - или 1. кидать ошибку , 2. не использовать версию в имени вообще.
      // или даже есть смысл различать когда файла нет, то отрабатывать нормально по 2. или
      // иначе, то возникла ошибка формата, что серьезней и стоит об этом сообщить...
      //WriteLn(verFile.ErrorMessage);
      ProjectVer := '0_0_0_0';
    end;
    verFile.Free;
  end
  else begin
    //Версия взята из sconf - по идее там надо точки на подчеркивание поменять.
    StringReplace(ProjectVer, '.', '_', [rfReplaceAll]);
  end;
end;

// Загружаем настройки проекта
function TPackService.LoadProjectConfiguration(const path :String) : Boolean;
var
  conf :TSconfFormat;
begin
  //Инициализация.
  conf := TSconfFormat.Create;
  Result := true;
  
  //Собсно читаем инфу...
  WriteLn(AddExtensionIfAbsent(path, '.sconf'));
  if (conf.Load(AddExtensionIfAbsent(path, '.sconf'))) then begin
    OutputPath   := conf.SourcePackBuilderSection.OutputDir;
    SourcePath   := conf.SourcePackBuilderSection.FilesDir;
    ArchiverType := conf.SourcePackBuilderSection.ArchiveFormat;
    ProjectVer   := conf.MainSection.ProjectVer;
    PackageName  := GetFileNameWithoutExtension(path);
    ProjectRoot  := conf.MainSection.ProjectRootDir;
  end
  else begin
    //Не удалось прочитать инфу.
    Result := false;
    Writeln(_('Corrupted .sconf file format, or wrong path to file...'));
  end;
  
  //Не забыть почистить мусор.
  conf.Free;
end;

// Достать параметры из командной строки
procedure TPackService.ProcessParameters;
begin
  //Выполнить унаследованную функцию
  inherited;
  
  if Application.HasOption('filepath') then begin
    //Прочитать имя файла проекта.
    Self.PathToProject := Application.GetOptionValue('filepath');
  end;
end;

// Работать...
procedure TPackService.DoWork;
var
  worker :TArchiver;
  temp   :TTempFolder;
  AllOk : Boolean;
  ExePath : AnsiString;
  
begin
  inherited;
  
  //Под-инициализация.
  AllOk := true;
  ExePath := DelLastSlash(ExtractFilePath(Application.ExeName));   //Сразу получим путь к .\bin.
  worker := nil;
  
  if (ProcessFurther) then begin
    //Блокировка других веток
    ProcessFurther := false;
    
    //Работаем....
    if Application.HasOption('filepath') = true then begin
      //Все ок.
      ShowVersion;
      WriteLn;
      WriteLn(_('Loading project settings...'));
      if LoadProjectConfiguration(PathToProject) = false then begin
        //Не удалось прочитать настройки.
        AllOk := false;
      end;
      
      if AllOk = true then begin
        //Если фсёок - то парсим дополнительно возможные параметры командной строки,
        //перекрывающие опции в sconf.
        Self.ProcessExtraSconfParams;
        //В зависимости от типа архиватора - создаем объект-исполнитель.
        if Self.ArchiverType = ARCHIVER_NAME_7ZIP then begin
          //Все ок, архивер тот что нужно.
          worker := T7ZipArchiver.Create;
          //Задать имя и путь к внешнему архиверу.
          worker.UtilPath := ResolveLocalPath('..\'+AddLastSlash(GGBT_ExtToolsPath)+GGBT_7zBinName,ExePath);
        end
        else begin
          //Какой-то другой архивер - какой неизвестно. Так и запишем.
          AllOk := false;
          Writeln(_('Unknown archivator type: ')+Self.ArchiverType);
        end;
      end;
      
      //Собсно приступаем к архивации.
      if AllOk = true then begin
        //Забиваем инфу в класс архивера...
        ResolveProjectVersion;
        worker.Name := PackageName + '_' + ProjectVer + '_src';
        temp := TTempFolder.Create(worker.Name);
        worker.OutputDir := ResolveLocalPath(OutputPath, ProjectRoot);
        worker.SourceDir := temp.GetTempPath;
        //Сообщаем что генерим временную диру.
        Writeln(_('Creating temporary source distro ')+worker.Name);
        CopyDirectory(ResolveLocalPath(SourcePath, ProjectRoot), temp.GetTempPath, true);
        Writeln(_('done.'));
        Writeln(_('Creating archive ')+worker.GetFullArchiveName());
        if worker.Pack = true then begin
          //Фсеок.
          Writeln(_('done.'));
        end
        else begin
          Writeln(_('Error, while creating archive:'));
          Writeln(worker.ErrorMessage);
          AllOk := false;
        end;
        
        temp.Free;
      end;

      //Не забыть выкинуть мусор.
      if worker <> nil then begin
        worker.Free;
      end;
    end
    else begin
      //Обломс. Нехватает опции которая обязательна для работы софтины.
      Self.ShowHelp();
      Writeln(_('Error!!! "--filepath=<value>" option is required!'));
      Writeln('');
    end;
  end;
end;

procedure TPackService.ProcessExtraSconfParams;
//Прочитать параметры, перекрывающие настройки sconf.
begin

  if Application.HasOption('FilesDir') then begin
    Self.SourcePath := Application.GetOptionValue('FilesDir');
  end;
  
  if Application.HasOption('OutputDir') then begin
    Self.OutputPath := Application.GetOptionValue('OutputDir');
  end;
  
  if Application.HasOption('ArchiveFormart') then begin
    Self.ArchiverType := Application.GetOptionValue('ArchiveFormart');
  end;
  
end;

/////////////////////////////////
initialization
begin
  //Инициализация %). Выделим память, создадим всякую херню... как обычно в общем %)
  PackService := TPackService.Create;
  //Включим перевод с языка по умолчанию.
  TranslMan.SetMODir(ResolveLocalPath('..\Languages',ExtractFilePath(Application.ExeName)));
  TranslMan.EnableLanguageDefault;
end;

finalization
//Мочим все лишнее...
begin
  PackService.Free;
end;

end.