blob: a84f0ea50aef6a4ae1e5887dcc40833daff28a18 [file] [log] [blame]
(*
* 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';
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
function Message : string; // hide inherited property: allow read, but prevent accidental writes
procedure UpdateMessageProperty; // update inherited message property with toString()
end;
implementation
{ TException }
function TException.Message;
// allow read (exception summary), but prevent accidental writes
// read will return the exception summary
begin
result := Self.ToString;
end;
procedure TException.UpdateMessageProperty;
// Update the inherited Message property to better conform to standard behaviour.
// Nice benefit: The IDE is now able to show the exception message again.
begin
inherited Message := Self.ToString; // produces a summary text
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.