unit cgiReport;

{$mode ObjFPC}{$H+}

interface

uses
  Classes, SysUtils,  commandCol, extTypes, xpMemParamManagerUnit, reportDMUnit,cgiDM;
type
  { TReportCommand }

  TReportCommand=class(TCommand)
    private
    fReportProcessor: TReportDM;
    procedure CreateVariablesTable;
    procedure UpdateCodeWithArguments(var code: string);
    procedure SetStage(ALevel:TLogLevel; Sender:TObject; stageName: string);
    public
    ReportID: integer;
    ReportName: string;
    ReportTitle: string;
    ReportCode: string;
    Varcode: string;
    class function CommandName: string; override;
    class function CommandSubClass: string; override;
    procedure Prepare; virtual;
    procedure PrepareVars; virtual;
    procedure FillVars;
    procedure OnFillVariables(AVariables: TxpMemParamManager); virtual;
    function Run: boolean; override;
    function ParseArguments(Args: TStrings; out Errors: TStrings): boolean; override;
    function ProcessOptionValues(ParamName: string;  out Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean; override;
    procedure EditTemplate(OnHash: TCalcHashProc);
    procedure FillDefaults;
    property ReportProcessor: TReportDM read fReportProcessor;
    constructor Create(ID: string;aProcesor: TNIDBDM; ASubClass: string; aLogger:TLogger; AUser: string; IDUser: integer); override;
    destructor Destroy; override;
  end;

implementation
uses
   types, strutils, LazUTF8,allreportsunit;
{ TReportCommand }

procedure TReportCommand.CreateVariablesTable;
begin
  Processor.ExecuteSQL(
    'drop table if exists tmp_report_variables; '+
    'create temporary table tmp_report_variables ( '+
    'name character varying,'+
    'value_string character varying, '+
    'value_int integer, '+
    'var_type integer '+
    '); '
  );
end;

procedure TReportCommand.UpdateCodeWithArguments(var code: string);
begin
  TNIDBDM.UpdateWithArguments(code,Arguments.Keys);
  Code := StringReplace(Code,'{#user}',inttostr(UserID),[rfReplaceAll]);
end;

procedure TReportCommand.SetStage(ALevel: TLogLevel; Sender: TObject;
  stageName: string);
begin
  log(mtInfo,stageName);
  fcurrentStage:=format('выполняется (%s)',[stageName]);
end;

class function TReportCommand.CommandName: string;
begin
  result := 'report';
end;

class function TReportCommand.CommandSubClass: string;
begin
  result := '';
end;

procedure TReportCommand.Prepare;
var
  ASQL: string;
  v: string;
  d: TStringDynArray;
  i: integer;
begin
  ReportCode := Processor.QueryValue(format('select report_routine from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
  UpdateCodeWithArguments(ReportCode);
  if reportcode<>'' then
    Processor.ExecuteSQL(format('select %s;',[ReportCode]));
  ASQL := format( 'select array_to_string(extra_routines,'';'') as v from  xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]);
  v := Processor.QueryValue(ASQL);
  if v>'' then
    begin
      d := SplitString(v,';');
      for i := low(d) to high(d) do
        begin
          v := d[i];
          UpdateCodeWithArguments(v);
          if v<>'' then
            Processor.ExecuteSQL(v);
        end;
    end;
end;

procedure TReportCommand.PrepareVars;
begin
  VarCode := Processor.QueryValue(format('select report_routine_vars from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
  UpdateCodeWithArguments(VarCode);
  if VarCode<>'' then
    Processor.ExecuteSQL(format('select %s;',[VarCode]));
end;

procedure TReportCommand.FillVars;
const
  Q_varlist=
    'select coalesce(v1.name,v0.name) as name,coalesce(v1.query,v0.query) as query '+
    'from xp_report_cgi c '+
    ' left join xp_report_variables v0 on v0.name=any(c.variables) and v0.xp_rpt_id=0 and v0.var_type=%1:d '+
    ' left join xp_report_variables v1 on v1.name=any(c.variables) and v1.xp_rpt_id=c.xp_rpt_id and v0.var_type=%1:d '+
    'where c.xp_rpt_id=%0:d and coalesce(v1.query,v0.query,'''')<>''''  ';
var
  ASQL: string;
  q: string;
  script: string;
  vs: string;
  vi: integer;
begin
  try
  script := format('insert into tmp_report_variables(name,value_string,var_type) values(''UserName'',%s,0); ',[TNIDBDM.StringAsSQL(UserName)]);
  ASQL := format(Q_varlist,[ReportID,0]);
  with Processor.GetData(ASQL) do
    try
      while not eof do
        begin
          log(mtDebug, FieldByName('name').asString);
          q := FieldByName('query').AsString;
          UpdateCodeWithArguments(q);
          try
          vs := Processor.QueryValue(q);

          except
            vs := '';
          end;
          script := script + format(#13#10'insert into tmp_report_variables(name,value_string,var_type) values (%s,%s,0); ',
            [TNIDBDM.StringAsSQL(fieldByName('name').asString),TNIDBDM.StringAsSQL(vs)]);
          Next;
        end;
    finally
      free;
    end;
  ASQL := format(Q_varlist,[ReportID,1]);
  with Processor.GetData(ASQL) do
    try
      while not eof do
        begin
          q := FieldByName('query').AsString;
          UpdateCodeWithArguments(q);
          try
          vi := Processor.QueryIntValue(q);

          except
            vi := 0;
          end;
          script := script + format('insert into tmp_report_variables(name,value_int,var_type) values (%s,%d,1); '#13#10,
            [TNIDBDM.StringAsSQL(fieldByName('name').asString),vi]);
          Next;
        end;
    finally
      free;
    end;


  if script<>'' then
      Processor.ExecuteSQL(script);

  except on e: Exception do
    begin
      LogError(e,'FillVars');
      raise;
    end;
  end;
end;

procedure TReportCommand.OnFillVariables(AVariables: TxpMemParamManager);
begin

end;
constructor TReportCommand.Create(ID: string; aProcesor: TNIDBDM;
  ASubClass: string; aLogger: TLogger; AUser: string; IDUser: integer);
begin
  inherited Create(ID,aProcesor, aSubClass, aLogger,AUser,IDUser);
  fReportProcessor:=TReportDM.Create(nil);
  fReportProcessor.ID := ID;
  fReportProcessor.RepName := ReportName;
  fReportProcessor.Name := 'Report'+fProcessor.Name;
  fReportProcessor.NidbData := fProcessor;
end;

destructor TReportCommand.Destroy;
begin
  fReportProcessor.Free;
  inherited Destroy;
end;

function TReportCommand.Run: boolean;
var
  i: integer;
  s: string;
  fileData: TStream;
begin
  result := false;
  fcurrentStage := 'исполняется (инициализация)';
  fileData := TMemoryStream.Create;
  try
  ReportID  := Processor.QueryIntValue(format('select xp_rpt_id from xp_report_cgi where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
  if ReportID<=0 then
    begin
      fResult := TCommandData.Create(ErrorArguments,0,'Отчет не найден',nil,[],nil);
      exit;
    end;
  ReportTitle :=  Processor.QueryValue(format('select r.name from xp_report_cgi g join xp_report r on r.xp_rpt_id=g.xp_rpt_id where cgi_name=%s',[TNIDBDM.StringAsSQL(ReportName)]));
  CreateVariablesTable;
  log(mtInfo,'Построение отчета '+ReportTitle);
  ReportProcessor.RecordID:=ReportID;
  fcurrentStage := 'исполняется (подготовка)';
  try
  Prepare;
  except on e: Exception do
    begin
      Processor.LogError(self,e,'prepare');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
  fcurrentStage := 'исполняется (настройка)';
  try
  FillVars;
  PrepareVars;
  except on e: Exception do
    begin
      Processor.LogError(self,e,'vars');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
  fcurrentStage := 'исполняется ()';
  try
  ReportProcessor.ExportReport(ftPDF,fileData,@SetStage,@OnFillVariables);
  except on e: Exception do
    begin
      Processor.LogError(self,e,'ExportReport');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
  fResult := TCommandData.Create(0,fileData.size,ReportTitle+'.pdf',['{"type":"application/pdf"}'],[],fileData);
  fileData.Seek(0,soFromBeginning);
  {$IFDEF DEBUG} (fileData as TMemoryStream).SaveToFile(format('%sout/%s_%s.pdf',[ Extractfilepath(paramstr(0)),self.CommandID,ReportTitle])); {$ENDIF}
  fileData.Seek(0,soFromBeginning);
  result := true;
  finally
    fileData.Free;
  end;
end;

function TReportCommand.ParseArguments(Args: TStrings; out Errors: TStrings
  ): boolean;
var
  asql: string;
  ids: string;
  i: integer;
  value: string;
  val_int: integer;
  val_float: double;
  val_date: TDateTime;
  fmt: TFormatSettings;
  val_ids: TStringDynArray;
procedure AddToErrors(error: string);
begin
  if not assigned(Errors) then
    Errors := TStringList.Create;
  Errors.Add(error);
end;

begin
  result := false;
  Errors := nil;
  ids := '';
  for i := 0 to Arguments.Keys.Count-1 do
    if ids='' then
      ids := TNIDBDM.StringAsSQL(Arguments.Keys.Names[i])
    else
      ids := ids + ','+ TNIDBDM.StringAsSQL(Arguments.Keys.Names[i]);
  ReportName := Arguments.Keys.Values['name'];

  asql := format(
    'select p.name from xp_report_cgi c '+
    'join xp_report_params p on p.xp_rpt_id=c.xp_rpt_id and  coalesce(p.required,true) '+
    'where c.cgi_name=%s and p.name not in (%s) '+
    'order by fill_order,p.name ',
    [TNIDBDM.StringAsSQL(ReportName),(ids)]);
  with Processor.GetData(asql) do
    try
      if not eof then
        begin
         Errors := TStringList.Create;
         while not eof do
           begin
             Errors.add(format('"%s"',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
             next;
           end;
        end
      else
        result := true;
    finally
      free;
    end;
  asql := format(
    'select p.name, p.type from xp_report_cgi c '+
    'join xp_report_params p on p.xp_rpt_id=c.xp_rpt_id and  coalesce(p.required,true) '+
    'where c.cgi_name=%s and p.name  in (%s) '+
    ' and p.type in (1,2) '+
    'order by fill_order,p.name ',
    [TNIDBDM.StringAsSQL(ReportName),(ids)]);
  fmt.DateSeparator:='-';
  fmt.TimeSeparator:=':';
  fmt.ShortDateFormat:='yyyy-mm-dd';
  fmt.ShortTimeFormat:='hh:nn:ss';
  with Processor.GetData(asql) do
    try
      while not eof do
        begin
          value := Arguments.Keys.Values[fieldbyname('name').AsString];
          case FieldByName('type').asInteger of
            1: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"ID"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            2: if not TryStrToInt(value,val_int) then AddToErrors(format('{name:"%s",type:"integer"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            3: if not TryStrToFloat(value,val_float) then AddToErrors(format('{name:"%s",type:"float"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            4: if not TryStrToDate(value,val_date,'yyyy-mm-dd','-') then AddToErrors(format('{name:"%s",type:"date"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            5: if not TryStrToDateTime(value,val_date,fmt) then AddToErrors(format('{name:"%s",type:"time"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            6: if not( (Value='0') or (Value='1') ) then  AddToErrors(format('{name:"%s",type:"boolean"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
            17: begin
              val_ids := SplitString(value,',');
              for i := low(val_ids) to high(val_ids) do
                if not TryStrToInt(val_ids[i],val_int) then
                  begin
                    AddToErrors(format('{name:"%s",type:"IDS"}',[TNIDBDM.StringAsJSON(FieldByName('name').AsString)]));
                    break;
                  end;
            end;
          end;
          next;
        end;
    finally
      free;
    end;
  result := not assigned(Errors);
end;

function TReportCommand.ProcessOptionValues(ParamName: string; out
  Answer: string; out RetValue: QWORD; out OptionValues: TStrings): boolean;
var
  ASQL: string;
  code,s,k,v: string;
  i,p: integer;
  d: TStringDynArray;
begin
  result := false;
  ASQL := format(
    'select  source from xp_report_params p '+
    ' join xp_report_cgi c on c.xp_rpt_id=p.xp_rpt_id '+
    'where c.cgi_name=%s and p.name=%s and p.type in (0,1,2,17) ',
    [TNIDBDM.StringAsSQL(fSubClass), TNIDBDM.StringAsSQL(ParamName)]);
  code := Processor.QueryValue(ASQL);
  if code='' then exit;
  if code[1]='(' then
    begin
      OptionValues := TStringList.Create;
      code := copy(code,2,length(code)-2);
      d := splitstring(code,',');
      for i := low(d) to high(d) do
        begin
          s:= d[i];
          p:=pos(':',s);
          if p>1 then
            begin
              k := copy(s,1,p-1);
              v := copy(s,p+1,length(s));
              OptionValues.add(format('{"id":"%s","value":"%s"}',[TNIDBDM.StringAsJSON(k),TNIDBDM.StringAsJSON(v)]));
            end
          else
            OptionValues.add(format('"%s"',[TNIDBDM.StringAsJSON(s)]));
        end;
    end
  else
  begin
  UpdateCodeWithArguments(code);
  if pos('{',code)>0 then
    begin
      result := false;
      Answer := 'недостаточно данных';
      exit;
    end;
  ASQL := code;
  OptionValues := TStringList.Create;
  if ASQL<>'' then
    with Processor.GetData(ASQL) do
      try
        while not eof do
          begin
            OptionValues.Add(format('{"id":"%d","value":"%s"}',
              [Fields[0].AsInteger, TNIDBDM.StringAsJSON(Fields[1].AsString)]));
            next;
          end;
      finally
        free;
      end;

  end;
  result := true;
end;

procedure TReportCommand.EditTemplate(OnHash: TCalcHashProc);
begin
  CreateVariablesTable;
  log(mtInfo,'Построение отчета '+ReportTitle);
  ReportProcessor.RecordID:=ReportID;
  fcurrentStage := 'исполняется (подготовка)';
  try
  Prepare;
  except on e: Exception do
    begin
      Processor.LogError(self,e,'prepare');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
  fcurrentStage := 'исполняется (настройка)';
  try
  FillVars;
  PrepareVars;
  except on e: Exception do
    begin
      Processor.LogError(self,e,'vars');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
  fcurrentStage := 'исполняется ()';
  try
  ReportProcessor.EditReport(@OnFillVariables,OnHash);
  except on e: Exception do
    begin
      Processor.LogError(self,e,'ExportReport');
      fResult := TCommandData.Create(ErrorInternal,0,'Ошибка составления',nil,[],nil);
      exit;
    end;
  end;
end;

procedure TReportCommand.FillDefaults;
var
  asql: string;
  l,e: TStrings;
begin
  asql := format(
  'select name, '+
  'case '+
  ' when type IN (1,2,3,6,17) then ''0'' '+
  ' when type=4 then ''2020-02-02'' '+
  ' when type=5 then ''2020-02-02 20:20:02'' '+
  ' when type=0 then '''' '+
  'end as value '+
  'from  xp_report_params p '+
  'where p.xp_rpt_id=%d ',
  [ReportID]);
  l := TStringList.Create;
  try
    l.add('name='+ReportName);
    with Processor.GetData(asql) do
      try
        while not eof do
          begin
            l.Add(format('%s=%s',[fieldbyname('name').asString,fieldbyname('value').asString]));
            Next;
          end;
      finally
        free;
      end;
    ParseCommand(0,0,ReportName,l,[],nil,e);
  finally
    l.free;
  end;
end;



end.