From 27274229510ce6c99f20dad2d11fc2d7acc6e8d3 Mon Sep 17 00:00:00 2001 From: Jake Farrell Date: Thu, 10 Nov 2011 20:32:44 +0000 Subject: 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.pas | 344 +++++++++++++++++++++++----------------------- 1 file changed, 172 insertions(+), 172 deletions(-) (limited to 'lib/delphi/src/Thrift.pas') diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas index a1c959d0f..50513d35d 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. -- cgit v1.2.1