Browse Source

* Refactored report designer, so the report design file can be loaded using report data manager class without visual components. Default support for CSV, DBF, JSON, SQLDB

git-svn-id: trunk@38550 -
michael 7 years ago
parent
commit
62fe64dbb2

+ 5 - 0
.gitattributes

@@ -2712,6 +2712,11 @@ packages/fcl-report/src/fpreportbarcode.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportcanvashelper.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportcheckbox.inc svneol=native#text/plain
 packages/fcl-report/src/fpreportcontnr.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportdata.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportdatacsv.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportdatadbf.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportdatajson.pp svneol=native#text/plain
+packages/fcl-report/src/fpreportdatasqldb.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportdb.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportdom.pp svneol=native#text/plain
 packages/fcl-report/src/fpreportfpimageexport.pp svneol=native#text/plain

+ 41 - 0
packages/fcl-report/fpmake.pp

@@ -48,11 +48,52 @@ begin
       AddUnit('fpreportstreamer');
       AddUnit('fpreporthtmlparser');
       end;
+
+    T:=P.Targets.AddUnit('fpreportdata.pp');
+    T.ResourceStrings := True;
+    with T.Dependencies do
+      AddUnit('fpreport');
+      
+    T:=P.Targets.AddUnit('fpreportdatacsv.pp');
+    T.ResourceStrings := True;
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      AddUnit('fpreportdata');
+      end;
+
+    T:=P.Targets.AddUnit('fpreportdatadbf.pp');
+    T.ResourceStrings := True;
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      AddUnit('fpreportdata');
+      end;
+
+    T:=P.Targets.AddUnit('fpreportdatajson.pp');
+    T.ResourceStrings := True;
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      AddUnit('fpreportdata');
+      end;
+
+
+    T:=P.Targets.AddUnit('fpreportdatasqldb.pp');
+    T.ResourceStrings := True;
+    with T.Dependencies do
+      begin
+      AddUnit('fpreport');
+      AddUnit('fpreportdata');
+      end;
       
     T:=P.Targets.AddUnit('fpjsonreport.pp');
     T.ResourceStrings := True;
     with T.Dependencies do
+      begin
       AddUnit('fpreport');
+      AddUnit('fpreportdata');
+      end; 
       
     T:=P.Targets.AddUnit('fpreportjson.pp');
     T.ResourceStrings := True;

+ 99 - 1
packages/fcl-report/src/fpjsonreport.pp

@@ -20,19 +20,33 @@ unit fpjsonreport;
 interface
 
 uses
-  Classes, SysUtils, fpreport, fpjson, fpreportstreamer;
+  Classes, SysUtils, fpreport, fpjson, fpreportstreamer, fpreportdata;
 
 Type
 
   { TFPJSONReport }
+  TReadReportJSONEvent = Procedure(Sender : TObject; JSON : TJSONObject) of object;
+  TWriteReportJSONEvent = Procedure(Sender : TObject; JSON : TJSONObject) of object;
 
   TFPJSONReport = class(TFPReport)
   private
+    FDataManager: TFPCustomReportDataManager;
     FDesignTimeJSON: TJSONObject;
+    FLoadErrors: TStrings;
+    FOnReadJSON: TReadReportJSONEvent;
+    FOnWriteJSON: TWriteReportJSONEvent;
+    FDesignDataName : String;
+    function GetDesignDataName: String;
     procedure ReadReportJSON(Reader: TReader);
+    procedure SetDataManager(AValue: TFPCustomReportDataManager);
+    procedure SetDesignDataName(AValue: String);
+    function StoreDesignDataName: Boolean;
     procedure WriteReportJSON(Writer: TWriter);
   Protected
+    procedure DoReadJSON(aJSON: TJSONObject);virtual;
+    procedure DoWriteJSON(aJSON: TJSONObject);virtual;
     Procedure DefineProperties(Filer: TFiler); override;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
   Public
     Constructor Create(AOwner : TComponent); override;
     destructor Destroy; override;
@@ -42,11 +56,19 @@ Type
     Procedure SavetoJSON(aJSON : TJSONObject); virtual;
     Procedure LoadFromFile(const aFileName : String);
     Procedure SaveToFile(const aFileName : String);
+    Property LoadErrors : TStrings Read FLoadErrors;
+    Property DataManager : TFPCustomReportDataManager Read FDataManager Write SetDataManager;
+    Property DesignDataName : String Read GetDesignDataName Write SetDesignDataName Stored StoreDesignDataName;
     Property DesignTimeJSON : TJSONObject Read FDesignTimeJSON;
+    Property OnReadJSON : TReadReportJSONEvent Read FOnReadJSON Write FOnReadJSON;
+    Property OnWriteJSON : TWriteReportJSONEvent Read FOnWriteJSON Write FOnWriteJSON;
   end;
 
 implementation
 
+Const
+  DefaultDesignData = 'DesignData';
+
 Resourcestring
   SErrInvalidJSONData = 'Invalid JSON Data';
   SErrFailedToLoad = 'Failed to load report: %s';
@@ -79,6 +101,27 @@ begin
     end;
 end;
 
+procedure TFPJSONReport.SetDataManager(AValue: TFPCustomReportDataManager);
+begin
+  if FDataManager=AValue then Exit;
+  If Assigned(FDataManager) then
+    FDataManager.RemoveFreeNotification(Self);
+  FDataManager:=AValue;
+  If Assigned(FDataManager) then
+    FDataManager.FreeNotification(Self);
+end;
+
+procedure TFPJSONReport.SetDesignDataName(AValue: String);
+begin
+  if AValue=GetDesignDataName then exit;
+  FDesignDataName:=aValue;
+end;
+
+function TFPJSONReport.StoreDesignDataName: Boolean;
+begin
+  Result:=GetDesignDataName<>DefaultDesignData;
+end;
+
 procedure TFPJSONReport.WriteReportJSON(Writer: TWriter);
 
 Var
@@ -97,18 +140,55 @@ begin
   Filer.DefineProperty('ReportJSON',@ReadReportJSON,@WriteReportJSON,Assigned(FDesignTimeJSON) and (FDesignTimeJSON.Count>0));
 end;
 
+procedure TFPJSONReport.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and (AComponent=FDataManager) then
+    FDataManager:=Nil;
+end;
+
 constructor TFPJSONReport.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FDesignTimeJSON:=TJSONObject.Create;
+  FLoadErrors:=TStringList.Create;
 end;
 
 destructor TFPJSONReport.Destroy;
 begin
+  FreeAndNil(FLoadErrors);
   FreeAndNil(FDesignTimeJSON);
   inherited Destroy;
 end;
 
+Function TFPJSONReport.GetDesignDataName : String;
+
+begin
+  Result:=FDesignDataName;
+  if (FDesignDataName='') then
+    Result:=DefaultDesignData;
+end;
+
+procedure TFPJSONReport.DoReadJSON(aJSON: TJSONObject);
+
+Var
+  O : TJSONObject;
+
+begin
+  FloadErrors.Clear;
+  if Assigned(FOnReadJSON) then
+    FOnReadJSON(Self,aJSON);
+  if Assigned(FDataManager) then
+    begin
+    O:=aJSON.get(GetDesignDataName,TJSONObject(Nil));
+    if Assigned(O) then
+      begin
+      FDataManager.LoadFromJSON(O);
+      FDataManager.ApplyToReport(Self,LoadErrors);
+      end;
+    end;
+end;
+
 procedure TFPJSONReport.LoadFromJSON(aJSON: TJSONObject);
 
 Var
@@ -117,6 +197,7 @@ Var
 
 begin
   N:=Name;
+  DoReadJSON(aJSON);
   R:=TFPReportJSONStreamer.Create(Nil);
   try
     R.OwnsJSON:=False;
@@ -128,12 +209,29 @@ begin
   end;
 end;
 
