From 27274229510ce6c99f20dad2d11fc2d7acc6e8d3 Mon Sep 17 00:00:00 2001 From: Jake Farrell Date: Thu, 10 Nov 2011 20:32:44 +0000 Subject: [PATCH] Thrift-1401: JSON-protocol for Delphi XE Libraries Client: delphi Patch: Jens Geyer Adds support for the JSON protocol to the existing Delphi XE libraries. git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1200538 13f79535-47bb-0310-9956-ffa450edef68 --- lib/delphi/src/Thrift.Protocol.JSON.pas | 1165 +++++++++++++++++++++++ lib/delphi/src/Thrift.Server.pas | 636 ++++++------- lib/delphi/src/Thrift.pas | 344 +++---- lib/delphi/test/TestClient.pas | 163 +++- lib/delphi/test/TestConstants.pas | 36 + lib/delphi/test/TestServer.pas | 911 +++++++++--------- lib/delphi/test/client.dpr | 125 +-- lib/delphi/test/server.dpr | 125 ++- 8 files changed, 2437 insertions(+), 1068 deletions(-) create mode 100644 lib/delphi/src/Thrift.Protocol.JSON.pas create mode 100644 lib/delphi/test/TestConstants.pas diff --git a/lib/delphi/src/Thrift.Protocol.JSON.pas b/lib/delphi/src/Thrift.Protocol.JSON.pas new file mode 100644 index 00000000..6fd64933 --- /dev/null +++ b/lib/delphi/src/Thrift.Protocol.JSON.pas @@ -0,0 +1,1165 @@ +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +{$SCOPEDENUMS ON} + +unit Thrift.Protocol.JSON; + +interface + +uses + Classes, + SysUtils, + Math, + IdCoderMIME, + Generics.Collections, + Thrift.Transport, + Thrift.Protocol; + +type + IJSONProtocol = interface( IProtocol) + ['{F0DAFDBD-692A-4B71-9736-F5D485A2178F}'] + // Read a byte that must match b; otherwise an exception is thrown. + procedure ReadJSONSyntaxChar( b : Byte); + end; + + // JSON protocol implementation for thrift. + // This is a full-featured protocol supporting Write and Read. + // Please see the C++ class header for a detailed description of the protocol's wire format. + // Adapted from the C# version. + TJSONProtocolImpl = class( TProtocolImpl, IJSONProtocol) + public + type + TFactory = class( TInterfacedObject, IProtocolFactory) + public + function GetProtocol( trans: ITransport): IProtocol; + end; + + private + class function GetTypeNameForTypeID(typeID : TType) : string; + class function GetTypeIDForTypeName( const name : string) : TType; + + protected + type + // Base class for tracking JSON contexts that may require + // inserting/Reading additional JSON syntax characters. + // This base context does nothing. + TJSONBaseContext = class + protected + FProto : IJSONProtocol; + public + constructor Create( const aProto : IJSONProtocol); + procedure Write; virtual; + procedure Read; virtual; + function EscapeNumbers : Boolean; virtual; + end; + + // Context for JSON lists. + // Will insert/Read commas before each item except for the first one. + TJSONListContext = class( TJSONBaseContext) + private + FFirst : Boolean; + public + constructor Create( const aProto : IJSONProtocol); + procedure Write; override; + procedure Read; override; + end; + + // Context for JSON records. Will insert/Read colons before the value portion of each record + // pair, and commas before each key except the first. In addition, will indicate that numbers + // in the key position need to be escaped in quotes (since JSON keys must be strings). + TJSONPairContext = class( TJSONBaseContext) + private + FFirst, FColon : Boolean; + public + constructor Create( const aProto : IJSONProtocol); + procedure Write; override; + procedure Read; override; + function EscapeNumbers : Boolean; override; + end; + + // Holds up to one byte from the transport + TLookaheadReader = class + protected + FProto : IJSONProtocol; + constructor Create( const aProto : IJSONProtocol); + + private + FHasData : Boolean; + FData : TBytes; + + public + // Return and consume the next byte to be Read, either taking it from the + // data buffer if present or getting it from the transport otherwise. + function Read : Byte; + + // Return the next byte to be Read without consuming, filling the data + // buffer if it has not been filled alReady. + function Peek : Byte; + end; + + protected + // Stack of nested contexts that we may be in + FContextStack : TStack; + + // Current context that we are in + FContext : TJSONBaseContext; + + // Reader that manages a 1-byte buffer + FReader : TLookaheadReader; + + // Push/pop a new JSON context onto/from the stack. + procedure PushContext( aCtx : TJSONBaseContext); + procedure PopContext; + + public + // TJSONProtocolImpl Constructor + constructor Create( aTrans : ITransport); + destructor Destroy; override; + + protected + // IJSONProtocol + // Read a byte that must match b; otherwise an exception is thrown. + procedure ReadJSONSyntaxChar( b : Byte); + + private + // Convert a byte containing a hex char ('0'-'9' or 'a'-'f') into its corresponding hex value + class function HexVal( ch : Byte) : Byte; + + // Convert a byte containing a hex value to its corresponding hex character + class function HexChar( val : Byte) : Byte; + + // Write the bytes in array buf as a JSON characters, escaping as needed + procedure WriteJSONString( const b : TBytes); overload; + procedure WriteJSONString( str : string); overload; + + // Write out number as a JSON value. If the context dictates so, it will be + // wrapped in quotes to output as a JSON string. + procedure WriteJSONInteger( num : Int64); + + // Write out a double as a JSON value. If it is NaN or infinity or if the + // context dictates escaping, Write out as JSON string. + procedure WriteJSONDouble( const num : Double); + + // Write out contents of byte array b as a JSON string with base-64 encoded data + procedure WriteJSONBase64( const b : TBytes); + + procedure WriteJSONObjectStart; + procedure WriteJSONObjectEnd; + procedure WriteJSONArrayStart; + procedure WriteJSONArrayEnd; + + public + // IProtocol + procedure WriteMessageBegin( aMsg : IMessage); override; + procedure WriteMessageEnd; override; + procedure WriteStructBegin(struc: IStruct); override; + procedure WriteStructEnd; override; + procedure WriteFieldBegin(field: IField); override; + procedure WriteFieldEnd; override; + procedure WriteFieldStop; override; + procedure WriteMapBegin(map: IMap); override; + procedure WriteMapEnd; override; + procedure WriteListBegin( list: IList); override; + procedure WriteListEnd(); override; + procedure WriteSetBegin( set_: ISet ); override; + procedure WriteSetEnd(); override; + procedure WriteBool( b: Boolean); override; + procedure WriteByte( b: ShortInt); override; + procedure WriteI16( i16: SmallInt); override; + procedure WriteI32( i32: Integer); override; + procedure WriteI64( i64: Int64); override; + procedure WriteDouble( d: Double); override; + procedure WriteString( const s: string ); override; + procedure WriteBinary( const b: TBytes); override; + // + function ReadMessageBegin: IMessage; override; + procedure ReadMessageEnd(); override; + function ReadStructBegin: IStruct; override; + procedure ReadStructEnd; override; + function ReadFieldBegin: IField; override; + procedure ReadFieldEnd(); override; + function ReadMapBegin: IMap; override; + procedure ReadMapEnd(); override; + function ReadListBegin: IList; override; + procedure ReadListEnd(); override; + function ReadSetBegin: ISet; override; + procedure ReadSetEnd(); override; + function ReadBool: Boolean; override; + function ReadByte: ShortInt; override; + function ReadI16: SmallInt; override; + function ReadI32: Integer; override; + function ReadI64: Int64; override; + function ReadDouble:Double; override; + function ReadString : string; override; + function ReadBinary: TBytes; override; + + + private + // Reading methods. + + // Read in a JSON string, unescaping as appropriate. + // Skip Reading from the context if skipContext is true. + function ReadJSONString( skipContext : Boolean) : TBytes; + + // Return true if the given byte could be a valid part of a JSON number. + function IsJSONNumeric( b : Byte) : Boolean; + + // Read in a sequence of characters that are all valid in JSON numbers. Does + // not do a complete regex check to validate that this is actually a number. + function ReadJSONNumericChars : String; + + // Read in a JSON number. If the context dictates, Read in enclosing quotes. + function ReadJSONInteger : Int64; + + // Read in a JSON double value. Throw if the value is not wrapped in quotes + // when expected or if wrapped in quotes when not expected. + function ReadJSONDouble : Double; + + // Read in a JSON string containing base-64 encoded data and decode it. + function ReadJSONBase64 : TBytes; + + procedure ReadJSONObjectStart; + procedure ReadJSONObjectEnd; + procedure ReadJSONArrayStart; + procedure ReadJSONArrayEnd; + end; + + +implementation + +var + COMMA : TBytes; + COLON : TBytes; + LBRACE : TBytes; + RBRACE : TBytes; + LBRACKET : TBytes; + RBRACKET : TBytes; + QUOTE : TBytes; + BACKSLASH : TBytes; + ZERO : TBytes; + ESCSEQ : TBytes; + +const + VERSION = 1; + JSON_CHAR_TABLE : array[0..$2F] of Byte + = (0,0,0,0, 0,0,0,0, Byte('b'),Byte('t'),Byte('n'),0, Byte('f'),Byte('r'),0,0, + 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, + 1,1,Byte('"'),1, 1,1,1,1, 1,1,1,1, 1,1,1,1); + + ESCAPE_CHARS = '"\btnfr'; + ESCAPE_CHAR_VALS = '"\'#8#9#10#12#13; + + DEF_STRING_SIZE = 16; + + NAME_BOOL = 'tf'; + NAME_BYTE = 'i8'; + NAME_I16 = 'i16'; + NAME_I32 = 'i32'; + NAME_I64 = 'i64'; + NAME_DOUBLE = 'dbl'; + NAME_STRUCT = 'rec'; + NAME_STRING = 'str'; + NAME_MAP = 'map'; + NAME_LIST = 'lst'; + NAME_SET = 'set'; + + INVARIANT_CULTURE : TFormatSettings + = ( ThousandSeparator: ','; + DecimalSeparator: '.'); + + + +//--- TJSONProtocolImpl ---------------------- + + +function TJSONProtocolImpl.TFactory.GetProtocol( trans: ITransport): IProtocol; +begin + result := TJSONProtocolImpl.Create(trans); +end; + +class function TJSONProtocolImpl.GetTypeNameForTypeID(typeID : TType) : string; +begin + case typeID of + TType.Bool_: result := NAME_BOOL; + TType.Byte_: result := NAME_BYTE; + TType.I16: result := NAME_I16; + TType.I32: result := NAME_I32; + TType.I64: result := NAME_I64; + TType.Double_: result := NAME_DOUBLE; + TType.String_: result := NAME_STRING; + TType.Struct: result := NAME_STRUCT; + TType.Map: result := NAME_MAP; + TType.Set_: result := NAME_SET; + TType.List: result := NAME_LIST; + else + raise TProtocolException.Create( TProtocolException.NOT_IMPLEMENTED, 'Unrecognized type ('+IntToStr(Ord(typeID))+')'); + end; +end; + + +class function TJSONProtocolImpl.GetTypeIDForTypeName( const name : string) : TType; +begin + if name = NAME_BOOL then result := TType.Bool_ + else if name = NAME_BYTE then result := TType.Byte_ + else if name = NAME_I16 then result := TType.I16 + else if name = NAME_I32 then result := TType.I32 + else if name = NAME_I64 then result := TType.I64 + else if name = NAME_DOUBLE then result := TType.Double_ + else if name = NAME_STRUCT then result := TType.Struct + else if name = NAME_STRING then result := TType.String_ + else if name = NAME_MAP then result := TType.Map + else if name = NAME_LIST then result := TType.List + else if name = NAME_SET then result := TType.Set_ + else raise TProtocolException.Create( TProtocolException.NOT_IMPLEMENTED, 'Unrecognized type ('+name+')'); +end; + + +constructor TJSONProtocolImpl.TJSONBaseContext.Create( const aProto : IJSONProtocol); +begin + inherited Create; + FProto := aProto; +end; + + +procedure TJSONProtocolImpl.TJSONBaseContext.Write; +begin + // nothing +end; + + +procedure TJSONProtocolImpl.TJSONBaseContext.Read; +begin + // nothing +end; + + +function TJSONProtocolImpl.TJSONBaseContext.EscapeNumbers : Boolean; +begin + result := FALSE; +end; + + +constructor TJSONProtocolImpl.TJSONListContext.Create( const aProto : IJSONProtocol); +begin + inherited Create( aProto); + FFirst := TRUE; +end; + + +procedure TJSONProtocolImpl.TJSONListContext.Write; +begin + if FFirst + then FFirst := FALSE + else FProto.Transport.Write( COMMA); +end; + + +procedure TJSONProtocolImpl.TJSONListContext.Read; +begin + if FFirst + then FFirst := FALSE + else FProto.ReadJSONSyntaxChar( COMMA[0]); +end; + + +constructor TJSONProtocolImpl.TJSONPairContext.Create( const aProto : IJSONProtocol); +begin + inherited Create( aProto); + FFirst := TRUE; + FColon := TRUE; +end; + + +procedure TJSONProtocolImpl.TJSONPairContext.Write; +begin + if FFirst then begin + FFirst := FALSE; + FColon := TRUE; + end + else begin + if FColon + then FProto.Transport.Write( COLON) + else FProto.Transport.Write( COMMA); + FColon := not FColon; + end; +end; + + +procedure TJSONProtocolImpl.TJSONPairContext.Read; +begin + if FFirst then begin + FFirst := FALSE; + FColon := TRUE; + end + else begin + if FColon + then FProto.ReadJSONSyntaxChar( COLON[0]) + else FProto.ReadJSONSyntaxChar( COMMA[0]); + FColon := not FColon; + end; +end; + + +function TJSONProtocolImpl.TJSONPairContext.EscapeNumbers : Boolean; +begin + result := FColon; +end; + + +constructor TJSONProtocolImpl.TLookaheadReader.Create( const aProto : IJSONProtocol); +begin + inherited Create; + FProto := aProto; + FHasData := FALSE; +end; + + +function TJSONProtocolImpl.TLookaheadReader.Read : Byte; +begin + if FHasData + then FHasData := FALSE + else begin + SetLength( FData, 1); + FProto.Transport.ReadAll( FData, 0, 1); + end; + result := FData[0]; +end; + + +function TJSONProtocolImpl.TLookaheadReader.Peek : Byte; +begin + if not FHasData then begin + SetLength( FData, 1); + FProto.Transport.ReadAll( FData, 0, 1); + FHasData := TRUE; + end; + result := FData[0]; +end; + + +procedure TJSONProtocolImpl.PushContext( aCtx : TJSONBaseContext); +begin + FContextStack.Push( FContext); + FContext := aCtx; +end; + +procedure TJSONProtocolImpl.PopContext; +begin + FreeAndNil(FContext); + FContext := FContextStack.Pop; +end; + + +constructor TJSONProtocolImpl.Create( aTrans : ITransport); +begin + inherited Create( aTrans); + + // Stack of nested contexts that we may be in + FContextStack := TStack.Create; + + FContext := TJSONBaseContext.Create( Self); + FReader := TLookaheadReader.Create( Self); +end; + + +destructor TJSONProtocolImpl.Destroy; +begin + try + FreeAndNil( FReader); + FreeAndNil( FContext); + FreeAndNil( FContextStack); + finally + inherited Destroy; + end; +end; + + +procedure TJSONProtocolImpl.ReadJSONSyntaxChar( b : Byte); +var ch : Byte; +begin + ch := FReader.Read; + if (ch <> b) + then raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Unexpected character ('+Char(ch)+')'); +end; + + +class function TJSONProtocolImpl.HexVal( ch : Byte) : Byte; +var i : Integer; +begin + i := StrToIntDef( '$0'+Char(ch), -1); + if (0 <= i) and (i < $10) + then result := i + else raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Expected hex character ('+Char(ch)+')'); +end; + + +class function TJSONProtocolImpl.HexChar( val : Byte) : Byte; +const HEXCHARS = '0123456789ABCDEF'; +begin + result := Byte( PChar(HEXCHARS)[val and $0F]); + ASSERT( Pos( Char(result), HEXCHARS) > 0); +end; + + +procedure TJSONProtocolImpl.WriteJSONString( str : string); +begin + WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( str)); +end; + + +procedure TJSONProtocolImpl.WriteJSONString( const b : TBytes); +var i : Integer; + tmp : TBytes; +begin + FContext.Write; + Transport.Write( QUOTE); + for i := 0 to Length(b)-1 do begin + + if (b[i] and $00FF) >= $30 then begin + + if (b[i] = BACKSLASH[0]) then begin + Transport.Write( BACKSLASH); + Transport.Write( BACKSLASH); + end + else begin + Transport.Write( b, i, 1); + end; + + end + else begin + SetLength( tmp, 2); + tmp[0] := JSON_CHAR_TABLE[b[i]]; + if (tmp[0] = 1) then begin + Transport.Write( b, i, 1) + end + else if (tmp[0] > 1) then begin + Transport.Write( BACKSLASH); + Transport.Write( tmp, 0, 1); + end + else begin + Transport.Write( ESCSEQ); + tmp[0] := HexChar( b[i] div $10); + tmp[1] := HexChar( b[i]); + Transport.Write( tmp, 0, 2); + end; + end; + end; + Transport.Write( QUOTE); +end; + + +procedure TJSONProtocolImpl.WriteJSONInteger( num : Int64); +var str : String; + escapeNum : Boolean; +begin + FContext.Write; + str := IntToStr(num); + + escapeNum := FContext.EscapeNumbers; + if escapeNum + then Transport.Write( QUOTE); + + Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str)); + + if escapeNum + then Transport.Write( QUOTE); +end; + + +procedure TJSONProtocolImpl.WriteJSONDouble( const num : Double); +var str : string; + special : Boolean; + escapeNum : Boolean; +begin + FContext.Write; + + str := FloatToStr( num, INVARIANT_CULTURE); + special := FALSE; + + case UpCase(str[1]) of + 'N' : special := TRUE; // NaN + 'I' : special := TRUE; // Infinity + '-' : special := (UpCase(str[2]) = 'I'); // -Infinity + end; + + escapeNum := special or FContext.EscapeNumbers; + + + if escapeNum + then Transport.Write( QUOTE); + + Transport.Write( SysUtils.TEncoding.UTF8.GetBytes( str)); + + if escapeNum + then Transport.Write( QUOTE); +end; + + +procedure TJSONProtocolImpl.WriteJSONBase64( const b : TBytes); +var str : string; + tmp : TBytes; + i : Integer; +begin + FContext.Write; + Transport.Write( QUOTE); + + // First base64-encode b, then write the resulting 8-bit chars + // Unfortunately, EncodeBytes() returns a string of 16-bit (wide) chars + // And for the sake of efficiency, we want to write everything at once + str := TIdEncoderMIME.EncodeBytes(b); + ASSERT( SizeOf(str[1]) = SizeOf(Word)); + SetLength( tmp, Length(str)); + for i := 1 to Length(str) do begin + ASSERT( Hi(Word(str[i])) = 0); // base64 consists of a well-defined set of 8-bit chars only + tmp[i-1] := Lo(Word(str[i])); // extract the lower byte + end; + Transport.Write( tmp); // now write all the data + + Transport.Write( QUOTE); +end; + + +procedure TJSONProtocolImpl.WriteJSONObjectStart; +begin + FContext.Write; + Transport.Write( LBRACE); + PushContext( TJSONPairContext.Create( Self)); +end; + + +procedure TJSONProtocolImpl.WriteJSONObjectEnd; +begin + PopContext; + Transport.Write( RBRACE); +end; + + +procedure TJSONProtocolImpl.WriteJSONArrayStart; +begin + FContext.Write; + Transport.Write( LBRACKET); + PushContext( TJSONListContext.Create( Self)); +end; + + +procedure TJSONProtocolImpl.WriteJSONArrayEnd; +begin + PopContext; + Transport.Write( RBRACKET); +end; + + +procedure TJSONProtocolImpl.WriteMessageBegin( aMsg : IMessage); +begin + WriteJSONArrayStart; + WriteJSONInteger(VERSION); + + WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( aMsg.Name)); + + WriteJSONInteger( LongInt( aMsg.Type_)); + WriteJSONInteger( aMsg.SeqID); +end; + +procedure TJSONProtocolImpl.WriteMessageEnd; +begin + WriteJSONArrayEnd; +end; + + +procedure TJSONProtocolImpl.WriteStructBegin( struc: IStruct); +begin + WriteJSONObjectStart; +end; + + +procedure TJSONProtocolImpl.WriteStructEnd; +begin + WriteJSONObjectEnd; +end; + + +procedure TJSONProtocolImpl.WriteFieldBegin( field : IField); +begin + WriteJSONInteger(field.ID); + WriteJSONObjectStart; + WriteJSONString( GetTypeNameForTypeID(field.Type_)); +end; + + +procedure TJSONProtocolImpl.WriteFieldEnd; +begin + WriteJSONObjectEnd; +end; + + +procedure TJSONProtocolImpl.WriteFieldStop; +begin + // nothing to do +end; + +procedure TJSONProtocolImpl.WriteMapBegin( map: IMap); +begin + WriteJSONArrayStart; + WriteJSONString( GetTypeNameForTypeID( map.KeyType)); + WriteJSONString( GetTypeNameForTypeID( map.ValueType)); + WriteJSONInteger( map.Count); + WriteJSONObjectStart; +end; + + +procedure TJSONProtocolImpl.WriteMapEnd; +begin + WriteJSONObjectEnd; + WriteJSONArrayEnd; +end; + + +procedure TJSONProtocolImpl.WriteListBegin( list: IList); +begin + WriteJSONArrayStart; + WriteJSONString( GetTypeNameForTypeID( list.ElementType)); + WriteJSONInteger(list.Count); +end; + + +procedure TJSONProtocolImpl.WriteListEnd; +begin + WriteJSONArrayEnd; +end; + + +procedure TJSONProtocolImpl.WriteSetBegin( set_: ISet); +begin + WriteJSONArrayStart; + WriteJSONString( GetTypeNameForTypeID( set_.ElementType)); + WriteJSONInteger( set_.Count); +end; + + +procedure TJSONProtocolImpl.WriteSetEnd; +begin + WriteJSONArrayEnd; +end; + +procedure TJSONProtocolImpl.WriteBool( b: Boolean); +begin + if b + then WriteJSONInteger( 1) + else WriteJSONInteger( 0); +end; + +procedure TJSONProtocolImpl.WriteByte( b: ShortInt); +begin + WriteJSONInteger( b); +end; + +procedure TJSONProtocolImpl.WriteI16( i16: SmallInt); +begin + WriteJSONInteger( i16); +end; + +procedure TJSONProtocolImpl.WriteI32( i32: Integer); +begin + WriteJSONInteger( i32); +end; + +procedure TJSONProtocolImpl.WriteI64( i64: Int64); +begin + WriteJSONInteger(i64); +end; + +procedure TJSONProtocolImpl.WriteDouble( d: Double); +begin + WriteJSONDouble( d); +end; + +procedure TJSONProtocolImpl.WriteString( const s: string ); +begin + WriteJSONString( SysUtils.TEncoding.UTF8.GetBytes( s)); +end; + +procedure TJSONProtocolImpl.WriteBinary( const b: TBytes); +begin + WriteJSONBase64( b); +end; + + +function TJSONProtocolImpl.ReadJSONString( skipContext : Boolean) : TBytes; +var buffer : TMemoryStream; + ch : Byte; + off : Integer; + tmp : TBytes; +begin + buffer := TMemoryStream.Create; + try + if not skipContext + then FContext.Read; + + ReadJSONSyntaxChar( QUOTE[0]); + + while TRUE do begin + ch := FReader.Read; + + if (ch = QUOTE[0]) + then Break; + + if (ch = ESCSEQ[0]) + then begin + ch := FReader.Read; + if (ch = ESCSEQ[1]) + then begin + ReadJSONSyntaxChar( ZERO[0]); + ReadJSONSyntaxChar( ZERO[0]); + SetLength( tmp, 2); + Transport.ReadAll( tmp, 0, 2); + ch := (HexVal(tmp[0]) shl 4) + HexVal(tmp[1]); + end + else begin + off := Pos( Char(ch), ESCAPE_CHARS); + if off < 1 + then raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Expected control char'); + ch := Byte( ESCAPE_CHAR_VALS[off]); + end; + end; + buffer.Write( ch, 1); + end; + + SetLength( result, buffer.Size); + Move( buffer.Memory^, result[0], Length(result)); + + finally + buffer.Free; + end; +end; + + +function TJSONProtocolImpl.IsJSONNumeric( b : Byte) : Boolean; +const NUMCHARS = ['+','-','.','0','1','2','3','4','5','6','7','8','9','E','e']; +begin + result := CharInSet( Char(b), NUMCHARS); +end; + + +function TJSONProtocolImpl.ReadJSONNumericChars : string; +var strbld : TThriftStringBuilder; + ch : Byte; +begin + strbld := TThriftStringBuilder.Create; + try + while TRUE do begin + ch := FReader.Peek; + if IsJSONNumeric(ch) + then strbld.Append( Char(FReader.Read)) + else Break; + end; + result := strbld.ToString; + + finally + strbld.Free; + end; +end; + + +function TJSONProtocolImpl.ReadJSONInteger : Int64; +var str : string; +begin + FContext.Read; + if FContext.EscapeNumbers + then ReadJSONSyntaxChar( QUOTE[0]); + + str := ReadJSONNumericChars; + + if FContext.EscapeNumbers + then ReadJSONSyntaxChar( QUOTE[0]); + + try + result := StrToInt64(str); + except + on e:Exception do begin + raise TProtocolException.Create( TProtocolException.INVALID_DATA, + 'Bad data encounted in numeric data ('+str+') ('+e.Message+')'); + end; + end; +end; + + +function TJSONProtocolImpl.ReadJSONDouble : Double; +var dub : Double; + str : string; +begin + FContext.Read; + + if FReader.Peek = QUOTE[0] + then begin + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( TRUE)); + dub := StrToFloat( str, INVARIANT_CULTURE); + + if not FContext.EscapeNumbers() + and not Math.IsNaN(dub) + and not Math.IsInfinite(dub) + then begin + // Throw exception -- we should not be in a string in Self case + raise TProtocolException.Create( TProtocolException.INVALID_DATA, 'Numeric data unexpectedly quoted'); + end; + result := dub; + Exit; + end; + + // will throw - we should have had a quote if escapeNum == true + if FContext.EscapeNumbers + then ReadJSONSyntaxChar( QUOTE[0]); + + try + str := ReadJSONNumericChars; + result := StrToFloat( str, INVARIANT_CULTURE); + except + on e:Exception + do raise TProtocolException.Create( TProtocolException.INVALID_DATA, + 'Bad data encounted in numeric data ('+str+') ('+e.Message+')'); + end; +end; + + +function TJSONProtocolImpl.ReadJSONBase64 : TBytes; +var b : TBytes; + str : string; +begin + b := ReadJSONString(false); + + SetString( str, PAnsiChar(b), Length(b)); + result := TIdDecoderMIME.DecodeBytes( str); +end; + + +procedure TJSONProtocolImpl.ReadJSONObjectStart; +begin + FContext.Read; + ReadJSONSyntaxChar( LBRACE[0]); + PushContext( TJSONPairContext.Create( Self)); +end; + + +procedure TJSONProtocolImpl.ReadJSONObjectEnd; +begin + ReadJSONSyntaxChar( RBRACE[0]); + PopContext; +end; + + +procedure TJSONProtocolImpl.ReadJSONArrayStart; +begin + FContext.Read; + ReadJSONSyntaxChar( LBRACKET[0]); + PushContext( TJSONListContext.Create( Self)); +end; + + +procedure TJSONProtocolImpl.ReadJSONArrayEnd; +begin + ReadJSONSyntaxChar( RBRACKET[0]); + PopContext; +end; + + +function TJSONProtocolImpl.ReadMessageBegin: IMessage; +begin + result := TMessageImpl.Create; + ReadJSONArrayStart; + + if ReadJSONInteger <> VERSION + then raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Message contained bad version.'); + + result.Name := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE)); + result.Type_ := TMessageType( ReadJSONInteger); + result.SeqID := ReadJSONInteger; +end; + + +procedure TJSONProtocolImpl.ReadMessageEnd; +begin + ReadJSONArrayEnd; +end; + + +function TJSONProtocolImpl.ReadStructBegin : IStruct ; +begin + ReadJSONObjectStart; + result := TStructImpl.Create(''); +end; + + +procedure TJSONProtocolImpl.ReadStructEnd; +begin + ReadJSONObjectEnd; +end; + + +function TJSONProtocolImpl.ReadFieldBegin : IField; +var ch : Byte; + str : string; +begin + result := TFieldImpl.Create; + ch := FReader.Peek; + if ch = RBRACE[0] + then result.Type_ := TType.Stop + else begin + result.ID := ReadJSONInteger; + ReadJSONObjectStart; + + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE)); + result.Type_ := GetTypeIDForTypeName( str); + end; +end; + + +procedure TJSONProtocolImpl.ReadFieldEnd; +begin + ReadJSONObjectEnd; +end; + + +function TJSONProtocolImpl.ReadMapBegin : IMap; +var str : string; +begin + result := TMapImpl.Create; + ReadJSONArrayStart; + + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE)); + result.KeyType := GetTypeIDForTypeName( str); + + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE)); + result.ValueType := GetTypeIDForTypeName( str); + + result.Count := ReadJSONInteger; + ReadJSONObjectStart; +end; + + +procedure TJSONProtocolImpl.ReadMapEnd; +begin + ReadJSONObjectEnd; + ReadJSONArrayEnd; +end; + + +function TJSONProtocolImpl.ReadListBegin : IList; +var str : string; +begin + result := TListImpl.Create; + ReadJSONArrayStart; + + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE)); + result.ElementType := GetTypeIDForTypeName( str); + result.Count := ReadJSONInteger; +end; + + +procedure TJSONProtocolImpl.ReadListEnd; +begin + ReadJSONArrayEnd; +end; + + +function TJSONProtocolImpl.ReadSetBegin : ISet; +var str : string; +begin + result := TSetImpl.Create; + ReadJSONArrayStart; + + str := SysUtils.TEncoding.UTF8.GetString( ReadJSONString(FALSE)); + result.ElementType := GetTypeIDForTypeName( str); + result.Count := ReadJSONInteger; +end; + + +procedure TJSONProtocolImpl.ReadSetEnd; +begin + ReadJSONArrayEnd; +end; + + +function TJSONProtocolImpl.ReadBool : Boolean; +begin + result := (ReadJSONInteger <> 0); +end; + + +function TJSONProtocolImpl.ReadByte : ShortInt; +begin + result := ReadJSONInteger; +end; + + +function TJSONProtocolImpl.ReadI16 : SmallInt; +begin + result := ReadJSONInteger; +end; + + +function TJSONProtocolImpl.ReadI32 : LongInt; +begin + result := ReadJSONInteger; +end; + + +function TJSONProtocolImpl.ReadI64 : Int64; +begin + result := ReadJSONInteger; +end; + + +function TJSONProtocolImpl.ReadDouble : Double; +begin + result := ReadJSONDouble; +end; + + +function TJSONProtocolImpl.ReadString : string; +begin + result := SysUtils.TEncoding.UTF8.GetString( ReadJSONString( FALSE)); +end; + + +function TJSONProtocolImpl.ReadBinary : TBytes; +begin + result := ReadJSONBase64; +end; + + +//--- init code --- + +procedure InitBytes( var b : TBytes; aData : array of Byte); +begin + SetLength( b, Length(aData)); + Move( aData, b[0], Length(b)); +end; + +initialization + InitBytes( COMMA, [Byte(',')]); + InitBytes( COLON, [Byte(':')]); + InitBytes( LBRACE, [Byte('{')]); + InitBytes( RBRACE, [Byte('}')]); + InitBytes( LBRACKET, [Byte('[')]); + InitBytes( RBRACKET, [Byte(']')]); + InitBytes( QUOTE, [Byte('"')]); + InitBytes( BACKSLASH, [Byte('\')]); + InitBytes( ZERO, [Byte('0')]); + InitBytes( ESCSEQ, [Byte('\'),Byte('u'),Byte('0'),Byte('0')]); +end. diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas index 23b69764..2d35c191 100644 --- a/lib/delphi/src/Thrift.Server.pas +++ b/lib/delphi/src/Thrift.Server.pas @@ -1,191 +1,191 @@ -(* - * Licensed to the Apache Software Foundation (ASF) under one - * or more contributor license agreements. See the NOTICE file - * distributed with this work for additional information - * regarding copyright ownership. The ASF licenses this file - * to you under the Apache License, Version 2.0 (the - * "License"); you may not use this file except in compliance - * with the License. You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, - * software distributed under the License is distributed on an - * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY - * KIND, either express or implied. See the License for the - * specific language governing permissions and limitations - * under the License. - *) - - unit Thrift.Server; - -interface - -uses - SysUtils, - Thrift, - Thrift.Protocol, - Thrift.Transport; - -type - IServer = interface - ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}'] - procedure Serve; - procedure Stop; - end; - - TServerImpl = class abstract( TInterfacedObject, IServer ) - public - type - TLogDelegate = reference to procedure( str: string); - protected - FProcessor : IProcessor; - FServerTransport : IServerTransport; - FInputTransportFactory : ITransportFactory; - FOutputTransportFactory : ITransportFactory; - FInputProtocolFactory : IProtocolFactory; - FOutputProtocolFactory : IProtocolFactory; - FLogDelegate : TLogDelegate; - - class procedure DefaultLogDelegate( str: string); - - procedure Serve; virtual; abstract; - procedure Stop; virtual; abstract; - public - constructor Create( - AProcessor :IProcessor; - AServerTransport: IServerTransport; - AInputTransportFactory : ITransportFactory; - AOutputTransportFactory : ITransportFactory; - AInputProtocolFactory : IProtocolFactory; - AOutputProtocolFactory : IProtocolFactory; - ALogDelegate : TLogDelegate - ); overload; - - constructor Create( AProcessor :IProcessor; - AServerTransport: IServerTransport); overload; - - constructor Create( - AProcessor :IProcessor; - AServerTransport: IServerTransport; - ALogDelegate: TLogDelegate - ); overload; - - constructor Create( - AProcessor :IProcessor; - AServerTransport: IServerTransport; - ATransportFactory : ITransportFactory - ); overload; - - constructor Create( - AProcessor :IProcessor; - AServerTransport: IServerTransport; - ATransportFactory : ITransportFactory; - AProtocolFactory : IProtocolFactory - ); overload; - end; - - TSimpleServer = class( TServerImpl) - private - FStop : Boolean; - public - constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport); overload; - constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; - ALogDel: TServerImpl.TLogDelegate); overload; - constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; - ATransportFactory: ITransportFactory); overload; - constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; - ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); overload; - - procedure Serve; override; - procedure Stop; override; - end; - - -implementation - -{ TServerImpl } - -constructor TServerImpl.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; ALogDelegate: TLogDelegate); -var - InputFactory, OutputFactory : IProtocolFactory; - InputTransFactory, OutputTransFactory : ITransportFactory; - -begin - InputFactory := TBinaryProtocolImpl.TFactory.Create; - OutputFactory := TBinaryProtocolImpl.TFactory.Create; - InputTransFactory := TTransportFactoryImpl.Create; - OutputTransFactory := TTransportFactoryImpl.Create; - - Create( - AProcessor, - AServerTransport, - InputTransFactory, - OutputTransFactory, - InputFactory, - OutputFactory, - ALogDelegate - ); -end; - -constructor TServerImpl.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport); -var - InputFactory, OutputFactory : IProtocolFactory; - InputTransFactory, OutputTransFactory : ITransportFactory; - -begin - InputFactory := TBinaryProtocolImpl.TFactory.Create; - OutputFactory := TBinaryProtocolImpl.TFactory.Create; - InputTransFactory := TTransportFactoryImpl.Create; - OutputTransFactory := TTransportFactoryImpl.Create; - - Create( - AProcessor, - AServerTransport, - InputTransFactory, - OutputTransFactory, - InputFactory, - OutputFactory, - DefaultLogDelegate - ); -end; - -constructor TServerImpl.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; ATransportFactory: ITransportFactory); -var - InputProtocolFactory : IProtocolFactory; - OutputProtocolFactory : IProtocolFactory; -begin - InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - - Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory, - InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate); -end; - -constructor TServerImpl.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; AInputTransportFactory, - AOutputTransportFactory: ITransportFactory; AInputProtocolFactory, - AOutputProtocolFactory: IProtocolFactory; - ALogDelegate : TLogDelegate); -begin - FProcessor := AProcessor; - FServerTransport := AServerTransport; - FInputTransportFactory := AInputTransportFactory; - FOutputTransportFactory := AOutputTransportFactory; - FInputProtocolFactory := AInputProtocolFactory; - FOutputProtocolFactory := AOutputProtocolFactory; - FLogDelegate := ALogDelegate; -end; - -class procedure TServerImpl.DefaultLogDelegate( str: string); -begin - Writeln( str ); -end; - -constructor TServerImpl.Create(AProcessor: IProcessor; +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + + unit Thrift.Server; + +interface + +uses + SysUtils, + Thrift, + Thrift.Protocol, + Thrift.Transport; + +type + IServer = interface + ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}'] + procedure Serve; + procedure Stop; + end; + + TServerImpl = class abstract( TInterfacedObject, IServer ) + public + type + TLogDelegate = reference to procedure( str: string); + protected + FProcessor : IProcessor; + FServerTransport : IServerTransport; + FInputTransportFactory : ITransportFactory; + FOutputTransportFactory : ITransportFactory; + FInputProtocolFactory : IProtocolFactory; + FOutputProtocolFactory : IProtocolFactory; + FLogDelegate : TLogDelegate; + + class procedure DefaultLogDelegate( str: string); + + procedure Serve; virtual; abstract; + procedure Stop; virtual; abstract; + public + constructor Create( + AProcessor :IProcessor; + AServerTransport: IServerTransport; + AInputTransportFactory : ITransportFactory; + AOutputTransportFactory : ITransportFactory; + AInputProtocolFactory : IProtocolFactory; + AOutputProtocolFactory : IProtocolFactory; + ALogDelegate : TLogDelegate + ); overload; + + constructor Create( AProcessor :IProcessor; + AServerTransport: IServerTransport); overload; + + constructor Create( + AProcessor :IProcessor; + AServerTransport: IServerTransport; + ALogDelegate: TLogDelegate + ); overload; + + constructor Create( + AProcessor :IProcessor; + AServerTransport: IServerTransport; + ATransportFactory : ITransportFactory + ); overload; + + constructor Create( + AProcessor :IProcessor; + AServerTransport: IServerTransport; + ATransportFactory : ITransportFactory; + AProtocolFactory : IProtocolFactory + ); overload; + end; + + TSimpleServer = class( TServerImpl) + private + FStop : Boolean; + public + constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport); overload; + constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; + ALogDel: TServerImpl.TLogDelegate); overload; + constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; + ATransportFactory: ITransportFactory); overload; + constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport; + ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); overload; + + procedure Serve; override; + procedure Stop; override; + end; + + +implementation + +{ TServerImpl } + +constructor TServerImpl.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; ALogDelegate: TLogDelegate); +var + InputFactory, OutputFactory : IProtocolFactory; + InputTransFactory, OutputTransFactory : ITransportFactory; + +begin + InputFactory := TBinaryProtocolImpl.TFactory.Create; + OutputFactory := TBinaryProtocolImpl.TFactory.Create; + InputTransFactory := TTransportFactoryImpl.Create; + OutputTransFactory := TTransportFactoryImpl.Create; + + Create( + AProcessor, + AServerTransport, + InputTransFactory, + OutputTransFactory, + InputFactory, + OutputFactory, + ALogDelegate + ); +end; + +constructor TServerImpl.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport); +var + InputFactory, OutputFactory : IProtocolFactory; + InputTransFactory, OutputTransFactory : ITransportFactory; + +begin + InputFactory := TBinaryProtocolImpl.TFactory.Create; + OutputFactory := TBinaryProtocolImpl.TFactory.Create; + InputTransFactory := TTransportFactoryImpl.Create; + OutputTransFactory := TTransportFactoryImpl.Create; + + Create( + AProcessor, + AServerTransport, + InputTransFactory, + OutputTransFactory, + InputFactory, + OutputFactory, + DefaultLogDelegate + ); +end; + +constructor TServerImpl.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; ATransportFactory: ITransportFactory); +var + InputProtocolFactory : IProtocolFactory; + OutputProtocolFactory : IProtocolFactory; +begin + InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + + Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory, + InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate); +end; + +constructor TServerImpl.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; AInputTransportFactory, + AOutputTransportFactory: ITransportFactory; AInputProtocolFactory, + AOutputProtocolFactory: IProtocolFactory; + ALogDelegate : TLogDelegate); +begin + FProcessor := AProcessor; + FServerTransport := AServerTransport; + FInputTransportFactory := AInputTransportFactory; + FOutputTransportFactory := AOutputTransportFactory; + FInputProtocolFactory := AInputProtocolFactory; + FOutputProtocolFactory := AOutputProtocolFactory; + FLogDelegate := ALogDelegate; +end; + +class procedure TServerImpl.DefaultLogDelegate( str: string); +begin + Writeln( str ); +end; + +constructor TServerImpl.Create(AProcessor: IProcessor; AServerTransport: IServerTransport; ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); begin @@ -196,133 +196,133 @@ begin end; { TSimpleServer } - -constructor TSimpleServer.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport); -var - InputProtocolFactory : IProtocolFactory; - OutputProtocolFactory : IProtocolFactory; - InputTransportFactory : ITransportFactory; - OutputTransportFactory : ITransportFactory; -begin - InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - InputTransportFactory := TTransportFactoryImpl.Create; - OutputTransportFactory := TTransportFactoryImpl.Create; - - inherited Create( AProcessor, AServerTransport, InputTransportFactory, - OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate); -end; - -constructor TSimpleServer.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate); -var - InputProtocolFactory : IProtocolFactory; - OutputProtocolFactory : IProtocolFactory; - InputTransportFactory : ITransportFactory; - OutputTransportFactory : ITransportFactory; -begin - InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; - InputTransportFactory := TTransportFactoryImpl.Create; - OutputTransportFactory := TTransportFactoryImpl.Create; - - inherited Create( AProcessor, AServerTransport, InputTransportFactory, - OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel); -end; - -constructor TSimpleServer.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; ATransportFactory: ITransportFactory); -begin - inherited Create( AProcessor, AServerTransport, ATransportFactory, - ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate); -end; - -constructor TSimpleServer.Create(AProcessor: IProcessor; - AServerTransport: IServerTransport; ATransportFactory: ITransportFactory; - AProtocolFactory: IProtocolFactory); -begin - inherited Create( AProcessor, AServerTransport, ATransportFactory, - ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate); -end; - -procedure TSimpleServer.Serve; -var - client : ITransport; - InputTransport : ITransport; - OutputTransport : ITransport; - InputProtocol : IProtocol; - OutputProtocol : IProtocol; -begin - try - FServerTransport.Listen; - except - on E: Exception do - begin - FLogDelegate( E.ToString); - end; - end; - - client := nil; - InputTransport := nil; - OutputTransport := nil; - InputProtocol := nil; - OutputProtocol := nil; - - while (not FStop) do - begin - try - client := FServerTransport.Accept; - FLogDelegate( 'Client Connected!'); - InputTransport := FInputTransportFactory.GetTransport( client ); - OutputTransport := FOutputTransportFactory.GetTransport( client ); - InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport ); - OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport ); - while ( FProcessor.Process( InputProtocol, OutputProtocol )) do - begin - if FStop then Break; - end; - except - on E: TTransportException do - begin - if FStop then - begin - FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName); - end; - end; - on E: Exception do - begin - FLogDelegate( E.ToString ); - end; - end; - if InputTransport <> nil then - begin - InputTransport.Close; - end; - if OutputTransport <> nil then - begin - OutputTransport.Close; - end; - end; - - if FStop then - begin - try - FServerTransport.Close; - except - on E: TTransportException do - begin - FLogDelegate('TServerTranport failed on close: ' + E.Message); - end; - end; - FStop := False; - end; -end; - -procedure TSimpleServer.Stop; -begin - FStop := True; - FServerTransport.Close; -end; - -end. + +constructor TSimpleServer.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport); +var + InputProtocolFactory : IProtocolFactory; + OutputProtocolFactory : IProtocolFactory; + InputTransportFactory : ITransportFactory; + OutputTransportFactory : ITransportFactory; +begin + InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + InputTransportFactory := TTransportFactoryImpl.Create; + OutputTransportFactory := TTransportFactoryImpl.Create; + + inherited Create( AProcessor, AServerTransport, InputTransportFactory, + OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate); +end; + +constructor TSimpleServer.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate); +var + InputProtocolFactory : IProtocolFactory; + OutputProtocolFactory : IProtocolFactory; + InputTransportFactory : ITransportFactory; + OutputTransportFactory : ITransportFactory; +begin + InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + InputTransportFactory := TTransportFactoryImpl.Create; + OutputTransportFactory := TTransportFactoryImpl.Create; + + inherited Create( AProcessor, AServerTransport, InputTransportFactory, + OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel); +end; + +constructor TSimpleServer.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; ATransportFactory: ITransportFactory); +begin + inherited Create( AProcessor, AServerTransport, ATransportFactory, + ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate); +end; + +constructor TSimpleServer.Create(AProcessor: IProcessor; + AServerTransport: IServerTransport; ATransportFactory: ITransportFactory; + AProtocolFactory: IProtocolFactory); +begin + inherited Create( AProcessor, AServerTransport, ATransportFactory, + ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate); +end; + +procedure TSimpleServer.Serve; +var + client : ITransport; + InputTransport : ITransport; + OutputTransport : ITransport; + InputProtocol : IProtocol; + OutputProtocol : IProtocol; +begin + try + FServerTransport.Listen; + except + on E: Exception do + begin + FLogDelegate( E.ToString); + end; + end; + + client := nil; + InputTransport := nil; + OutputTransport := nil; + InputProtocol := nil; + OutputProtocol := nil; + + while (not FStop) do + begin + try + client := FServerTransport.Accept; + FLogDelegate( 'Client Connected!'); + InputTransport := FInputTransportFactory.GetTransport( client ); + OutputTransport := FOutputTransportFactory.GetTransport( client ); + InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport ); + OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport ); + while ( FProcessor.Process( InputProtocol, OutputProtocol )) do + begin + if FStop then Break; + end; + except + on E: TTransportException do + begin + if FStop then + begin + FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName); + end; + end; + on E: Exception do + begin + FLogDelegate( E.ToString ); + end; + end; + if InputTransport <> nil then + begin + InputTransport.Close; + end; + if OutputTransport <> nil then + begin + OutputTransport.Close; + end; + end; + + if FStop then + begin + try + FServerTransport.Close; + except + on E: TTransportException do + begin + FLogDelegate('TServerTranport failed on close: ' + E.Message); + end; + end; + FStop := False; + end; +end; + +procedure TSimpleServer.Stop; +begin + FStop := True; + FServerTransport.Close; +end; + +end. diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas index a1c959d0..50513d35 100644 --- a/lib/delphi/src/Thrift.pas +++ b/lib/delphi/src/Thrift.pas @@ -1,173 +1,173 @@ -(* - * Licensed to the Apache Software Foundation (ASF) under one - * or more contributor license agreements. See the NOTICE file - * distributed with this work for additional information - * regarding copyright ownership. The ASF licenses this file - * to you under the Apache License, Version 2.0 (the - * "License"); you may not use this file except in compliance - * with the License. You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, - * software distributed under the License is distributed on an - * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY - * KIND, either express or implied. See the License for the - * specific language governing permissions and limitations - * under the License. - *) - -unit Thrift; - -interface - -uses - SysUtils, Thrift.Protocol; - -const - Version = '0.8.0-dev'; - -type - IProcessor = interface - ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}'] - function Process( iprot :IProtocol; oprot: IProtocol): Boolean; - end; - - TApplicationException = class( SysUtils.Exception ) - public - type -{$SCOPEDENUMS ON} +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +unit Thrift; + +interface + +uses + SysUtils, Thrift.Protocol; + +const + Version = '0.8.0-dev'; + +type + IProcessor = interface + ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}'] + function Process( iprot :IProtocol; oprot: IProtocol): Boolean; + end; + + TApplicationException = class( SysUtils.Exception ) + public + type +{$SCOPEDENUMS ON} TExceptionType = ( - Unknown, - UnknownMethod, - InvalidMessageType, - WrongMethodName, - BadSequenceID, - MissingResult - ); -{$SCOPEDENUMS OFF} - private - FType : TExceptionType; - public - constructor Create; overload; - constructor Create( AType: TExceptionType); overload; - constructor Create( AType: TExceptionType; const msg: string); overload; - - class function Read( iprot: IProtocol): TApplicationException; - procedure Write( oprot: IProtocol ); - end; - - // base class for IDL-generated exceptions - TException = class( SysUtils.Exception) - public - procedure Message; // hide inherited property to prevent accidental read/write - end; - -implementation - -{ TException } - -procedure TException.Message; -// hide inherited property to prevent accidental read/write -begin - ASSERT( FALSE, 'Unexpected call to '+ClassName+'.message. Forgot the underscore?'); -end; - -{ TApplicationException } - -constructor TApplicationException.Create; -begin - inherited Create( '' ); -end; - -constructor TApplicationException.Create(AType: TExceptionType; - const msg: string); -begin - inherited Create( msg ); - FType := AType; -end; - -constructor TApplicationException.Create(AType: TExceptionType); -begin - inherited Create(''); - FType := AType; -end; - -class function TApplicationException.Read( - iprot: IProtocol): TApplicationException; -var - field : IField; - msg : string; - typ : TExceptionType; -begin - msg := ''; - typ := TExceptionType.Unknown; - while ( True ) do - begin - field := iprot.ReadFieldBegin; - if ( field.Type_ = TType.Stop) then - begin - Break; - end; - - case field.Id of - 1 : begin - if ( field.Type_ = TType.String_) then - begin - msg := iprot.ReadString; - end else - begin - TProtocolUtil.Skip( iprot, field.Type_ ); - end; - end; - - 2 : begin - if ( field.Type_ = TType.I32) then - begin - typ := TExceptionType( iprot.ReadI32 ); - end else - begin - TProtocolUtil.Skip( iprot, field.Type_ ); - end; - end else - begin - TProtocolUtil.Skip( iprot, field.Type_); - end; - end; - iprot.ReadFieldEnd; - end; - iprot.ReadStructEnd; - Result := TApplicationException.Create( typ, msg ); -end; - -procedure TApplicationException.Write(oprot: IProtocol); -var - struc : IStruct; - field : IField; - -begin - struc := TStructImpl.Create( 'TApplicationException' ); - field := TFieldImpl.Create; - - oprot.WriteStructBegin( struc ); - if Message <> '' then - begin - field.Name := 'message'; - field.Type_ := TType.String_; - field.Id := 1; - oprot.WriteFieldBegin( field ); - oprot.WriteString( Message ); - oprot.WriteFieldEnd; - end; - - field.Name := 'type'; - field.Type_ := TType.I32; - field.Id := 2; - oprot.WriteFieldBegin(field); - oprot.WriteI32(Integer(FType)); - oprot.WriteFieldEnd(); - oprot.WriteFieldStop(); - oprot.WriteStructEnd(); -end; - -end. + Unknown, + UnknownMethod, + InvalidMessageType, + WrongMethodName, + BadSequenceID, + MissingResult + ); +{$SCOPEDENUMS OFF} + private + FType : TExceptionType; + public + constructor Create; overload; + constructor Create( AType: TExceptionType); overload; + constructor Create( AType: TExceptionType; const msg: string); overload; + + class function Read( iprot: IProtocol): TApplicationException; + procedure Write( oprot: IProtocol ); + end; + + // base class for IDL-generated exceptions + TException = class( SysUtils.Exception) + public + procedure Message; // hide inherited property to prevent accidental read/write + end; + +implementation + +{ TException } + +procedure TException.Message; +// hide inherited property to prevent accidental read/write +begin + ASSERT( FALSE, 'Unexpected call to '+ClassName+'.message. Forgot the underscore?'); +end; + +{ TApplicationException } + +constructor TApplicationException.Create; +begin + inherited Create( '' ); +end; + +constructor TApplicationException.Create(AType: TExceptionType; + const msg: string); +begin + inherited Create( msg ); + FType := AType; +end; + +constructor TApplicationException.Create(AType: TExceptionType); +begin + inherited Create(''); + FType := AType; +end; + +class function TApplicationException.Read( + iprot: IProtocol): TApplicationException; +var + field : IField; + msg : string; + typ : TExceptionType; +begin + msg := ''; + typ := TExceptionType.Unknown; + while ( True ) do + begin + field := iprot.ReadFieldBegin; + if ( field.Type_ = TType.Stop) then + begin + Break; + end; + + case field.Id of + 1 : begin + if ( field.Type_ = TType.String_) then + begin + msg := iprot.ReadString; + end else + begin + TProtocolUtil.Skip( iprot, field.Type_ ); + end; + end; + + 2 : begin + if ( field.Type_ = TType.I32) then + begin + typ := TExceptionType( iprot.ReadI32 ); + end else + begin + TProtocolUtil.Skip( iprot, field.Type_ ); + end; + end else + begin + TProtocolUtil.Skip( iprot, field.Type_); + end; + end; + iprot.ReadFieldEnd; + end; + iprot.ReadStructEnd; + Result := TApplicationException.Create( typ, msg ); +end; + +procedure TApplicationException.Write(oprot: IProtocol); +var + struc : IStruct; + field : IField; + +begin + struc := TStructImpl.Create( 'TApplicationException' ); + field := TFieldImpl.Create; + + oprot.WriteStructBegin( struc ); + if Message <> '' then + begin + field.Name := 'message'; + field.Type_ := TType.String_; + field.Id := 1; + oprot.WriteFieldBegin( field ); + oprot.WriteString( Message ); + oprot.WriteFieldEnd; + end; + + field.Name := 'type'; + field.Type_ := TType.I32; + field.Id := 2; + oprot.WriteFieldBegin(field); + oprot.WriteI32(Integer(FType)); + oprot.WriteFieldEnd(); + oprot.WriteFieldStop(); + oprot.WriteStructEnd(); +end; + +end. diff --git a/lib/delphi/test/TestClient.pas b/lib/delphi/test/TestClient.pas index b3c90178..e8edd821 100644 --- a/lib/delphi/test/TestClient.pas +++ b/lib/delphi/test/TestClient.pas @@ -22,12 +22,19 @@ unit TestClient; interface uses - SysUtils, Classes, Thrift.Protocol, Thrift.Transport, Thrift.Test, - Generics.Collections, Thrift.Collections, Windows, Thrift.Console, - DateUtils; + Windows, SysUtils, Classes, + DateUtils, + Generics.Collections, + TestConstants, + Thrift.Protocol.JSON, + Thrift.Protocol, + Thrift.Transport, + Thrift.Stream, + Thrift.Test, + Thrift.Collections, + Thrift.Console; type - TThreadConsole = class private FThread : TThread; @@ -40,14 +47,19 @@ type TClientThread = class( TThread ) private FTransport : ITransport; + FProtocol : IProtocol; FNumIteration : Integer; FConsole : TThreadConsole; + FErrors, FSuccesses : Integer; + procedure Expect( aTestResult : Boolean; const aTestInfo : string); + procedure ClientTest; + procedure JSONProtocolReadWriteTest; protected procedure Execute; override; public - constructor Create(ATransport: ITransport; ANumIteration: Integer); + constructor Create(ATransport: ITransport; AProtocol : IProtocol; ANumIteration: Integer); destructor Destroy; override; end; @@ -62,6 +74,7 @@ type implementation + { TTestClient } class procedure TTestClient.Execute(const args: array of string); @@ -79,12 +92,14 @@ var test : Integer; thread : TThread; trans : ITransport; + prot : IProtocol; streamtrans : IStreamTransport; http : IHTTPClient; - + protType, p : TKnownProtocol; begin bBuffered := False;; bFramed := False; + protType := prot_Binary; try host := 'localhost'; port := 9090; @@ -132,6 +147,18 @@ begin begin Inc( i ); FNumThread := StrToInt( args[i] ); + end else + if (args[i] = '-prot') then // -prot JSON|binary + begin + Inc( i ); + s := args[i]; + for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin + if SameText( s, KNOWN_PROTOCOLS[p]) then begin + protType := p; + Console.WriteLine('Using '+KNOWN_PROTOCOLS[protType]+' protocol'); + Break; + end; + end; end; finally Inc( i ); @@ -167,7 +194,17 @@ begin http := THTTPClientImpl.Create( url ); trans := http; end; - thread := TClientThread.Create( trans, FNumIteration); + + // create protocol instance, default to BinaryProtocol + case protType of + prot_Binary: prot := TBinaryProtocolImpl.Create( trans); + prot_JSON : prot := TJSONProtocolImpl.Create( trans); + else + ASSERT( FALSE); // unhandled case! + prot := TBinaryProtocolImpl.Create( trans); // use default + end; + + thread := TClientThread.Create( trans, prot, FNumIteration); threads[test] := thread; {$WARN SYMBOL_DEPRECATED OFF} thread.Resume; @@ -201,7 +238,6 @@ end; procedure TClientThread.ClientTest; var - binaryProtocol : TBinaryProtocolImpl; client : TThriftTest.Iface; s : string; i8 : ShortInt; @@ -234,7 +270,7 @@ var k2_2 : TNumberz; k3 : TNumberz; v2 : IInsanity; - userMap : IThriftDictionary; + userMap : IThriftDictionary; xtructs : IThriftList; x : IXtruct; arg0 : ShortInt; @@ -248,8 +284,7 @@ var proc : TThreadProcedure; begin - binaryProtocol := TBinaryProtocolImpl.Create( FTransport ); - client := TThriftTest.TClient.Create( binaryProtocol ); + client := TThriftTest.TClient.Create( FProtocol); try if not FTransport.IsOpen then begin @@ -523,11 +558,114 @@ begin end; -constructor TClientThread.Create(ATransport: ITransport; ANumIteration: Integer); + +procedure TClientThread.JSONProtocolReadWriteTest; +// Tests only then read/write procedures of the JSON protocol +// All tests succeed, if we can read what we wrote before +// Note that passing this test does not imply, that our JSON is really compatible to what +// other clients or servers expect as the real JSON. This is beyond the scope of this test. +var prot : IProtocol; + stm : TStringStream; + list : IList; + binary, binRead : TBytes; + i,iErr : Integer; +const + TEST_SHORT = ShortInt( $FE); + TEST_SMALL = SmallInt( $FEDC); + TEST_LONG = LongInt( $FEDCBA98); + TEST_I64 = Int64( $FEDCBA9876543210); + TEST_DOUBLE = -1.234e-56; + DELTA_DOUBLE = TEST_DOUBLE * 1e-14; + TEST_STRING = 'abc-'#$00E4#$00f6#$00fc; // german umlauts (en-us: "funny chars") +begin + stm := TStringStream.Create; + try + // prepare binary data + SetLength( binary, $100); + for i := Low(binary) to High(binary) do binary[i] := i; + + // output setup + prot := TJSONProtocolImpl.Create( + TStreamTransportImpl.Create( + nil, TThriftStreamAdapterDelphi.Create( stm, FALSE))); + + // write + prot.WriteListBegin( TListImpl.Create( TType.String_, 9)); + prot.WriteBool( TRUE); + prot.WriteBool( FALSE); + prot.WriteByte( TEST_SHORT); + prot.WriteI16( TEST_SMALL); + prot.WriteI32( TEST_LONG); + prot.WriteI64( TEST_I64); + prot.WriteDouble( TEST_DOUBLE); + prot.WriteString( TEST_STRING); + prot.WriteBinary( binary); + prot.WriteListEnd; + + // input setup + Expect( stm.Position = stm.Size, 'Stream position/length after write'); + stm.Position := 0; + prot := TJSONProtocolImpl.Create( + TStreamTransportImpl.Create( + TThriftStreamAdapterDelphi.Create( stm, FALSE), nil)); + + // read and compare + list := prot.ReadListBegin; + Expect( list.ElementType = TType.String_, 'list element type'); + Expect( list.Count = 9, 'list element count'); + Expect( prot.ReadBool, 'WriteBool/ReadBool: TRUE'); + Expect( not prot.ReadBool, 'WriteBool/ReadBool: FALSE'); + Expect( prot.ReadByte = TEST_SHORT, 'WriteByte/ReadByte'); + Expect( prot.ReadI16 = TEST_SMALL, 'WriteI16/ReadI16'); + Expect( prot.ReadI32 = TEST_LONG, 'WriteI32/ReadI32'); + Expect( prot.ReadI64 = TEST_I64, 'WriteI64/ReadI64'); + Expect( abs(prot.ReadDouble-TEST_DOUBLE) < abs(DELTA_DOUBLE), 'WriteDouble/ReadDouble'); + Expect( prot.ReadString = TEST_STRING, 'WriteString/ReadString'); + binRead := prot.ReadBinary; + prot.ReadListEnd; + + // test binary data + Expect( Length(binary) = Length(binRead), 'Binary data length check'); + iErr := -1; + for i := Low(binary) to High(binary) do begin + if binary[i] <> binRead[i] then begin + iErr := i; + Break; + end; + end; + if iErr < 0 + then Expect( TRUE, 'Binary data check ('+IntToStr(Length(binary))+' Bytes)') + else Expect( FALSE, 'Binary data check at offset '+IntToStr(iErr)); + + Expect( stm.Position = stm.Size, 'Stream position after read'); + + finally + stm.Free; + prot := nil; //-> Release + end; +end; + + +procedure TClientThread.Expect( aTestResult : Boolean; const aTestInfo : string); +begin + if aTestResult then begin + Inc(FSuccesses); + Console.WriteLine( aTestInfo+' = OK'); + end + else begin + Inc(FErrors); + Console.WriteLine( aTestInfo+' = FAILED'); + ASSERT( FALSE); // we have a failed test! + end; +end; + + +constructor TClientThread.Create(ATransport: ITransport; AProtocol : IProtocol; ANumIteration: Integer); begin inherited Create( True ); FNumIteration := ANumIteration; FTransport := ATransport; + FProtocol := AProtocol; FConsole := TThreadConsole.Create( Self ); end; @@ -545,6 +683,7 @@ begin for i := 0 to FNumIteration - 1 do begin ClientTest; + JSONProtocolReadWriteTest; end; proc := procedure diff --git a/lib/delphi/test/TestConstants.pas b/lib/delphi/test/TestConstants.pas new file mode 100644 index 00000000..9cb85ab5 --- /dev/null +++ b/lib/delphi/test/TestConstants.pas @@ -0,0 +1,36 @@ +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +unit TestConstants; + +interface + +type + TKnownProtocol = ( prot_Binary, // default binary protocol + prot_JSON // JSON protocol + ); +const + KNOWN_PROTOCOLS : array[TKnownProtocol] of string + = ('binary', 'JSON'); + +implementation + +// nothing + +end. diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas index 67cce776..ecaf80d6 100644 --- a/lib/delphi/test/TestServer.pas +++ b/lib/delphi/test/TestServer.pas @@ -1,52 +1,55 @@ -(* - * Licensed to the Apache Software Foundation (ASF) under one - * or more contributor license agreements. See the NOTICE file - * distributed with this work for additional information - * regarding copyright ownership. The ASF licenses this file - * to you under the Apache License, Version 2.0 (the - * "License"); you may not use this file except in compliance - * with the License. You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, - * software distributed under the License is distributed on an - * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY - * KIND, either express or implied. See the License for the - * specific language governing permissions and limitations - * under the License. - *) - -unit TestServer; - -interface - -uses - SysUtils, - Generics.Collections, - Thrift.Console, - Thrift.Server, - Thrift.Transport, - Thrift.Collections, - Thrift.Utils, - Thrift.Test, - Thrift, - Contnrs; - -type - TTestServer = class - public - type - - ITestHandler = interface( TThriftTest.Iface ) - procedure SetServer( AServer : IServer ); - end; - - TTestHandlerImpl = class( TInterfacedObject, ITestHandler ) - private - FServer : IServer; - protected - procedure testVoid(); +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +unit TestServer; + +interface + +uses + SysUtils, + Generics.Collections, + Thrift.Console, + Thrift.Server, + Thrift.Transport, + Thrift.Protocol, + Thrift.Protocol.JSON, + Thrift.Collections, + Thrift.Utils, + Thrift.Test, + Thrift, + TestConstants, + Contnrs; + +type + TTestServer = class + public + type + + ITestHandler = interface( TThriftTest.Iface ) + procedure SetServer( AServer : IServer ); + end; + + TTestHandlerImpl = class( TInterfacedObject, ITestHandler ) + private + FServer : IServer; + protected + procedure testVoid(); function testString(thing: string): string; function testByte(thing: ShortInt): ShortInt; function testI32(thing: Integer): Integer; @@ -66,395 +69,421 @@ type procedure testException(arg: string); function testMultiException(arg0: string; arg1: string): IXtruct; procedure testOneway(secondsToSleep: Integer); - - procedure testStop; - - procedure SetServer( AServer : IServer ); - end; - - class procedure Execute( args: array of string); - end; - -implementation - -{ TTestServer.TTestHandlerImpl } - -procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer); -begin - FServer := AServer; -end; - -function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt; -begin - Console.WriteLine('testByte("' + IntToStr( thing) + '")'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double; -begin - Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz; -begin - Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')'); - Result := thing; -end; - -procedure TTestServer.TTestHandlerImpl.testException(arg: string); -var - x : TXception; -begin - Console.WriteLine('testException(' + arg + ')'); - if ( arg = 'Xception') then - begin - x := TXception.Create; - x.ErrorCode := 1001; - x.Message_ := 'This is an Xception'; - raise x; - end; -end; - -function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer; -begin - Console.WriteLine('testI32("' + IntToStr( thing) + '")'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64; -begin - Console.WriteLine('testI64("' + IntToStr( thing) + '")'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testInsanity( - argument: IInsanity): IThriftDictionary>; -var - hello, goodbye : IXtruct; - crazy : IInsanity; - looney : IInsanity; - first_map : IThriftDictionary; - second_map : IThriftDictionary; - insane : IThriftDictionary>; - -begin - - Console.WriteLine('testInsanity()'); - hello := TXtructImpl.Create; - hello.String_thing := 'hello'; - hello.Byte_thing := 2; - hello.I32_thing := 2; - hello.I64_thing := 2; - - goodbye := TXtructImpl.Create; - goodbye.String_thing := 'Goodbye4'; - goodbye.Byte_thing := 4; - goodbye.I32_thing := 4; - goodbye.I64_thing := 4; - - crazy := TInsanityImpl.Create; - crazy.UserMap := TThriftDictionaryImpl.Create; - crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8); - crazy.Xtructs := TThriftListImpl.Create; - crazy.Xtructs.Add(goodbye); - - looney := TInsanityImpl.Create; - crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5); - crazy.Xtructs.Add(hello); - - first_map := TThriftDictionaryImpl.Create; - second_map := TThriftDictionaryImpl.Create; - - first_map.AddOrSetValue( TNumberz.SIX, crazy); - first_map.AddOrSetValue( TNumberz.THREE, crazy); - - second_map.AddOrSetValue( TNumberz.SIX, looney); - - insane := TThriftDictionaryImpl>.Create; - - insane.AddOrSetValue( 1, first_map); - insane.AddOrSetValue( 2, second_map); - - Result := insane; -end; - -function TTestServer.TTestHandlerImpl.testList( - thing: IThriftList): IThriftList; -var - first : Boolean; - elem : Integer; -begin - Console.Write('testList({'); - first := True; - for elem in thing do - begin - if first then - begin - first := False; - end else - begin - Console.Write(', '); - end; - Console.Write( IntToStr( elem)); - end; - Console.WriteLine('})'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testMap( - thing: IThriftDictionary): IThriftDictionary; -var - first : Boolean; - key : Integer; -begin - Console.Write('testMap({'); - first := True; - for key in thing.Keys do - begin - if (first) then - begin - first := false; - end else - begin - Console.Write(', '); - end; - Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key])); - end; - Console.WriteLine('})'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.TestMapMap( - hello: Integer): IThriftDictionary>; -var - mapmap : IThriftDictionary>; - pos : IThriftDictionary; - neg : IThriftDictionary; - i : Integer; -begin - Console.WriteLine('testMapMap(' + IntToStr( hello) + ')'); - mapmap := TThriftDictionaryImpl>.Create; - pos := TThriftDictionaryImpl.Create; - neg := TThriftDictionaryImpl.Create; - - for i := 1 to 4 do - begin - pos.AddOrSetValue( i, i); - neg.AddOrSetValue( -i, -i); - end; - - mapmap.AddOrSetValue(4, pos); - mapmap.AddOrSetValue( -4, neg); - - Result := mapmap; -end; - -function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer; - arg2: Int64; arg3: IThriftDictionary; arg4: TNumberz; - arg5: Int64): IXtruct; -var - hello : IXtruct; -begin - Console.WriteLine('testMulti()'); - hello := TXtructImpl.Create; - hello.String_thing := 'Hello2'; - hello.Byte_thing := arg0; - hello.I32_thing := arg1; - hello.I64_thing := arg2; - Result := hello; -end; - -function TTestServer.TTestHandlerImpl.testMultiException(arg0, - arg1: string): IXtruct; -var - x : TXception; - x2 : TXception2; -begin - Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')'); - if ( arg0 = 'Xception') then - begin - x := TXception.Create; - x.ErrorCode := 1001; - x.Message_ := 'This is an Xception'; - raise x; - end else - if ( arg0 = 'Xception2') then - begin - x2 := TXception2.Create; - x2.ErrorCode := 2002; - x2.Struct_thing := TXtructImpl.Create; - x2.Struct_thing.String_thing := 'This is an Xception2'; - raise x2; - end; - - Result := TXtructImpl.Create; - Result.String_thing := arg1; -end; - -function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2; -var - temp : IXtruct; -begin - temp := thing.Struct_thing; - Console.WriteLine('testNest({' + - IntToStr( thing.Byte_thing) + ', {' + - '"' + temp.String_thing + '", ' + - IntToStr( temp.Byte_thing) + ', ' + - IntToStr( temp.I32_thing) + ', ' + - IntToStr( temp.I64_thing) + '}, ' + - IntToStr( temp.I32_thing) + '})'); - Result := thing; -end; - -procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer); -begin - Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...'); - Sleep(secondsToSleep * 1000); - Console.WriteLine('testOneway finished'); -end; - -function TTestServer.TTestHandlerImpl.testSet( - thing: IHashSet):IHashSet; -var - first : Boolean; - elem : Integer; -begin - Console.Write('testSet({'); - first := True; - - for elem in thing do - begin - if first then - begin - first := False; - end else - begin - Console.Write( ', '); - end; - Console.Write( IntToStr( elem)); - end; - Console.WriteLine('})'); - Result := thing; -end; - -procedure TTestServer.TTestHandlerImpl.testStop; -begin - if FServer <> nil then - begin - FServer.Stop; - end; -end; - -function TTestServer.TTestHandlerImpl.testString(thing: string): string; -begin - Console.WriteLine('teststring("' + thing + '")'); - Result := thing; -end; - -function TTestServer.TTestHandlerImpl.testStringMap( - thing: IThriftDictionary): IThriftDictionary; -begin - -end; - -function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64; -begin - Console.WriteLine('testTypedef(' + IntToStr( thing) + ')'); - Result := thing; -end; - -procedure TTestServer.TTestHandlerImpl.TestVoid; -begin - Console.WriteLine('testVoid()'); -end; - -function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct; -begin - Console.WriteLine('testStruct({' + - '"' + thing.String_thing + '", ' + - IntToStr( thing.Byte_thing) + ', ' + - IntToStr( thing.I32_thing) + ', ' + - IntToStr( thing.I64_thing)); - Result := thing; -end; - -{ TTestServer } - -class procedure TTestServer.Execute(args: array of string); -var - UseBufferedSockets : Boolean; - UseFramed : Boolean; - Port : Integer; - testHandler : ITestHandler; - testProcessor : IProcessor; - ServerSocket : IServerTransport; - ServerEngine : IServer; - TransportFactroy : ITransportFactory; - - -begin - try - UseBufferedSockets := False; - UseFramed := False; - Port := 9090; - - if ( Length( args) > 0) then - begin - Port := StrToIntDef( args[0], Port); - - if ( Length( args) > 0) then - begin - if ( args[0] = 'raw' ) then - begin - // as default - end else - if ( args[0] = 'buffered' ) then - begin - UseBufferedSockets := True; - end else - if ( args[0] = 'framed' ) then - begin - UseFramed := True; - end else - begin - // Fall back to the older boolean syntax - UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets); - end - end - end; - - testHandler := TTestHandlerImpl.Create; - - testProcessor := TThriftTest.TProcessorImpl.Create( testHandler ); - ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets ); - if UseFramed then - begin - TransportFactroy := TFramedTransportImpl.TFactory.Create; - ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket, - TransportFactroy); - end else - begin - ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket); - end; - - testHandler.SetServer( ServerEngine); - - Console.WriteLine('Starting the server on port ' + IntToStr( Port) + - IfValue(UseBufferedSockets, ' with buffered socket', '') + - IfValue(useFramed, ' with framed transport', '') + - '...'); - - serverEngine.Serve; - testHandler.SetServer( nil); - - except - on E: Exception do - begin - Console.Write( E.Message); - end; - end; - Console.WriteLine( 'done.'); -end; - -end. + + procedure testStop; + + procedure SetServer( AServer : IServer ); + end; + + class procedure Execute( args: array of string); + end; + +implementation + +{ TTestServer.TTestHandlerImpl } + +procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer); +begin + FServer := AServer; +end; + +function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt; +begin + Console.WriteLine('testByte("' + IntToStr( thing) + '")'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double; +begin + Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz; +begin + Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')'); + Result := thing; +end; + +procedure TTestServer.TTestHandlerImpl.testException(arg: string); +var + x : TXception; +begin + Console.WriteLine('testException(' + arg + ')'); + if ( arg = 'Xception') then + begin + x := TXception.Create; + x.ErrorCode := 1001; + x.Message_ := 'This is an Xception'; + raise x; + end; +end; + +function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer; +begin + Console.WriteLine('testI32("' + IntToStr( thing) + '")'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64; +begin + Console.WriteLine('testI64("' + IntToStr( thing) + '")'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testInsanity( + argument: IInsanity): IThriftDictionary>; +var + hello, goodbye : IXtruct; + crazy : IInsanity; + looney : IInsanity; + first_map : IThriftDictionary; + second_map : IThriftDictionary; + insane : IThriftDictionary>; + +begin + + Console.WriteLine('testInsanity()'); + hello := TXtructImpl.Create; + hello.String_thing := 'hello'; + hello.Byte_thing := 2; + hello.I32_thing := 2; + hello.I64_thing := 2; + + goodbye := TXtructImpl.Create; + goodbye.String_thing := 'Goodbye4'; + goodbye.Byte_thing := 4; + goodbye.I32_thing := 4; + goodbye.I64_thing := 4; + + crazy := TInsanityImpl.Create; + crazy.UserMap := TThriftDictionaryImpl.Create; + crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8); + crazy.Xtructs := TThriftListImpl.Create; + crazy.Xtructs.Add(goodbye); + + looney := TInsanityImpl.Create; + crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5); + crazy.Xtructs.Add(hello); + + first_map := TThriftDictionaryImpl.Create; + second_map := TThriftDictionaryImpl.Create; + + first_map.AddOrSetValue( TNumberz.SIX, crazy); + first_map.AddOrSetValue( TNumberz.THREE, crazy); + + second_map.AddOrSetValue( TNumberz.SIX, looney); + + insane := TThriftDictionaryImpl>.Create; + + insane.AddOrSetValue( 1, first_map); + insane.AddOrSetValue( 2, second_map); + + Result := insane; +end; + +function TTestServer.TTestHandlerImpl.testList( + thing: IThriftList): IThriftList; +var + first : Boolean; + elem : Integer; +begin + Console.Write('testList({'); + first := True; + for elem in thing do + begin + if first then + begin + first := False; + end else + begin + Console.Write(', '); + end; + Console.Write( IntToStr( elem)); + end; + Console.WriteLine('})'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testMap( + thing: IThriftDictionary): IThriftDictionary; +var + first : Boolean; + key : Integer; +begin + Console.Write('testMap({'); + first := True; + for key in thing.Keys do + begin + if (first) then + begin + first := false; + end else + begin + Console.Write(', '); + end; + Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key])); + end; + Console.WriteLine('})'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.TestMapMap( + hello: Integer): IThriftDictionary>; +var + mapmap : IThriftDictionary>; + pos : IThriftDictionary; + neg : IThriftDictionary; + i : Integer; +begin + Console.WriteLine('testMapMap(' + IntToStr( hello) + ')'); + mapmap := TThriftDictionaryImpl>.Create; + pos := TThriftDictionaryImpl.Create; + neg := TThriftDictionaryImpl.Create; + + for i := 1 to 4 do + begin + pos.AddOrSetValue( i, i); + neg.AddOrSetValue( -i, -i); + end; + + mapmap.AddOrSetValue(4, pos); + mapmap.AddOrSetValue( -4, neg); + + Result := mapmap; +end; + +function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer; + arg2: Int64; arg3: IThriftDictionary; arg4: TNumberz; + arg5: Int64): IXtruct; +var + hello : IXtruct; +begin + Console.WriteLine('testMulti()'); + hello := TXtructImpl.Create; + hello.String_thing := 'Hello2'; + hello.Byte_thing := arg0; + hello.I32_thing := arg1; + hello.I64_thing := arg2; + Result := hello; +end; + +function TTestServer.TTestHandlerImpl.testMultiException(arg0, + arg1: string): IXtruct; +var + x : TXception; + x2 : TXception2; +begin + Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')'); + if ( arg0 = 'Xception') then + begin + x := TXception.Create; + x.ErrorCode := 1001; + x.Message_ := 'This is an Xception'; + raise x; + end else + if ( arg0 = 'Xception2') then + begin + x2 := TXception2.Create; + x2.ErrorCode := 2002; + x2.Struct_thing := TXtructImpl.Create; + x2.Struct_thing.String_thing := 'This is an Xception2'; + raise x2; + end; + + Result := TXtructImpl.Create; + Result.String_thing := arg1; +end; + +function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2; +var + temp : IXtruct; +begin + temp := thing.Struct_thing; + Console.WriteLine('testNest({' + + IntToStr( thing.Byte_thing) + ', {' + + '"' + temp.String_thing + '", ' + + IntToStr( temp.Byte_thing) + ', ' + + IntToStr( temp.I32_thing) + ', ' + + IntToStr( temp.I64_thing) + '}, ' + + IntToStr( temp.I32_thing) + '})'); + Result := thing; +end; + +procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer); +begin + Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...'); + Sleep(secondsToSleep * 1000); + Console.WriteLine('testOneway finished'); +end; + +function TTestServer.TTestHandlerImpl.testSet( + thing: IHashSet):IHashSet; +var + first : Boolean; + elem : Integer; +begin + Console.Write('testSet({'); + first := True; + + for elem in thing do + begin + if first then + begin + first := False; + end else + begin + Console.Write( ', '); + end; + Console.Write( IntToStr( elem)); + end; + Console.WriteLine('})'); + Result := thing; +end; + +procedure TTestServer.TTestHandlerImpl.testStop; +begin + if FServer <> nil then + begin + FServer.Stop; + end; +end; + +function TTestServer.TTestHandlerImpl.testString(thing: string): string; +begin + Console.WriteLine('teststring("' + thing + '")'); + Result := thing; +end; + +function TTestServer.TTestHandlerImpl.testStringMap( + thing: IThriftDictionary): IThriftDictionary; +begin + +end; + +function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64; +begin + Console.WriteLine('testTypedef(' + IntToStr( thing) + ')'); + Result := thing; +end; + +procedure TTestServer.TTestHandlerImpl.TestVoid; +begin + Console.WriteLine('testVoid()'); +end; + +function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct; +begin + Console.WriteLine('testStruct({' + + '"' + thing.String_thing + '", ' + + IntToStr( thing.Byte_thing) + ', ' + + IntToStr( thing.I32_thing) + ', ' + + IntToStr( thing.I64_thing)); + Result := thing; +end; + +{ TTestServer } + +class procedure TTestServer.Execute(args: array of string); +var + UseBufferedSockets : Boolean; + UseFramed : Boolean; + Port : Integer; + testHandler : ITestHandler; + testProcessor : IProcessor; + ServerSocket : IServerTransport; + ServerEngine : IServer; + TransportFactory : ITransportFactory; + ProtocolFactory : IProtocolFactory; + i : Integer; + s : string; + protType, p : TKnownProtocol; +begin + try + UseBufferedSockets := False; + UseFramed := False; + protType := prot_Binary; + Port := 9090; + + i := 0; + while ( i < Length(args) ) do begin + s := args[i]; + Inc(i); + + if StrToIntDef( s, -1) > 0 then + begin + Port := StrToIntDef( s, Port); + end else + if ( s = 'raw' ) then + begin + // as default + end else + if ( s = 'buffered' ) then + begin + UseBufferedSockets := True; + end else + if ( s = 'framed' ) then + begin + UseFramed := True; + end else + if (s = '-prot') then // -prot JSON|binary + begin + s := args[i]; + Inc( i ); + for p:= Low(TKnownProtocol) to High(TKnownProtocol) do begin + if SameText( s, KNOWN_PROTOCOLS[p]) then begin + protType := p; + Break; + end; + end; + end else + begin + // Fall back to the older boolean syntax + UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets); + end + end; + + // create protocol factory, default to BinaryProtocol + case protType of + prot_Binary: ProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + prot_JSON : ProtocolFactory := TJSONProtocolImpl.TFactory.Create; + else + ASSERT( FALSE); // unhandled case! + ProtocolFactory := TBinaryProtocolImpl.TFactory.Create; + end; + + testHandler := TTestHandlerImpl.Create; + + testProcessor := TThriftTest.TProcessorImpl.Create( testHandler ); + ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets ); + + if UseFramed + then TransportFactory := TFramedTransportImpl.TFactory.Create + else TransportFactory := TTransportFactoryImpl.Create; + + ServerEngine := TSimpleServer.Create( testProcessor, + ServerSocket, + TransportFactory, + ProtocolFactory); + + testHandler.SetServer( ServerEngine); + + Console.WriteLine('Starting the server on port ' + IntToStr( Port) + + IfValue(UseBufferedSockets, ' with buffered socket', '') + + IfValue(useFramed, ' with framed transport', '') + + ' using '+KNOWN_PROTOCOLS[protType]+' protocol' + + '...'); + + serverEngine.Serve; + testHandler.SetServer( nil); + + except + on E: Exception do + begin + Console.Write( E.Message); + end; + end; + Console.WriteLine( 'done.'); +end; + +end. diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr index d14079d2..310e9662 100644 --- a/lib/delphi/test/client.dpr +++ b/lib/delphi/test/client.dpr @@ -1,62 +1,63 @@ -(* - * Licensed to the Apache Software Foundation (ASF) under one - * or more contributor license agreements. See the NOTICE file - * distributed with this work for additional information - * regarding copyright ownership. The ASF licenses this file - * to you under the Apache License, Version 2.0 (the - * "License"); you may not use this file except in compliance - * with the License. You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, - * software distributed under the License is distributed on an - * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY - * KIND, either express or implied. See the License for the - * specific language governing permissions and limitations - * under the License. - *) - - -program client; - -{$APPTYPE CONSOLE} - -uses - SysUtils, - TestClient in 'TestClient.pas', - Thrift.Test in 'gen-delphi\Thrift.Test.pas', - Thrift in '..\..\..\lib\delphi\src\Thrift.pas', - Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas', - Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas', - Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas', - Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas', - Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas', - Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas', - Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas'; - -var - nParamCount : Integer; - args : array of string; - i : Integer; - arg : string; - s : string; - -begin - try - Writeln( 'Delphi TestClient '+Thrift.Version); - nParamCount := ParamCount; - SetLength( args, nParamCount); - for i := 1 to nParamCount do - begin - arg := ParamStr( i ); - args[i-1] := arg; - end; - TTestClient.Execute( args ); - Readln; - except - on E: Exception do - Writeln(E.ClassName, ': ', E.Message); - end; -end. - +(*g + * Licensed to the Apache Software Foundation (ASF) under oneg + * or more contributor license agreements. See the NOTICE fileg + * distributed with this work for additional informationg + * regarding copyright ownership. The ASF licenses this fileg + * to you under the Apache License, Version 2.0 (theg + * "License"); you may not use this file except in complianceg + * with the License. You may obtain a copy of the License atg + *g + * http://www.apache.org/licenses/LICENSE-2.0g + *g + * Unless required by applicable law or agreed to in writing,g + * software distributed under the License is distributed on ang + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANYg + * KIND, either express or implied. See the License for theg + * specific language governing permissions and limitationsg + * under the License.g + *)g +g +g +program client;g +g +{$APPTYPE CONSOLE}g +g +usesg + SysUtils, + TestClient in 'TestClient.pas', + Thrift.Test in 'gen-delphi\Thrift.Test.pas', + Thrift in '..\..\..\lib\delphi\src\Thrift.pas', + Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas', + Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas', + Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas', + Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas', + Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas', + Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas', + Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas', + Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas'; + +varg + nParamCount : Integer;g + args : array of string;g + i : Integer;g + arg : string;g + s : string;g +g +beging + tryg + Writeln( 'Delphi TestClient '+Thrift.Version);g + nParamCount := ParamCount;g + SetLength( args, nParamCount);g + for i := 1 to nParamCount dog + beging + arg := ParamStr( i );g + args[i-1] := arg;g + end;g + TTestClient.Execute( args );g + Readln;g + exceptg + on E: Exception dog + Writeln(E.ClassName, ': ', E.Message);g + end;g +end.g +g diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr index d6a53bcb..832f8259 100644 --- a/lib/delphi/test/server.dpr +++ b/lib/delphi/test/server.dpr @@ -1,63 +1,62 @@ -(* - * Licensed to the Apache Software Foundation (ASF) under one - * or more contributor license agreements. See the NOTICE file - * distributed with this work for additional information - * regarding copyright ownership. The ASF licenses this file - * to you under the Apache License, Version 2.0 (the - * "License"); you may not use this file except in compliance - * with the License. You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, - * software distributed under the License is distributed on an - * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY - * KIND, either express or implied. See the License for the - * specific language governing permissions and limitations - * under the License. - *) - -program server; - -{$APPTYPE CONSOLE} - -uses - SysUtils, - TestServer in 'TestServer.pas', - Thrift.Test in 'gen-delphi\Thrift.Test.pas', - Thrift in '..\..\..\lib\delphi\src\Thrift.pas', - Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas', - Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas', - Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas', - Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas', - Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas', - Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas', - Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas'; - -var - nParamCount : Integer; - args : array of string; - i : Integer; - arg : string; - s : string; - -begin - try - Writeln( 'Delphi TestServer '+Thrift.Version); - nParamCount := ParamCount; - SetLength( args, nParamCount); - for i := 1 to nParamCount do - begin - arg := ParamStr( i ); - args[i-1] := arg; - end; - TTestServer.Execute( args ); - Readln; - except - on E: Exception do - Writeln(E.ClassName, ': ', E.Message); - end; -end. - - - +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) + +program server; + +{$APPTYPE CONSOLE} + +uses + SysUtils, + TestServer in 'TestServer.pas', + Thrift.Test in 'gen-delphi\Thrift.Test.pas', + Thrift in '..\..\..\lib\delphi\src\Thrift.pas', + Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas', + Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas', + Thrift.Protocol.JSON in '..\..\..\lib\delphi\src\Thrift.Protocol.JSON.pas', + Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas', + Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas', + Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas', + Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas', + Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas'; + +var + nParamCount : Integer; + args : array of string; + i : Integer; + arg : string; + s : string; + +begin + try + Writeln( 'Delphi TestServer '+Thrift.Version); + nParamCount := ParamCount; + SetLength( args, nParamCount); + for i := 1 to nParamCount do + begin + arg := ParamStr( i ); + args[i-1] := arg; + end; + TTestServer.Execute( args ); + Readln; + except + on E: Exception do + Writeln(E.ClassName, ': ', E.Message); + end; +end. + -- 2.17.1