freepascal.compiler/packages/fcl-passrc/examples/showdpk.pp

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

    Program to analyse a package file, demo for dpkinfo.pp

    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 showdpk;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils, Types, CustApp, dpkinfo;

type


  { TDPK2LPKApplication }

  TDPK2LPKApplication = class(TCustomApplication)
  private
    function ConfigInfo(Info: TPackageInfo): TInfoKind;
  protected
    procedure DoRun; override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure Usage(const Msg: String); virtual;
  end;


{ TDPK2LPKApplication }

function TDPK2LPKApplication.ConfigInfo(Info : TPackageInfo) : TInfoKind;

  procedure OptToStrings(Opt : string; Strings: TSTrings);
  begin
    begin
    if (Opt[1]='@') then
      begin
      Opt:=Copy(Opt,2);
      if FileExists(Opt) then
        Strings.LoadFromFile(Opt);
      end
    else
      begin
      Strings.Delimiter:=';';
      Strings.DelimitedText:=Opt;
      end;
    end;

  end;

var
  m,Opt : String;

begin
  Opt:=GetOptionValue('k','known');
  if (Opt<>'') then
    OptToStrings(Opt,Info.KnownPackages);
  Opt:=GetOptionValue('d','defines');
  if (Opt<>'') then
    OptToStrings(Opt,Info.Defines);
  info.UseAbsolute:=HasOption('a','absolute');
  m:=GetOptionValue('m','mode');
  case lowercase(m) of
    'requires' : result:=ikRequires;
    'files' : Result:=ikFiles;
    'paths' : Result:=ikPaths;
  else
    Usage('Unknown mode: '+m);
    Result:=ikUnknown;
  end;
end;

procedure TDPK2LPKApplication.DoRun;

const
  Short = 'ho:k:m:d:a';
  Long : Array of string = ('help','output:','known:','mode:','defines:','absolute');

var
  ErrorMsg: String;
  Info : TPackageInfo;
  Kind : TInfoKind;
  aLine,PFN,OFN : String;
  FNS : TStringDynArray;

begin
  Terminate;
  ErrorMsg:=CheckOptions(Short,Long);
  if (ErrorMsg<>'') or HasOption('h','help') then
    begin
    Usage(ErrorMsg);
    Exit;
    end;
  FNS:=GetNonOptions(Short,Long);
  if Length(FNS)<>1 then
    begin
    Usage('Need one input file');
    exit;
    end;
  PFN:=FNS[0];
  OFN:=GetOptionValue('o','output');
  Info:=TPackageInfo.Create(Self);
  try
    Kind:=ConfigInfo(Info);
    if Kind=ikUnknown then
      exit;
    Info.ShowInfo(PFN,Kind);
    if OFN<>'' then
      Info.Output.SaveToFile(OFN)
    else
      for aLine in Info.Output do
        Writeln(aLine);
  finally
    Info.Free;
  end;

end;

constructor TDPK2LPKApplication.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException:=True;
end;

destructor TDPK2LPKApplication.Destroy;
begin
  inherited Destroy;
end;

procedure TDPK2LPKApplication.Usage(Const Msg : String);

begin
  if Msg<>'' then
    Writeln('Error: ',Msg);
  Writeln('Usage: ',ExeName, ' [options] PackageFile');
  Writeln('Where [options] is one or more of:');
  Writeln('-h --help        this help');
  Writeln('-k --known=FILE  File with known packages, they will not appear in output');
  Writeln('-o --output=FILE Write output to file instead of stdout.');
  Writeln('-m --mode=MODE   Select output mode, MODE is one of:');
  Writeln('                 requires    Show requires in package');
  Writeln('                 files       Show files in package');
  Writeln('                 paths       Show paths for source files in package');
  Writeln('-d --defines     Semicolon-separated list of defines for parser');
  Writeln('-a --absolute    Use absolute filenames instead of relative');
  ExitCode:=Ord(Msg<>'');
end;

var
  Application: TDPK2LPKApplication;
begin
  Application:=TDPK2LPKApplication.Create(nil);
  Application.Title:='Show package info';
  Application.Run;
  Application.Free;
end.