+procedure TFPJSONReport.DoWriteJSON(aJSON: TJSONObject);
+
+Var
+   O: TJSONObject;
+
+begin
+  if Assigned(FDataManager) then
+    begin
+    O:=TJSONObject.Create();
+    aJSON.Add(GetDesignDataName,O);
+    FDataManager.SaveToJSON(O);
+    end;
+  if Assigned(FOnWriteJSON) then
+    FOnWriteJSON(Self,aJSON);
+end;
+
 procedure TFPJSONReport.SavetoJSON(aJSON: TJSONObject);
 
 Var
   R : TFPReportJSONStreamer;
 
 begin
+  DoWriteJSON(aJSON);
   R:=TFPReportJSONStreamer.Create(Nil);
   try
     R.OwnsJSON:=False;

+ 8 - 1
packages/fcl-report/src/fpreport.pp

@@ -1615,6 +1615,14 @@ type
     property OnEndReport;
   end;
 
+  TFPReportCustomDataManager = Class(TComponent)
+  Public
+    procedure WriteElement(AWriter: TFPReportStreamer); virtual; abstract;
+    procedure ReadElement(AReader: TFPReportStreamer); virtual; abstract;
+    Procedure ApplyToReport(aReport : TFPCustomReport; AErrors: TStrings); virtual; abstract;
+    Procedure RemoveFromReport(aReport : TFPCustomReport); virtual; abstract;
+  end;
+
 
   { TFPReportLayouter }
   TOverFlowAction = (oaNone,oaBandWithChilds,oaSingleBand);
@@ -2124,7 +2132,6 @@ type
     property    Items[AIndex: Integer]: TFPReportCustomBand read GetItems write SetItems; default;
   end;
 
-
   { TFPReportExportManager }
 
   TFPReportExportManager = Class(TComponent)

+ 723 - 0
packages/fcl-report/src/fpreportdata.pp

