Browse Source

--- Merging r18133 into '.':
C packages/Makefile
U packages/Makefile.fpc
--- Merging r19629 into '.':
U packages/fcl-web/src/base/custcgi.pp
U packages/fcl-web/src/base/fpwebfile.pp
U packages/fcl-web/src/base/custfcgi.pp
U packages/fcl-web/src/base/fpapache.pp
U packages/fcl-web/src/base/custweb.pp
U packages/fcl-web/src/base/custhttpapp.pp
U packages/fcl-web/src/base/httpdefs.pp
U packages/fcl-web/src/base/fphttpserver.pp
--- Merging r19853 into '.':
C packages/fcl-db/src/json
--- Merging r19854 into '.':
C packages/fcl-db/src/json/fpjsondataset.pp
C packages/fcl-db/src/json/jsondataset.pp
--- Merging r19855 into '.':
U packages/fcl-db/Makefile.fpc
C packages/fcl-db/Makefile
Skipped 'packages/fcl-db/tests/testjsondataset.pp'
Skipped 'packages/fcl-db/tests/test.json'
--- Merging r19860 into '.':
C packages/Makefile
G packages/Makefile.fpc
--- Merging r19862 into '.':
U packages/fcl-db/fpmake.pp
Skipped 'packages/fcl-db/tests/testjsondataset.pp'
Skipped 'packages/fcl-db/tests/testjsondataset.pp'
--- Merging r19885 into '.':
U packages/fcl-json/src/jsonparser.pp
Summary of conflicts:
Text conflicts: 3
Tree conflicts: 3
Skipped paths: 4

# revisions: 18133,19629,19853,19854,19855,19857,19858,19860,19862,19863,19864,19885
------------------------------------------------------------------------
r18133 | joost | 2011-08-07 12:08:07 +0200 (Sun, 07 Aug 2011) | 1 line
Changed paths:
M /trunk/packages/Makefile
M /trunk/packages/Makefile.fpc

