From 39ec6101991a6f7c9392eed6c9289881369fb49e Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 28 Feb 2011 14:37:35 +0000 Subject: * In some cases, a looking for a non-existing provider did not return Nil git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17057 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/fpwebdata.pp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/fpwebdata.pp b/packages/fcl-web/src/webdata/fpwebdata.pp index ea47199a9a..54ae582886 100644 --- a/packages/fcl-web/src/webdata/fpwebdata.pp +++ b/packages/fcl-web/src/webdata/fpwebdata.pp @@ -1663,6 +1663,7 @@ begin Exit; end; end; + P:=Nil; C:=FindComponent(AProviderName); {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif} If (C<>Nil) and (C is TFPCustomWebDataProvider) then @@ -1675,7 +1676,9 @@ begin begin {$ifdef wmdebug}SendDebug(Format('Found providerdef "%s" 1 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif} P:=WebDataProviderManager.GetProvider(ADef,Self,AContainer); - end; + end + else + P:=Nil; end; {$ifdef wmdebug}SendDebug(Format('Searching provider "%s" 2 : %d ',[AProvidername,Ord(Assigned(C))]));{$endif} Result:=P; -- cgit v1.2.1 From 089b0921634dea3be0b4a011086dbe64e6c3017a Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 28 Feb 2011 15:55:11 +0000 Subject: * GetNewID should be virtual so it can be overridden git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17058 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/sqldbwebdata.pp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/sqldbwebdata.pp b/packages/fcl-web/src/webdata/sqldbwebdata.pp index 33b1d7f8e1..c706904971 100644 --- a/packages/fcl-web/src/webdata/sqldbwebdata.pp +++ b/packages/fcl-web/src/webdata/sqldbwebdata.pp @@ -44,7 +44,7 @@ Type Procedure DoApplyParams; override; Function SQLQuery : TSQLQuery; Function GetDataset : TDataset; override; - Function GetNewID : String; + Function GetNewID : String; virtual; Function IDFieldValue : String; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; Property SelectSQL : TStrings Index 0 Read GetS Write SetS; -- cgit v1.2.1 From c1ff59a2962e515e2848439fcc029c8859055bbe Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 3 Mar 2011 09:39:39 +0000 Subject: * SetTypedParam: Clear parameter if data is empty and not a string. Fixed bug with GetNewID - undid virtual, moved to DoGetNewID to correctly save Last inert ID git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17065 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/sqldbwebdata.pp | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/sqldbwebdata.pp b/packages/fcl-web/src/webdata/sqldbwebdata.pp index c706904971..81783a9d8f 100644 --- a/packages/fcl-web/src/webdata/sqldbwebdata.pp +++ b/packages/fcl-web/src/webdata/sqldbwebdata.pp @@ -44,7 +44,8 @@ Type Procedure DoApplyParams; override; Function SQLQuery : TSQLQuery; Function GetDataset : TDataset; override; - Function GetNewID : String; virtual; + Function DoGetNewID : String; virtual; + Function GetNewID : String; Function IDFieldValue : String; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; Property SelectSQL : TStrings Index 0 Read GetS Write SetS; @@ -273,7 +274,12 @@ Var begin ft:=GetParamtype(P,AValue); - If ft<>ftUnknown then + If (AValue='') and (not (ft in [ftString,ftFixedChar,ftWideString,ftFixedWideChar])) then + begin + P.Clear; + exit; + end; + If (ft<>ftUnknown) then begin try case ft of @@ -358,7 +364,10 @@ begin if not B then begin If (P.Name=IDFieldName) and DoNewID then - SetTypedParam(P,GetNewID) + begin + GetNewID; + SetTypedParam(P,FLastNewID) + end else If Adaptor.TryFieldValue(P.Name,S) then SetTypedParam(P,S) else If Adaptor.TryParamValue(P.Name,S) then @@ -394,12 +403,17 @@ begin {$ifdef wmdebug}SendDebug('Get dataset: done');{$endif} end; -function TCustomSQLDBWebDataProvider.GetNewID: String; - +function TCustomSQLDBWebDataProvider.DoGetNewID: String; begin If Not Assigned(FOnGetNewID) then Raise EFPHTTPError.CreateFmt(SErrNoNewIDEvent,[Self.Name]); FOnGetNewID(Self,Result); +end; + +function TCustomSQLDBWebDataProvider.GetNewID: String; + +begin + Result:=DoGetNewID; FLastNewID:=Result; end; -- cgit v1.2.1 From 0d3e7eca307d06bf6ff935035742ebccb36d1691 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 23 Mar 2011 08:25:11 +0000 Subject: * OnGetDataset Event git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17165 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/sqldbwebdata.pp | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/sqldbwebdata.pp b/packages/fcl-web/src/webdata/sqldbwebdata.pp index 81783a9d8f..28b5356045 100644 --- a/packages/fcl-web/src/webdata/sqldbwebdata.pp +++ b/packages/fcl-web/src/webdata/sqldbwebdata.pp @@ -17,6 +17,7 @@ Type TCustomSQLDBWebDataProvider = Class(TFPCustomWebDataProvider) private FIDFieldName: String; + FONGetDataset: TNotifyEvent; FOnGetNewID: TNewIDEvent; FOnGetParamValue: TGetParamValueEvent; FParams: TParams; @@ -56,6 +57,7 @@ Type Property OnGetNewID : TNewIDEvent Read FOnGetNewID Write FOnGetNewID; property OnGetParameterType : TGetParamTypeEvent Read FOnGetParamType Write FOnGetParamType; property OnGetParameterValue : TGetParamValueEvent Read FOnGetParamValue Write FOnGetParamValue; + Property OnGetDataset : TNotifyEvent Read FONGetDataset Write FOnGetDataset; Property Params : TParams Read FParams Write SetParams; Public Constructor Create(AOwner : TComponent); override; @@ -73,6 +75,7 @@ Type Property OnGetNewID; property OnGetParameterType; property OnGetParameterValue; + Property OnGetDataset; Property Options; Property Params; end; @@ -394,6 +397,8 @@ end; function TCustomSQLDBWebDataProvider.GetDataset: TDataset; begin {$ifdef wmdebug}SendDebug('Get dataset: checking dataset');{$endif} + If Assigned(FonGetDataset) then + FOnGetDataset(Self); CheckDataset; FLastNewID:=''; Result:=FQuery; -- cgit v1.2.1 From d52b610c1ec804c31667798f3ac29930a9c9fc0d Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 23 Mar 2011 08:25:42 +0000 Subject: * BeforeDelete/Update/Insert events git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17166 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/fpwebdata.pp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/fpwebdata.pp b/packages/fcl-web/src/webdata/fpwebdata.pp index 54ae582886..8db55515c0 100644 --- a/packages/fcl-web/src/webdata/fpwebdata.pp +++ b/packages/fcl-web/src/webdata/fpwebdata.pp @@ -132,6 +132,9 @@ type TCustomHTTPDataContentProducer = Class(THTTPContentProducer) Private FAllowPageSize: Boolean; + FBeforeDelete: TNotifyEvent; + FBeforeInsert: TNotifyEvent; + FBeforeUpdate: TNotifyEvent; FDataProvider: TFPCustomWebDataProvider; FMetadata: Boolean; FOnTranscode: TOnTranscodeEvent; @@ -159,6 +162,12 @@ type Procedure DoExceptionToStream(E : Exception; ResponseContent : TStream); virtual; abstract; procedure Notification(AComponent: TComponent; Operation: TOperation);override; Property Dataset: TDataset Read GetDataSet; + // Before a record is about to be updated + Property BeforeUpdate : TNotifyEvent Read FBeforeUpdate Write FBeforeUpdate; + // Before a record is about to be inserted + Property BeforeInsert : TNotifyEvent Read FBeforeInsert Write FBeforeInsert; + // Before a record is about to be deleted + Property BeforeDelete : TNotifyEvent Read FBeforeDelete Write FBeforeDelete; Public Constructor Create(AOwner : TComponent); override; Property Adaptor : TCustomWebDataInputAdaptor Read FAdaptor Write SetAdaptor; @@ -975,17 +984,23 @@ end; procedure TCustomHTTPDataContentProducer.DoUpdateRecord(ResponseContent: TStream); begin {$ifdef wmdebug}SendDebug('DoUpdateRecord: Updating record');{$endif} + If Assigned(FBeforeUpdate) then + FBeforeUpdate(Self); Provider.Update; {$ifdef wmdebug}SendDebug('DoUpdateRecord: Updated record');{$endif} end; procedure TCustomHTTPDataContentProducer.DoInsertRecord(ResponseContent: TStream); begin + If Assigned(FBeforeInsert) then + FBeforeInsert(Self); Provider.Insert; end; procedure TCustomHTTPDataContentProducer.DoDeleteRecord(ResponseContent: TStream); begin + If Assigned(FBeforeDelete) then + FBeforeDelete(Self); Provider.Delete; end; -- cgit v1.2.1 From 69fb19b8abf21b318401e7428dc4e68d064be284 Mon Sep 17 00:00:00 2001 From: michael Date: Wed, 23 Mar 2011 08:26:39 +0000 Subject: * AllowRow event git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17167 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/extjsjson.pp | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/extjsjson.pp b/packages/fcl-web/src/webdata/extjsjson.pp index 447a223580..01595bdc74 100644 --- a/packages/fcl-web/src/webdata/extjsjson.pp +++ b/packages/fcl-web/src/webdata/extjsjson.pp @@ -28,6 +28,8 @@ type { TExtJSJSONDataFormatter } TJSONObjectEvent = Procedure(Sender : TObject; AObject : TJSONObject) of Object; TJSONExceptionObjectEvent = Procedure(Sender : TObject; E : Exception; AResponse : TJSONObject) of Object; + TJSONObjectAllowRowEvent = Procedure(Sender : TObject; Dataset : TDataset; Var Allow : Boolean) of Object; + TJSONObjectAllowEvent = Procedure(Sender : TObject; AObject : TJSONObject; Var Allow : Boolean) of Object; TExtJSJSONDataFormatter = Class(TExtJSDataFormatter) private @@ -37,13 +39,18 @@ type FAfterRowToJSON: TJSONObjectEvent; FAfterUpdate: TJSONObjectEvent; FBeforeDataToJSON: TJSONObjectEvent; + FBeforeDelete: TNotifyEvent; + FBeforeInsert: TNotifyEvent; FBeforeRowToJSON: TJSONObjectEvent; + FBeforeUpdate: TNotifyEvent; + FOnAllowRow: TJSONObjectAllowRowEvent; FOnErrorResponse: TJSONExceptionObjectEvent; FOnMetaDataToJSON: TJSONObjectEvent; FBatchResult : TJSONArray; Function AddIdToBatch : TJSONObject; procedure SendSuccess(ResponseContent: TStream; AddIDValue : Boolean = False); protected + function AllowRow(ADataset : TDataset) : Boolean; virtual; Procedure StartBatch(ResponseContent : TStream); override; Procedure NextBatchItem(ResponseContent : TStream); override; Procedure EndBatch(ResponseContent : TStream); override; @@ -77,12 +84,18 @@ type Property BeforeDataToJSON : TJSONObjectEvent Read FBeforeDataToJSON Write FBeforeDataToJSON; // Called when an exception is caught and formatted. Property OnErrorResponse : TJSONExceptionObjectEvent Read FOnErrorResponse Write FOnErrorResponse; + // Called to decide whether a record is sent to the client; + Property OnAllowRow : TJSONObjectAllowRowEvent Read FOnAllowRow Write FOnAllowRow; // After a record was succesfully updated Property AfterUpdate : TJSONObjectEvent Read FAfterUpdate Write FAfterUpdate; // After a record was succesfully inserted. Property AfterInsert : TJSONObjectEvent Read FAfterInsert Write FAfterInsert; // After a record was succesfully inserted. Property AfterDelete : TJSONObjectEvent Read FAfterDelete Write FAfterDelete; + // From TCustomHTTPDataContentProducer + Property BeforeUpdate; + Property BeforeInsert; + Property BeforeDelete; end; implementation @@ -337,9 +350,12 @@ begin ACount:=PageSize; While (not DS.EOF) and ((PageSize=0) or (ACount>0)) do begin - Inc(RCount); - Dec(ACount); - Rows.Add(RowToJSON); + If AllowRow(DS) then + begin + Inc(RCount); + Dec(ACount); + Rows.Add(RowToJSON); + end; DS.Next; end; If (PageSize>0) then @@ -411,6 +427,13 @@ begin end; end; +function TExtJSJSONDataFormatter.AllowRow(ADataset: TDataset): Boolean; +begin + Result:=True; + If Assigned(FOnAllowRow) then + FOnAllowRow(Self,Dataset,Result); +end; + procedure TExtJSJSONDataFormatter.StartBatch(ResponseContent: TStream); begin If Assigned(FBatchResult) then -- cgit v1.2.1 From 0f56acc55d0b64dbece40704545b575df1dd2b9a Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 10 Apr 2011 17:18:38 +0000 Subject: * Published CreateSession property git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@17282 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/fcl-web/src/webdata/fpwebdata.pp | 1 + 1 file changed, 1 insertion(+) (limited to 'packages/fcl-web/src/webdata') diff --git a/packages/fcl-web/src/webdata/fpwebdata.pp b/packages/fcl-web/src/webdata/fpwebdata.pp index 8db55515c0..68c3591e61 100644 --- a/packages/fcl-web/src/webdata/fpwebdata.pp +++ b/packages/fcl-web/src/webdata/fpwebdata.pp @@ -473,6 +473,7 @@ type TFPWebProviderDataModule = Class(TFPCustomWebProviderDataModule) Published + Property CreateSession; Property InputAdaptor; Property ContentProducer; Property UseProviderManager; -- cgit v1.2.1