fpc/utils/dotutils/makedottedfiles.pp

{
    This file is part of the Free Component Library
    Copyright (c) 2022 by Michael Van Canneyt, [email protected]

    Application to Prefix units in uses clause of a list of programs. 
    Optionally adapts an fpmake file.
    
    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

program makedottedfiles;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  types, Classes, SysUtils, CustApp, Prefixer, namespacetool;


type

  { TNamespaceCreation }

  TNamespaceCreation = class(TCustomApplication)
  Private
    FTool : TNamespaceTool;
    FListFileName: string;
    FQuiet : Boolean;
    FVerbose : Boolean;
    procedure DoLogTool(Sender: TObject; EventType: TEventType; const Msg: String);
    function ProcessOptions: Boolean;
  protected
    procedure DoLog(EventType: TEventType; const Msg: String); override;
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Usage(const aMsg : String);
  end;

{ TNamespaceCreation }

procedure TNamespaceCreation.DoLog(EventType: TEventType; const Msg: String);
begin
  Writeln('[',EventType,'] ',Msg);
end;


function TNamespaceCreation.ProcessOptions : Boolean;

const
  Short = 'qDhbncarl:k:d:p:s:e:m:vu';
  Long : Array of string = ('help','list:','known-prefixes:','dirmap:','backup','prefix:','subdir:','dry-run','cased','apply-rule','restart','replace-subdir','ext','fpmake-file:','quiet','verbose','update');

var
  aExt,ErrorMsg: String;
  NonOpts : Array of string;

begin
  Result:=False;
  ErrorMsg:=CheckOptions(Short,Long);
  if (ErrorMsg<>'') or HasOption('h','help') then
    begin
    Usage(ErrorMsg);
    Exit;
    end;
  // Options for tool class
  aExt:=GetOptionValue('e','ext');
  FTool.ForcedExt:=aExt;
  FTool.DirMapFileName:=GetOptionValue('d','dirmap');
  FTool.PrefixesFileName:=GetOptionValue('k','known-prefixes');
  FTool.DefaultPrefix:=GetOptionValue('p','prefix');
  FTool.Subdir:=GetOptionValue('s','subdir');
  if FTool.SubDir='' then
    FTool.SubDir:=DefaultSubdir;
  FTool.SubdirMode:=sdmAppend;
  if HasOption('D','replace-subdir') then
    FTool.SubDirMode:=sdmReplace;
  FTool.Backup:=HasOption('b','backup');
  FTool.Update:=HasOption('u','update');
  FTool.DryRun:=HasOption('n','dry-run');
  FTool.Restart:=HasOption('r','restart');
  FTool.CasedFiles:=HasOption('c','cased');
  FTool.FPMakeNameSpaceFile:=GetoptionValue('m','fpmake-file');
  FQuiet:=HasOption('q','quiet');
  FVerbose:=HasOption('v','verbose');
  if FVerbose then
    FQuiet:=False;
  FListFileName:=GetOptionValue('l','list');
  NonOpts:=GetNonOptions(Short,Long);
  if (FListFileName='') and (Length(NonOpts)=1) then
    FListFileName:=NonOpts[0];
  If (FListFileName='') then
    begin
    Usage('Need file list filename');
    exit;
    end;
  If (FTool.PrefixesFileName='') and (FTool.DefaultPrefix='') and not HasOption('a','apply-rule') then
    begin
    Usage('Need prefixes filename or default prefix');
    exit;
    end;
  Result:=True;
end;

procedure TNamespaceCreation.DoLogTool(Sender: TObject; EventType : TEventType; const Msg: String);

var
  CanLog : Boolean;
begin
  Case EventType of
    etDebug : CanLog:=FVerbose;
    etError : CanLog:=True;
  else
    CanLog:=Not FQuiet;
  end;
  if CanLog then
    Log(EventType,Msg);
end;

procedure TNamespaceCreation.DoRun;


begin
  Terminate;
  if not ProcessOptions then
    exit;
  FTool.Init;
  if HasOption('a','apply-rule') then
    FTool.CreateKnown(FListFileName)
  else
    FTool.HandleFileList(FListFileName);
end;

constructor TNamespaceCreation.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
  FTool:=TNamespaceTool.Create(Self);
  FTool.OnLog:=@DoLogTool;
end;

destructor TNamespaceCreation.Destroy;

begin
  FreeAndNil(FTool);
  Inherited;
end;

procedure TNamespaceCreation.Usage(const aMsg: String);

begin
  if aMsg<>'' then
    Writeln('Error : ',aMsg);
  { add your help code here }
  Writeln('Usage: ', ExeName, ' [options] list');
  Writeln('Where options is one or more of');
  Writeln('-h --help                  This help');
  Writeln('-a --apply-rule            Apply rule in filelist to construct known file list.');
  Writeln('                           if -k is not specified, then map file is list file with extension changed to FILE.map)');
  Writeln('-b --backup                Create backup of files that are written');
  Writeln('-c --cased                 First letter of name is uppercased when creating alias');
  Writeln('-d --dirmap=FILE           Directory mapping. Old=New, new is relative to subdir');
  Writeln('-e --ext=EXT               Force extension of created dotted units to EXT. If not set, original extension is taken');
  Writeln('-D --replace-subdir        Directory mapping. Completely replace dir with mapping from dirmap.');
  Writeln('-k --known-prefixes=FILE   Namespace mapping. Unit=Namespace');
  Writeln('-l --list=FILE             Files to handle. One file per line');
  Writeln('-m --fpmake-file=FILE      Write namespace unit mappping to FILE and add as NameSpaceMap to package definition in fpmake.pp');
  Writeln('-n --dry-run               Do not execute commands, only write what would be done.');
  Writeln('-r --restart               Do not load done.lst. Default is to load done.lst and skip files listed in it.');
  Writeln('                           The file is always updated when done.');
  Writeln('-q --quiet                 Do not produce any output.');
  Writeln('-s --subdir=DIRECTORY      Directory in which to write files. Default: '+FTool.DefaultPrefix);
  Writeln('-u --update                Write updated known prefixes file.');
  Writeln('-v --verbose               Produce debug output (reports on uses clause manipulations).');
end;

var
  Application: TNamespaceCreation;
begin
  Application:=TNamespaceCreation.Create(nil);
  Application.Title:='Namespaced files creation tool';
  Application.Run;
  Application.Free;
end.