@@ -0,0 +1,723 @@
+unit fpreportdata;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DB, fpjson, fpreport, fpreportdb;
+
+Type
+  EReportDataError = class(EReportError);
+
+  { TFPReportDataHandler }
+
+  TFPReportDataHandler = Class(TObject)
+  Public
+    Class Procedure RegisterHandler;
+    Class Procedure UnRegisterHandler;
+    Class Procedure RegisterConfigClass(aClass : TComponentClass);
+    // Override this to return a dataset which is owned by AOwner, and configured by AConfig.
+    // The dataset must not be opened.
+    Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; virtual; abstract;
+    // Check if the configuration is valid. Return a string that describes the error(s)
+    // If the return is an empty string, the data designer will not close.
+    Class Function CheckConfig(AConfig : TJSONObject) : String; virtual;
+    // Configuration component. This is normally a visual class.
+    Class Function ConfigFrameClass : TComponentClass; virtual;
+    Class Function DataType : String; virtual; abstract;
+    Class Function DataTypeDescription : String; virtual;
+  end;
+  TFPReportDataHandlerClass = Class of TFPReportDataHandler;
+
+  { TFPReportDataDefinitionItem }
+
+  TFPReportDataDefinitionItem = Class(TCollectionItem)
+  private
+    FConfig: TJSONObject;
+    FDataType: String;
+    FName: String;
+    FReportData: TFPReportDatasetData;
+    FRunReportDataItem: TFPReportDataItem;
+    function GetJSONConfig: TJSONStringType;
+    procedure SetConfig(AValue: TJSONObject);
+    procedure SetJSONConfig(AValue: TJSONStringType);
+    procedure SetName(AValue: String);
+  Protected
+    // To hold temporary references
+    Property RunReportData : TFPReportDatasetData Read FReportData Write FReportData;
+    Property RunReportDataItem : TFPReportDataItem Read FRunReportDataItem Write FRunReportDataItem;
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source : TPersistent); override;
+    Procedure SaveToJSON(O : TJSONObject); virtual;
+    procedure LoadFromJSON(O: TJSONObject); virtual;
+    // Clone this
+    Function Clone(aNewName : String) : TFPReportDataDefinitionItem;
+    // Create a dataset.
+    Function CreateDataSet(AOwner : TComponent) : TDataset;
+    // Check if the configuration is OK.
+    Function Check : String;
+    Property Config : TJSONObject Read FConfig Write SetConfig;
+  Published
+    property Name : String Read FName Write SetName;
+    Property DataType : String Read FDataType Write FDataType;
+    Property JSONConfig : TJSONStringType Read GetJSONConfig Write SetJSONConfig;
+  end;
+
+  { TFPReportDataDefinitions }
+
+  TFPReportDataDefinitions = Class(TCollection)
+  private
+    function GetD(Aindex : Integer): TFPReportDataDefinitionItem;
+    procedure SetD(Aindex : Integer; AValue: TFPReportDataDefinitionItem);
+  Public
+    Function IndexOfRunData(aData : TFPReportDatasetData) : integer;
+    Function IndexOfName(const aName : String): Integer;
+    Function FindDataByName(const aName : String): TFPReportDataDefinitionItem;
+    Function AddData(const aName : String) : TFPReportDataDefinitionItem;
+    Procedure SaveToJSON(O : TJSONObject);
+    Procedure LoadFromJSON(O : TJSONObject);
+    Property Data [Aindex : Integer] : TFPReportDataDefinitionItem Read GetD Write SetD; default;
+  end;
+
+  { TFPCustomReportDataManager }
+
+  TFPCustomReportDataManager = class(TComponent)
+  private
+    Class Var
+      FTypesList : TStrings;
+    Type
+      { THDef }
+
+      THDef = Class(TObject)
+        TheClass : TFPReportDataHandlerClass;
+        TheConfigClass : TComponentClass;
+        Constructor Create(aClass : TFPReportDataHandlerClass; aConfigClass : TComponentClass);
+      end;
+    procedure ClearReportDatasetReference(aDataset: TFPReportDatasetData);
+    Class Function FindDef(aDataType: String) : THDef;
+    Class Function GetDef(aDataType: String) : THDef;
+  Private
+    FDataParent: TComponent;
+    FMyParent : TComponent;
+    FDefinitions: TFPReportDataDefinitions;
+    FReport: TFPReport;
+    procedure SetDataParent(AValue: TComponent);
+    procedure SetDefinitions(AValue: TFPReportDataDefinitions);
+    procedure SetReport(AValue: TFPReport);
+  Protected
+    Class Function TypeList : TStrings;
+    Class procedure RemoveHandler(aDataType: String);
+    Class Procedure RegisterHandler(aClass: TFPReportDataHandlerClass); virtual;
+    Class Procedure UnRegisterHandler(aClass: TFPReportDataHandlerClass); virtual;
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    Function CreateDataDefinitions : TFPReportDataDefinitions; virtual;
+    Function GetDatasetParent : TComponent;
+    Property DataDefinitions : TFPReportDataDefinitions Read FDefinitions Write SetDefinitions;
+  Public
+    Class Function GetRegisteredTypes(AList : Tstrings) : Integer;
+    Class Procedure RegisterConfigFrameClass(aTypeName : String; aClass : TComponentClass);
+    Class Procedure UnRegisterConfigFrameClass(aTypeName : String);
+    Class Function GetTypeHandlerClass(aTypeName : String) : TFPReportDataHandlerClass;
+    Class Function GetTypeHandler(aTypeName : String) : TFPReportDataHandler;
+    Class Function GetConfigFrameClass(aTypeName : String) : TComponentClass;
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure SaveToJSON(O : TJSONObject);
+    Procedure LoadFromJSON(O : TJSONObject);
+    procedure RemoveFromReport(aReport: TFPReport);virtual;
+    procedure RemoveFromReport;
+    procedure ApplyToReport(aReport: TFPReport; Errors: TStrings); virtual;
+    Procedure ApplyToReport(Errors : TStrings);
+    Property Report : TFPReport Read FReport Write SetReport;
+    Property DataParent : TComponent Read FDataParent Write SetDataParent;
+  end;
+
+  TFPReportDataManager = Class(TFPCustomReportDataManager)
+  Public
+    Property DataDefinitions;
+  end;
+
+Resourcestring
+  SErrDuplicateData = 'Duplicate data set name: "%s"';
+  SErrInvalidDataName = 'Invalid data set name: "%s"';
+  SErrNeedName = 'Data set needs a name';
+  SErrNeedDataType = 'Data set needs a type';
+  SErrInvalidDataType = 'Invalid data type: "%s"';
+  SErrInvalidJSONConfig = '%s: Invalid JSON Configuration';
+  SErrUnknownDataType =   'Unknown report data type: %s';
+
+
+implementation
+
+Const
+  DatasetNamePrefix = '__DS__';
+
+{ TFPCustomReportDataManager }
+
+procedure TFPCustomReportDataManager.SetDefinitions(AValue: TFPReportDataDefinitions);
+begin
+  if FDefinitions=AValue then Exit;
+  FDefinitions.Assign(AValue);
+end;
+
+procedure TFPCustomReportDataManager.SetDataParent(AValue: TComponent);
+begin
+  if FDataParent=AValue then Exit;
+  If Assigned(FDataParent) then
+    FDataParent.RemoveFreeNotification(Self);
+  FDataParent:=AValue;
+  If Assigned(FDataParent) then
+    FDataParent.FreeNotification(Self);
+  FreeAndNil(FMyParent);
+end;
+
+class function TFPCustomReportDataManager.FindDef(aDataType: String): THDef;
+
+var
+  I : Integer;
+
+begin
+  I:=TypeList.IndexOf(aDataType);
+  if (I<>-1) then
+    Result:=TypeList.Objects[i] as THDef
+  else
+    Result:=Nil;
+end;
+
+class function TFPCustomReportDataManager.GetDef(aDataType: String): THDef;
+begin
+  Result:=FindDef(aDataType);
+  if Result=Nil then
+    Raise EReportDataError.CreateFmt(SErrUnknownDataType,[aDataType]);
+end;
+
+procedure TFPCustomReportDataManager.SetReport(AValue: TFPReport);
+begin
+  if FReport=AValue then Exit;
+  If Assigned(FReport) then
+    FReport.RemoveFreeNotification(Self);
+  FReport:=AValue;
+  If Assigned(FReport) then
+    FReport.FreeNotification(Self);
+end;
+
+class procedure TFPCustomReportDataManager.RegisterHandler(aClass: TFPReportDataHandlerClass);
+
+Var
+  N : String;
+  C : TComponentClass;
+
+begin
+  N:=aClass.DataType;
+  RemoveHandler(N);
+  C:=aClass.ConfigFrameClass;
+  TypeList.AddObject(N, THDef.Create(aClass,C));
+end;
+
+class procedure TFPCustomReportDataManager.RemoveHandler(aDataType : String);
+
+Var
+  I : Integer;
+  O : TObject;
+
+begin
+  I:=TypeList.IndexOf(aDataType);
+  if (I<>-1) then
+    begin
+    O:=TypeList.Objects[i];
+    TypeList.Delete(I);
+    O.Free;
+    end;
+end;
+
+class procedure TFPCustomReportDataManager.UnRegisterHandler(aClass: TFPReportDataHandlerClass);
+
+begin
+  RemoveHandler(aClass.DataType);
+end;
+
+procedure TFPCustomReportDataManager.ClearReportDatasetReference(aDataset : TFPReportDatasetData);
+
+Var
+  I : Integer;
+
+begin
+  if Assigned(FDefinitions) then
+    begin
+    I:=FDefinitions.IndexOfRunData(aDataset);
+    if (I<>-1) then
+      FDefinitions[i].RunReportData:=nil;
+    end;
+end;
+
+procedure TFPCustomReportDataManager.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if Operation=opRemove then
+    begin
+    if AComponent=FDataParent then
+      FDataParent:=Nil
+    else if AComponent=FReport then
+      FReport:=Nil
+    else if (aComponent is TFPReportDatasetData) then
+      ClearReportDatasetReference(aComponent as TFPReportDatasetData);
+    end;
+end;
+
+Class function TFPCustomReportDataManager.TypeList: TStrings;
+
+Var
+  SL : TStringList;
+
+begin
+  If (FTypesList=nil) then
+    begin
+    SL:=TStringList.Create;
+    SL.Sorted:=True;
+    SL.Duplicates:=dupError;
+    SL.OwnsObjects:=True;
+    FTypesList:=SL;
+    end;
+  Result:=FTypesList;
+end;
+
+function TFPCustomReportDataManager.CreateDataDefinitions: TFPReportDataDefinitions;
+begin
+  Result:=TFPReportDataDefinitions.Create(TFPReportDataDefinitionItem);
+end;
+
+function TFPCustomReportDataManager.GetDatasetParent: TComponent;
+begin
+  Result:=FDataParent;
+  if Result=Nil then
+    begin
+    If (FMyParent=Nil) then
+      FMyParent:=TComponent.Create(Nil);
+    Result:=FMyParent;
+    end;
+end;
+
+constructor TFPCustomReportDataManager.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDefinitions:=CreateDataDefinitions;
+end;
+
+destructor TFPCustomReportDataManager.Destroy;
+begin
+  FreeAndNil(FDefinitions);
+  FreeAndNil(FMyParent);
+  inherited Destroy;
+end;
+
+procedure TFPCustomReportDataManager.SaveToJSON(O: TJSONObject);
+begin
+  DataDefinitions.SaveToJSON(O);
+end;
+
+procedure TFPCustomReportDataManager.LoadFromJSON(O: TJSONObject);
+begin
+  DataDefinitions.LoadFromJSON(O);
+end;
+
+
+procedure TFPCustomReportDataManager.RemoveFromReport(aReport: TFPReport);
+
+Var
+  DD : TFPReportDataDefinitionItem;
+  RD : TFPReportDatasetData;
+  D : TDataset;
+  I : Integer;
+
+begin
+  For I:=0 to DataDefinitions.Count-1 do
+    begin
+    DD:=DataDefinitions[i];
+    RD:=DD.RunReportData;
+    if (RD<>Nil) then
+      if (aReport.ReportData.IndexOfReportData(RD)<>-1) then
+        begin
+        D:=RD.Dataset;
+        FreeAndNil(D);
+        FreeAndNil(RD); // Should nil due to freenotification...
+        DD.RunReportData:=Nil;
+        end;
+    end;
+end;
+
+procedure TFPCustomReportDataManager.RemoveFromReport;
+begin
+  RemoveFromReport(FReport);
+end;
+
+procedure TFPCustomReportDataManager.ApplyToReport(Errors: TStrings);
+
+begin
+  ApplyToReport(FReport,Errors);
+end;
+
+procedure TFPCustomReportDataManager.ApplyToReport(aReport : TFPReport; Errors: TStrings);
+
+
+Var
+  I : Integer;
+  DesignD : TFPReportDataDefinitionItem;
+  DatasetD : TFPReportDatasetData;
+  L : TFPList;
+  P : TComponent;
+
+begin
+  RemoveFromReport(aReport);
+  P:=GetDatasetParent;
+  aReport.SaveDataToNames;
+  aReport.ReportData.Clear;
+  For I:=0 to DataDefinitions.Count-1 do
+    begin
+    DesignD:=DataDefinitions[i];
+    DatasetD:=TFPReportDatasetData.Create(P);
+    DesignD.RunReportData:=DatasetD;
+    DatasetD.FreeNotification(Self);
+    DatasetD.Dataset:=DesignD.CreateDataSet(P);
+    Try
+      DatasetD.InitFieldDefs;
+    except
+      On E : Exception do
+        If Assigned(Errors) then
+          Errors.Add(Format('Error opening data "%s" : Exception %s with message %s',[DesignD.Name,E.ClassName,E.Message]))
+        else
+          Raise;
+    end;
+    DatasetD.Name:=DesignD.Name;
+    DatasetD.Dataset.Name:=DatasetNamePrefix+DesignD.Name;
+    DatasetD.StartDesigning;    // set designing flag, or OI will not show reference to it.
+    DesignD.RunReportDataItem:=aReport.ReportData.AddReportData(DatasetD);
+    end;
+end;
+
+class function TFPCustomReportDataManager.GetRegisteredTypes(AList: Tstrings): Integer;
+begin
+  // Don't use assign or addstrings, it will copy the THRefs too, possibly leading to errors
+  AList.Text:=TypeList.Text;
+  Result:=AList.Count;
+end;
+
+class procedure TFPCustomReportDataManager.RegisterConfigFrameClass(aTypeName: String; aClass: TComponentClass);
+
+Var
+  H : THDef;
+
+begin
+  H:=GetDef(aTypeName);
+  H.TheConfigClass:=aClass;
+end;
+
+class procedure TFPCustomReportDataManager.UnRegisterConfigFrameClass(aTypeName: String);
+
+Var
+  H : THDef;
+
+begin
+  H:=FindDef(aTypeName);
+  if Assigned(H) then
+    H.TheConfigClass:=Nil;
+end;
+
+class function TFPCustomReportDataManager.GetTypeHandlerClass(aTypeName: String): TFPReportDataHandlerClass;
+
+Var
+  H : THDef;
+
+begin
+  H:=GetDef(aTypeName);
+  Result:=H.TheClass;
+end;
+
+class function TFPCustomReportDataManager.GetTypeHandler(aTypeName: String): TFPReportDataHandler;
+
+begin
+  Result:=GetTypeHandlerClass(aTypeName).Create;
+end;
+
+class function TFPCustomReportDataManager.GetConfigFrameClass(aTypeName: String): TComponentClass;
+
+Var
+  H : THDef;
+
+begin
+  H:=GetDef(aTypeName);
+  Result:=H.TheConfigClass;
+end;
+
+{ THDef }
+
+constructor TFPCustomReportDataManager.THDef.Create(aClass: TFPReportDataHandlerClass; aConfigClass : TComponentClass);
+
+begin
+  TheClass:=AClass;
+  TheConfigClass:=aConfigClass;
+end;
+
+{ TFPReportDataDefinitions }
+
+function TFPReportDataDefinitions.GetD(Aindex : Integer): TFPReportDataDefinitionItem;
+begin
+  Result:=Items[Aindex] as TFPReportDataDefinitionItem;
+end;
+
+procedure TFPReportDataDefinitions.SetD(Aindex : Integer; AValue: TFPReportDataDefinitionItem);
+begin
+  Items[Aindex]:=AValue;
+end;
+
+function TFPReportDataDefinitions.IndexOfRunData(aData: TFPReportDatasetData): integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (GetD(Result).RunReportData<>aData) do
+    Dec(Result);
+end;
+
+function TFPReportDataDefinitions.IndexOfName(const aName: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (CompareText(AName,GetD(Result).Name)<>0) do
+    Dec(Result);
+end;
+
+function TFPReportDataDefinitions.FindDataByName(const aName: String): TFPReportDataDefinitionItem;
+
+var
+  I : Integer;
+
+begin
+  I:=indexOfname(aName);
+  if I=-1 then
+    Result:=Nil
+  else
+    Result:=GetD(I);
+end;
+
+function TFPReportDataDefinitions.AddData(const aName: String): TFPReportDataDefinitionItem;
+
+begin
+  if (IndexOfName(aName)<>-1) then
+    raise EReportError.CreateFmt(SErrDuplicateData, [aName]);
+  Result:=add as TFPReportDataDefinitionItem;
+  Result.Name:=aName;
+end;
+
+procedure TFPReportDataDefinitions.SaveToJSON(O: TJSONObject);
+
+Var
+  A : TJSONArray;
+  DS : TJSONObject;
+  I : Integer;
+
+begin
+  A:=TJSONArray.Create;
+  O.Add('datasets',a);
+  For I:=0 to Count-1 do
+    begin
+    DS:=TJSONObject.Create;
+    A.Add(DS);
+    Data[i].SaveToJSON(DS);
+    end;
+end;
+
+procedure TFPReportDataDefinitions.LoadFromJSON(O: TJSONObject);
+Var
+  A : TJSONArray;
+  DS : TFPReportDataDefinitionItem;
+  I : Integer;
+
+begin
+  Clear;
+  A:=O.Get('datasets',TJSONArray(Nil));
+  if Assigned(A) then
+    For I:=0 to A.Count-1 do
+      if A.Types[i]=jtObject then
+        begin
+        DS:=Add as TFPReportDataDefinitionItem;
+        DS.LoadFromJSON(A.Objects[i]);
+        end;
+end;
+
+
+
+class procedure TFPReportDataHandler.RegisterHandler;
+begin
+  TFPCustomReportDataManager.RegisterHandler(Self);
+end;
+
+class procedure TFPReportDataHandler.UnRegisterHandler;
+
+begin
+  TFPCustomReportDataManager.UnRegisterHandler(Self);
+end;
+
+class procedure TFPReportDataHandler.RegisterConfigClass(aClass: TComponentClass);
+begin
+  TFPCustomReportDataManager.RegisterConfigFrameClass(DataType,aClass);
+end;
+
+
+
+class function TFPReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
+begin
+  Result:='';
+end;
+
+class function TFPReportDataHandler.ConfigFrameClass: TComponentClass;
+begin
+  Result:=Nil;
+end;
+
+class function TFPReportDataHandler.DataTypeDescription: String;
+begin
+  Result:=DataType
+end;
+
+{ TFPReportDataDefinitionItem }
+
+procedure TFPReportDataDefinitionItem.SetConfig(AValue: TJSONObject);
+begin
+  if FConfig=AValue then Exit;
+  FreeAndNil(FConfig);
+  FConfig:=AValue.Clone as TJSONObject;
+end;
+
+function TFPReportDataDefinitionItem.GetJSONConfig: TJSONStringType;
+begin
+  Result:=FConfig.AsJSON;
+end;
+
+procedure TFPReportDataDefinitionItem.SetJSONConfig(AValue: TJSONStringType);
+
+Var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aValue);
+  if D is TJSONObject then
+    begin
+    FreeAndNil(FConfig);
+    FConfig:=D as TJSONObject;
+    end
+  else
+    begin
+    FreeAndNil(D);
+    Raise EReportDataError.CreateFmt(SErrInvalidJSONConfig,[Name]);
+    end;
+end;
+
+procedure TFPReportDataDefinitionItem.SetName(AValue: String);
+begin
+  if FName=AValue then Exit;
+  {$IF FPC_FULLVERSION < 30002}
+  if Not IsValidIdent(aValue) then
+  {$ELSE}
+  if Not IsValidIdent(aValue,True,true) then
+  {$ENDIF}
+    raise EReportDataError.CreateFmt(SErrInvalidDataName, [aValue]);
+  if (Collection is TFPReportVariables) then
+    If ((Collection as TFPReportVariables).FindVariable(AValue)<>Nil) then
+      raise EReportDataError.CreateFmt(SErrDuplicateData, [aValue]);
+  FName:=AValue;
+end;
+
+procedure TFPReportDataDefinitionItem.Assign(Source: TPersistent);
+
+Var
+  D : TFPReportDataDefinitionItem;
+begin
+  if (Source is TFPReportDataDefinitionItem) then
+    begin
+    D:=Source as TFPReportDataDefinitionItem;
+    Config:=D.Config;
+    Name:=D.Name;
+    DataType:=D.DataType;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+procedure TFPReportDataDefinitionItem.SaveToJSON(O: TJSONObject);
+begin
+  O.Add('name',Name);
+  O.Add('type',DataType);
+  O.Add('config',Config.Clone);
+end;
+
+procedure TFPReportDataDefinitionItem.LoadFromJSON(O: TJSONObject);
+
+Var
+  C : TJSONObject;
+
+begin
+  Name:=O.Get('name',Name);
+  DataType:=O.Get('type',DataType);
+  C:=O.Get('config',TJSONObject(Nil));
+  if Assigned(C) then
+    Config:=C;
+end;
+
+function TFPReportDataDefinitionItem.Clone(aNewName: String): TFPReportDataDefinitionItem;
+begin
+  Result:=Collection.Add as TFPReportDataDefinitionItem;
+  Result.Assign(Self);
+  Result.Name:=aNewName;
+end;
+
+function TFPReportDataDefinitionItem.CreateDataSet(AOwner: TComponent): TDataset;
+
+Var
+  H : TFPReportDataHandler;
+
+begin
+  H:=TFPCustomReportDataManager.GetTypeHandler(DataType);
+  try
+    Result:=H.CreateDataset(AOwner,Config);
+  finally
+    H.Free;
+  end;
+end;
+
+
+function TFPReportDataDefinitionItem.Check: String;
+
+Var
+  H : TFPReportDataHandler;
+
+begin
+  If (Name='') then
+    Result:=SErrNeedName
+  else if (DataType='') then
+    Result:=SErrNeedDataType
+  else
+    begin
+    H:=TFPCustomReportDataManager.GetTypeHandler(DataType);
+    if H=Nil then
+      Result:=Format(SErrInvalidDataType,[DataType])
+    else
+      Result:=H.CheckConfig(Config);
+    end;
+end;
+
+constructor TFPReportDataDefinitionItem.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FConfig:=TJSONObject.Create;
+end;
+
+destructor TFPReportDataDefinitionItem.Destroy;
+begin
+  FreeAndNil(FConfig);
+  inherited Destroy;
+end;
+
+Finalization
+  FreeAndNil(TFPCustomReportDataManager.FTypesList);
+end.
+

