Hello together!
I've played around a bit with the SQLDBRESTBridge and encountered some
troubles which I wanted to check up here on the list whether those are
indeed bugs or not before reporting them to Mantis.
For the tests I've used FPC 3.0.4 and Lazarus 2.0 with the
SQLDBRESTBridge and the Lazarus examples being from trunk on Friday 14th
June.
As server I used the restmodule demo in
$lazarus/components/sqldbrest/demo/restmodule and changed it to use
SQLite3 instead of PostgreSQL.
For the client I used the jsonclient demo in
$lazarus/components/sqldbrest/demo/jsonclient.
I created the database using the expenses-sqlite.sql script in
$fpc/packages/fcl-web/examples/restbridge/expenses-sqlite.sql (and no I
didn't execute expenses-data.sql at first which will be important
further down ;) ).
I started the server and tried to access localhost:7331/REST/metadata (I
changed the port from 8080), but this resulted in a 404 error which was
displayed as an empty page (maybe something isn't correctly working
here?). Using localhost:7331/metadata resulted in a "Not found" exception.
So I started to research what went wrong and found various points:
- the metadata was coupled with the rdoConnectionInURL flag in
TSQLDBRestDispatcher.DoRegisterRoutes instead of rdoExposeMetadata (see
patch exposematadata.patch)
- then it turned out that the routes are only registered once the module
was loaded and thus they would never be found so I adjusted
TSQLDBRestModule.HandleRequest to call the router again (this of course
required to change the BasePath of the TSQLDBDispatcher in the example
to 'REST' instead of '') (see patch reroute.patch) - this point I'm
definitely not sure whether it is the right solution (but in the end it
works)
- then the problem was that the module's route ('REST/*/') took
precedence over the routes added by the TSQLDBRestDispatcher, so I
implemented a sorting of the routes so that more specific ones are
encountered first (see patch sort-routes.patch) - don't know whether
this is the right approach either, but this *is* a problem
- then the fact that TSQLDBRestModule is by default set to wkOneShot
lead to the routes being registered again or more precisely the old
routes being left over and pointing to a freed TSQLDBRestDispatcher
instance; thus I added a call to UnRegisterRoutes to
TSQLDBRestDispatcher.Destroy (see unregister-routes.patch)
With these changes the server worked, but then I encountered two
problems in the client:
- if the database table is empty an empty JSON object ('{}') is returned
resulting in the client complaining about the missing metadata (after
this I executed the expenses-data.sql script)
- when changing from one resource to another I got an exception that the
operation is not possible on an active dataset; I solved this for me by
closing the dataset before executing LoadFromStream (see patch
jsonclient.patch)
And an additional note regarding the expenses-sqlite.sql script. The
intention appears to be that the ID columns are auto increment. This
will however *only* work if the type of the columns is "integer primary
key". "bigint primary key" won't work here. See also:
https://www.sqlite.org/autoinc.html
Thus as with patch expenses-sqlite.sql I updat the SQL script for that
database.
If these are indeed bugs I'll either commit the patches as is (e.g. the
one for the SQLite script is rather surely a bug) or open a bug report
for the more complex ones.
I haven't tested more yet, so I don't know whether there are any further
problems. :)
Regards,
Sven
diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
index 6dc839c2..76a3465d 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
@@ -668,11 +668,14 @@ begin
FConnectionsRoute:=HTTPRouter.RegisterRoute(res+C,@HandleConnRequest);
FConnectionItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleConnRequest);
end;
- if (rdoConnectionInURL in DispatchOptions) then
+ if (rdoExposeMetadata in DispatchOptions) then
begin
C:=Strings.GetRestString(rpMetadataResourceName);
FMetadataRoute:=HTTPRouter.RegisterRoute(res+C,@HandleMetaDataRequest);
FMetadataItemRoute:=HTTPRouter.RegisterRoute(res+C+'/:id',@HandleMetaDataRequest);
+ end;
+ if (rdoConnectionInURL in DispatchOptions) then
+ begin
Res:=Res+':connection/';
end;
Res:=Res+':resource';
diff --git a/packages/fcl-web/src/restbridge/sqldbrestmodule.pp b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp
index 0fb7cae1..d13e45d5 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestmodule.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestmodule.pp
@@ -14,6 +14,7 @@ Type
TSQLDBRestModule = Class (TSessionHTTPModule)
private
FDispatcher: TSQLDBRestDispatcher;
+ FRecursive: Boolean;
procedure SetDispatcher(AValue: TSQLDBRestDispatcher);
Protected
Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -28,7 +29,7 @@ Type
implementation
-uses sqldbrestconst;
+uses sqldbrestconst,httproute;
{ TSQLDBRestModule }
@@ -67,11 +68,20 @@ Var
Disp : TSQLDBRestDispatcher;
begin
- Disp:=FindDispatcher;
- If assigned(Disp) then
- Disp.HandleRequest(aRequest,aResponse)
- else
- Raise EHTTP.Create(SErrNoRESTDispatcher);
+ if FRecursive then begin
+ Disp:=FindDispatcher;
+ If assigned(Disp) then
+ Disp.HandleRequest(aRequest,aResponse)
+ else
+ Raise EHTTP.Create(SErrNoRESTDispatcher);
+ end else begin
+ FRecursive := True;
+ try
+ HTTPRouter.RouteRequest(ARequest,AResponse);
+ finally
+ FRecursive:=False;
+ end;
+ end;
end;
end.
diff --git a/packages/fcl-web/src/base/httproute.pp b/packages/fcl-web/src/base/httproute.pp
index 50961109..d0974382 100644
--- a/packages/fcl-web/src/base/httproute.pp
+++ b/packages/fcl-web/src/base/httproute.pp
@@ -259,6 +259,116 @@ begin
Result:=THTTPRouter.Service;
end;
+function CompareHTTPRoute(AItem1, AItem2: TCollectionItem): Integer;
+
+ function StartsWith(const aStr: String; aChr: Char): Boolean; inline;
+ begin
+ Result := (Length(aStr) > 0) and (aStr[1] = aChr);
+ end;
+
+ function CompareURLComp(const aComp1, aComp2: String): Integer;
+ var
+ idx1, idx2: SizeInt;
+ isarg1, isarg2: Boolean;
+ begin
+ if (aComp1 = '') and (aComp2 <> '') then
+ Result := -1
+ else if (aComp1 <> '') and (aComp2 = '') then
+ Result := 1
+ else if (aComp1 = '') and (aComp2 = '') then
+ Result := 0
+ else begin
+ idx1 := Pos('*', aComp1);
+ idx2 := Pos('*', aComp2);
+ if (idx1 = 0) and (idx2 <> 0) then
+ Result := -1
+ else if (idx1 <> 0) and (idx2 = 0) then
+ Result := 1
+ else if (idx1 <> 0) and (idx2 <> 0) then
+ Result := CompareStr(aComp1, aComp2)
+ else begin
+ isarg1 := StartsWith(aComp1, ':');
+ isarg2 := StartsWith(aComp2, ':');
+ if isarg1 and not isarg2 then
+ Result := 1
+ else if not isarg1 and isarg2 then
+ Result := -1
+ else
+ Result := CompareStr(aComp1, aComp2);
+ end;
+ end;
+ end;
+
+var
+ route1: THTTPRoute absolute AItem1;
+ route2: THTTPRoute absolute AItem2;
+ path1, path2, comp1, comp2: String;
+ idx1, idx2: SizeInt;
+begin
+ if Assigned(AItem1) and not Assigned(AItem2) then
+ Result := -1
+ else if not Assigned(AItem1) and Assigned(AItem2) then
+ Result := 1
+ else if not Assigned(AItem1) and not Assigned(AItem2) then
+ Result := 0
+ else begin
+ Result := 0;
+ if route1.URLPattern <> route2.URLPattern then begin
+ path1 := route1.URLPattern;
+ path2 := route2.URLPattern;
+ if StartsWith(path1, '/') then
+ Delete(path1, 1, 1);
+ if StartsWith(path2, '/') then
+ Delete(path2, 1, 1);
+ idx1 := Pos('?', path1);
+ idx2 := Pos('?', path2);
+ if idx1 > 0 then
+ Delete(path1, idx1, Length(path1) - idx1 + 1);
+ if idx2 > 0 then
+ Delete(path2, idx2, Length(path2) - idx2 + 1);
+ while (path1 <> '') and (path2 <> '') do begin
+ idx1 := Pos('/', path1);
+ idx2 := Pos('/', path2);
+ if idx1 <> 0 then
+ comp1 := Copy(path1, 1, idx1 - 1)
+ else
+ comp1 := path1;
+ if idx2 <> 0 then
+ comp2 := Copy(path2, 1, idx2 - 1)
+ else
+ comp2 := path2;
+ Result := CompareURLComp(comp1, comp2);
+ if Result <> 0 then
+ Break;
+ if idx1 > 0 then
+ Delete(path1, 1, idx1)
+ else
+ path1 := '';
+ if idx2 > 0 then
+ Delete(path2, 1, idx2)
+ else
+ path2 := '';
+ end;
+ end;
+ if (Result = 0) and ((path1 <> '') or (path2 <> '')) then
+ Result := CompareURLComp(path1, path2);
+ if Result = 0 then begin
+ if route1.Method > route2.Method then
+ Result := 1
+ else if route1.Method < route2.Method then
+ Result := -1
+ else begin
+ if route1.Default and not route2.Default then
+ Result := 1
+ else if not route1.Default and route2.Default then
+ Result := -1
+ else
+ Result := 0;
+ end;
+ end;
+ end;
+end;
+
{ THTTPRouteCallback }
procedure THTTPRouteCallback.DoHandleRequest(ARequest: TRequest; AResponse: TResponse);
@@ -487,6 +597,8 @@ begin
Default:=IsDefault;
Method:=AMethod;
end;
+ { sort routes so that more specific ones are found before general ones }
+ FRoutes.Sort(@CompareHTTPRoute);
end;
function THTTPRouter.RegisterRoute(const APattern: String;AMethod: TRouteMethod; const AIntf: IRouteInterface; IsDefault: Boolean ): THTTPRoute;
diff --git a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
index 6dc839c2..ac9e23a5 100644
--- a/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
+++ b/packages/fcl-web/src/restbridge/sqldbrestbridge.pp
@@ -854,6 +854,7 @@ end;
destructor TSQLDBRestDispatcher.Destroy;
begin
+ UnRegisterRoutes;
Authenticator:=Nil;
FreeAndNil(FAdminUserIDs);
FreeAndNil(FCustomViewResource);
Index: frmmain.pp
===================================================================
--- frmmain.pp (revision 61387)
+++ frmmain.pp (working copy)
@@ -139,6 +139,7 @@
S.Position:=0;
SERawData.Lines.LoadFromStream(S);
S.Position:=0;
+ JSResource.Close;
JSResource.LoadFromStream(S);
JSResource.Open;
finally
diff --git a/packages/fcl-web/examples/restbridge/expenses-sqlite.sql b/packages/fcl-web/examples/restbridge/expenses-sqlite.sql
index 2243d3db..f9697e07 100644
--- a/packages/fcl-web/examples/restbridge/expenses-sqlite.sql
+++ b/packages/fcl-web/examples/restbridge/expenses-sqlite.sql
@@ -6,7 +6,7 @@ insert into sqlite_sequence (name,seq) values ('seqProjectsID',1);
drop table t2;
create table ExpenseTypes (
- etID bigint primary key,
+ etID integer primary key,
etName varchar(50) not null,
etDescription varchar(100) not null,
etMaxAmount decimal(10,2),
@@ -15,7 +15,7 @@ create table ExpenseTypes (
);
create table Users (
- uID bigint primary key,
+ uID integer primary key,
uLogin varchar(50) not null,
uFullName varchar(100) not null,
uPassword varchar(100) not null,
@@ -23,17 +23,17 @@ create table Users (
);
create table Projects (
- pID bigint primary key,
+ pID integer primary key,
pName varchar(50) not null,
pDescription varchar(100) not null,
pActive boolean not null default true
);
create table Expenses (
- eID bigint primary key,
- eUserFK bigint not null,
- eProjectFK bigint not null,
- eTypeFK bigint not null,
+ eID integer primary key,
+ eUserFK integer not null,
+ eProjectFK integer not null,
+ eTypeFK integer not null,
eAmount decimal(10,2) not null,
eDate date not null default CURRENT_DATE,
eComment varchar(1024)
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