* Dependency of fcl-db on fcl-base added to packages/Makefile*
------------------------------------------------------------------------
------------------------------------------------------------------------
r19629 | michael | 2011-11-12 13:40:12 +0100 (Sat, 12 Nov 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-web/src/base/custcgi.pp
M /trunk/packages/fcl-web/src/base/custfcgi.pp
M /trunk/packages/fcl-web/src/base/custhttpapp.pp
M /trunk/packages/fcl-web/src/base/custweb.pp
M /trunk/packages/fcl-web/src/base/fpapache.pp
M /trunk/packages/fcl-web/src/base/fphttpserver.pp
M /trunk/packages/fcl-web/src/base/fpwebfile.pp
M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Implemented OnUnknownRequestEncoding
------------------------------------------------------------------------
------------------------------------------------------------------------
r19853 | michael | 2011-12-16 17:20:13 +0100 (Fri, 16 Dec 2011) | 1 line
Changed paths:
A /trunk/packages/fcl-db/src/json
A /trunk/packages/fcl-db/src/json/Makefile
A /trunk/packages/fcl-db/src/json/Makefile.fpc
A /trunk/packages/fcl-db/src/json/jsondataset.pp

* Initial implementation of JSON dataset
------------------------------------------------------------------------
------------------------------------------------------------------------
r19854 | michael | 2011-12-16 17:21:36 +0100 (Fri, 16 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/json/Makefile
M /trunk/packages/fcl-db/src/json/Makefile.fpc
A /trunk/packages/fcl-db/src/json/fpjsondataset.pp (from /trunk/packages/fcl-db/src/json/jsondataset.pp:19853)
D /trunk/packages/fcl-db/src/json/jsondataset.pp

* Renamed to fpjsondataset, in line with other FPC units
------------------------------------------------------------------------
------------------------------------------------------------------------
r19855 | michael | 2011-12-16 17:23:33 +0100 (Fri, 16 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/Makefile
M /trunk/packages/fcl-db/Makefile.fpc

* Added JSON dataset
------------------------------------------------------------------------
------------------------------------------------------------------------
r19857 | michael | 2011-12-16 17:31:13 +0100 (Fri, 16 Dec 2011) | 1 line
Changed paths:
A /trunk/packages/fcl-db/tests/test.json
A /trunk/packages/fcl-db/tests/testjsondataset.pp

* Example for JSON dataset
------------------------------------------------------------------------
------------------------------------------------------------------------
r19858 | michael | 2011-12-16 20:51:22 +0100 (Fri, 16 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/src/json/fpjsondataset.pp

* Removed fpwebdata
------------------------------------------------------------------------
------------------------------------------------------------------------
r19860 | michael | 2011-12-17 11:24:53 +0100 (Sat, 17 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/Makefile
M /trunk/packages/Makefile.fpc

* Added dependency of fcl-db on fcl-json
------------------------------------------------------------------------
------------------------------------------------------------------------
r19862 | michael | 2011-12-17 13:29:24 +0100 (Sat, 17 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/fpmake.pp

* Added fpjsondataset
------------------------------------------------------------------------
------------------------------------------------------------------------
r19863 | michael | 2011-12-17 13:30:16 +0100 (Sat, 17 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testjsondataset.pp

* Fixed unit name of jsondataset
------------------------------------------------------------------------
------------------------------------------------------------------------
r19864 | michael | 2011-12-17 13:31:42 +0100 (Sat, 17 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-db/tests/testjsondataset.pp

* Removed resource added by lazarus
------------------------------------------------------------------------
------------------------------------------------------------------------
r19885 | michael | 2011-12-23 20:08:54 +0100 (Fri, 23 Dec 2011) | 1 line
Changed paths:
M /trunk/packages/fcl-json/src/jsonparser.pp

* Made scanner a protected property
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20032 -

marco 13 years ago
parent
commit
f1f3b95cf4

+ 2 - 0
.gitattributes

@@ -1991,12 +1991,14 @@ packages/fcl-db/tests/sqldbtoolsunit.pas svneol=native#text/plain
 packages/fcl-db/tests/tcgensql.pas svneol=native#text/plain
 packages/fcl-db/tests/tcparser.pas svneol=native#text/plain
 packages/fcl-db/tests/tcsqlscanner.pas svneol=native#text/plain
+packages/fcl-db/tests/test.json svneol=native#text/plain
 packages/fcl-db/tests/testbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testbufdatasetstreams.pas svneol=native#text/plain
 packages/fcl-db/tests/testdatasources.pas svneol=native#text/plain
 packages/fcl-db/tests/testdbbasics.pas svneol=native#text/plain
 packages/fcl-db/tests/testdddiff.pp svneol=native#text/plain
 packages/fcl-db/tests/testfieldtypes.pas svneol=native#text/plain
+packages/fcl-db/tests/testjsondataset.pp svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpi svneol=native#text/plain
 packages/fcl-db/tests/testsqlfiles.lpr svneol=native#text/plain
 packages/fcl-db/tests/testsqlscanner.lpi svneol=native#text/plain

+ 15 - 15
packages/Makefile

@@ -9464,24 +9464,24 @@ fastcgi_smart: fpmkunit_smart
 fastcgi_release: fpmkunit_release
 fastcgi_shared: fpmkunit_shared
 ifneq ($(findstring $(OS_TARGET),linux freebsd openbsd netbsd win32 beos haiku),)
-fcl-db_all: fcl-xml_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all pxlib_all
-fcl-db_debug: fcl-xml_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug pxlib_debug
-fcl-db_smart: fcl-xml_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart pxlib_smart
-fcl-db_release: fcl-xml_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release pxlib_release
-fcl-db_shared: fcl-xml_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared pxlib_shared
+fcl-db_all: fcl-xml_all fcl-base_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all pxlib_all fcl-json_all
+fcl-db_debug: fcl-xml_debug fcl-base_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug pxlib_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart pxlib_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release pxlib_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared pxlib_shared fcl-json_shared
 else
 ifneq ($(findstring $(OS_TARGET),win64 wince solaris darwin iphonesim),)
-fcl-db_all: fcl-xml_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all
-fcl-db_debug: fcl-xml_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug
-fcl-db_smart: fcl-xml_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart
-fcl-db_release: fcl-xml_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release
-fcl-db_shared: fcl-xml_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared
+fcl-db_all: fcl-xml_all fcl-base_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all fcl-json_all
+fcl-db_debug: fcl-xml_debug fcl-base_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared fcl-json_shared
 else
-fcl-db_all: fcl-xml_all
-fcl-db_debug: fcl-xml_debug
-fcl-db_smart: fcl-xml_smart
-fcl-db_release: fcl-xml_release
-fcl-db_shared: fcl-xml_shared
+fcl-db_all: fcl-xml_all fcl-base_all fcl-json_all 
+fcl-db_debug: fcl-xml_debug fcl-base_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared fcl-json_shared
 endif
 endif
 fcl_all: fcl-base_all fcl-xml_all fcl-fpcunit_all fcl-db_all fcl-web_all fcl-registry_all fcl-passrc_all fcl-image_all fcl-net_all fcl-json_all fcl-res_all

+ 15 - 15
packages/Makefile.fpc

@@ -205,24 +205,24 @@ fastcgi_release: fpmkunit_release
 fastcgi_shared: fpmkunit_shared
 
 ifneq ($(findstring $(OS_TARGET),linux freebsd openbsd netbsd win32 beos haiku),)
-fcl-db_all: fcl-xml_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all pxlib_all
-fcl-db_debug: fcl-xml_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug pxlib_debug
-fcl-db_smart: fcl-xml_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart pxlib_smart
-fcl-db_release: fcl-xml_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release pxlib_release
-fcl-db_shared: fcl-xml_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared pxlib_shared
+fcl-db_all: fcl-xml_all fcl-base_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all pxlib_all fcl-json_all
+fcl-db_debug: fcl-xml_debug fcl-base_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug pxlib_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart pxlib_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release pxlib_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared pxlib_shared fcl-json_shared
 else
 ifneq ($(findstring $(OS_TARGET),win64 wince solaris darwin iphonesim),)
-fcl-db_all: fcl-xml_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all
-fcl-db_debug: fcl-xml_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug
-fcl-db_smart: fcl-xml_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart
-fcl-db_release: fcl-xml_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release
-fcl-db_shared: fcl-xml_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared
+fcl-db_all: fcl-xml_all fcl-base_all mysql_all ibase_all oracle_all odbc_all postgres_all sqlite_all fcl-json_all
+fcl-db_debug: fcl-xml_debug fcl-base_debug mysql_debug ibase_debug oracle_debug odbc_debug postgres_debug sqlite_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart mysql_smart ibase_smart oracle_smart odbc_smart postgres_smart sqlite_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release mysql_release ibase_release oracle_release odbc_release postgres_release sqlite_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared mysql_shared ibase_shared oracle_shared odbc_shared postgres_shared sqlite_shared fcl-json_shared
 else
-fcl-db_all: fcl-xml_all
-fcl-db_debug: fcl-xml_debug
-fcl-db_smart: fcl-xml_smart
-fcl-db_release: fcl-xml_release
-fcl-db_shared: fcl-xml_shared
+fcl-db_all: fcl-xml_all fcl-base_all fcl-json_all 
+fcl-db_debug: fcl-xml_debug fcl-base_debug fcl-json_debug
+fcl-db_smart: fcl-xml_smart fcl-base_smart fcl-json_smart
+fcl-db_release: fcl-xml_release fcl-base_release fcl-json_release
+fcl-db_shared: fcl-xml_shared fcl-base_shared fcl-json_shared
 endif
 endif
 

File diff suppressed because it is too large
+ 199 - 64
packages/fcl-db/Makefile


+ 8 - 2
packages/fcl-db/Makefile.fpc

@@ -7,7 +7,7 @@ name=fcl-db
 version=2.6.1
 
 [target]
-dirs=src/sdf src/memds src/sqldb src/base src/sql
+dirs=src/sdf src/memds src/sqldb src/base src/sql src/json
 dirs_beos=src/dbase src/sqlite src/paradox src/export src/datadict src/codegen
 dirs_haiku=src/dbase src/sqlite src/paradox src/export src/datadict src/codegen
 dirs_linux=src/dbase src/sqlite src/paradox src/export src/datadict src/codegen 
@@ -22,7 +22,7 @@ dirs_win64=src/dbase src/export src/datadict src/codegen
 dirs_wince=src/dbase src/sqlite src/export src/datadict src/codegen
 
 [require]
-packages=fcl-base fcl-xml
+packages=fcl-base fcl-xml fcl-json
 
 [compiler]
 options=-S2h
@@ -58,3 +58,9 @@ src/dbase_smart: src/base_smart
 src/dbase_release: src/base_release
 src/dbase_shared: src/base_shared
 
+src/json_all: src/base_all
+src/json_debug: src/base_debug
+src/json_smart: src/base_smart
+src/json_release: src/base_release
+src/json_shared: src/base_shared
+

+ 4 - 0
packages/fcl-db/fpmake.pp

@@ -37,6 +37,7 @@ begin
     P.SourcePath.Add('src/sqldb/examples');
     P.SourcePath.Add('src/sqldb/oracle');
     P.SourcePath.Add('src/sdf');
+    P.SourcePath.Add('src/json');
     P.SourcePath.Add('src/datadict');
     P.SourcePath.Add('src/memds');
     P.SourcePath.Add('src/codegen');
@@ -661,6 +662,9 @@ begin
         end;
     T.ResourceStrings := True;
 
+    // JSON
+    T:=P.Targets.AddUnit('fpjsondataset.pp');
+
     P.ExamplePath.Add('tests');
     T:=P.Targets.AddExampleProgram('dbftoolsunit.pas');
     T:=P.Targets.AddExampleProgram('dbtestframework.pas');

+ 43 - 0
packages/fcl-db/tests/test.json

@@ -0,0 +1,43 @@
+{
+  "metaData" : {
+    "fields" : [
+      {
+        "name" : "ID",
+        "type" : "int"
+      },
+      {
+        "name" : "Name",
+        "type" : "string",
+        "maxlen" : 20
+      },
+      {
+        "name" : "Email",
+        "type" : "string",
+        "maxlen" : 30
+      }
+    ],
+    "root" : "rows"
+  },
+  "rows" : [
+    {
+      "ID" : 3,
+      "Name" : "Michael",
+      "Email" : "[email protected]"
+    },
+    {
+      "ID" : 4,
+      "Name" : "jonas",
+      "Email" : "[email protected]"
+    },
+    {
+      "ID" : 1,
+      "Name" : "Florian",
+      "Email" : "[email protected]"
+    },
+    {
+      "ID" : 12,
+      "Name" : "Marco",
+      "Email" : "[email protected]"
+    }
+  ]
+}

+ 190 - 0
packages/fcl-db/tests/testjsondataset.pp

@@ -0,0 +1,190 @@
+program testjsondataset;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, sysutils, DB, fpjsondataset, fpjson, jsonparser;
+
+Function ExtractData(Const AFileName : string) : TJSONObject;
+
+Var
+  F : TFIleStream;
+  P : TJSONParser;
+  D : TJSONData;
+
+begin
+  Result:=Nil;
+  F:=TFileStream.Create(AFileName,fmOpenRead);
+  try
+    P:=TJSONParser.Create(F);
+    try
+      D:=P.Parse;
+      if (D.JSONType=jtObject) then
+        Result:=D as TJSONObject
+      else
+        FreeAndNil(D);
+    finally
+      P.Free;
+    end;
+  finally
+    F.Free;
+  end;
+end;
+Procedure DumpDataset(DS : TDataset);
+
+Var
+  I,J : Integer;
+
+begin
+  I:=0;
+  Writeln('Dataset contains ',DS.RecordCount,' records');
+  While not DS.EOF do
+    begin
+    Inc(I);
+    Writeln('=== Record ',I,' : ',DS.RecNo,' ===');
+    For J:=0 to DS.Fields.Count-1 do
+      With DS.Fields[J] do
+        Writeln(FieldName,' : ',AsString);
+    DS.Next;
+    end;
+  Writeln('Dataset contained ',I,' records');
+end;
+
+Procedure DoTest4(Const AFileName : string);
+
+Var
+  DS : TExtjsJSONObjectDataset;
+
+begin
+  DS:=TExtjsJSONObjectDataset.Create(Nil);
+  try
+    DS.LoadFromFile(AFileName);
+    DS.Open;
+    DumpDataset(DS);
+  finally
+    DS.Free;
+  end;
+end;
+
+Procedure DoTest1(Const AFileName : string);
+
+Var
+  D,M : TJSONObject;
+  DS : TExtjsJSONObjectDataset;
+  I,J : Integer;
+  F : TFieldDef;
+
+begin
+  D:=ExtractData(AFileName);
+  try
+    DS:=TExtjsJSONObjectDataset.Create(Nil);
+    try
+      DS.Rows:=D.Arrays['rows'];
+      DS.Metadata:=D.Objects['metaData'];
+      DS.OwnsData:=False;
+      DS.Open;
+      For I:=0 to DS.FieldDefs.Count-1 do
+        begin
+        F:=DS.FieldDefs[i];
+        Writeln('FieldDefs.Add(''',F.Name,''',',F.DataType,',',F.Size,');');
+        end;
+      DumpDataset(DS);
+    finally
+      DS.Free;
+    end;
+  finally
+    D.Free;
+  end;
+end;
+
+Procedure DoTest2(Const AFileName : string);
+
+Var
+  D,M : TJSONObject;
+  DS : TExtjsJSONObjectDataset;
+  I,J : Integer;
+  F : TFieldDef;
+begin
+  D:=ExtractData(AFileName);
+  DS:=TExtjsJSONObjectDataset.Create(Nil);
+  DS.Rows:=D.Arrays['rows'];
+  With DS do
+    begin
+    FieldDefs.Add('ID',ftLargeint,0);
+    FieldDefs.Add('Name',ftString,20);
+    FieldDefs.Add('Email',ftString,30);
+    end;
+  DS.Open;
+  DumpDataset(DS);
+end;
+
+Procedure DoTest3(Const AFileName : string);
+
+Var
+  DS : TExtjsJSONObjectDataset;
+  I,J : Integer;
+  F : TFieldDef;
+
+begin
+  DS:=TExtjsJSONObjectDataset.Create(Nil);
+  try
+    With DS do
+      begin
+      FieldDefs.Add('ID',ftLargeint,0);
+      FieldDefs.Add('Name',ftString,20);
+      FieldDefs.Add('Email',ftString,30);
+      Open;
+      // Record 1
+      Append;
+      FieldByName('ID').AsInteger:=3;
+      FieldByName('Name').AsString:='Michael';
+      FieldByName('Email').AsString:='[email protected]';
+      Post;
+      // Record 2
+      Append;
+      FieldByName('ID').AsInteger:=4;
+      FieldByName('Name').AsString:='jonas';
+      FieldByName('Email').AsString:='[email protected]';
+      Post;
+      DumpDataset(DS);
+      First;
+      // insert record 1
+      Insert;
+      FieldByName('ID').AsInteger:=1;
+      FieldByName('Name').AsString:='Florian';
+      FieldByName('Email').AsString:='[email protected]';
+      Post;
+      DumpDataset(DS);
+      Writeln('First');
+      First;
+      Writeln('Editing record ', RecNo,' ',FieldByName('Name').AsString);
+      Edit;
+      FieldByName('ID').AsInteger:=12;
+      FieldByName('Name').AsString:='Marco';
+      FieldByName('Email').AsString:='[email protected]';
+      Post;
+      First;
+      DumpDataset(DS);
+      First;
+      Next;
+      Writeln('Deleting record ', RecNo,' ',FieldByName('Name').AsString);
+      Delete;
+      First;
+      DumpDataset(DS);
+      SaveToFile(AFileName,True);
+      end;
+  finally
+    DS.Free
+  end;
+end;
+begin
+  Writeln('Test 1');
+  DoTest1('test.json');
+  Writeln('Test 2');
+  DoTest2('test.json');
+  Writeln('Test 3');
+  DoTest3('test3.json');
+  Writeln('Test 4');
+  DoTest4('test.json');
+end.
+

+ 1 - 0
packages/fcl-json/src/jsonparser.pp

@@ -39,6 +39,7 @@ Type
     function CurrentToken: TJSONToken;
     function ParseArray: TJSONArray;
     function ParseObject: TJSONObject;
+    Property Scanner : TJSONScanner read FScanner;
   Public
     function Parse: TJSONData;
     Constructor Create(Source : TStream); overload;

+ 2 - 0
packages/fcl-web/src/base/custcgi.pp

@@ -205,10 +205,12 @@ end;
 function TCgiHandler.WaitForRequest(out ARequest: TRequest; out AResponse: TResponse): boolean;
 begin
   FRequest:=CreateRequest;
+  InitRequest(FRequest);
   FRequest.InitFromEnvironment;
   FRequest.InitRequestVars;
   FOutput:=TIOStream.Create(iosOutput);
   FResponse:=CreateResponse(FOutput);
+  InitResponse(FResponse);
   ARequest:=FRequest;
   AResponse:=FResponse;
   Result := True;

+ 2 - 0
packages/fcl-web/src/base/custfcgi.pp

@@ -832,6 +832,7 @@ begin
     assert(not assigned(FRequestsArray[ARequestID].Request));
     assert(not assigned(FRequestsArray[ARequestID].Response));
     ATempRequest:=TFCGIRequest.Create;
+    InitRequest(ATempRequest);
     ATempRequest.RequestID:=ARequestID;
     ATempRequest.Handle:=FHandle;
     ATempRequest.ProtocolOptions:=Self.Protocoloptions;
@@ -848,6 +849,7 @@ begin
     begin
     ARequest:=FRequestsArray[ARequestID].Request;
     FRequestsArray[ARequestID].Response := TFCGIResponse.Create(ARequest);
+    InitResponse(FRequestsArray[ARequestID].Response);
     FRequestsArray[ARequestID].Response.ProtocolOptions:=Self.ProtocolOptions;
     FRequestsArray[ARequestID].Response.FOnWrite:=@DoFastCGIWrite;
     AResponse:=FRequestsArray[ARequestID].Response;

+ 35 - 0
packages/fcl-web/src/base/custhttpapp.pp

@@ -25,8 +25,17 @@ uses
 
 Type
   TCustomHTTPApplication = Class;
+  TFPHTTPServerHandler = Class;
+
+  { TEmbeddedHttpServer }
+
   TEmbeddedHttpServer = Class(TFPCustomHttpServer)
+  Private
+    FWebHandler: TFPHTTPServerHandler;
   protected
+    Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
+    Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
+    Property WebHandler : TFPHTTPServerHandler Read FWebHandler;
     Property Active;
   end;
 
@@ -49,6 +58,8 @@ Type
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
   protected
+    Procedure InitRequest(ARequest : TRequest); override;
+    Procedure InitResponse(AResponse : TResponse); override;
     function WaitForRequest(out ARequest : TRequest; out AResponse : TResponse) : boolean; override;
     Function CreateServer : TEmbeddedHttpServer; virtual;
     Property HTTPServer : TEmbeddedHttpServer Read FServer;
@@ -102,6 +113,19 @@ ResourceString
 
 Implementation
 
+{ TEmbeddedHttpServer }
+
+procedure TEmbeddedHttpServer.InitRequest(ARequest: TFPHTTPConnectionRequest);
+begin
+  WebHandler.InitRequest(ARequest);
+end;
+
+procedure TEmbeddedHttpServer.InitResponse(AResponse: TFPHTTPConnectionResponse
+  );
+begin
+  WebHandler.InitResponse(AResponse);
+end;
+
 {$ifdef CGIDEBUG}
 uses
   dbugintf;
@@ -215,6 +239,16 @@ begin
   FServer.Threaded:=AValue;
 end;
 
+procedure TFPHTTPServerHandler.InitRequest(ARequest: TRequest);
+begin
+  inherited InitRequest(ARequest);
+end;
+
+procedure TFPHTTPServerHandler.InitResponse(AResponse: TResponse);
+begin
+  inherited InitResponse(AResponse);
+end;
+
 function TFPHTTPServerHandler.WaitForRequest(out ARequest: TRequest;
   out AResponse: TResponse): boolean;
 begin
@@ -237,6 +271,7 @@ constructor TFPHTTPServerHandler.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FServer:=CreateServer;
+  FServer.FWebHandler:=Self;
   FServer.OnRequest:=@HTTPHandleRequest;
 end;
 

+ 28 - 2
packages/fcl-web/src/base/custweb.pp

@@ -84,6 +84,7 @@ Type
   TWebHandler = class(TComponent)
   private
     FOnIdle: TNotifyEvent;
+    FOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     FTerminated: boolean;
     FAdministrator: String;
     FAllowDefaultModule: Boolean;
@@ -92,7 +93,6 @@ Type
     FModuleVar: String;
     FOnGetModule: TGetModuleEvent;
     FOnShowRequestException: TOnShowRequestException;
-    FRequest : TRequest;
     FHandleGetOnPost : Boolean;
     FRedirectOnError : Boolean;
     FRedirectOnErrorURL : String;
@@ -108,6 +108,8 @@ Type
     Procedure SetBaseURL(AModule : TCustomHTTPModule; Const AModuleName : String; ARequest : TRequest); virtual;
     function GetApplicationURL(ARequest : TRequest): String; virtual;
     procedure ShowRequestException(R: TResponse; E: Exception); virtual;
+    Procedure InitRequest(ARequest : TRequest); virtual;
+    Procedure InitResponse(AResponse : TResponse); virtual;
     Function GetEmail : String; virtual;
     Function GetAdministrator : String; virtual;
     property Terminated: boolean read FTerminated;
@@ -121,7 +123,6 @@ Type
     Property RedirectOnError : boolean Read FRedirectOnError Write FRedirectOnError;
     Property RedirectOnErrorURL : string Read FRedirectOnErrorURL Write FRedirectOnErrorURL;
     Property ApplicationURL : String Read FApplicationURL Write FApplicationURL;
-    Property Request : TRequest read FRequest;
     Property AllowDefaultModule : Boolean Read FAllowDefaultModule Write FAllowDefaultModule;
     Property ModuleVariable : String Read FModuleVar Write FModuleVar;
     Property OnGetModule : TGetModuleEvent Read FOnGetModule Write FOnGetModule;
@@ -131,6 +132,7 @@ Type
     property OnShowRequestException: TOnShowRequestException read FOnShowRequestException write FOnShowRequestException;
     property OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
     Property OnLog : TLogEvent Read FOnLog Write FOnLog;
+    Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read FOnUnknownRequestEncoding Write FOnUnknownRequestEncoding;
   end;
 
   TCustomWebApplication = Class(TCustomApplication)
@@ -146,6 +148,7 @@ Type
     function GetModuleVar: String;
     function GetOnGetModule: TGetModuleEvent;
     function GetOnShowRequestException: TOnShowRequestException;
+    function GetOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
     function GetRedirectOnError: boolean;
     function GetRedirectOnErrorURL: string;
     procedure SetAdministrator(const AValue: String);
@@ -156,6 +159,7 @@ Type
     procedure SetModuleVar(const AValue: String);
     procedure SetOnGetModule(const AValue: TGetModuleEvent);
     procedure SetOnShowRequestException(const AValue: TOnShowRequestException);
+    procedure SetOnUnknownRequestEncoding(AValue: TOnUnknownEncodingEvent);
     procedure SetRedirectOnError(const AValue: boolean);
     procedure SetRedirectOnErrorURL(const AValue: string);
     procedure DoOnTerminate(Sender : TObject);
@@ -181,6 +185,7 @@ Type
     Property Email : String Read GetEmail Write SetEmail;
     Property Administrator : String Read GetAdministrator Write SetAdministrator;
     property OnShowRequestException: TOnShowRequestException read GetOnShowRequestException write SetOnShowRequestException;
+    Property OnUnknownRequestEncoding : TOnUnknownEncodingEvent Read GetOnUnknownRequestEncoding Write SetOnUnknownRequestEncoding;
     Property EventLog: TEventLog read GetEventLog;
   end;
 
@@ -289,6 +294,16 @@ begin
     end;
 end;
 
+procedure TWebHandler.InitRequest(ARequest: TRequest);
+begin
+  ARequest.OnUnknownEncoding:=Self.OnUnknownRequestEncoding;
+end;
+
+procedure TWebHandler.InitResponse(AResponse: TResponse);
+begin
+  // Do nothing
+end;
+
 function TWebHandler.GetEmail: String;
 begin
   Result := FEmail;
@@ -506,6 +521,11 @@ begin
   result := FWebHandler.OnShowRequestException;
 end;
 
+function TCustomWebApplication.GetOnUnknownRequestEncoding: TOnUnknownEncodingEvent;
+begin
+  Result := FWebHandler.OnUnknownRequestEncoding
+end;
+
 function TCustomWebApplication.GetRedirectOnError: boolean;
 begin
   result := FWebHandler.RedirectOnError;
@@ -556,6 +576,12 @@ begin
   FWebHandler.OnShowRequestException := AValue;
 end;
 
+procedure TCustomWebApplication.SetOnUnknownRequestEncoding(
+  AValue: TOnUnknownEncodingEvent);
+begin
+  FWebHandler.OnUnknownRequestEncoding:=AValue;
+end;
+
 procedure TCustomWebApplication.SetRedirectOnError(const AValue: boolean);
 begin
   FWebHandler.RedirectOnError := AValue;

+ 2 - 0
packages/fcl-web/src/base/fpapache.pp

@@ -254,9 +254,11 @@ Var
 begin
   Req:=TApacheRequest.CreateReq(Self,P);
   Try
+    InitRequest(Req);
     Req.InitRequestVars;
     Resp:=TApacheResponse.CreateApache(Req);
     Try
+      InitResponse(Resp);
       HandleRequest(Req,Resp);
       If Not Resp.ContentSent then
         Resp.SendContent;

+ 15 - 0
packages/fcl-web/src/base/fphttpserver.pp

@@ -111,6 +111,8 @@ Type
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
   Protected
+    Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
+    Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
     // Create a connection handling object.
     function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual;
     // Create a connection handling thread.
@@ -429,6 +431,7 @@ Var
   StartLine,S : String;
 begin
   Result:=TFPHTTPConnectionRequest.Create;
+  Server.InitRequest(Result);
   Result.FConnection:=Self;
   StartLine:=ReadString;
   ParseStartLine(Result,StartLine);
@@ -471,6 +474,7 @@ begin
     // Create Response
     Resp:= TFPHTTPConnectionResponse.Create(Req);
     try
+      Server.InitResponse(Resp);
       Resp.FConnection:=Self;
       // And dispatch
       if Server.Active then
@@ -557,6 +561,17 @@ begin
   FThreaded:=AValue;
 end;
 
+procedure TFPCustomHttpServer.InitRequest(ARequest: TFPHTTPConnectionRequest);
+begin
+
+end;
+
+procedure TFPCustomHttpServer.InitResponse(AResponse: TFPHTTPConnectionResponse
+  );
+begin
+
+end;
+
 function TFPCustomHttpServer.CreateConnection(Data: TSocketStream): TFPHTTPConnection;
 begin
   Result:=TFPHTTPConnection.Create(Self,Data);

+ 10 - 5
packages/fcl-web/src/base/fpwebfile.pp

@@ -98,13 +98,18 @@ Var
   D : String;
 
 begin
-  D:=Locations.Values[BaseURL];
-  If (D='') then
-    Result:=''
+  if (BaseURL='') then
+    Result:=AFileName
   else
     begin
-    Result:=D+AFileName;
-    DoDirSeparators(Result);
+    D:=Locations.Values[BaseURL];
+    If (D='') then
+      Result:=''
+    else
+      begin
+      Result:=D+AFileName;
+      DoDirSeparators(Result);
+      end;
     end;
 end;
 

+ 14 - 2
packages/fcl-web/src/base/httpdefs.pp

@@ -92,6 +92,7 @@ Const
                 
 
 type
+  TRequest = Class;
 
   { TCookie }
 
@@ -261,7 +262,7 @@ type
     property QueryFields : TStrings read FQueryFields;
   end;
 
-
+  TOnUnknownEncodingEvent = Procedure (Sender : TRequest; Const ContentType : String;Stream : TStream) of object;
   { TRequest }
 
   TRequest = class(THttpHeader)
@@ -269,6 +270,7 @@ type
     FCommand: String;
     FCommandLine: String;
     FHandleGetOnPost: Boolean;
+    FOnUnknownEncoding: TOnUnknownEncodingEvent;
     FPathInfo,
     FURI: String;
     FFiles : TUploadedFiles;
@@ -280,6 +282,7 @@ type
   Protected
     FContentRead : Boolean;
     FContent : String;
+    procedure HandleUnknownEncoding(Const AContentType : String;Stream : TStream); virtual;
     procedure ParseFirstHeaderLine(const line: String);override;
     procedure ReadContent; virtual;
     Function GetFieldValue(AIndex : Integer) : String; override;
@@ -304,6 +307,7 @@ type
     Property  HeaderLine : String read GetFirstHeaderLine;
     Property  Files : TUploadedFiles Read FFiles;
     Property  HandleGetOnPost : Boolean Read FHandleGetOnPost Write FHandleGetOnPost;
+    Property  OnUnknownEncoding : TOnUnknownEncodingEvent Read FOnUnknownEncoding Write FOnUnknownEncoding;
   end;
 
 
@@ -1065,6 +1069,12 @@ begin
     Result := Result + ' HTTP/' + HttpVersion;
 end;
 
+procedure TRequest.HandleUnknownEncoding(Const AContentType : String;Stream : TStream);
+begin
+  If Assigned(FOnUnknownEncoding) then
+    FOnUnknownEncoding(Self,AContentType,Stream);
+end;
+
 procedure TRequest.ReadContent;
 begin
   // Implement in descendents
@@ -1253,6 +1263,8 @@ begin
         ProcessMultiPart(M,CT, ContentFields)
       else if Pos('APPLICATION/X-WWW-FORM-URLENCODED',Uppercase(CT))<>0 then
         ProcessUrlEncoded(M, ContentFields)
+      else
+        HandleUnknownEncoding(CT,M)
     finally
      M.Free;
     end;
@@ -1260,7 +1272,7 @@ begin
 {$ifdef CGIDEBUG}
   SendMethodExit('InitPostVars');
 {$endif}
-        end;
+end;
 
 procedure TRequest.InitGetVars;
 Var

Some files were not shown because too many files changed in this diff