+ 122 - 0
packages/fcl-report/src/fpreportdatacsv.pp

@@ -0,0 +1,122 @@
+unit fpreportdatacsv;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, bufdataset, csvdataset, fpjson, fpreportdata;
+
+Const
+  keyFileName = 'filename';
+  keyFirstLineHasFieldNames = 'firstLineHasFieldNames';
+  keyCustomFieldNames = 'customFieldNames';
+  keyDelimiter = 'delimiter';
+  keyQuoteChar = 'quoteChar';
+
+  DefFirstLineFieldNames = True;
+  DefDelimiter = ',';
+  DefQuoteChar = '"';
+
+Type
+  TCSVReportDataHandler = Class(TFPReportDataHandler)
+    Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
+    Class Function CheckConfig(AConfig: TJSONObject): String; override;
+    Class Function DataType : String; override;
+    Class Function DataTypeDescription : String; override;
+  end;
+
+Resourcestring
+  SFileNameDoesNotExist = 'Filename does not exist: "%s"';
+  SErrNeedFileName = 'Need a CSV file name';
+
+implementation
+
+
+{ TCSVReportDataHandler }
+
+Type
+
+  { TMyCSVDataset }
+
+  TMyCSVDataset = Class(TCSVDataset)
+  private
+    FCSVFileName: String;
+  Protected
+    function GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader; override;
+    Procedure InternalOpen; override;
+  Public
+    Property CSVFileName : String Read FCSVFileName Write FCSVFileName;
+  end;
+
+
+{ TMyCSVDataset }
+
+function TMyCSVDataset.GetPacketReader(const Format: TDataPacketFormat; const AStream: TStream): TDataPacketReader;
+begin
+  Result:=inherited GetPacketReader(Format, AStream);
+  if (Result is TCSVDataPacketReader) and (FieldDefs.Count>0) then
+     TCSVDataPacketReader(Result).CreateFieldDefs:=FieldDefs;
+end;
+
+procedure TMyCSVDataset.InternalOpen;
+
+begin
+  FileName:=CSVFileName;
+  Inherited;
+  FileName:='';
+end;
+
+function TCSVReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
+
+Var
+  C : TMyCSVDataset;
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  C:=TMyCSVDataset.Create(AOWner);
+  C.CSVOptions.FirstLineAsFieldNames:=AConfig.Get(keyFirstLineHasFieldNames,DefFirstLineFieldNames);
+  C.CSVOptions.Delimiter:=AConfig.Get(KeyDelimiter,defDelimiter)[1];
+  C.CSVOptions.quoteChar:=AConfig.Get(KeyQuoteChar,defQuoteChar)[1];
+  if not C.CSVOptions.FirstLineAsFieldNames then
+    begin
+    A:=AConfig.Get(keyCustomFieldNames,TJSONArray(Nil));
+    If Assigned(A) then
+      For I:=0 to A.Count-1 do
+        C.FieldDefs.Add(A.Strings[i],ftString,255);
+    end;
+  C.ReadOnly:=True;
+  C.CSVFileName:=AConfig.Get(KeyFileName,'');
+  Result:=C;
+end;
+
+class function TCSVReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
+
+Var
+  FN : UTF8String;
+
+begin
+  Result:='';
+  FN:=AConfig.Get(KeyFileName,'');
+  if FN='' then
+    Result:=SErrNeedFileName
+  else if not FileExists(FN) then
+    Result:=Format(SFileNameDoesNotExist,[FN]);
+end;
+
+class function TCSVReportDataHandler.DataType: String;
+begin
+  Result:='CSV'
+end;
+
+class function TCSVReportDataHandler.DataTypeDescription: String;
+begin
+  Result:='Comma-separated values text file';
+end;
+
+
+initialization
+  TCSVReportDataHandler.RegisterHandler;
+end.
+

