--- Merging r21769 into '.':

U    packages/fcl-web/src/base/httpdefs.pp
--- Merging r21870 into '.':
U    packages/fcl-base/src/uriparser.pp
--- Merging r21821 into '.':
U    packages/fcl-json/src/fpjson.pp
--- Merging r21837 into '.':
U    packages/fcl-json/src/jsonscanner.pp
U    packages/fcl-json/src/jsonparser.pp
--- Merging r21838 into '.':
G    packages/fcl-json/src/jsonscanner.pp
G    packages/fcl-json/src/jsonparser.pp
--- Merging r21865 into '.':
U    rtl/unix/sysutils.pp
U    rtl/win/sysutils.pp
U    rtl/objpas/sysutils/dati.inc
U    rtl/objpas/sysutils/datih.inc
--- Merging r21871 into '.':
U    packages/fcl-web/src/base/fphttpclient.pp
--- Merging r21872 into '.':
U    packages/fcl-web/src/base/fphttpserver.pp
--- Merging r21920 into '.':
U    packages/fcl-web/src/webdata/extjsjson.pp

# revisions: 21769,21870,21821,21837,21838,21865,21871,21872,21920
r21769 | michael | 2012-07-04 14:45:46 +0200 (Wed, 04 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/httpdefs.pp

* Customization of upload dir
r21870 | michael | 2012-07-11 15:53:25 +0200 (Wed, 11 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/uriparser.pp

* Added decode parameter to parseuri
r21821 | michael | 2012-07-09 09:39:51 +0200 (Mon, 09 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/fpjson.pp

* Patch from Luiz Americo to return a variant with get
r21837 | michael | 2012-07-10 08:56:06 +0200 (Tue, 10 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/jsonparser.pp
   M /trunk/packages/fcl-json/src/jsonscanner.pp

* Patch to allow use of UTF8 in ansistring (as requested in Bug ID #22310)
r21838 | michael | 2012-07-10 11:09:38 +0200 (Tue, 10 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-json/src/jsonparser.pp
   M /trunk/packages/fcl-json/src/jsonscanner.pp

* Reversed default. Using UTF8 is now the default, old behaviour can be restored
r21865 | michael | 2012-07-11 11:56:34 +0200 (Wed, 11 Jul 2012) | 1 line
Changed paths:
   M /trunk/rtl/objpas/sysutils/dati.inc
   M /trunk/rtl/objpas/sysutils/datih.inc
   M /trunk/rtl/unix/sysutils.pp
   M /trunk/rtl/win/sysutils.pp

* Added  GetLocalTimeOffset function
r21871 | michael | 2012-07-11 15:54:07 +0200 (Wed, 11 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpclient.pp

* Do not decode the URL before passing it on
r21872 | michael | 2012-07-11 16:54:26 +0200 (Wed, 11 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/base/fphttpserver.pp

* Initialize QueryString
r21920 | michael | 2012-07-16 15:24:23 +0200 (Mon, 16 Jul 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-web/src/webdata/extjsjson.pp

* Time is in 24 hours time

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

packages/fcl-base/src/uriparser.pp

@@ -37,8 +37,8 @@ type
   end;
 
 function EncodeURI(const URI: TURI): String;
-function ParseURI(const URI: String):  TURI; overload;
-function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI; overload;
+function ParseURI(const URI: String; Decode : Boolean = True):  TURI; overload;
+function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word; Decode : Boolean = True):  TURI; overload;
 
 function ResolveRelativeURI(const BaseUri, RelUri: WideString;
   out ResultUri: WideString): Boolean; overload;
@@ -125,9 +125,9 @@ begin
     Result := Result + '#' + Escape(URI.Bookmark, ValidPathChars);
 end;
 
-function ParseURI(const URI: String):  TURI;
+function ParseURI(const URI: String; Decode : Boolean = True):  TURI;
 begin
-  Result := ParseURI(URI, '', 0);
+  Result := ParseURI(URI, '', 0, Decode);
 end;
 
 function HexValue(c: Char): Integer;
@@ -166,7 +166,7 @@ begin
   SetLength(Result, RealLength);
 end;
 
-function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word):  TURI;
+function ParseURI(const URI, DefaultProtocol: String; DefaultPort: Word;Decode : Boolean = True):  TURI;
 var
   s, Authority: String;
   i: Integer;
@@ -194,7 +194,9 @@ begin
   i := LastDelimiter('#', s);
   if i > 0 then
   begin
-    Result.Bookmark := Unescape(Copy(s, i + 1, MaxInt));
+    Result.Bookmark := Copy(s, i + 1, MaxInt);
+    if Decode then
+      Result.Bookmark:=Unescape(Result.Bookmark);
     s := Copy(s, 1, i - 1);
   end;
 
@@ -203,7 +205,9 @@ begin
   i := LastDelimiter('?', s);
   if i > 0 then
   begin
-    Result.Params := Unescape(Copy(s, i + 1, MaxInt));
+    Result.Params := Copy(s, i + 1, MaxInt);
+    if Decode then
+      Result.Params:=Unescape(Result.Params);
     s := Copy(s, 1, i - 1);
   end;
 
@@ -230,7 +234,9 @@ begin
   for i := Length(s) downto 1 do
     if s[i] = '/' then
     begin
-      Result.Document := Unescape(Copy(s, i + 1, Length(s)));
+      Result.Document :=Copy(s, i + 1, Length(s));
+      if Decode then
+        Result.Document:=Unescape(Result.Document);
       if (Result.Document <> '.') and (Result.Document <> '..') then
         s := Copy(s, 1, i)
       else
@@ -240,7 +246,9 @@ begin
       break
     else if i = 1 then
     begin
-      Result.Document := Unescape(s);
+      Result.Document :=s;
+      if Decode then
+        Result.Document:=Unescape(Result.Document);
       if (Result.Document <> '.') and (Result.Document <> '..') then
         s := ''
       else
@@ -250,7 +258,9 @@ begin
 
   // Everything left is a path
 
-  Result.Path := Unescape(s);
+  Result.Path := s;
+  if Decode then
+    Result.Path:=Unescape(Result.Path);
 
   // Extract the port number
 

packages/fcl-json/src/fpjson.pp

@@ -396,6 +396,7 @@ Type
     Function IndexOfName(const AName: TJSONStringType; CaseInsensitive : Boolean = False): Integer;
     Function Find(Const AName : String) : TJSONData; overload;
     Function Find(Const AName : String; AType : TJSONType) : TJSONData; overload;
+    Function Get(Const AName : String) : Variant;
     Function Get(Const AName : String; ADefault : TJSONFloat) : TJSONFloat;
     Function Get(Const AName : String; ADefault : Integer) : Integer;
     Function Get(Const AName : String; ADefault : Int64) : Int64;
@@ -2059,6 +2060,18 @@ begin
     Result:=Nil
 end;
 
+function TJSONObject.Get(const AName: String): Variant;
+Var
+  I : Integer;
+
+begin
+  I:=IndexOfName(AName);
+  If (I<>-1) then
+    Result:=Items[i].Value
+  else
+    Result:=Null;
+end;
+
 function TJSONObject.Get(const AName: String; ADefault: TJSONFloat
   ): TJSONFloat;
 

packages/fcl-json/src/jsonparser.pp

@@ -28,9 +28,12 @@ Type
   TJSONParser = Class(TObject)
   Private
     FScanner : TJSONScanner;
+    FuseUTF8,
     FStrict: Boolean;
     function ParseNumber: TJSONNumber;
     procedure SetStrict(const AValue: Boolean);
+    function GetUTF8 : Boolean;
+    procedure SetUTF8(const AValue: Boolean);
   Protected
     procedure DoError(const Msg: String);
     function DoParse(AtCurrent,AllowEOF: Boolean): TJSONData;
@@ -42,11 +45,13 @@ Type
     Property Scanner : TJSONScanner read FScanner;
   Public
     function Parse: TJSONData;
-    Constructor Create(Source : TStream); overload;
-    Constructor Create(Source : TJSONStringType); overload;
+    Constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;
+    Constructor Create(Source : TJSONStringType; AUseUTF8 : Boolean = True); overload;
     destructor Destroy();override;
     // Use strict JSON: " for strings, object members are strings, not identifiers
     Property Strict : Boolean Read FStrict Write SetStrict;
+    // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
+    Property UseUTF8 : Boolean Read GetUTF8 Write SetUTF8;
   end;
   
   EJSONParser = Class(EParserError);
@@ -152,6 +157,23 @@ begin
     end;
 end;
 
+function TJSONParser.GetUTF8 : Boolean;
+
+begin
+  if Assigned(FScanner) then
+    Result:=FScanner.UseUTF8
+  else
+    Result:=FUseUTF8;  
+end;
+
+procedure TJSONParser.SetUTF8(const AValue: Boolean);
+
+begin
+  FUseUTF8:=AValue;
+  if Assigned(FScanner) then
+    FScanner.UseUTF8:=FUseUTF8;
+end;
+
 procedure TJSONParser.SetStrict(const AValue: Boolean);
 begin
   if (FStrict=AValue) then
@@ -250,16 +272,18 @@ begin
   Raise EJSONParser.Create(S);
 end;
 
-constructor TJSONParser.Create(Source: TStream);
+constructor TJSONParser.Create(Source: TStream; AUseUTF8 : Boolean = True);
 begin
   Inherited Create;
   FScanner:=TJSONScanner.Create(Source);
+  UseUTF8:=AUseUTF8;
 end;
 
-constructor TJSONParser.Create(Source: TJSONStringType);
+constructor TJSONParser.Create(Source: TJSONStringType; AUseUTF8 : Boolean = True);
 begin
   Inherited Create;
   FScanner:=TJSONScanner.Create(Source);
+  UseUTF8:=AUseUTF8;
 end;
 
 destructor TJSONParser.Destroy();

packages/fcl-json/src/jsonscanner.pp

@@ -59,6 +59,7 @@ type
     FCurTokenString: string;
     FCurLine: string;
     FStrict: Boolean;
+    FUseUTF8 : Boolean;
     TokenStr: PChar;
     function GetCurColumn: Integer;
   protected
@@ -66,8 +67,8 @@ type
     procedure Error(const Msg: string; Args: array of Const);overload;
     function DoFetchToken: TJSONToken;
   public
-    constructor Create(Source : TStream); overload;
-    constructor Create(const Source : String); overload;
+    constructor Create(Source : TStream; AUseUTF8 : Boolean = True); overload;
+    constructor Create(const Source : String; AUseUTF8 : Boolean = True); overload;
     destructor Destroy; override;
     function FetchToken: TJSONToken;
 
@@ -80,6 +81,8 @@ type
     property CurTokenString: string read FCurTokenString;
     // Use strict JSON: " for strings, object members are strings, not identifiers
     Property Strict : Boolean Read FStrict Write FStrict;
+    // if set to TRUE, then strings will be converted to UTF8 ansistrings, not system codepage ansistrings.
+    Property UseUTF8 : Boolean Read FUseUTF8 Write FUseUTF8;
   end;
 
 const
@@ -104,17 +107,19 @@ const
 
 implementation
 
-constructor TJSONScanner.Create(Source : TStream);
+constructor TJSONScanner.Create(Source : TStream; AUseUTF8 : Boolean = True);
 
 begin
   FSource:=TStringList.Create;
   FSource.LoadFromStream(Source);
+  FUseUTF8:=AUseUTF8;
 end;
 
-constructor TJSONScanner.Create(const Source : String);
+constructor TJSONScanner.Create(const Source : String; AUseUTF8 : Boolean = True);
 begin
   FSource:=TStringList.Create;
   FSource.Text:=Source;
+  FUseUTF8:=AUseUTF8;
 end;
 
 destructor TJSONScanner.Destroy;
@@ -235,8 +240,11 @@ begin
                         Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
                       end;
                       end;
-                    // Takes care of conversion...  
-                    S:=WideChar(StrToInt('$'+S));  
+                    // WideChar takes care of conversion...  
+                    if UseUTF8 then
+                      S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
+                    else
+                      S:=WideChar(StrToInt('$'+S));  
                     end;
               #0  : Error(SErrOpenString);
             else

packages/fcl-web/src/base/fphttpclient.pp

@@ -738,7 +738,7 @@ Var
 
 begin
   FResponseHeaders.Clear;
-  URI:=ParseURI(AURL);
+  URI:=ParseURI(AURL,False);
   If (Lowercase(URI.Protocol)<>'http') then
    Raise EHTTPClient.CreateFmt(SErrInvalidProtocol,[URI.Protocol]);
   ConnectToServer(URI.Host,URI.Port);

packages/fcl-web/src/base/fphttpserver.pp

@@ -35,7 +35,11 @@ Type
   TFPHTTPConnectionRequest = Class(TRequest)
   private
     FConnection: TFPHTTPConnection;
+    FQueryString : String;
   protected
+    function GetFieldValue(Index: Integer): String; override;
+    procedure SetFieldValue(Index: Integer; Value: String);override;
+    Procedure InitRequestVars; override;
     procedure SetContent(AValue : String);
   published
     Property Connection : TFPHTTPConnection Read FConnection;
@@ -111,6 +115,9 @@ Type
     procedure SetQueueSize(const AValue: Word);
     procedure SetThreaded(const AValue: Boolean);
   Protected
+    // Override these to create descendents of the request/response instead.
+    Function CreateRequest : TFPHTTPConnectionRequest; virtual;
+    Function CreateResponse(ARequest : TFPHTTPConnectionRequest) : TFPHTTPConnectionResponse; virtual;
     Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
     Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
     // Create a connection handling object.
@@ -223,32 +230,40 @@ begin
   end;
 end;
 
+procedure TFPHTTPConnectionRequest.InitRequestVars;
+Var
+  P : Integer;
+begin
+  P:=Pos('?',URI);
+  if (P<>0) then
+    FQueryString:=Copy(URI,P+1,Length(URI)-P);
+  inherited InitRequestVars;
+end;
+
 procedure TFPHTTPConnectionRequest.SetContent(AValue : String);
 
 begin
   FContent:=Avalue;
   FContentRead:=true;
-  InitRequestVars;
 end;
-(*
+
 Procedure TFPHTTPConnectionRequest.SetFieldValue(Index : Integer; Value : String);
 
 begin
-  if Index=35 then
-    FContent:=Value
+  if Index=33 then
+    FQueryString:=Value
   else
-    Inherited (Index,Value);
+    Inherited SetFieldValue(Index,Value);
 end;
 
 Function TFPHTTPConnectionRequest.GetFieldValue(Index : Integer) : String;
 
 begin
-  if Index=35 then
-    Result:=FContent
+  if Index=33 then
+    Result:=FQueryString
   else
     Result:=Inherited GetFieldValue(Index);
 end;
-*)
 
 procedure TFPHTTPConnectionResponse.DoSendHeaders(Headers: TStrings);
 
@@ -430,7 +445,7 @@ function TFPHTTPConnection.ReadRequestHeaders: TFPHTTPConnectionRequest;
 Var
   StartLine,S : String;
 begin
-  Result:=TFPHTTPConnectionRequest.Create;
+  Result:=Server.CreateRequest;
   Server.InitRequest(Result);
   Result.FConnection:=Self;
   StartLine:=ReadString;
@@ -468,11 +483,10 @@ begin
   try
     // Read content, if any
     If Req.ContentLength>0 then
-      begin
       ReadRequestContent(Req);
-      end;
+    Req.InitRequestVars;
     // Create Response
-    Resp:= TFPHTTPConnectionResponse.Create(Req);
+    Resp:= Server.CreateResponse(Req);
     try
       Server.InitResponse(Resp);
       Resp.FConnection:=Self;
@@ -561,6 +575,16 @@ begin
   FThreaded:=AValue;
 end;
 
+function TFPCustomHttpServer.CreateRequest: TFPHTTPConnectionRequest;
+begin
+  Result:=TFPHTTPConnectionRequest.Create;
+end;
+
+function TFPCustomHttpServer.CreateResponse(ARequest : TFPHTTPConnectionRequest): TFPHTTPConnectionResponse;
+begin
+  Result:=TFPHTTPConnectionResponse.Create(ARequest);
+end;
+
 procedure TFPCustomHttpServer.InitRequest(ARequest: TFPHTTPConnectionRequest);
 begin
 

packages/fcl-web/src/base/httpdefs.pp

@@ -294,7 +294,9 @@ type
     Procedure ProcessMultiPart(Stream : TStream; Const Boundary : String;SL:TStrings); virtual;
     Procedure ProcessQueryString(Const FQueryString : String; SL:TStrings); virtual;
     procedure ProcessURLEncoded(Stream : TStream;SL:TStrings); virtual;
-    Function  GetTempUploadFileName : String; virtual;
+    Function RequestUploadDir : String; virtual;
+    Function  GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64) : String; virtual;
+    Procedure DeleteTempUploadedFiles; virtual;
     Procedure InitRequestVars; virtual;
     Procedure InitPostVars; virtual;
     Procedure InitGetVars; virtual;
@@ -955,18 +957,8 @@ begin
 end;
 
 destructor TRequest.destroy;
-var
-  i: Integer;
-  s: String;
 begin
-  //delete all temporary uploaded files created for this request if there is any
-  i := FFiles.Count;
-  if i > 0 then for i := i - 1 downto 0 do
-    begin
-    s := FFiles[i].LocalFileName;
-    if FileExists(s) then DeleteFile(s);
-    end;
-  //
+  DeleteTempUploadedFiles;
   FreeAndNil(FFiles);
   inherited destroy;
 end;
@@ -1195,18 +1187,36 @@ begin
 {$ifdef CGIDEBUG}SendMethodExit('ProcessQueryString');{$endif CGIDEBUG}
 end;
 
-function TRequest.GetTempUploadFileName: String;
+Function TRequest.RequestUploadDir : String;
 
 begin
-//Result:=GetTempFileName('/tmp/','CGI') {Hard coded path no good for all OS-es}
-{
-GetTempDir returns the OS temporary directory if possible, or from the
-environment variable TEMP . For CGI programs you need to pass global environment
- variables, it is not automatic. For example in the Apache httpd.conf with a
-"PassEnv TEMP" or "SetEnv TEMP /pathtotmpdir" line so the web server passes this
- global environment variable to the CGI programs' local environment variables.
-}
-  Result := GetTempFileName(GetTempDir, 'CGI');
+  Result:='';
+end;
+
+Function TRequest.GetTempUploadFileName(Const AName, AFileName : String; ASize : Int64): String;
+
+Var
+  D : String;
+
+begin
+  D:=RequestUploadDir;
+  if (D='') then
+    D:=GetTempDir; // Note that this may require a TEMP environment variable to be set by the webserver.
+  Result:=GetTempFileName(D, 'CGI');
+end;
+
+Procedure TRequest.DeleteTempUploadedFiles;
+var
+  i: Integer;
+  s: String;
+begin
+  //delete all temporary uploaded files created for this request if there is any
+  i := FFiles.Count;
+  if i > 0 then for i := i - 1 downto 0 do
+    begin
+    s := FFiles[i].LocalFileName;
+    if FileExists(s) then DeleteFile(s);
+    end;
 end;
 
 procedure TRequest.InitRequestVars;
@@ -1360,10 +1370,10 @@ begin
         else
           begin
           FI.DLen:=J;
-          FF:=GetTempUploadFileName;
+          FF:=GetTempUploadFileName(FI.name,FI.FileName,J);
           F:=TFileStream.Create(FF,fmCreate);
           Try
-            F.Write(FI.Data[1],Length(FI.Data));
+            F.Write(FI.Data[1],J);
           finally
             F.Free;
           end;

packages/fcl-web/src/webdata/extjsjson.pp

@@ -291,9 +291,9 @@ begin
           // Needs improving
           Case Fi.DataType of
             ftDate : O.Add('dateFormat','Y-m-d');
-            ftTime : O.Add('dateFormat','h:i:s');
+            ftTime : O.Add('dateFormat','H:i:s');
             ftDateTime,
-            ftTimeStamp : O.Add('dateFormat','Y-m-d h:i:s');
+            ftTimeStamp : O.Add('dateFormat','Y-m-d H:i:s');
           end;
         end;
       F.Add(O);

rtl/objpas/sysutils/dati.inc

@@ -1394,3 +1394,10 @@ begin
   DateTime:=tmp;
 end;
 
+{$IFNDEF HAS_LOCALTIMEZONEOFFSET}
+Function GetLocalTimeOffset : Integer;
+
+begin
+  Result:=0;
+end;
+{$ENDIF}

rtl/objpas/sysutils/datih.inc

@@ -186,3 +186,4 @@ Procedure GetLocalTime(var SystemTime: TSystemTime);
 
 procedure ReplaceTime(var dati:TDateTime; NewTime : TDateTime); inline;
 procedure ReplaceDate(var DateTime: TDateTime; const NewDate: TDateTime); inline;
+function GetLocalTimeOffset: Integer;

rtl/unix/sysutils.pp

@@ -33,7 +33,7 @@ interface
 {$DEFINE HASUNIX}
 {$DEFINE HASCREATEGUID}
 {$DEFINE HAS_OSUSERDIR}
-
+{$DEFINE HAS_LOCALTIMEZONEOFFSET}
 uses
   Unix,errors,sysconst,Unixtype;
 
@@ -1390,6 +1390,12 @@ begin
   Flush(Output);
 end;
 
+function GetLocalTimeOffset: Integer;
+
+begin
+ Result := -Tzseconds div 60; 
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}

rtl/win/sysutils.pp

@@ -30,7 +30,7 @@ uses
 {$DEFINE HAS_OSCONFIG}
 {$DEFINE HAS_OSUSERDIR}
 {$DEFINE HAS_CREATEGUID}
-
+{$DEFINE HAS_LOCALTIMEZONEOFFSET}
 { Include platform independent interface part }
 {$i sysutilh.inc}
 
@@ -587,6 +587,25 @@ begin
   windows.Getlocaltime(SystemTime);
 end;
 
+function GetLocalTimeOffset: Integer;
+
+var 
+  TZInfo: TTimeZoneInformation;
+
+begin
+   case GetTimeZoneInformation(TZInfo) of
+     TIME_ZONE_ID_UNKNOWN:
+       Result := TZInfo.Bias;
+     TIME_ZONE_ID_STANDARD:
+       Result := TZInfo.Bias + TZInfo.StandardBias;
+     TIME_ZONE_ID_DAYLIGHT:
+       Result := TZInfo.Bias + TZInfo.DaylightBias;
+     else
+       Result := 0;
+   end;
+end; 
+ 
+                                                                    
 
 {****************************************************************************
                               Misc Functions