uSQLFunctionBuilder.pas

unit uSQLFunctionBuilder;

interface

uses
  System.SysUtils, System.Classes, System.Generics.Collections, Data.DB,
  FireDAC.Comp.Client, System.IOUtils, System.Threading;

type
  TFunctionType = (ftScalar, ftTable);
  TParameterDirection = (pdInput, pdOutput);

  TFunctionParameter = class
  private
    FName      : string;
    FDataType  : string;
    FDirection : TParameterDirection;
    FLength    : Integer;
    FPrecision : Integer;
    FScale     : Integer;
  public
    constructor Create(const AName, ADataType : string; ADirection : TParameterDirection = pdInput;
      ALength : Integer = 0; APrecision : Integer = 0; AScale : Integer = 0);
    function ToSQLString : string;
    property Name : string read FName write FName;
    property DataType : string read FDataType write FDataType;
    property Direction : TParameterDirection read FDirection write FDirection;
    property Length : Integer read FLength write FLength;
    property Precision : Integer read FPrecision write FPrecision;
    property Scale : Integer read FScale write FScale;
  end;

  TSQLFunctionBuilder = class
  private
    FFunctionName    : string;
    FFunctionType    : TFunctionType;
    FParameters      : TObjectList<TFunctionParameter>;
    FReturnType      : string;
    FReturnLength    : Integer;
    FReturnPrecision : Integer;
    FReturnScale     : Integer;
    FTableColumns    : TObjectList<TFunctionParameter>;
    FBody            : TStringList;
    FSchema          : string;

    function GetParametersSQL : string;
    function GetReturnTypeSQL : string;
    function GetTableDefinitionSQL : string;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Clear;
    function AddParameter(const AName, ADataType : string; ADirection : TParameterDirection = pdInput;
      ALength : Integer = 0; APrecision : Integer = 0; AScale : Integer = 0) : TFunctionParameter;
    function AddTableColumn(const AName, ADataType : string;
      ALength : Integer = 0; APrecision : Integer = 0; AScale : Integer = 0) : TFunctionParameter;
    procedure SetReturnType(const AType : string; ALength : Integer = 0;
      APrecision : Integer = 0; AScale : Integer = 0);
    procedure SetFunctionBody(const ABody : string);
    function GenerateSQL : string;

    property FunctionName : string read FFunctionName write FFunctionName;
    property FunctionType : TFunctionType read FFunctionType write FFunctionType;
    property Schema : string read FSchema write FSchema;
    property Body : TStringList read FBody;
  end;

implementation

{ TFunctionParameter }

constructor TFunctionParameter.Create(const AName, ADataType : string;
  ADirection : TParameterDirection; ALength, APrecision, AScale : Integer);
begin
  FName      := AName;
  FDataType  := ADataType;
  FDirection := ADirection;
  FLength    := ALength;
  FPrecision := APrecision;
  FScale     := AScale;
end;

function TFunctionParameter.ToSQLString : string;
var
  TypeStr : string;
begin
  TypeStr := FDataType;

  if (FDataType = 'VARCHAR') or (FDataType = 'NVARCHAR')
  or (FDataType = 'CHAR') or (FDataType = 'NCHAR') or (FDataType = 'BINARY')
  or (FDataType = 'VARBINARY') then
    begin
      if FLength = -1 then
        TypeStr := TypeStr + '(MAX)'
      else if FLength > 0 then
        TypeStr := TypeStr + '(' + FLength.ToString + ')';
    end
  else
  if (FDataType = 'DECIMAL') or (FDataType = 'NUMERIC') then
    begin
      if (FPrecision > 0) then
        begin
          if FScale > 0 then
            TypeStr := TypeStr + '(' + FPrecision.ToString + ',' + FScale.ToString + ')'
          else
            TypeStr := TypeStr + '(' + FPrecision.ToString + ')';
        end;
    end;

  Result := '@' + FName + ' ' + TypeStr;
end;

{ TSQLFunctionBuilder }

constructor TSQLFunctionBuilder.Create;
begin
  inherited;
  FParameters   := TObjectList<TFunctionParameter>.Create(True);
  FTableColumns := TObjectList<TFunctionParameter>.Create(True);
  FBody         := TStringList.Create;
  FSchema       := 'dbo';
  Clear;
end;

destructor TSQLFunctionBuilder.Destroy;
begin
  FParameters.Free;
  FTableColumns.Free;
  FBody.Free;
  inherited;
end;

procedure TSQLFunctionBuilder.Clear;
begin
  FFunctionName    := '';
  FFunctionType    := ftScalar;
  FParameters.Clear;
  FReturnType      := '';
  FReturnLength    := 0;
  FReturnPrecision := 0;
  FReturnScale     := 0;
  FTableColumns.Clear;
  FBody.Clear;