+ 67 - 0
packages/fcl-report/src/fpreportdatadbf.pp

@@ -0,0 +1,67 @@
+unit fpreportdatadbf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, dbf, fpjson, fpreportdata;
+
+
+Const
+  keyFileName = 'filename';
+
+Type
+  TDBFReportDataHandler = Class(TFPReportDataHandler)
+    Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
+    Class Function CheckConfig(AConfig: TJSONObject): String; override;
+    Class Function DataType : String; override;
+    Class Function DataTypeDescription : String; override;
+  end;
+
+Resourcestring
+  SErrNeedFileName = 'Need a DBF file name';
+  SFileNameDoesNotExist = 'Filename does not exist: "%s"';
+
+implementation
+
+function TDBFReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
+
+Var
+  C : TDBF;
+
+begin
+  C:=TDBF.Create(AOWner);
+  C.TableName:=AConfig.Get(KeyFileName,'');
+  C.ReadOnly:=True;
+  Result:=C;
+end;
+
+class function TDBFReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
+
+Var
+  FN : UTF8String;
+
+begin
+  Result:='';
+  FN:=AConfig.Get(KeyFileName,'');
+  if FN='' then
+    Result:=SErrNeedFileName
+  else if not FileExists(FN) then
+    Result:=Format(SFileNameDoesNotExist,[FN]);
+end;
+
+class function TDBFReportDataHandler.DataType: String;
+begin
+  Result:='DBF'
+end;
+
+class function TDBFReportDataHandler.DataTypeDescription: String;
+begin
+  Result:='DBase data file';
+end;
+
+initialization
+  TDBFReportDataHandler.RegisterHandler;
+end.
+

+ 457 - 0
packages/fcl-report/src/fpreportdatajson.pp

