439 lines
13 KiB
ObjectPascal
439 lines
13 KiB
ObjectPascal
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
|
|
log(mtDebug,'FillVars');
|
|
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
|
|
log(mtDebug, FieldByName('name').asString);
|
|
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);
|
|
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.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);
|
|
(fileData as TMemoryStream).SaveToFile(Extractfilepath(paramstr(0))+'out/report.pdf');
|
|
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;
|
|
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;
|
|
|
|
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.
|
|
|