end;

function TSQLFunctionBuilder.AddParameter(const AName, ADataType : string;
  ADirection : TParameterDirection; ALength, APrecision, AScale : Integer) : TFunctionParameter;
var
  Param: TFunctionParameter;
begin
  Param := TFunctionParameter.Create(AName, ADataType, ADirection, ALength, APrecision, AScale);
  FParameters.Add(Param);
  Result := Param;
end;

function TSQLFunctionBuilder.AddTableColumn(const AName, ADataType : string;
  ALength, APrecision, AScale : Integer) : TFunctionParameter;
var
  Column: TFunctionParameter;
begin
  Column := TFunctionParameter.Create(AName, ADataType, pdInput, ALength, APrecision, AScale);
  FTableColumns.Add(Column);
  Result := Column;
end;

procedure TSQLFunctionBuilder.SetReturnType(const AType : string;
  ALength, APrecision, AScale : Integer);
begin
  FReturnType      := AType;
  FReturnLength    := ALength;
  FReturnPrecision := APrecision;
  FReturnScale     := AScale;
end;

procedure TSQLFunctionBuilder.SetFunctionBody(const ABody: string);
begin
  FBody.Text := ABody;
end;

function TSQLFunctionBuilder.GetParametersSQL : string;
var
  I : Integer;
  Params : TStringList;
begin
  Params := TStringList.Create;
  try
    for I := 0 to FParameters.Count - 1 do
      Params.Add(FParameters[I].ToSQLString);

    Result := String.Join(',' + #13#10, Params.ToStringArray);
  finally
    Params.Free;
  end;
end;

function TSQLFunctionBuilder.GetReturnTypeSQL : string;
var
  TypeStr : string;
begin
  if FReturnType = '' then
    Exit('');

  TypeStr := FReturnType;

  if (FReturnType = 'VARCHAR') or (FReturnType = 'NVARCHAR')
  or (FReturnType = 'CHAR') or (FReturnType = 'NCHAR')
  or (FReturnType = 'BINARY') or (FReturnType = 'VARBINARY') then
    begin
      if FReturnLength = -1 then
        TypeStr := TypeStr + '(MAX)'
      else
        if FReturnLength > 0 then
          TypeStr := TypeStr + '(' + FReturnLength.ToString + ')';
    end
  else
    if (FReturnType = 'DECIMAL') or (FReturnType = 'NUMERIC') then
      begin
        if (FReturnPrecision > 0) then
          begin
            if FReturnScale > 0 then
              TypeStr := TypeStr + '(' + FReturnPrecision.ToString + ',' + FReturnScale.ToString + ')'
            else
              TypeStr := TypeStr + '(' + FReturnPrecision.ToString + ')';
          end;
      end;

  Result := TypeStr;
end;

function TSQLFunctionBuilder.GetTableDefinitionSQL : string;
var
  I : Integer;
  Columns : TStringList;
begin
  if FTableColumns.Count = 0 then
    Exit('');

  Columns := TStringList.Create;
  try
    for I := 0 to FTableColumns.Count - 1 do
    begin
      Columns.Add(FTableColumns[I].Name + ' ' + FTableColumns[I].DataType);
    end;

    Result := #13#10 + 'RETURNS TABLE' + #13#10 + '(' + #13#10 +
              '    ' + String.Join(',' + #13#10 + '    ', Columns.ToStringArray) + #13#10 +
              ')';
  finally
    Columns.Free;
  end;
end;

function TSQLFunctionBuilder.GenerateSQL : string;
var
  SQL : TStringList;
  ParametersSQL : string;
begin
  SQL := TStringList.Create;
  try
    SQL.Add('CREATE OR ALTER FUNCTION ' + FSchema + '.' + FFunctionName);
    SQL.Add('(');

    ParametersSQL := GetParametersSQL;
    if ParametersSQL <> '' then
      SQL.Add('    ' + ParametersSQL);

    SQL.Add(')');

    if FFunctionType = ftScalar then
      SQL.Add('RETURNS ' + GetReturnTypeSQL)
    else
      SQL.Add(GetTableDefinitionSQL);

    SQL.Add('AS');
    SQL.Add('BEGIN');

    // Indent body
    FBody.Text := '    ' + StringReplace(FBody.Text, #13#10, #13#10 + '    ', [rfReplaceAll]);
    SQL.Add(FBody.Text);

    SQL.Add('END;');

    Result := SQL.Text;
  finally
    SQL.Free;
  end;
end;

end.