@@ -0,0 +1,457 @@
+unit fpreportdatajson;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, db, fpjsondataset, fpjson, fpreportdata;
+
+{ TDBFReportDataFrame }
+
+Const
+  keyFileName  = 'filename';
+  keyMetaData  = 'meta';
+  keyURL       = 'url';
+  keyDataForm  = 'dataform';
+  keyDataPath  = 'path';
+  keyFields    = 'fields';
+  keyFieldType = 'type';
+  keyFieldName = 'name';
+
+
+Type
+  TJSONReportDataHandler = Class(TFPReportDataHandler)
+    Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
+    Class Function CheckConfig(AConfig: TJSONObject): String; override;
+    Class Function DataType : String; override;
+    Class Function DataTypeDescription : String; override;
+    Class Function GetDataFromFile(aFileName : String) : TJSONData;
+    Class Function GetDataFromURL(aURL : String) : TJSONData;
+  end;
+
+Type
+  TDataForm = (dfObject,dfArray);
+
+  { TMyJSONDataset }
+
+  TMyJSONDataset = class(TBaseJSONDataSet)
+  private
+    FDataForm: TDataForm;
+    FDataPath: String;
+    FFileNAme: String;
+    FMaxStringFieldSize: Integer;
+    FURL: String;
+    FJSON : TJSONData;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    procedure InternalClose; override;
+    Procedure InternalOpen; override;
+    Procedure MetaDataToFieldDefs; override;
+    Function CreateFieldMapper : TJSONFieldMapper; override;
+    property DataForm : TDataForm Read FDataForm Write FDataForm;
+    Property MetaData;
+    Property FileName : String Read FFileNAme Write FFileName;
+    Property URL : String Read FURL Write FURL;
+    Property DataPath : String Read FDataPath Write FDataPath;
+    Property MaxStringFieldSize : Integer Read FMaxStringFieldSize Write FMaxStringFieldSize;
+  end;
+
+  TMyJSONObjectFieldMapper = Class(TJSONFieldMapper)
+    procedure SetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row,Data : TJSONData); override;
+    Function GetJSONDataForField(Const FieldName : String; FieldIndex : Integer; Row : TJSONData) : TJSONData; override;
+    Function CreateRow : TJSONData; override;
+  end;
+
+Type
+  TRecordDesc = Record
+    name : string;
+    fieldtype : TFieldType;
+  end;
+  TRecordDescArray = Array of TRecordDesc;
+
+Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
+Function FieldTypeToString(Ft : TFieldType; Strict : Boolean) : String;
+Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
+
+Resourcestring
+  SErrNeedFileNameOrURL = 'Need a file name or URL';
+  SErrNeedFileName = 'Need a file name';
+  SErrNeedURL = 'Need a URL';
+  SErrNeedFields = 'No fields have been defined';
+  SErrFileNameDoesNotExist = 'Filename does not exist: "%s"';
+  SErrInvalidProtocol = 'URL has invalid protocol: "%s". Only http and https are supported';
+  SErrNotArrayData = 'Data at "%s" does not exist or is not an array.';
+  SErrNoDataFound = 'JSON data was found, but no valid data structure was detected.';
+  SErrUnsupportedJSONFieldType = 'Unsupported JSON field type: "%s"';
+  SErrEmptyFieldsNotAllowed = 'Empty fields are not allowed (field: %d)';
+
+implementation
+
+uses typinfo,jsonparser,uriparser, fphttpclient;
+
+Function FieldTypeToString(Ft : TFieldType; Strict : Boolean) : String;
+
+begin
+  Case FT of
+   ftstring : Result:='string';
+   ftBoolean : Result:='boolean';
+   ftInteger : Result:='integer';
+   ftLargeint : Result:='largeint';
+   ftFloat : Result:='float';
+ else
+   if Strict then
+     Raise EDatabaseError.CreateFmt(SErrUnsupportedJSONFieldType,[GetEnumName(TypeInfo(TFieldType),Ord(FT))]);
+   result:='string';
+ end;
+end;
+
+Function TryStringToFieldType(S : String; out Ft : TFieldType; Strict : Boolean) : Boolean;
+
+begin
+  Result:=True;
+  Case lowercase(s) of
+   'string' : ft:=ftstring;
+   'boolean': ft:=ftBoolean;
+   'integer': ft:=ftInteger;
+   'bigint' : ft:=ftLargeint;
+   'largeint' : ft:=ftLargeint ;
+   'float' : ft:=ftFloat;
+  else
+    if Strict then
+      Result:=False
+    else
+      ft:=ftString;
+  end;
+end;
+
+Function DetectJSONStruct(J : TJSONData; StartPath : String; Out APath : String; Out Records : TRecordDescArray; Out ArrayBased : Boolean) : Boolean;
+
+Var
+  A : TJSONArray;
+  D : TJSONData;
+  O : TJSONObject;
+  I,C : Integer;
+
+begin
+  J:=J.FindPath(StartPath);
+  A:=Nil;
+  if J is TJSONArray then
+    begin
+    APath:=StartPath;
+    A:=J as TJSONArray;
+    end
+  else
+    begin
+    If J is TJSONObject then
+      begin
+      O:=J as TJSONObject;
+      I:=0;
+      While (A=Nil) and (I<J.Count) do
+        begin
+        If J.Items[i].JSONType=jtArray then
+          begin
+          A:= J.Items[i] as TJSONArray;
+          APath:=O.Names[I];
+          If StartPath<>'' then
+            APath:=StartPath+'.'+APath;
+          end;;
+        Inc(I);
+        end;
+      end;
+    end;
+  Result:=Assigned(A) and (A.Count>0) and (A.Items[0].JSONType in [jtArray,jtObject]);
+  if Result then
+    begin
+    D:=A.items[0];
+    if D is TJSONObject then
+      O:=D as TJSONObject
+    else
+      O:=Nil;
+    ArrayBased:=O=Nil;
+    SetLength(Records,D.Count);
+    C:=0;
+    for I:=0 to D.Count-1 do
+      begin
+      Records[C].FieldType:=ftUnknown;
+      Case D.Items[C].JSONType of
+        jtString : Records[C].FieldType:=ftString;
+        jtNumber :
+          Case TJSONNumber(D.Items[C]).NumberType of
+            ntFloat:  Records[C].fieldtype:=ftFloat;
+            ntInteger:  Records[C].fieldtype:=ftInteger;
+          else
+            Records[C].fieldtype:=ftLargeInt;
+          end;
+        jtBoolean :  Records[C].fieldtype:=ftBoolean;
+        jtNull : Records[C].fieldtype:=ftString;
+      end;
+      if (Records[C].FieldType<>ftUnknown) then
+        begin
+        if Assigned(O) then
+          Records[C].Name:=O.Names[i]
+        else
+          Records[C].Name:='Column'+IntToStr(I);
+        Inc(C);
+        end;
+      end;
+    SetLength(Records,C);
+    end
+  else  If J is TJSONObject then
+    begin
+    // Check members one by one
+    O:=J as TJSONObject;
+    I:=0;
+    While Not result and (I<J.Count) do
+      begin
+      If J.Items[i].JSONType=jtObject then
+        begin
+        Result:=DetectJSONStruct(J,O.Names[I],APath,Records,ArrayBased);
+        end;
+      Inc(I);
+      end;
+    end;
+end;
+
+
+procedure TMyJSONObjectFieldMapper.SetJSONDataForField(const FieldName: String;
+  FieldIndex: Integer; Row, Data: TJSONData);
+
+begin
+  Raise Exception.Create('Read-only data!');
+end;
+
+function TMyJSONObjectFieldMapper.GetJSONDataForField(const FieldName: String;
+  FieldIndex: Integer; Row: TJSONData): TJSONData;
+
+Var
+  I : integer;
+
+begin
+  I:=(Row as TJSONObject).IndexOfName(FieldName);
+  if I=-1 then
+    Result:=Nil
+  else
+    Result:=Row.Items[i];
+end;
+
+function TMyJSONObjectFieldMapper.CreateRow: TJSONData;
+begin
+  Result:=TJSONObject.Create;
+end;
+{ TMyJSONDataset }
+
+constructor TMyJSONDataset.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  MaxStringFieldSize:=1024;
+  OwnsData:=False;
+end;
+
+destructor TMyJSONDataset.Destroy;
+begin
+  FreeAndNil(FJSON);
+  // We own metadata
+  Metadata.Free;
+  inherited Destroy;
+end;
+
+procedure TMyJSONDataset.InternalClose;
+
+begin
+  Inherited;
+  FreeAndNil(FJSON);
+end;
+
+procedure TMyJSONDataset.InternalOpen;
+
+Var
+  R : TJSONData;
+
+begin
+  FreeAndNil(FJSON);
+  if (URL<>'') then
+    FJSON:=TJSONReportDataHandler.GetDataFromURL(URL)
+  else
+    FJSON:=TJSONReportDataHandler.GetDataFromFile(FileName);
+  R:=FJSON.FindPath(DataPath);
+  if not (R is TJSONArray) then
+    Raise EDatabaseError.CreateFmt(SErrNotArrayData,[DataPath]);
+  Rows:=R as TJSONArray;
+  inherited InternalOpen;
+end;
+
+
+procedure TMyJSONDataset.MetaDataToFieldDefs;
+
+Var
+  F : TJSONarray;
+  I : Integer;
+  O : TJSONObject;
+  Ft : TFieldType;
+
+begin
+  FieldDefs.Clear;
+  F:=Metadata.get(keyFields,TJSONArray(Nil));
+  if not Assigned(F) then
+    exit;
+  For I:=0 to F.Count-1 do
+    begin
+    O:=F.Objects[i];
+    if TryStringToFieldType(O.strings[keyFieldType],ft,false) then
+      if ft=ftString then
+        FieldDefs.Add(O.strings[keyFieldName],FT,MaxStringFieldSize,False)
+      else
+        FieldDefs.Add(O.strings[keyFieldName],FT);
+    end;
+end;
+
+function TMyJSONDataset.CreateFieldMapper: TJSONFieldMapper;
+begin
+  if DataForm = dfObject then
+    begin
+    Result:=TMyJSONObjectFieldMapper.Create;
+    end
+  else
+    begin
+    Result:=TJSONArrayFieldMapper.Create;
+    end
+end;
+
+function TJSONReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
+
+Var
+  C : TMyJSONDataset;
+  O : TJSONObject;
+
+begin
+//  Writeln('Starting dataset',aConfig.FormatJSON());
+  C:=TMyJSONDataset.Create(AOWner);
+  C.FileName:=AConfig.get(keyFileName,'');
+  C.URL:=AConfig.get(keyURL,'');
+  O:=AConfig.get(keyMetaData,TJSONObject(Nil));
+  if Assigned(O) then
+    C.MetaData:=O.Clone as TJSONObject
+  else
+    Raise EDatabaseError.Create('No metadata');
+  if AConfig.get(keyDataForm,'object')='object' then
+    C.DataForm:=dfObject
+  else
+    C.DataForm:=dfArray;
+  C.DataPath:=AConfig.get(keyDataPath,'');;
+  Result:=C;
+end;
+
+class function TJSONReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
+
+Var
+  FN,URL : UTF8String;
+  URI : TURI;
+  O : TJSONObject;
+  A : TJSONArray;
+  I : Integer;
+  Ft : TFieldType;
+  V : String;
+
+begin
+  Result:='';
+  FN:=AConfig.Get(KeyFileName,'');
+  if (FN='') then
+    begin
+    URL:=AConfig.Get(KeyURL,'');
+    URI:=parseuri(URL,'http',80,True);
+    case lowercase(uri.Protocol) of
+     'https' : ;
+     'http' : ;
+     '' : ;
+    else
+      Result:=Format(SErrInvalidProtocol,[URI.Protocol]);
+    end
+    end
+  else if FN='' then
+    Result:=SErrNeedFileNameOrURL
+  else if not FileExists(FN) then
+    Result:=Format(SErrFileNameDoesNotExist,[FN])
+  else
+    begin
+    O:=aConfig.get(keyMetaData,TJSONObject(Nil));
+    if not Assigned(O) then
+      Result:=SErrNeedFields
+    else
+      begin
+      A:=O.get(keyFields,TJSONArray(Nil));
+      if (A=Nil) or (A.Count=0) then
+        Result:=SErrNeedFields
+      else
+        begin
+        I:=0;
+        While (Result='') and (I<A.Count) do
+          begin
+          if A.Types[i]=jtObject then
+            begin
+            O:=A.Objects[i];
+            if (O.Get(KeyfieldName,'')='') then
+              Result:=Format(SErrEmptyFieldsNotAllowed,[I+1])
+            else
+              begin
+              V:=O.Get(KeyFieldType,'');
+              if not TryStringToFieldType(V,ft,True) then
+                 Result:=Format(SErrUnsupportedJSONFieldType,[V]);
+              end;
+            end;
+          Inc(I);
+          end;
+        end;
+      end;
+    end;
+end;
+
+class function TJSONReportDataHandler.DataType: String;
+begin
+  Result:='JSON'
+end;
+
+class function TJSONReportDataHandler.DataTypeDescription: String;
+begin
+  Result:='JSON data';
+end;
+
+class function TJSONReportDataHandler.GetDataFromFile(aFileName: String): TJSONData;
+
+Var
+  F : TFileStream;
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    Result:=GetJSON(F);
+  finally
+    F.Free;
+  end;
+end;
+
+class function TJSONReportDataHandler.GetDataFromURL(aURL: String): TJSONData;
+
+Var
+  S : TStringStream;
+  URI : TURI;
+
+begin
+  S:=TStringStream.Create('');
+  try
+    URI:=ParseURI(aURL,False);
+    if (URI.protocol='') then
+      URI.protocol:='http';
+    TFPHTTPClient.SimpleGet(EncodeURI(URI),S);
+    S.Position:=0;
+    Result:=getJSON(S);
+  finally
+    S.Free;
+  end;
+end;
+
+initialization
+  TJSONReportDataHandler.RegisterHandler;
+
+end.
+

+ 271 - 0
packages/fcl-report/src/fpreportdatasqldb.pp

@@ -0,0 +1,271 @@
+{
+    This file is part of the Free Component Library.
+    Copyright (c) 2017 Michael Van Canneyt, member of the Free Pascal development team
+
+    Report Designer Data connector for SQLDB based data.
+
+    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.
+
+ **********************************************************************}
+unit fpreportdatasqldb;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, strutils, sqldb, db, fpjson, fpreportdata;
+
+Const
+  keyConnection   = 'connection';
+  keySQL          = 'sql';
+  keyType         = 'dbtype';
+  keyHostName     = 'host';
+  keyDatabaseName = 'database';
+  keyUserName     = 'user';
+  keyPassword     = 'pwd';
+  keyRole         = 'role';
+  keyParams       = 'params';
+  KeyCharSet      = 'charset';
+  keyHash         = 'FPCRulez';
+
+Resourcestring
+  SErrNoConnectionData = 'No connection data available';
+  SErrNoSQL = 'No SQL statement set';
+
+Type
+
+  { TFPReportConnector }
+
+  TFPReportConnector = Class(TSQLConnector)
+  Private
+    FRefCount: Integer;
+    Class procedure init;
+    class procedure done;
+    Class var
+      FPool : TStringList;
+  Public
+    Procedure LoadFromConfig(aConfig : TJSONObject);
+    class function CreateConnection(aConfig: TJSONObject): TFPReportConnector;
+    Class Function TestConnection (aConfig : TJSONObject) : string;
+    class function CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
+    class function CreateConfigHash(aConfig: TJSONObject): String;
+    Class procedure CheckDBRelease;
+    Property RefCount : Integer Read FRefCount;
+  end;
+
+  { TFPReportQuery }
+
+  TFPReportQuery = class(TSQLQuery)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  end;
+
+
+  TSQLDBReportDataHandler = Class(TFPReportDataHandler)
+    Function CreateDataset(AOwner : TComponent; AConfig : TJSONObject) : TDataset; override;
+    Class Function CheckConfig(AConfig: TJSONObject): String; override;
+    Class Function DataType : String; override;
+    Class Function DataTypeDescription : String; override;
+  end;
+
+
+implementation
+
+{ TFPReportQuery }
+
+constructor TFPReportQuery.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ReadOnly:=True;
+end;
+
+destructor TFPReportQuery.Destroy;
+
+begin
+  If Database is TFPReportConnector then
+    Dec(TFPReportConnector(Database).FRefCount);
+  inherited Destroy;
+  TFPReportConnector.CheckDBRelease;
+end;
+
+{ TFPReportConnector }
+
+class procedure TFPReportConnector.init;
+begin
+  FPool:=TStringList.Create;
+  FPool.OwnsObjects:=True;
+  FPool.Sorted:=True;
+  FPool.Duplicates:=dupError;
+end;
+
+class procedure TFPReportConnector.done;
+begin
+  FreeAndNil(FPool);
+end;
+
+Class Function TFPReportConnector.CreateConfigHash(aConfig : TJSONObject) : String;
+
+  Procedure AH(N,V : String);
+
+  begin
+    if (V<>'') then
+      Result:=Result+';'+N+'='+V;
+  end;
+
+  Procedure AH(N : String);
+
+
+  begin
+    AH(N,aConfig.get(N,''));
+  end;
+
+Var
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  AH(keyType);
+  AH(keyHostName);
+  AH(keyDatabaseName);
+  AH(keyUserName);
+  AH(keyPassword);
+  AH(keyRole);
+  A:=aConfig.get(keyParams,TJSONArray(Nil));
+  If Assigned(A) then
+    For I:=0 to A.Count-1 do
+      AH(IntToStr(I),A.Strings[i]);
+end;
+
+class procedure TFPReportConnector.CheckDBRelease;
+
+Var
+  I : Integer;
+
+begin
+  For I:=FPool.Count-1 downto 0 do
+    begin
+    // Writeln('Connection count for ',FPool[i], ' : ',TFPReportConnector(FPool.Objects[i]).FRefCount);
+    if TFPReportConnector(FPool.Objects[i]).FRefCount=0 then
+      FPool.Delete(I);
+    end;
+end;
+
+procedure TFPReportConnector.LoadFromConfig(aConfig: TJSONObject);
+
+Var
+  S : String;
+  A : TJSONArray;
+  I : Integer;
+
+begin
+  ConnectorType:=aConfig.get(keyType,'');
+  HostName:=aConfig.get(keyHostName,'');
+  DatabaseName:=aConfig.get(keyDatabaseName,'');
+  UserName:=aConfig.get(keyUserName,'');
+  S:=aConfig.get(keyPassword,'');
+  if (S<>'') then
+    Password:=XORDecode(keyHash,S);
+  Role:=aConfig.get(keyRole,'');
+  Params.Clear;
+  A:=aConfig.get(keyParams,TJSONArray(Nil));
+  If Assigned(A) then
+    For I:=0 to A.Count-1 do
+      Params.Add(A.Strings[i]);
+end;
+
+class function TFPReportConnector.CreateConnection(aConfig: TJSONObject): TFPReportConnector;
+
+begin
+  Result:=Self.Create(Nil);
+  Result.LoadFromConfig(aConfig);
+  Result.Transaction:=TSQLtransaction.Create(Result);
+end;
+
+class function TFPReportConnector.TestConnection(aConfig: TJSONObject): string;
+
+Var
+  C : TFPReportConnector;
+
+begin
+  Result:='';
+  C:=CreateConnection(aConfig);
+  try
+    C.Connected:=True;
+  except
+    On E : Exception do
+      Result:=E.Message;
+  end;
+  C.free;
+end;
+
+class function TFPReportConnector.CreateDataset(aOwner: TComponent; aConfig: TJSONObject): TSQLQuery;
+
+Var
+  S : String;
+  C : TFPReportConnector;
+  I : integer;
+  O : TJSONObject;
+
+begin
+  O:=aConfig.Get(keyConnection,TJSONObject(Nil));
+  if O=Nil then
+    Raise EDatabaseError.Create(SErrNoConnectionData);
+  S:=CreateConfigHash(o);
+  i:=FPool.IndexOf(S);
+  if (I<>-1) then
+    C:=FPool.Objects[i] as TFPReportConnector
+  else
+    begin
+    C:=CreateConnection(o);
+    FPool.AddObject(S,C);
+    end;
+  Result:=TFPReportQuery.Create(aOwner);
+  Result.Database:=C;
+  Result.SQL.Text:=aConfig.get(keySQL,'');
+  Inc(C.FRefCount);
+end;
+
+{ TSQLDBReportDataHandler }
+
+function TSQLDBReportDataHandler.CreateDataset(AOwner: TComponent; AConfig: TJSONObject): TDataset;
+begin
+  Result:=TFPReportConnector.CreateDataset(aOwner,aConfig);
+end;
+
+class function TSQLDBReportDataHandler.CheckConfig(AConfig: TJSONObject): String;
+
+Var
+  O : TJSONObject;
+
+begin
+  O:=aConfig.Get(keyConnection,TJSONObject(Nil));
+  if (O=Nil) or (O.Count=0) then
+    Result:=SErrNoConnectionData
+  else if Trim(aConfig.Get(keySQL,''))='' then
+    Result:=SErrNoSQL
+end;
+
+class function TSQLDBReportDataHandler.DataType: String;
+begin
+  Result:='SQLDB';
+end;
+
+class function TSQLDBReportDataHandler.DataTypeDescription: String;
+begin
+  Result:='SQL Database server';
+end;
+
+initialization
+  TSQLDBReportDataHandler.RegisterHandler;
+  TFPReportConnector.Init;
+Finalization
+  TFPReportConnector.Done;
+end.
+

+ 20 - 1
packages/fcl-report/src/fpreportdb.pp

@@ -28,7 +28,9 @@ Type
   TFPReportDatasetData = class(TFPReportData)
   private
     FDataSet: TDataSet;
+    procedure SetDataSet(AValue: TDataSet);
   protected
+    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure DoGetValue(const AFieldName: string; var AValue: variant); override;
     procedure DoInitDataFields; override;
     procedure DoOpen; override;
@@ -41,7 +43,7 @@ Type
     Procedure StartDesigning; override;
     Procedure EndDesigning; override;
   published
-    property  DataSet: TDataSet read FDataSet write FDataSet;
+    property  DataSet: TDataSet read FDataSet write SetDataSet;
   end;
 
 implementation
@@ -53,6 +55,23 @@ resourcestring
 
 { TFPReportDatasetData }
 
+procedure TFPReportDatasetData.SetDataSet(AValue: TDataSet);
+begin
+  if FDataSet=AValue then Exit;
+  if Assigned(FDataset) then
+    FDataset.RemoveFreeNotification(Self);
+  FDataSet:=AValue;
+  if Assigned(FDataset) then
+    FDataset.FreeNotification(Self);
+end;
+
+procedure TFPReportDatasetData.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation=opRemove) and (AComponent=FDataset) then
+    FDataset:=Nil;
+end;
+
 procedure TFPReportDatasetData.DoGetValue(const AFieldName: string; var AValue: variant);
 var
   ms: TMemoryStream;