From 7ae13e10f7cb0e0c6107cb849d33b9a46b299840 Mon Sep 17 00:00:00 2001 From: Jake Farrell Date: Tue, 18 Oct 2011 14:35:26 +0000 Subject: [PATCH] Thrift-1366: Delphi generator, lirbrary and unit test. Client: delphi Patch: Kenjiro Fukumitsu Adding delphi XE generator, lib and unit tests. git-svn-id: https://svn.apache.org/repos/asf/thrift/trunk@1185688 13f79535-47bb-0310-9956-ffa450edef68 --- compiler/cpp/Makefile.am | 1 + .../cpp/src/generate/t_delphi_generator.cc | 2688 +++++++++++++++++ compiler/cpp/src/main.cc | 7 + compiler/cpp/src/thriftl.ll | 1 + compiler/cpp/src/thrifty.yy | 10 + configure.ac | 1 - lib/delphi/src/Thrift.Collections.pas | 618 ++++ lib/delphi/src/Thrift.Console.pas | 132 + lib/delphi/src/Thrift.Protocol.pas | 1178 ++++++++ lib/delphi/src/Thrift.Server.pas | 325 ++ lib/delphi/src/Thrift.Stream.pas | 298 ++ lib/delphi/src/Thrift.Transport.pas | 1250 ++++++++ lib/delphi/src/Thrift.Utils.pas | 36 + lib/delphi/src/Thrift.pas | 156 + lib/delphi/test/TestClient.pas | 597 ++++ lib/delphi/test/TestServer.pas | 460 +++ lib/delphi/test/client.dpr | 61 + lib/delphi/test/maketest.sh | 23 + lib/delphi/test/server.dpr | 62 + test/ThriftTest.thrift | 1 + 20 files changed, 7904 insertions(+), 1 deletion(-) create mode 100644 compiler/cpp/src/generate/t_delphi_generator.cc create mode 100644 lib/delphi/src/Thrift.Collections.pas create mode 100644 lib/delphi/src/Thrift.Console.pas create mode 100644 lib/delphi/src/Thrift.Protocol.pas create mode 100644 lib/delphi/src/Thrift.Server.pas create mode 100644 lib/delphi/src/Thrift.Stream.pas create mode 100644 lib/delphi/src/Thrift.Transport.pas create mode 100644 lib/delphi/src/Thrift.Utils.pas create mode 100644 lib/delphi/src/Thrift.pas create mode 100644 lib/delphi/test/TestClient.pas create mode 100644 lib/delphi/test/TestServer.pas create mode 100644 lib/delphi/test/client.dpr create mode 100644 lib/delphi/test/maketest.sh create mode 100644 lib/delphi/test/server.dpr diff --git a/compiler/cpp/Makefile.am b/compiler/cpp/Makefile.am index 39a071e8..f69ffb2a 100644 --- a/compiler/cpp/Makefile.am +++ b/compiler/cpp/Makefile.am @@ -80,6 +80,7 @@ thrift_SOURCES += src/generate/t_c_glib_generator.cc \ src/generate/t_html_generator.cc \ src/generate/t_js_generator.cc \ src/generate/t_javame_generator.cc \ + src/generate/t_delphi_generator.cc \ src/generate/t_go_generator.cc thrift_CPPFLAGS = -I$(srcdir)/src diff --git a/compiler/cpp/src/generate/t_delphi_generator.cc b/compiler/cpp/src/generate/t_delphi_generator.cc new file mode 100644 index 00000000..a346f6df --- /dev/null +++ b/compiler/cpp/src/generate/t_delphi_generator.cc @@ -0,0 +1,2688 @@ +/* + * 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. + * + * Contains some contributions under the Thrift Software License. + * Please see doc/old-thrift-license.txt in the Thrift distribution for + * details. + */ + +#include +#include +#include +#include + +#include +#include +#include + +#include +#include +#include + +#include "platform.h" +#include "t_oop_generator.h" + +using namespace std; + + +class t_delphi_generator : public t_oop_generator +{ + public: + t_delphi_generator( + t_program* program, + const std::map& parsed_options, + const std::string& option_string) + : t_oop_generator(program) + { + (void) option_string; + + std::map::const_iterator iter; + + iter = parsed_options.find("ansistr_binary"); + ansistr_binary_ = (iter != parsed_options.end()); + + iter = parsed_options.find("suppress_guid"); + suppress_guid_ = (iter != parsed_options.end()); + + out_dir_base_ = "gen-delphi"; + escape_.clear(); + escape_['\''] = "''"; + } + + + void init_generator(); + void close_generator(); + + void generate_consts(std::vector consts); + + void generate_typedef (t_typedef* ttypedef); + void generate_enum (t_enum* tenum); + void generate_struct (t_struct* tstruct); + void generate_xception (t_struct* txception); + void generate_service (t_service* tservice); + void generate_property(ostream& out, t_field* tfield, bool isPublic, bool is_xception); + void generate_property_writer_(ostream& out, t_field* tfield, bool isPublic); + + void generate_delphi_property(ostream& out, bool struct_is_exception, t_field* tfield, bool isPublic, std::string fieldPrefix = ""); + void generate_delphi_isset_reader_definition(ostream& out, t_field* tfield); + void generate_delphi_property_reader_definition(ostream& out, t_field* tfield); + void generate_delphi_property_writer_definition(ostream& out, t_field* tfield); + void generate_delphi_property_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix); + void generate_delphi_property_writer_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix, bool is_xception_class, std::string xception_factroy_name); + void generate_delphi_isset_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix); + void generate_delphi_struct_writer_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception); + void generate_delphi_struct_result_writer_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception); + + void generate_delphi_struct_tostring_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception); + + void add_delphi_uses_list( string unitname); + + void generate_delphi_struct_reader_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception); + void generate_delphi_create_exception_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception); + + void print_const_prop(std::ostream& out, string name, t_type* type, t_const_value* value); + void print_private_field(std::ostream& out, string name, t_type* type, t_const_value* value); + void print_const_value ( std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value); + void initialize_field(std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = ""); + void finalize_field(std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = ""); + std::string render_const_value( std::ostream& local_vars, std::ostream& out, std::string name, t_type* type, t_const_value* value); + void print_const_def_value( std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = ""); + + void generate_delphi_struct(t_struct* tstruct, bool is_exception); + void generate_delphi_struct_impl( ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception, bool is_result = false, bool is_x_factory = false); + void generate_delphi_struct_definition(std::ostream& out, t_struct* tstruct, bool is_xception=false, bool in_class=false, bool is_result=false, bool is_x_factory = false); + void generate_delphi_struct_reader(std::ostream& out, t_struct* tstruct); + void generate_delphi_struct_result_writer(std::ostream& out, t_struct* tstruct); + void generate_delphi_struct_writer(std::ostream& out, t_struct* tstruct); + void generate_delphi_struct_tostring(std::ostream& out, t_struct* tstruct); + + void generate_function_helpers(t_function* tfunction); + void generate_service_interface (t_service* tservice); + void generate_service_helpers (t_service* tservice); + void generate_service_client (t_service* tservice); + void generate_service_server (t_service* tservice); + void generate_process_function (t_service* tservice, t_function* function); + + void generate_deserialize_field (std::ostream& out, bool is_xception, t_field* tfield, std::string prefix, std::ostream& local_vars); + void generate_deserialize_struct (std::ostream& out, t_struct* tstruct, std::string name, std::string prefix); + void generate_deserialize_container(ostream& out, bool is_xception, t_type* ttype, string name, std::ostream& local_vars); + + void generate_deserialize_set_element (std::ostream& out, bool is_xception, t_set* tset, std::string prefix, std::ostream& local_vars); + void generate_deserialize_map_element (std::ostream& out, bool is_xception, t_map* tmap, std::string prefix, std::ostream& local_vars); + void generate_deserialize_list_element (std::ostream& out, bool is_xception, t_list* list, std::string prefix, std::ostream& local_vars); + + void generate_serialize_field (std::ostream& out, bool is_xception, t_field* tfield, std::string prefix, std::ostream& local_vars); + void generate_serialize_struct (std::ostream& out, t_struct* tstruct, std::string prefix, std::ostream& local_vars); + void generate_serialize_container (std::ostream& out, bool is_xception, t_type* ttype, std::string prefix, std::ostream& local_vars); + void generate_serialize_map_element (std::ostream& out, bool is_xception, t_map* tmap, std::string iter, std::string map, std::ostream& local_vars); + void generate_serialize_set_element (std::ostream& out, bool is_xception, t_set* tmap, std::string iter, std::ostream& local_vars); + void generate_serialize_list_element (std::ostream& out, bool is_xception, t_list* tlist, std::string iter, std::ostream& local_vars); + + void delphi_type_usings(std::ostream& out); + std::string delphi_thrift_usings(); + + std::string type_name( t_type* ttype, bool b_cls=false, bool b_no_postfix=false, bool b_exception_factory=false, bool b_full_exception_factory = false); + std::string normalize_clsnm(std::string name, std::string prefix, bool b_no_check_keyword = false); + + std::string base_type_name(t_base_type* tbase); + std::string declare_field(t_field* tfield, bool init=false, std::string prefix=""); + std::string function_signature(t_function* tfunction, std::string full_cls="", bool is_xception = false); + std::string argument_list(t_struct* tstruct); + std::string type_to_enum(t_type* ttype); + std::string prop_name(t_field* tfield, bool is_xception = false); + std::string prop_name(std::string name, bool is_xception = false); + + void write_enum(std::string line); + void write_forward_decr(std::string line); + void write_const(std::string line); + void write_struct(std::string line); + void write_service(std::string line); + + virtual std::string autogen_comment() { + return + std::string("(**\n") + + " * Autogenerated by Thrift\n" + + " *\n" + + " * DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n" + + " *)\n"; + } + + bool type_can_be_null(t_type* ttype) { + while (ttype->is_typedef()) { + ttype = ((t_typedef*)ttype)->get_type(); + } + + return ttype->is_container() || + ttype->is_struct() || + ttype->is_xception(); + } + + private: + std::string namespace_name_; + std::ostringstream s_forward_decr; + std::ostringstream s_enum; + std::ostringstream s_const; + std::ostringstream s_struct; + std::ostringstream s_service; + std::ostringstream s_const_impl; + std::ostringstream s_struct_impl; + std::ostringstream s_service_impl; + bool has_enum; + bool has_const; + std::string namespace_dir_; + std::map delphi_keywords; + std::map delphi_reserved_method; + std::map delphi_reserved_method_exception; + std::vector uses_list; + void create_keywords(); + bool find_keyword( std::map& keyword_map, std::string name); + std::string normalize_name( std::string name, bool b_method = false, bool b_exception_method = false); + std::string empty_value(t_type* type); + bool is_void( t_type* type ); + int indent_impl_; + bool ansistr_binary_; + bool suppress_guid_; + + std::string generate_guid(); + + void indent_up_impl(){ + ++indent_impl_; + }; + void indent_down_impl() { + --indent_impl_; + }; + std::string indent_impl() { + std::string ind = ""; + int i; + for (i = 0; i < indent_impl_; ++i) { + ind += " "; + } + return ind; + }; + std::ostream& indent_impl(std::ostream &os) { + return os << indent_impl(); + }; +}; + +/** + * Generates a new UUID/GUID for internal purposes. + * These GUIDs are not intended to be used cross-module, + * as they are always re-generated and NOT constant! + * + * @return Pascal-style GUID. + */ +std::string t_delphi_generator::generate_guid() { + boost::uuids::basic_random_generator gen; + boost::uuids::uuid u = gen(); + std::ostringstream stream; + stream << u; + return "['{" + upcase_string(stream.str()) + "}']"; +} + +bool t_delphi_generator::find_keyword( std::map& keyword_map, std::string name) { + int len = name.length(); + + if ( len <= 0 ) { + return false; + } + + int nlast = name.find_last_of('_'); + + if ( nlast >= 1) { + if (nlast == (len - 1)) { + string new_name( name, 0, nlast); + return find_keyword( keyword_map, new_name); + } + } + return (keyword_map[name] == 1); +} + +std::string t_delphi_generator::normalize_name( std::string name, bool b_method, bool b_exception_method) { + string tmp( name ); + std::transform(tmp.begin(), tmp.end(), tmp.begin(), static_cast(std::tolower)); + + bool b_found = false; + + if ( find_keyword( delphi_keywords, tmp) ) { + b_found = true; + } else if ( b_method && find_keyword( delphi_reserved_method, tmp)) { + b_found = true; + } else if ( b_method && find_keyword( delphi_reserved_method_exception, tmp)) { + b_found = true; + } + + if (b_found) { + return name + "_"; + } else { + return name; + } +} + +void t_delphi_generator::create_keywords() { + delphi_keywords["and"] = 1; + delphi_keywords["end"] = 1; + delphi_keywords["interface"] = 1; + delphi_keywords["raise"] = 1; + delphi_keywords["uses"] = 1; + delphi_keywords["array"] = 1; + delphi_keywords["except"] = 1; + delphi_keywords["is"] = 1; + delphi_keywords["record"] = 1; + delphi_keywords["var"] = 1; + delphi_keywords["as"] = 1; + delphi_keywords["exports"] = 1; + delphi_keywords["label"] = 1; + delphi_keywords["repeat"] = 1; + delphi_keywords["while"] = 1; + delphi_keywords["asm"] = 1; + delphi_keywords["file"] = 1; + delphi_keywords["library"] = 1; + delphi_keywords["resourcestring"] = 1; + delphi_keywords["with"] = 1; + delphi_keywords["begin"] = 1; + delphi_keywords["finalization"] = 1; + delphi_keywords["mod"] = 1; + delphi_keywords["set"] = 1; + delphi_keywords["xor"] = 1; + delphi_keywords["case"] = 1; + delphi_keywords["finally"] = 1; + delphi_keywords["nil"] = 1; + delphi_keywords["shl"] = 1; + delphi_keywords["class"] = 1; + delphi_keywords["for"] = 1; + delphi_keywords["not"] = 1; + delphi_keywords["shr"] = 1; + delphi_keywords["const"] = 1; + delphi_keywords["function"] = 1; + delphi_keywords["object"] = 1; + delphi_keywords["string"] = 1; + delphi_keywords["constructor"] = 1; + delphi_keywords["goto"] = 1; + delphi_keywords["of"] = 1; + delphi_keywords["then"] = 1; + delphi_keywords["destructor"] = 1; + delphi_keywords["if"] = 1; + delphi_keywords["or"] = 1; + delphi_keywords["threadvar"] = 1; + delphi_keywords["dispinterface"] = 1; + delphi_keywords["implementation"] = 1; + delphi_keywords["out"] = 1; + delphi_keywords["to"] = 1; + delphi_keywords["div"] = 1; + delphi_keywords["in"] = 1; + delphi_keywords["packed"] = 1; + delphi_keywords["try"] = 1; + delphi_keywords["do"] = 1; + delphi_keywords["inherited"] = 1; + delphi_keywords["procedure"] = 1; + delphi_keywords["type"] = 1; + delphi_keywords["downto"] = 1; + delphi_keywords["initialization"] = 1; + delphi_keywords["program"] = 1; + delphi_keywords["unit"] = 1; + delphi_keywords["else"] = 1; + delphi_keywords["inline"] = 1; + delphi_keywords["property"] = 1; + delphi_keywords["until"] = 1; + delphi_keywords["private"] = 1; + delphi_keywords["protected"] = 1; + delphi_keywords["public"] = 1; + delphi_keywords["published"] = 1; + delphi_keywords["automated"] = 1; + delphi_keywords["at"] = 1; + delphi_keywords["on"] = 1; + + delphi_reserved_method["create"] = 1; + delphi_reserved_method["free"] = 1; + delphi_reserved_method["initinstance"] = 1; + delphi_reserved_method["cleanupinstance"] = 1; + delphi_reserved_method["classtype"] = 1; + delphi_reserved_method["classname"] = 1; + delphi_reserved_method["classnameis"] = 1; + delphi_reserved_method["classparent"] = 1; + delphi_reserved_method["classinfo"] = 1; + delphi_reserved_method["instancesize"] = 1; + delphi_reserved_method["inheritsfrom"] = 1; + delphi_reserved_method["methodaddress"] = 1; + delphi_reserved_method["methodaddress"] = 1; + delphi_reserved_method["methodname"] = 1; + delphi_reserved_method["fieldaddress"] = 1; + delphi_reserved_method["fieldaddress"] = 1; + delphi_reserved_method["getinterface"] = 1; + delphi_reserved_method["getinterfaceentry"] = 1; + delphi_reserved_method["getinterfacetable"] = 1; + delphi_reserved_method["unitname"] = 1; + delphi_reserved_method["equals"] = 1; + delphi_reserved_method["gethashcode"] = 1; + delphi_reserved_method["tostring"] = 1; + delphi_reserved_method["safecallexception"] = 1; + delphi_reserved_method["afterconstruction"] = 1; + delphi_reserved_method["beforedestruction"] = 1; + delphi_reserved_method["dispatch"] = 1; + delphi_reserved_method["defaulthandler"] = 1; + delphi_reserved_method["newinstance"] = 1; + delphi_reserved_method["freeinstance"] = 1; + delphi_reserved_method["destroy"] = 1; + delphi_reserved_method["read"] = 1; + delphi_reserved_method["write"] = 1; + + delphi_reserved_method_exception["setinnerexception"] = 1; + delphi_reserved_method_exception["setstackinfo"] = 1; + delphi_reserved_method_exception["getstacktrace"] = 1; + delphi_reserved_method_exception["raisingexception"] = 1; + delphi_reserved_method_exception["createfmt"] = 1; + delphi_reserved_method_exception["createres"] = 1; + delphi_reserved_method_exception["createresfmt"] = 1; + delphi_reserved_method_exception["createhelp"] = 1; + delphi_reserved_method_exception["createfmthelp"] = 1; + delphi_reserved_method_exception["createreshelp"] = 1; + delphi_reserved_method_exception["createresfmthelp"] = 1; + delphi_reserved_method_exception["getbaseexception"] = 1; + delphi_reserved_method_exception["baseexception"] = 1; + delphi_reserved_method_exception["helpcontext"] = 1; + delphi_reserved_method_exception["innerexception"] = 1; + delphi_reserved_method_exception["message"] = 1; + delphi_reserved_method_exception["stacktrace"] = 1; + delphi_reserved_method_exception["stackinfo"] = 1; + delphi_reserved_method_exception["getexceptionstackinfoproc"] = 1; + delphi_reserved_method_exception["getstackinfostringproc"] = 1; + delphi_reserved_method_exception["cleanupstackinfoproc"] = 1; + delphi_reserved_method_exception["raiseouterexception"] = 1; + delphi_reserved_method_exception["throwouterexception"] = 1; +} + +void t_delphi_generator::add_delphi_uses_list( string unitname){ + vector::const_iterator s_iter; + bool found = false; + for (s_iter = uses_list.begin(); s_iter != uses_list.end(); ++s_iter) { + if ((*s_iter) == unitname ) { + found = true; + break; + } + } + if (! found) { + uses_list.push_back( unitname ); + } +} + +void t_delphi_generator::init_generator() { + indent_impl_ = 0; + namespace_name_ = program_->get_namespace("delphi"); + has_enum = false; + has_const = false; + create_keywords(); + add_delphi_uses_list("Classes"); + add_delphi_uses_list("SysUtils"); + add_delphi_uses_list("Generics.Collections"); + add_delphi_uses_list("Thrift"); + add_delphi_uses_list("Thrift.Utils"); + add_delphi_uses_list("Thrift.Collections"); + add_delphi_uses_list("Thrift.Protocol"); + add_delphi_uses_list("Thrift.Transport"); + + string unitname, nsname; + const vector& includes = program_->get_includes(); + for (size_t i = 0; i < includes.size(); ++i) { + unitname = includes[i]->get_name(); + nsname = includes[i]->get_namespace("delphi"); + if ( "" != nsname) { + unitname = nsname; + } + add_delphi_uses_list(unitname); + } + + + MKDIR(get_out_dir().c_str()); +} + +void t_delphi_generator::close_generator() { + std::string unitname = program_name_; + if( "" != namespace_name_) { + unitname = namespace_name_; + } + + for ( int i = 0; i < (int)unitname.size(); i++) { + if ( unitname[i] == ' ' ) { + unitname.replace( i, 1, "_" ); + } + } + + std::string f_name = get_out_dir() + "/" + unitname + ".pas"; + std::ofstream f_all; + + f_all.open( f_name.c_str() ); + + f_all << autogen_comment() << endl; + f_all << "unit " << unitname << ";" << endl << endl; + f_all << "interface" << endl << endl; + f_all << "uses" << endl; + + indent_up(); + + vector::const_iterator s_iter; + for (s_iter = uses_list.begin(); s_iter != uses_list.end(); ++s_iter) { + if (s_iter != uses_list.begin()) { + f_all << ","; + f_all << endl; + } + indent(f_all) << *s_iter; + } + + f_all << ";" << endl << endl; + + indent_down(); + + string tmp_unit( unitname ); + for ( int i = 0; i < (int)tmp_unit.size(); i++) { + if ( tmp_unit[i] == '.' ) { + tmp_unit.replace( i, 1, "_" ); + } + } + + f_all << "const" << endl; + indent_up(); + indent(f_all) << "c" << tmp_unit << "_Option_AnsiStr_Binary = " << ( ansistr_binary_ ? "True" : "False") << ";" << endl; + indent(f_all) << "c" << tmp_unit << "_Option_Suppress_GUID = " << ( suppress_guid_ ? "True" : "False") << ";" << endl << endl; + indent_down(); + + f_all << "type" << endl; + f_all << s_forward_decr.str(); + if (has_enum) { + indent(f_all) << endl; + indent(f_all) << "{$SCOPEDENUMS ON}" << endl << endl; + f_all << s_enum.str(); + indent(f_all) << "{$SCOPEDENUMS OFF}" << endl << endl; + } + f_all << s_struct.str(); + f_all << s_service.str(); + f_all << s_const.str(); + f_all << "implementation" << endl << endl; + f_all << s_struct_impl.str(); + f_all << s_service_impl.str(); + f_all << s_const_impl.str(); + + if ( has_const ) { + f_all << "{$IF CompilerVersion < 21.0}" << endl; + f_all << "initialization" << endl; + f_all << "begin" << endl; + f_all << " TConstants_Initialize;" << endl; + f_all << "end;" << endl << endl; + + f_all << "finalization" << endl; + f_all << "begin" << endl; + f_all << " TConstants_Finalize;" << endl; + f_all << "end;" << endl; + f_all << "{$IFEND}" << endl << endl; + } + f_all << "end." << endl; + f_all.close(); +} + +void t_delphi_generator::delphi_type_usings( ostream& out) { + indent_up(); + indent(out) << "Classes, SysUtils, Generics.Collections, Thrift.Collections, Thrift.Protocol," << endl; + indent(out) << "Thrift.Transport;" << endl << endl; + indent_down(); +} + +void t_delphi_generator::generate_typedef(t_typedef* ttypedef) { + (void) ttypedef; +} + +void t_delphi_generator::generate_enum(t_enum* tenum) { + has_enum = true; + indent_up(); + indent(s_enum) << + type_name(tenum,true,true) << " = " << "(" << endl; + indent_up(); + vector constants = tenum->get_constants(); + vector::iterator c_iter; + for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) { + int value = (*c_iter)->get_value(); + if (c_iter != constants.begin()) { + s_enum << ","; + s_enum << endl; + } + indent(s_enum) << normalize_name((*c_iter)->get_name()) << " = " << value; + } + s_enum << endl; + indent_down(); + indent(s_enum) << ");" << endl << endl; + indent_down(); +} + +void t_delphi_generator::generate_consts(std::vector consts) { + if (consts.empty()){ + return; + } + + has_const = true; + + indent_up(); + indent(s_const) << + "TConstants = class" << endl; + indent(s_const) << "private" << endl; + indent_up(); + vector::iterator c_iter; + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + print_private_field(s_const, normalize_name((*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value()); + } + indent_down(); + indent(s_const) << "public" << endl; + indent_up(); + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + print_const_prop(s_const, normalize_name((*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value()); + } + indent(s_const) << "{$IF CompilerVersion >= 21.0}" << endl; + indent(s_const) << "class constructor Create;" << endl; + indent(s_const) << "class destructor Destroy;" << endl; + indent(s_const) << "{$IFEND}" << endl; + indent_down(); + indent(s_const) << "end;" << endl << endl; + indent_down(); + + std::ostringstream vars, code; + + indent_up_impl(); + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + initialize_field(vars, code, "F" + prop_name( (*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value()); + } + indent_down_impl(); + + indent_impl(s_const_impl) << "{$IF CompilerVersion >= 21.0}" << endl; + indent_impl(s_const_impl) << "class constructor TConstants.Create;" << endl; + + if ( ! vars.str().empty() ) { + indent_impl(s_const_impl) << "var" << endl; + s_const_impl << vars.str(); + } + indent_impl(s_const_impl) << "begin" << endl; + if ( ! code.str().empty() ) { + s_const_impl << code.str(); + } + indent_impl(s_const_impl) << "end;" << endl << endl; + indent_impl(s_const_impl) << "class destructor TConstants.Destroy;" << endl; + indent_impl(s_const_impl) << "begin" << endl; + indent_up_impl(); + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + finalize_field(s_const_impl, normalize_name( (*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value()); + } + indent_impl(s_const_impl) << "inherited;" << endl; + indent_down_impl(); + indent_impl(s_const_impl) << "end;" << endl; + indent_impl(s_const_impl) << "{$ELSE}" << endl; + + vars.str(""); + code.str(""); + + indent_up_impl(); + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + initialize_field( vars, code, "F" + prop_name( (*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value(), "TConstants" ); + } + indent_down_impl(); + + indent_impl(s_const_impl) << "procedure TConstants_Initialize;" << endl; + if ( ! vars.str().empty() ) { + indent_impl(s_const_impl) << "var" << endl; + s_const_impl << vars.str(); + } + indent_impl(s_const_impl) << "begin" << endl; + if ( ! code.str().empty() ) { + s_const_impl << code.str(); + } + indent_impl(s_const_impl) << "end;" << endl << endl; + + indent_impl(s_const_impl) << "procedure TConstants_Finalize;" << endl; + indent_impl(s_const_impl) << "begin" << endl; + indent_up_impl(); + for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) { + finalize_field(s_const_impl, normalize_name( (*c_iter)->get_name()), + (*c_iter)->get_type(), (*c_iter)->get_value(), "TConstants" ); + } + indent_down_impl(); + indent_impl(s_const_impl) << "end;" << endl; + indent_impl(s_const_impl) << "{$IFEND}" << endl << endl; +} + +void t_delphi_generator::print_const_def_value(std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value, string cls_nm) +{ + + string cls_prefix; + + if (cls_nm == "") { + cls_prefix = ""; + } else { + cls_prefix = cls_nm + "."; + } + + if (type->is_struct() || type->is_xception()) { + const vector& fields = ((t_struct*)type)->get_members(); + vector::const_iterator f_iter; + const map& val = value->get_map(); + map::const_iterator v_iter; + for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) { + t_type* field_type = NULL; + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + if ((*f_iter)->get_name() == v_iter->first->get_string()) { + field_type = (*f_iter)->get_type(); + } + } + if (field_type == NULL) { + throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string(); + } + string val = render_const_value( vars, out, name, field_type, v_iter->second); + indent_impl(out) << cls_prefix << normalize_name(name) << "." << normalize_name( v_iter->first->get_string()) << " := " << val << ";" << endl; + } + } else if (type->is_map()) { + t_type* ktype = ((t_map*)type)->get_key_type(); + t_type* vtype = ((t_map*)type)->get_val_type(); + const map& val = value->get_map(); + map::const_iterator v_iter; + for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) { + string key = render_const_value( vars, out, name, ktype, v_iter->first); + string val = render_const_value( vars, out, name, vtype, v_iter->second); + indent_impl(out) << cls_prefix << normalize_name(name) << "[" << key << "]" << " := " << val << ";" << endl; + } + } else if (type->is_list() || type->is_set()) { + t_type* etype; + if (type->is_list()) { + etype = ((t_list*)type)->get_elem_type(); + } else { + etype = ((t_set*)type)->get_elem_type(); + } + + const vector& val = value->get_list(); + vector::const_iterator v_iter; + for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) { + string val = render_const_value( vars, out, name, etype, *v_iter); + indent_impl(out) << cls_prefix << normalize_name(name) << ".Add(" << val << ");" << endl; + } + } +} + +void t_delphi_generator::print_private_field(std::ostream& out, string name, t_type* type, t_const_value* value) { + indent(out) << "class var F" << name << ": " << type_name(type) << ";" << endl; +} + +void t_delphi_generator::print_const_prop(std::ostream& out, string name, t_type* type, t_const_value* value) { + indent(out) << "class property " << name << ": " << type_name(type) << " read F" << name << ";" << endl; +} + +void t_delphi_generator::print_const_value( std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value) { + t_type* truetype = type; + while (truetype->is_typedef()) { + truetype = ((t_typedef*)truetype)->get_type(); + } + + if (truetype->is_base_type()) { + string v2 = render_const_value( vars, out, name, type, value); + indent_impl(out) << name << " := " << v2 << ";" << endl; + } else if (truetype->is_enum()) { + indent_impl(out) << name << " := " << type_name(type) << "(" << value->get_integer() << ");" << endl; + } else { + string typname; + typname = type_name(type,!type->is_xception()); + indent_impl(out) << name << " := " << typname << ".Create;" << endl; + print_const_def_value( vars, out, name, type, value); + } + +} + +void t_delphi_generator::initialize_field(std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value, string cls_nm) { + print_const_value( vars, out, name, type, value ); +} + +void t_delphi_generator::finalize_field(std::ostream& out, string name, t_type* type, t_const_value* value , string cls_nm) { +} + +string t_delphi_generator::render_const_value(ostream& vars, ostream& out, string name, t_type* type, t_const_value* value) { + + t_type* truetype = type; + while (truetype->is_typedef()) { + truetype = ((t_typedef*)truetype)->get_type(); + } + + std::ostringstream render; + + if (truetype->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)truetype)->get_base(); + switch (tbase) { + case t_base_type::TYPE_STRING: + render << "'" << get_escaped_string(value) << "'"; + break; + case t_base_type::TYPE_BOOL: + render << ((value->get_integer() > 0) ? "True" : "False"); + break; + case t_base_type::TYPE_BYTE: + case t_base_type::TYPE_I16: + case t_base_type::TYPE_I32: + case t_base_type::TYPE_I64: + render << value->get_integer(); + break; + case t_base_type::TYPE_DOUBLE: + if (value->get_type() == t_const_value::CV_INTEGER) { + render << value->get_integer(); + } else { + render << value->get_double(); + } + break; + default: + render << ""; + } + } else if (truetype->is_enum()) { + render << type_name( type, false) << "(" << value->get_integer() << ")"; + } else { + string t = tmp("tmp"); + vars << " " << t << " : " << type_name(type) << ";" << endl; + print_const_value( vars, out, t, type, value); + render << t; + } + + return render.str(); +} + +void t_delphi_generator::generate_struct(t_struct* tstruct) { + generate_delphi_struct(tstruct, false); +} + +void t_delphi_generator::generate_xception(t_struct* txception) { + generate_delphi_struct(txception, true); +} + +void t_delphi_generator::generate_delphi_struct(t_struct* tstruct, bool is_exception) { + indent_up(); + generate_delphi_struct_definition(s_struct, tstruct, is_exception); + indent_down(); + + generate_delphi_struct_impl(s_struct_impl, "", tstruct, is_exception); + +} + +void t_delphi_generator::generate_delphi_struct_impl( ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception, bool is_result, bool is_x_factory) { + + if (is_exception && (! is_x_factory)) { + generate_delphi_struct_impl( out, cls_prefix, tstruct, is_exception, is_result, true); + } + + string cls_nm; + + string exception_factory_name; + + if (is_exception) { + exception_factory_name = normalize_clsnm( tstruct->get_name(), "", true ) + "Factory"; + } + + if (is_exception) { + cls_nm = type_name(tstruct,true,(! is_x_factory),is_x_factory,true); + } + else { + cls_nm = type_name(tstruct,true,false); + } + + std::ostringstream vars, code; + + const vector& members = tstruct->get_members(); + vector::const_iterator m_iter; + + indent_up_impl(); + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + t_type* t = (*m_iter)->get_type(); + while (t->is_typedef()) { + t = ((t_typedef*)t)->get_type(); + } + if ((*m_iter)->get_value() != NULL) { + initialize_field( vars, code, "F" + prop_name( (*m_iter)->get_name(), is_exception), t, (*m_iter)->get_value()); + } + } + indent_down_impl(); + + + indent_impl(out) << "constructor " << cls_prefix << cls_nm << "." << "Create;" << endl; + + if ( ! vars.str().empty()) { + out << vars.str(); + } + + indent_impl(out) << "begin" << endl; + indent_up_impl(); + if (is_exception && (! is_x_factory)) { + indent_impl(out) << "inherited Create('');" << endl; + indent_impl(out) << "F" << exception_factory_name << " := T" << exception_factory_name << "Impl.Create;" << endl; + } else { + indent_impl(out) << "inherited;" << endl; + } + + if ( ! code.str().empty()) { + out << code.str(); + } + + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; + + indent_impl(out) << "destructor " << cls_prefix << cls_nm << "." << "Destroy;" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + t_type* t = (*m_iter)->get_type(); + while (t->is_typedef()) { + t = ((t_typedef*)t)->get_type(); + } + finalize_field( out, prop_name(*m_iter, is_exception), t, (*m_iter)->get_value()); + } + + indent_impl(out) << "inherited;" << endl; + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; + + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + t_type* t = (*m_iter)->get_type(); + while (t->is_typedef()) { + t = ((t_typedef*)t)->get_type(); + } + generate_delphi_property_reader_impl( out, cls_prefix, cls_nm, t, *m_iter, "F"); + generate_delphi_property_writer_impl( out, cls_prefix, cls_nm, t, *m_iter, "F", (is_exception && (! is_x_factory)), exception_factory_name); + generate_delphi_isset_reader_impl( out, cls_prefix, cls_nm, t, *m_iter, "F"); + } + + if ((! is_exception) || is_x_factory) { + generate_delphi_struct_reader_impl( out, cls_prefix, tstruct, is_exception); + if ( is_result ) { + generate_delphi_struct_result_writer_impl( out, cls_prefix, tstruct, is_exception); + } else { + generate_delphi_struct_writer_impl( out, cls_prefix, tstruct, is_exception); + } + generate_delphi_struct_tostring_impl( out, cls_prefix, tstruct, is_exception); + } + + if (is_exception && is_x_factory) { + generate_delphi_create_exception_impl( out, cls_prefix, tstruct, is_exception); + } +} + +void t_delphi_generator::generate_delphi_struct_definition(ostream &out, t_struct* tstruct, bool is_exception, bool in_class, bool is_result, bool is_x_factory) { + bool is_final = (tstruct->annotations_.find("final") != tstruct->annotations_.end()); + string struct_intf_name; + string struct_name; + string isset_name; + const vector& members = tstruct->get_members(); + vector::const_iterator m_iter; + + string exception_factory_name = normalize_clsnm( tstruct->get_name(), "", true ) + "Factory"; + + if (is_exception) { + struct_intf_name = type_name(tstruct,false,false,true); + } + else { + struct_intf_name = type_name(tstruct); + } + + + if (is_exception) { + struct_name = type_name(tstruct, true, (! is_x_factory), is_x_factory); + } + else { + struct_name = type_name(tstruct,true); + } + + if ((! is_exception) || is_x_factory) { + + indent(out) << struct_intf_name << " = interface(IBase)" << endl; + indent_up(); + + if (! suppress_guid_) { + indent(out) << generate_guid() << endl; + } + + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + generate_delphi_property_reader_definition( out, *m_iter); + generate_delphi_property_writer_definition( out, *m_iter); + } + + if (is_x_factory) { + out << endl; + indent(out) << "// Create Exception Object" << endl; + indent(out) << "function CreateException: " << type_name(tstruct,true,true) << ";" << endl; + } + + if (members.size() > 0) { + out << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + generate_property(out, *m_iter, true, is_exception); + } + } + + if (members.size() > 0) { + out << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + generate_delphi_isset_reader_definition( out, *m_iter); + } + } + + if (members.size() > 0) { + out << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + isset_name = "__isset_" + prop_name(*m_iter, is_exception); + indent(out) << "property " << isset_name << ": Boolean read Get" << isset_name << ";" << endl; + } + } + + indent_down(); + indent(out) << "end;" << endl << endl; + } + + indent(out) << struct_name << " = "; + if (is_final) { + out << "sealed "; + } + out << "class("; + if ( is_exception && (! is_x_factory)) { + out << "Exception"; + } else { + out << "TInterfacedObject, IBase, " << struct_intf_name; + } + out << ")" << endl; + + if (is_exception && (! is_x_factory)) { + indent(out) << "public" << endl; + indent_up(); + indent(out) << "type" << endl; + indent_up(); + generate_delphi_struct_definition( out, tstruct, is_exception, in_class, is_result, true); + indent_down(); + indent_down(); + } + + indent(out) << "private" << endl; + indent_up(); + + if (is_exception && (! is_x_factory)) { + indent(out) << "F" << exception_factory_name << " :" << struct_intf_name << ";" << endl << endl; + } + + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + indent(out) << declare_field(*m_iter, false, "F") << endl; + } + + if (members.size() > 0) { + indent(out) << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + isset_name = "F__isset_" + prop_name(*m_iter, is_exception); + indent(out) << isset_name << ": Boolean;" << endl; + } + } + + indent(out) << endl; + + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + generate_delphi_property_reader_definition( out, *m_iter); + generate_delphi_property_writer_definition( out, *m_iter); + } + + if (members.size() > 0) { + out << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + isset_name = "__isset_" + prop_name(*m_iter, is_exception); + indent(out) << "function Get" << isset_name << ": Boolean;" << endl; + } + } + + indent_down(); + + indent(out) << "public" << endl; + indent_up(); + + indent(out) << "constructor Create;" << endl; + indent(out) << "destructor Destroy; override;" << endl; + + if ((! is_exception) || is_x_factory) { + out << endl; + indent(out) << "function ToString: string; override;" << endl; + } + + if (is_exception && (! is_x_factory)) { + out << endl; + indent(out) << "// Exception Factory" << endl; + indent(out) << "property " << exception_factory_name << ": " << struct_intf_name << " read F" << exception_factory_name << " write F" << exception_factory_name << ";" << endl; + } + + if ((! is_exception) || is_x_factory) { + out << endl; + indent(out) << "// IBase" << endl; + indent(out) << "procedure Read( iprot: IProtocol);" << endl; + indent(out) << "procedure Write( oprot: IProtocol);" << endl; + } + + if (is_exception && is_x_factory) { + out << endl; + indent(out) << "// Create Exception Object" << endl; + indent(out) << "function CreateException: " << type_name(tstruct,true,true) << ";" << endl; + } + + if (members.size() > 0) { + out << endl; + indent(out) << "// Properties" << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + generate_property(out, *m_iter, true, is_exception); + } + } + + if (members.size() > 0) { + out << endl; + indent(out) << "// isset" << endl; + for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) { + isset_name = "__isset_" + prop_name(*m_iter, is_exception); + indent(out) << "property " << isset_name << ": Boolean read Get" << isset_name << ";" << endl; + } + } + + indent_down(); + indent(out) << "end;" << endl; + + indent(out) << endl; +} + +void t_delphi_generator::generate_service(t_service* tservice) { + indent_up(); + indent(s_service) << normalize_clsnm(service_name_, "T") << " = class" << endl; + indent(s_service) << "public" << endl; + indent_up(); + indent(s_service) << "type" << endl; + generate_service_interface(tservice); + generate_service_client(tservice); + generate_service_server(tservice); + generate_service_helpers(tservice); + indent_down(); + indent_down(); + indent(s_service) << "end;" << endl; + indent(s_service) << endl; + indent_down(); +} + +void t_delphi_generator::generate_service_interface(t_service* tservice) { + string extends = ""; + string extends_iface = ""; + + indent_up(); + + if (tservice->get_extends() != NULL) { + extends = type_name(tservice->get_extends(), true, true); + extends_iface = extends + ".Iface"; + indent(s_service) << + "Iface = interface(" << extends_iface << ")" << endl; + } else { + indent(s_service) << + "Iface = interface" << endl; + } + + indent_up(); + + if (! suppress_guid_) { + indent(s_service) << generate_guid() << endl; + } + + vector functions = tservice->get_functions(); + vector::iterator f_iter; + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) + { + indent(s_service) << + function_signature(*f_iter) << endl; + } + indent_down(); + indent(s_service) << "end;" << endl << endl; + + indent_down(); +} + +void t_delphi_generator::generate_service_helpers(t_service* tservice) { + vector functions = tservice->get_functions(); + vector::iterator f_iter; + + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) { + t_struct* ts = (*f_iter)->get_arglist(); + generate_delphi_struct_definition(s_service, ts, false, true); + generate_delphi_struct_impl(s_service_impl, normalize_clsnm( service_name_, "T") + ".", ts, false); + generate_function_helpers(*f_iter); + } +} + +void t_delphi_generator::generate_service_client(t_service* tservice) { + indent_up(); + string extends = ""; + string extends_client = ""; + if (tservice->get_extends() != NULL) { + extends = type_name(tservice->get_extends()); + extends_client = extends + ".Client, "; + } + + if (tservice->get_extends() != NULL) { + extends = type_name(tservice->get_extends(), true, true); + extends_client = extends + ".TClient"; + indent(s_service) << + "TClient = class(" << extends_client << ", Iface)" << endl; + } else { + indent(s_service) << + "TClient = class( TInterfacedObject, Iface)" << endl; + } + + indent(s_service) << "public" << endl; + indent_up(); + + indent(s_service) << "constructor Create( prot: IProtocol); overload;" << endl; + + indent_impl(s_service_impl) << "constructor " << normalize_clsnm( service_name_, "T") << ".TClient.Create( prot: IProtocol);" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "Create( prot, prot );" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + indent(s_service) << "constructor Create( iprot: IProtocol; oprot: IProtocol); overload;" << endl; + + indent_impl(s_service_impl) << "constructor " << normalize_clsnm( service_name_, "T") << ".TClient.Create( iprot: IProtocol; oprot: IProtocol);" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "iprot_ := iprot;" << endl; + indent_impl(s_service_impl) << "oprot_ := oprot;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + indent_down(); + + if (extends.empty()) { + indent(s_service) << "protected" << endl; + indent_up(); + indent(s_service) << "iprot_: IProtocol;" << endl; + indent(s_service) << "oprot_: IProtocol;" << endl; + indent(s_service) << "seqid_: Integer;" << endl; + indent_down(); + + indent(s_service) << "public" << endl; + indent_up(); + indent(s_service) << "property InputProtocol: IProtocol read iprot_;" << endl; + indent(s_service) << "property OutputProtocol: IProtocol read oprot_;" << endl; + indent_down(); + } + + vector functions = tservice->get_functions(); + vector::const_iterator f_iter; + + indent(s_service) << "protected" << endl; + indent_up(); + indent(s_service) << "// Iface" << endl; + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) { + string funname = (*f_iter)->get_name(); + indent(s_service) << function_signature(*f_iter) << endl; + } + indent_down(); + + indent(s_service) << "public" << endl; + indent_up(); + + string full_cls = normalize_clsnm(service_name_,"T") + ".TClient"; + + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) { + string funname = (*f_iter)->get_name(); + + indent_impl(s_service_impl) << function_signature(*f_iter, full_cls) << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "send_" << funname << "("; + + t_struct* arg_struct = (*f_iter)->get_arglist(); + + const vector& fields = arg_struct->get_members(); + vector::const_iterator fld_iter; + bool first = true; + for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) { + if (first) { + first = false; + } else { + s_service_impl << ", "; + } + s_service_impl << normalize_name( (*fld_iter)->get_name()); + } + s_service_impl << ");" << endl; + + if (!(*f_iter)->is_oneway()) { + s_service_impl << indent_impl(); + if (!(*f_iter)->get_returntype()->is_void()) { + s_service_impl << "Result := "; + } + s_service_impl << + "recv_" << funname << "();" << endl; + } + + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + t_function send_function(g_type_void, + string("send_") + (*f_iter)->get_name(), + (*f_iter)->get_arglist()); + + string argsname = (*f_iter)->get_name() + "_args"; + string args_clsnm = normalize_clsnm( argsname, "T"); + string args_intfnm= normalize_clsnm( argsname, "I"); + + indent(s_service) << function_signature(&send_function) << endl; + indent_impl(s_service_impl) << function_signature(&send_function, full_cls) << endl; + indent_impl(s_service_impl) << "var" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "args : " << args_intfnm << ";" << endl; + indent_impl(s_service_impl) << "msg : IMessage;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + + indent_impl(s_service_impl) << + "seqid_ := seqid_ + 1;" << endl; + indent_impl(s_service_impl) << + "msg := TMessageImpl.Create('" << funname << "', TMessageType.Call, seqid_);" << endl; + + indent_impl(s_service_impl) << + "oprot_.WriteMessageBegin( msg );" << endl; + indent_impl(s_service_impl) << + "args := " << args_clsnm << "Impl.Create();" << endl; + + for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) { + indent_impl(s_service_impl) << + "args." << prop_name(*fld_iter) << " := " << normalize_name( (*fld_iter)->get_name()) << ";" << endl; + } + indent_impl(s_service_impl) << "args.Write(oprot_);" << endl; + for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) { + indent_impl(s_service_impl) << + "args." << prop_name(*fld_iter) << " := " << empty_value((*fld_iter)->get_type()) << ";" << endl; + } + + indent_impl(s_service_impl) << "oprot_.WriteMessageEnd();" << endl; + indent_impl(s_service_impl) << "oprot_.Transport.Flush();" << endl; + + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + if (!(*f_iter)->is_oneway()) { + string org_resultname = (*f_iter)->get_name() + "_result" ; + string result_clsnm = normalize_clsnm( org_resultname, "T"); + string result_intfnm = normalize_clsnm( org_resultname, "I"); + + t_struct noargs(program_); + t_function recv_function((*f_iter)->get_returntype(), + string("recv_") + (*f_iter)->get_name(), + &noargs, + (*f_iter)->get_xceptions()); + + t_struct *xs = (*f_iter)->get_xceptions(); + const std::vector& xceptions = xs->get_members(); + + indent(s_service) << function_signature(&recv_function) << endl; + indent_impl(s_service_impl) << function_signature(&recv_function, full_cls) << endl; + indent_impl(s_service_impl) << "var" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "msg : IMessage;" << endl; + if ( xceptions.size() > 0) { + indent_impl(s_service_impl) << "ex : Exception;" << endl; + } + indent_impl(s_service_impl) << "x : TApplicationException;" << endl; + indent_impl(s_service_impl) << "ret : " << result_intfnm << ";" << endl; + + indent_down_impl(); + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "msg := iprot_.ReadMessageBegin();" << endl; + indent_impl(s_service_impl) << "if (msg.Type_ = TMessageType.Exception) then" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "x := TApplicationException.Read(iprot_);" << endl; + indent_impl(s_service_impl) << "iprot_.ReadMessageEnd();" << endl; + indent_impl(s_service_impl) << "raise x;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + + indent_impl(s_service_impl) << "ret := " << result_clsnm << "Impl.Create();" << endl; + indent_impl(s_service_impl) << "ret.Read(iprot_);" << endl; + indent_impl(s_service_impl) << "iprot_.ReadMessageEnd();" << endl; + + if (!(*f_iter)->get_returntype()->is_void()) { + indent_impl(s_service_impl) << "if (ret.__isset_success) then" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "Result := ret.Success;" << endl; + t_type *type = (*f_iter)->get_returntype(); + if (type->is_struct() || type->is_xception() || type->is_map() || type->is_list() || type->is_set()) { + indent_impl(s_service_impl) << "ret.Success := nil;" << endl; + } + indent_impl(s_service_impl) << "Exit;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + } + + vector::const_iterator x_iter; + for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) { + indent_impl(s_service_impl) << "if (ret.__isset_" << prop_name(*x_iter) << ") then" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "ex := ret." << prop_name(*x_iter) << ".CreateException;" << endl; + indent_impl(s_service_impl) << "raise ex;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + } + + if (!(*f_iter)->get_returntype()->is_void()) { + indent_impl(s_service_impl) << + "raise TApplicationException.Create(TApplicationException.TExceptionType.MissingResult, '" << (*f_iter)->get_name() << " failed: unknown result');" << endl; + } + + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + } + } + + indent_down(); + indent(s_service) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_service_server(t_service* tservice) { + vector functions = tservice->get_functions(); + vector::iterator f_iter; + + string extends = ""; + string extends_processor = ""; + + string full_cls = normalize_clsnm( service_name_, "T") + ".TProcessorImpl"; + + if (tservice->get_extends() != NULL) { + extends = type_name(tservice->get_extends(), true, true); + extends_processor = extends + ".TProcessorImpl"; + indent(s_service) << + "TProcessorImpl = class(" << extends_processor << ", IProcessor)" << endl; + } else { + indent(s_service) << + "TProcessorImpl = class( TInterfacedObject, IProcessor)" << endl; + } + + indent(s_service) << "public" << endl; + indent_up(); + indent(s_service) << "constructor Create( iface_: Iface );" << endl; + indent(s_service) << "destructor Destroy; override;" << endl; + indent_down(); + + indent_impl(s_service_impl) << "constructor " << full_cls << ".Create( iface_: Iface );" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "Self.iface_ := iface_;" << endl; + indent_impl(s_service_impl) << "processMap_ := TThriftDictionaryImpl.Create;" << endl; + + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) { + indent_impl(s_service_impl) << + "processMap_.AddOrSetValue( '" << (*f_iter)->get_name() << "', " << (*f_iter)->get_name() << "_Process);" << endl; + } + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + indent_impl(s_service_impl) << "destructor " << full_cls << ".Destroy;" << endl; + indent_impl(s_service_impl) << "begin;" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "inherited;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + indent(s_service) << "protected" << endl; + indent_up(); + indent(s_service) << "type" << endl; + indent_up(); + indent(s_service) << "TProcessFunction = reference to procedure( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl; + indent_down(); + indent_down(); + + indent(s_service) << "private" << endl; + indent_up(); + indent(s_service) << "iface_: Iface;" << endl; + indent_down(); + indent(s_service) << "protected" << endl; + indent_up(); + indent(s_service) << "processMap_: IThriftDictionary;" << endl; + indent_down(); + indent(s_service) << "public" << endl; + indent_up(); + if (extends.empty()) { + indent(s_service) << "function Process( iprot: IProtocol; oprot: IProtocol): Boolean;" << endl; + } else { + indent(s_service) << "function Process( iprot: IProtocol; oprot: IProtocol): Boolean; reintroduce;" << endl; + } + + indent_impl(s_service_impl) << "function " << full_cls << ".Process( iprot: IProtocol; oprot: IProtocol): Boolean;" << endl;; + indent_impl(s_service_impl) << "var" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "msg : IMessage;" << endl; + indent_impl(s_service_impl) << "fn : TProcessFunction;" << endl; + indent_impl(s_service_impl) << "x : TApplicationException;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "try" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "msg := iprot.ReadMessageBegin();" << endl; + indent_impl(s_service_impl) << "fn := nil;" << endl; + indent_impl(s_service_impl) << "processMap_.TryGetValue(msg.Name, fn);" << endl; + indent_impl(s_service_impl) << "if (@fn = nil) then" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "TProtocolUtil.Skip(iprot, TType.Struct);" << endl; + indent_impl(s_service_impl) << "iprot.ReadMessageEnd();" << endl; + indent_impl(s_service_impl) << "x := TApplicationException.Create(TApplicationException.TExceptionType.UnknownMethod, 'Invalid method name: ''' + msg.Name + '''');" << endl; + indent_impl(s_service_impl) << "oprot.WriteMessageBegin(TMessageImpl.Create(msg.Name, TMessageType.Exception, msg.SeqID));" << endl; + indent_impl(s_service_impl) << "x.Write(oprot);" << endl; + indent_impl(s_service_impl) << "oprot.WriteMessageEnd();" << endl; + indent_impl(s_service_impl) << "oprot.Transport.Flush();" << endl; + indent_impl(s_service_impl) << "Result := True;" << endl; + indent_impl(s_service_impl) << "Exit;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + indent_impl(s_service_impl) << "fn(msg.SeqID, iprot, oprot);" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "except" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "Result := False;" << endl; + indent_impl(s_service_impl) << "Exit;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + indent_impl(s_service_impl) << "Result := True;" << endl; + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; + + for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) + { + generate_process_function(tservice, *f_iter); + } + + indent_down(); + indent(s_service) << "end;" << endl << endl; + +} + +void t_delphi_generator::generate_function_helpers(t_function* tfunction) { + if (tfunction->is_oneway()) { + return; + } + + t_struct result(program_, tfunction->get_name() + "_result"); + t_field success(tfunction->get_returntype(), "Success", 0); + if (!tfunction->get_returntype()->is_void()) { + result.append(&success); + } + + t_struct *xs = tfunction->get_xceptions(); + const vector& fields = xs->get_members(); + vector::const_iterator f_iter; + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + result.append(*f_iter); + } + + generate_delphi_struct_definition(s_service, &result, false, true, true); + generate_delphi_struct_impl(s_service_impl, normalize_clsnm( service_name_, "T") + ".", &result, false); +} + +void t_delphi_generator::generate_process_function(t_service* tservice, t_function* tfunction) { + (void) tservice; + string funcname = tfunction->get_name(); + string full_cls = normalize_clsnm( service_name_, "T") + ".TProcessorImpl"; + + string org_argsname = funcname + "_args"; + string args_clsnm = normalize_clsnm(org_argsname, "T"); + string args_intfnm = normalize_clsnm(org_argsname, "I"); + + string org_resultname = funcname + "_result"; + string result_clsnm = normalize_clsnm(org_resultname, "T"); + string result_intfnm = normalize_clsnm(org_resultname, "I"); + + indent(s_service) << + "procedure " << funcname << "_Process( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl; + + if (tfunction->is_oneway()) { + indent_impl(s_service_impl) << "// one way processor" << endl; + } else { + indent_impl(s_service_impl) << "// both way processor" << endl; + } + + indent_impl(s_service_impl) << + "procedure " << full_cls << "." << funcname << "_Process( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl; + indent_impl(s_service_impl) << "var" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "args: " << args_intfnm << ";" << endl; + if (!tfunction->is_oneway()) { + indent_impl(s_service_impl) << "ret: " << result_intfnm << ";" << endl; + } + + indent_down_impl(); + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + indent_impl(s_service_impl) << "args := " << args_clsnm << "Impl.Create;" << endl; + indent_impl(s_service_impl) << "args.Read(iprot);" << endl; + indent_impl(s_service_impl) << "iprot.ReadMessageEnd();" << endl; + + t_struct* xs = tfunction->get_xceptions(); + const std::vector& xceptions = xs->get_members(); + vector::const_iterator x_iter; + + if (!tfunction->is_oneway()) { + indent_impl(s_service_impl) << "ret := " << result_clsnm << "Impl.Create;" << endl; + } + + if (!tfunction->is_oneway() && xceptions.size() > 0) { + indent_impl(s_service_impl) << "try" << endl; + indent_up_impl(); + } + + t_struct* arg_struct = tfunction->get_arglist(); + const std::vector& fields = arg_struct->get_members(); + vector::const_iterator f_iter; + + s_service_impl << indent_impl(); + if (!tfunction->is_oneway() && !tfunction->get_returntype()->is_void()) { + s_service_impl << "ret.Success := "; + } + s_service_impl << "iface_." << normalize_name( tfunction->get_name(), true) << "("; + bool first = true; + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + if (first) { + first = false; + } else { + s_service_impl << ", "; + } + s_service_impl << "args." << prop_name(*f_iter); + } + s_service_impl << ");" << endl; + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + indent_impl(s_service_impl) << + "args." << prop_name(*f_iter) << " := " << empty_value((*f_iter)->get_type()) << ";" << endl; + } + + if (!tfunction->is_oneway() && xceptions.size() > 0) { + indent_down_impl(); + indent_impl(s_service_impl) << "except" << endl; + indent_up_impl(); + for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) { + indent_impl(s_service_impl) << "on E: " << type_name((*x_iter)->get_type(),true,true) << " do" << endl; + indent_impl(s_service_impl) << "begin" << endl; + indent_up_impl(); + if (!tfunction->is_oneway()) { + string factory_name = normalize_clsnm((*x_iter)->get_type()->get_name(),"",true) + "Factory"; + indent_impl(s_service_impl) << + "ret." << prop_name(*x_iter) << " := E." << factory_name << ";" << endl; + } + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + } + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl; + } + + if (! tfunction->is_oneway()) { + indent_impl(s_service_impl) << "oprot.WriteMessageBegin( TMessageImpl.Create('" << tfunction->get_name() << "', TMessageType.Reply, seqid)); " << endl; + indent_impl(s_service_impl) << "ret.Write(oprot);" << endl; + indent_impl(s_service_impl) << "oprot.WriteMessageEnd();" << endl; + indent_impl(s_service_impl) << "oprot.Transport.Flush();" << endl; + } + + indent_down_impl(); + indent_impl(s_service_impl) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_deserialize_field(ostream& out, bool is_xception, t_field* tfield, string prefix, ostream& local_vars) { + t_type* type = tfield->get_type(); + while(type->is_typedef()) { + type = ((t_typedef*)type)->get_type(); + } + + if (type->is_void()) { + throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE: " + prefix + tfield->get_name(); + } + + string name = prefix + prop_name(tfield,is_xception); + + if (type->is_struct() || type->is_xception()) { + generate_deserialize_struct(out, (t_struct*)type, name, ""); + } else if (type->is_container()) { + generate_deserialize_container(out, is_xception, type, name, local_vars); + } else if (type->is_base_type() || type->is_enum()) { + indent_impl(out) << + name << " := "; + + if (type->is_enum()) + { + out << type_name(type, false) << "("; + } + + out << "iprot."; + + if (type->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); + switch (tbase) { + case t_base_type::TYPE_VOID: + throw "compiler error: cannot serialize void field in a struct: " + name; + break; + case t_base_type::TYPE_STRING: + if (((t_base_type*)type)->is_binary()) { + if (ansistr_binary_) { + out << "ReadAnsiString();"; + } else { + out << "ReadBinary();"; + } + } else { + out << "ReadString();"; + } + break; + case t_base_type::TYPE_BOOL: + out << "ReadBool();"; + break; + case t_base_type::TYPE_BYTE: + out << "ReadByte();"; + break; + case t_base_type::TYPE_I16: + out << "ReadI16();"; + break; + case t_base_type::TYPE_I32: + out << "ReadI32();"; + break; + case t_base_type::TYPE_I64: + out << "ReadI64();"; + break; + case t_base_type::TYPE_DOUBLE: + out << "ReadDouble();"; + break; + default: + throw "compiler error: no C# name for base type " + tbase; + } + } else if (type->is_enum()) { + out << "ReadI32()"; + out << ");"; + } + out << endl; + } else { + printf("DO NOT KNOW HOW TO DESERIALIZE FIELD '%s' TYPE '%s'\n", tfield->get_name().c_str(), type_name(type).c_str()); + } +} + +void t_delphi_generator::generate_deserialize_struct(ostream& out, t_struct* tstruct, string name, string prefix) { + string typ_name; + + if (tstruct->is_xception()) { + typ_name = type_name(tstruct,true,false,true,true); + } else { + typ_name = type_name(tstruct,true,false); + } + + indent_impl(out) << prefix << name << " := " << typ_name << ".Create;" << endl; + indent_impl(out) << prefix << name << ".Read(iprot);" << endl; +} + +void t_delphi_generator::generate_deserialize_container(ostream& out, bool is_xception, t_type* ttype, string name, std::ostream& local_vars) { + + string obj; + string counter; + string local_var; + + if (ttype->is_map()) { + obj = tmp("_map"); + } else if (ttype->is_set()) { + obj = tmp("_set"); + } else if (ttype->is_list()) { + obj = tmp("_list"); + } + + if (ttype->is_map()) { + local_var = obj + ": IMap;"; + } else if (ttype->is_set()) { + local_var = obj + ": ISet;"; + } else if (ttype->is_list()) { + local_var = obj + ": IList;"; + } + local_vars << " " << local_var << endl; + counter = tmp("_i"); + local_var = counter + ": Integer;"; + local_vars << " " << local_var << endl; + + indent_impl(out) << name << " := " << type_name(ttype, true) << ".Create;" << endl; + + if (ttype->is_map()) { + indent_impl(out) << obj << " := iprot.ReadMapBegin();" << endl; + } else if (ttype->is_set()) { + indent_impl(out) << obj << " := iprot.ReadSetBegin();" << endl; + } else if (ttype->is_list()) { + indent_impl(out) << obj << " := iprot.ReadListBegin();" << endl; + } + + indent_impl(out) << + "for " << counter << " := 0 to " << obj << ".Count - 1 do" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + if (ttype->is_map()) { + generate_deserialize_map_element(out, is_xception, (t_map*)ttype, name, local_vars); + } else if (ttype->is_set()) { + generate_deserialize_set_element(out, is_xception, (t_set*)ttype, name, local_vars); + } else if (ttype->is_list()) { + generate_deserialize_list_element(out, is_xception, (t_list*)ttype, name, local_vars); + } + indent_down_impl(); + indent_impl(out) << "end;" << endl; +} + +void t_delphi_generator::generate_deserialize_map_element(ostream& out, bool is_xception, t_map* tmap, string prefix, ostream& local_vars) { + + string key = tmp("_key"); + string val = tmp("_val"); + string local_var; + + t_field fkey(tmap->get_key_type(), key); + t_field fval(tmap->get_val_type(), val); + + local_vars << " " << declare_field(&fkey) << endl; + local_vars << " " << declare_field(&fval) << endl; + + generate_deserialize_field(out, is_xception, &fkey, "", local_vars); + generate_deserialize_field(out, is_xception, &fval, "", local_vars); + + indent_impl(out) << + prefix << ".AddOrSetValue( " << key << ", " << val << ");" << endl; + +} + +void t_delphi_generator::generate_deserialize_set_element(ostream& out, bool is_xception, t_set* tset, string prefix, ostream& local_vars) { + string elem = tmp("_elem"); + t_field felem(tset->get_elem_type(), elem); + local_vars << " " << declare_field(&felem, true) << endl; + generate_deserialize_field(out, is_xception, &felem, "", local_vars); + indent_impl(out) << + prefix << ".Add(" << elem << ");" << endl; +} + +void t_delphi_generator::generate_deserialize_list_element(ostream& out, bool is_xception, t_list* tlist, string prefix, ostream& local_vars) { + string elem = tmp("_elem"); + t_field felem(tlist->get_elem_type(), elem); + local_vars << " " << declare_field(&felem, true) << endl; + generate_deserialize_field(out, is_xception, &felem, "", local_vars); + indent_impl(out) << + prefix << ".Add(" << elem << ");" << endl; +} + +void t_delphi_generator::generate_serialize_field(ostream& out, bool is_xception, t_field* tfield, string prefix, ostream& local_vars) { + t_type* type = tfield->get_type(); + while (type->is_typedef()) { + type = ((t_typedef*)type)->get_type(); + } + + string name = prefix + prop_name(tfield, is_xception); + + if (type->is_void()) { + throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " + name; + } + + if (type->is_struct() || type->is_xception()) { + generate_serialize_struct(out, (t_struct*)type, name, local_vars); + } else if (type->is_container()) { + generate_serialize_container(out, is_xception, type, name, local_vars); + } else if (type->is_base_type() || type->is_enum()) { + + indent_impl(out) << + "oprot."; + + if (type->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); + + switch(tbase) { + case t_base_type::TYPE_VOID: + throw "compiler error: cannot serialize void field in a struct: " + name; + break; + case t_base_type::TYPE_STRING: + if (((t_base_type*)type)->is_binary()) { + if (ansistr_binary_) { + out << "WriteAnsiString("; + } else { + out << "WriteBinary("; + } + } else { + out << "WriteString("; + } + out << name << ");"; + break; + case t_base_type::TYPE_BOOL: + out << "WriteBool(" << name << ");"; + break; + case t_base_type::TYPE_BYTE: + out << "WriteByte(" << name << ");"; + break; + case t_base_type::TYPE_I16: + out << "WriteI16(" << name << ");"; + break; + case t_base_type::TYPE_I32: + out << "WriteI32(" << name << ");"; + break; + case t_base_type::TYPE_I64: + out << "WriteI64(" << name << ");"; + break; + case t_base_type::TYPE_DOUBLE: + out << "WriteDouble(" << name << ");"; + break; + default: + throw "compiler error: no Delphi name for base type " + tbase; + } + } else if (type->is_enum()) { + out << "WriteI32(Integer(" << name << "));"; + } + out << endl; + } else { + printf("DO NOT KNOW HOW TO SERIALIZE '%s%s' TYPE '%s'\n", + prefix.c_str(), + tfield->get_name().c_str(), + type_name(type).c_str()); + } +} + +void t_delphi_generator::generate_serialize_struct(ostream& out, t_struct* tstruct, string prefix, ostream& local_vars) { + (void) tstruct; + out << + indent_impl() << prefix << ".Write(oprot);" << endl; +} + +void t_delphi_generator::generate_serialize_container(ostream& out, bool is_xception, t_type* ttype, string prefix, ostream& local_vars) { + string obj; + if (ttype->is_map()) { + obj = tmp("map"); + local_vars << " " << obj << " : IMap;" << endl; + indent_impl(out) << obj << " := TMapImpl.Create( " << + type_to_enum(((t_map*)ttype)->get_key_type()) << ", " << + type_to_enum(((t_map*)ttype)->get_val_type()) << ", " << + prefix << ".Count);" << endl; + indent_impl(out) << "oprot.WriteMapBegin( " << obj << ");" << endl; + } else if (ttype->is_set()) { + obj = tmp("set_"); + local_vars << " " << obj << " : ISet;" << endl; + indent_impl(out) << obj << " := TSetImpl.Create(" << + type_to_enum(((t_set*)ttype)->get_elem_type()) << ", " << + prefix << ".Count);" << endl; + indent_impl(out) << + "oprot.WriteSetBegin( " << obj << ");" << endl; + } else if (ttype->is_list()) { + obj = tmp("list_"); + local_vars << " " << obj << " : IList;" << endl; + indent_impl(out) << obj << " := TListImpl.Create(" << + type_to_enum(((t_list*)ttype)->get_elem_type()) << ", " << + prefix << ".Count);" << endl; + indent_impl(out) << + "oprot.WriteListBegin( " << obj << ");" << endl; + } + + string iter = tmp("_iter"); + if (ttype->is_map()) { + local_vars << " " << iter << ": " << type_name(((t_map*)ttype)->get_key_type()) << ";" << endl; + indent_impl(out) << "for " << iter << " in " << prefix << ".Keys do" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + } else if (ttype->is_set()) { + local_vars << " " << iter << ": " << type_name(((t_set*)ttype)->get_elem_type()) << ";" << endl; + indent_impl(out) << "for " << iter << " in " << prefix << " do" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + } else if (ttype->is_list()) { + local_vars << " " << iter << ": " << type_name(((t_list*)ttype)->get_elem_type()) << ";" << endl; + indent_impl(out) << "for " << iter << " in " << prefix << " do" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + } + + if (ttype->is_map()) { + generate_serialize_map_element(out, is_xception, (t_map*)ttype, iter, prefix, local_vars); + } else if (ttype->is_set()) { + generate_serialize_set_element(out, is_xception, (t_set*)ttype, iter, local_vars); + } else if (ttype->is_list()) { + generate_serialize_list_element(out, is_xception, (t_list*)ttype, iter, local_vars); + } + + if (ttype->is_map()) { + indent_impl(out) << "oprot.WriteMapEnd();" << endl; + } else if (ttype->is_set()) { + indent_impl(out) << "oprot.WriteSetEnd();" << endl; + } else if (ttype->is_list()) { + indent_impl(out) << "oprot.WriteListEnd();" << endl; + } + + indent_down_impl(); + indent_impl(out) << "end;" << endl; +} + +void t_delphi_generator::generate_serialize_map_element(ostream& out, bool is_xception, t_map* tmap, string iter, string map, ostream& local_vars) { + t_field kfield(tmap->get_key_type(), iter); + generate_serialize_field(out, is_xception, &kfield, "", local_vars); + t_field vfield(tmap->get_val_type(), map + "[" + iter + "]"); + generate_serialize_field(out, is_xception, &vfield, "", local_vars); +} + +void t_delphi_generator::generate_serialize_set_element(ostream& out, bool is_xception, t_set* tset, string iter, ostream& local_vars) { + t_field efield(tset->get_elem_type(), iter); + generate_serialize_field(out, is_xception, &efield, "", local_vars); +} + +void t_delphi_generator::generate_serialize_list_element(ostream& out, bool is_xception, t_list* tlist, string iter, ostream& local_vars) { + t_field efield(tlist->get_elem_type(), iter); + generate_serialize_field(out, is_xception, &efield, "", local_vars); +} + +void t_delphi_generator::generate_property(ostream& out, t_field* tfield, bool isPublic, bool is_xception) { + generate_delphi_property(out, is_xception, tfield, isPublic, "Get"); +} + +void t_delphi_generator::generate_delphi_property(ostream& out, bool struct_is_xception, t_field* tfield, bool isPublic, std::string fieldPrefix) { + t_type* ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + indent(out) << "property " << prop_name(tfield, struct_is_xception) << ": " << type_name(ftype, false, true, is_xception, true) << " read " << fieldPrefix + prop_name(tfield) + << " write Set" << prop_name(tfield) << ";" << endl; +} + +std::string t_delphi_generator::prop_name(t_field* tfield, bool is_xception) { + return prop_name(tfield->get_name(), is_xception); +} + +std::string t_delphi_generator::prop_name(string name, bool is_xception) { + string ret = name; + ret[0] = toupper(ret[0]); + return normalize_name( ret, true, is_xception); +} + +string t_delphi_generator::normalize_clsnm(string clsnm, string prefix, bool b_no_check_keyword) { + if (clsnm.size() >= 0) { + clsnm[0] = toupper(clsnm[0]); + } + if (b_no_check_keyword) { + return prefix + clsnm; + } else { + return normalize_name( prefix + clsnm); + } +} + +string t_delphi_generator::type_name( t_type* ttype, bool b_cls, bool b_no_postfix, bool b_exception_factory, bool b_full_exception_factory) { + while (ttype->is_typedef()) { + ttype = ((t_typedef*)ttype)->get_type(); + } + + string typ_nm; + + string s_factory; + + if (ttype->is_base_type()) { + return base_type_name((t_base_type*)ttype); + } else if (ttype->is_enum()) { + b_cls = true; + b_no_postfix = true; + } else if (ttype->is_map()) { + t_map *tmap = (t_map*) ttype; + if (b_cls) { + typ_nm = "TThriftDictionaryImpl"; + } else { + typ_nm = "IThriftDictionary"; + } + return typ_nm + "<" + type_name(tmap->get_key_type()) + + ", " + type_name(tmap->get_val_type()) + ">"; + } else if (ttype->is_set()) { + t_set* tset = (t_set*) ttype; + if (b_cls) { + typ_nm = "THashSetImpl"; + } else { + typ_nm = "IHashSet"; + } + return typ_nm + "<" + type_name(tset->get_elem_type()) + ">"; + } else if (ttype->is_list()) { + t_list* tlist = (t_list*) ttype; + if (b_cls) { + typ_nm = "TThriftListImpl"; + } else { + typ_nm = "IThriftList"; + } + return typ_nm + "<" + type_name(tlist->get_elem_type()) + ">"; + } + + string type_prefix; + + if (b_cls) { + type_prefix = "T"; + } else { + type_prefix = "I"; + } + + string nm = normalize_clsnm( ttype->get_name(), type_prefix); + + if (b_exception_factory) { + nm = nm + "Factory"; + } + + if (b_cls) { + if (! b_no_postfix) { + nm = nm + "Impl"; + } + } + + if ( b_exception_factory && b_full_exception_factory) { + return type_name( ttype, true, true, false, false ) + "." + nm; + } + + return nm; +} + +string t_delphi_generator::base_type_name(t_base_type* tbase) { + switch (tbase->get_base()) { + case t_base_type::TYPE_VOID: + // no "void" in Delphi language + return ""; + case t_base_type::TYPE_STRING: + if (tbase->is_binary()) { + if ( ansistr_binary_) { + return "AnsiString"; + } else { + return "TBytes"; + } + } else { + return "string"; + } + case t_base_type::TYPE_BOOL: + return "Boolean"; + case t_base_type::TYPE_BYTE: + return "ShortInt"; + case t_base_type::TYPE_I16: + return "SmallInt"; + case t_base_type::TYPE_I32: + return "Integer"; + case t_base_type::TYPE_I64: + return "Int64"; + case t_base_type::TYPE_DOUBLE: + return "Double"; + default: + throw "compiler error: no Delphi name for base type " + tbase->get_base(); + } +} + +string t_delphi_generator::declare_field(t_field* tfield, bool init, std::string prefix) { + t_type * ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + + string result = prefix + prop_name(tfield) + ": " + type_name(ftype,false,true,is_xception,true) + ";"; + return result; +} + +string t_delphi_generator::function_signature(t_function* tfunction, std::string full_cls, bool is_xception) { + t_type* ttype = tfunction->get_returntype(); + string prefix; + if (full_cls == "") { + prefix = ""; + } else { + prefix = full_cls + "."; + } + if (is_void(ttype)) { + return "procedure " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "(" + argument_list(tfunction->get_arglist()) + ");"; + } else { + return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "(" + argument_list(tfunction->get_arglist()) + "): " + type_name(ttype, false, true, is_xception, true) + ";"; + } +} + +string t_delphi_generator::argument_list(t_struct* tstruct) { + string result = ""; + const vector& fields = tstruct->get_members(); + vector::const_iterator f_iter; + bool first = true; + t_type* tt; + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + if (first) { + first = false; + } else { + result += "; "; + } + + tt = (*f_iter)->get_type(); + result += normalize_name((*f_iter)->get_name()) + ": " + type_name( tt, false, true, tt->is_xception(), true); + } + return result; +} + +string t_delphi_generator::type_to_enum(t_type* type) { + while (type->is_typedef()) { + type = ((t_typedef*)type)->get_type(); + } + + if (type->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); + switch (tbase) { + case t_base_type::TYPE_VOID: + throw "NO T_VOID CONSTRUCT"; + case t_base_type::TYPE_STRING: + return "TType.String_"; + case t_base_type::TYPE_BOOL: + return "TType.Bool_"; + case t_base_type::TYPE_BYTE: + return "TType.Byte_"; + case t_base_type::TYPE_I16: + return "TType.I16"; + case t_base_type::TYPE_I32: + return "TType.I32"; + case t_base_type::TYPE_I64: + return "TType.I64"; + case t_base_type::TYPE_DOUBLE: + return "TType.Double_"; + } + } else if (type->is_enum()) { + return "TType.I32"; + } else if (type->is_struct() || type->is_xception()) { + return "TType.Struct"; + } else if (type->is_map()) { + return "TType.Map"; + } else if (type->is_set()) { + return "TType.Set_"; + } else if (type->is_list()) { + return "TType.List"; + } + + throw "INVALID TYPE IN type_to_enum: " + type->get_name(); +} + +string t_delphi_generator::empty_value(t_type* type) { + while (type->is_typedef()) { + type = ((t_typedef*)type)->get_type(); + } + + if (type->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); + switch (tbase) { + case t_base_type::TYPE_VOID: + return "0"; + case t_base_type::TYPE_STRING: + if (((t_base_type*)type)->is_binary()) { + if (ansistr_binary_) { + return "''"; + } else { + return "nil"; + } + } else { + return "''"; + } + case t_base_type::TYPE_BOOL: + return "False"; + case t_base_type::TYPE_BYTE: + case t_base_type::TYPE_I16: + case t_base_type::TYPE_I32: + case t_base_type::TYPE_I64: + return "0"; + case t_base_type::TYPE_DOUBLE: + return "0.0"; + } + } else if (type->is_enum()) { + return "T" + type->get_name() + "(0)"; + } else if (type->is_struct() || type->is_xception()) { + return "nil"; + } else if (type->is_map()) { + return "nil"; + } else if (type->is_set()) { + return "nil"; + } else if (type->is_list()) { + return "nil"; + } + + throw "INVALID TYPE IN type_to_enum: " + type->get_name(); +} + +void t_delphi_generator::generate_delphi_property_writer_definition(ostream& out, t_field* tfield) { + t_type * ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + + indent(out) << "procedure Set" << prop_name(tfield) << "( const Value: " << type_name(ftype,false,true,is_xception,true) << ");" << endl; +} + +void t_delphi_generator::generate_delphi_property_reader_definition(ostream& out, t_field* tfield) { + t_type * ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + + indent(out) << "function Get" << prop_name(tfield) << ": " << type_name(ftype,false,true,is_xception,true) << ";" << endl; +} + +void t_delphi_generator::generate_delphi_isset_reader_definition(ostream& out, t_field* tfield) { + indent(out) << "function Get__isset_" << prop_name( tfield) << ": Boolean;" << endl; +} + +void t_delphi_generator::generate_delphi_property_writer_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix, bool is_xception_class, std::string xception_factroy_name) { + t_type * ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + + indent_impl(out) << "procedure " << cls_prefix << name << "." << "Set" << prop_name(tfield) << "( const Value: " << type_name(ftype,false,true,is_xception,true) << ");" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + indent_impl(out) << "F__isset_" << prop_name(tfield) << " := True;" << endl; + indent_impl(out) << fieldPrefix << prop_name(tfield) << " := Value;" << endl; + + if (is_xception_class) { + indent_impl(out) << "F" << xception_factroy_name << "." << prop_name(tfield) << " := Value;" << endl; + } + + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_delphi_property_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix) { + t_type * ftype = tfield->get_type(); + bool is_xception = ftype->is_xception(); + + indent_impl(out) << "function " << cls_prefix << name << "." << "Get" << prop_name(tfield) << ": " << type_name(ftype,false,true,is_xception,true) << ";" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + indent_impl(out) << "Result := " << fieldPrefix << prop_name(tfield) << ";" << endl; + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_delphi_isset_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix) { + string isset_name = "__isset_" + prop_name( tfield); + indent_impl(out) << "function " << cls_prefix << name << "." << "Get" << isset_name << ": Boolean;" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + indent_impl(out) << "Result := " << fieldPrefix << isset_name << ";" << endl; + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_delphi_create_exception_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) { + string exception_cls_nm = type_name(tstruct,true,true); + string cls_nm = type_name(tstruct,true,false,is_exception,is_exception); + + indent_impl(out) << "function " << cls_nm << ".CreateException: " << exception_cls_nm << ";" << endl; + + indent_impl(out) << "begin" << endl; + indent_up_impl(); + + + indent_impl(out) << "Result := " << exception_cls_nm << ".Create;" << endl; + string factory_name = normalize_clsnm(tstruct->get_name(),"",true) + "Factory"; + indent_impl(out) << "Result." << factory_name << " := Self;" << endl; + + const vector& fields = tstruct->get_members(); + vector::const_iterator f_iter; + + string propname; + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + propname = prop_name(*f_iter); + indent_impl(out) << "if __isset_" << propname << " then" << endl; + indent_impl(out) << "begin" << endl; + indent_up_impl(); + indent_impl(out) << "Result." << propname << " := " << propname << ";" << endl; + indent_down_impl(); + indent_impl(out) << "end;" << endl; + } + + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; +} + +void t_delphi_generator::generate_delphi_struct_reader_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) { + + ostringstream local_vars; + ostringstream code_block; + + const vector& fields = tstruct->get_members(); + vector::const_iterator f_iter; + + + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + + indent_impl(code_block) << "struc := iprot.ReadStructBegin;" << endl; + + indent_impl(code_block) << "try" << endl; + indent_up_impl(); + + indent_impl(code_block) << "while (true) do" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + + indent_impl(code_block) << "field_ := iprot.ReadFieldBegin();" << endl; + + indent_impl(code_block) << "try" << endl; + indent_up_impl(); + + indent_impl(code_block) << "if (field_.Type_ = TType.Stop) then" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + indent_impl(code_block) << "break;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + + + bool first = true; + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + + if (first) { + indent_impl(code_block) << "case field_.ID of" << endl; + indent_up_impl(); + } + + first = false; + if (f_iter != fields.begin()) { + code_block << ";" << endl; + } + indent_impl(code_block) << (*f_iter)->get_key() << ": begin" << endl; + indent_up_impl(); + indent_impl(code_block) << "if (field_.Type_ = " << type_to_enum((*f_iter)->get_type()) << ") then" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + + generate_deserialize_field(code_block, is_exception, *f_iter, "", local_vars); + + indent_down_impl(); + + indent_impl(code_block) << "end else" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + indent_impl(code_block) << "TProtocolUtil.Skip(iprot, field_.Type_);" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end"; + + } + + if (! first) { + code_block << endl; + indent_impl(code_block) << "else begin" << endl; + indent_up_impl(); + } + + indent_impl(code_block) << "TProtocolUtil.Skip(iprot, field_.Type_);" << endl; + + if (! first) { + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + } + + + indent_down_impl(); + + indent_impl(code_block) << "finally" << endl; + indent_up_impl(); + indent_impl(code_block) << "iprot.ReadFieldEnd;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + + indent_down_impl(); + + indent_impl(code_block) << "end;" << endl; + indent_down_impl(); + + indent_impl(code_block) << "finally" << endl; + indent_up_impl(); + indent_impl(code_block) << "iprot.ReadStructEnd;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl << endl; + + string cls_nm; + + cls_nm = type_name(tstruct,true,false,is_exception,is_exception); + + indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Read( iprot: IProtocol);" << endl; + indent_impl(out) << "var" << endl; + indent_up_impl(); + indent_impl(out) << "field_ : IField;" << endl; + indent_impl(out) << "struc : IStruct;" << endl; + indent_down_impl(); + out << local_vars.str() << endl; + out << code_block.str(); +} + +void t_delphi_generator::generate_delphi_struct_result_writer_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) { + + ostringstream local_vars; + ostringstream code_block; + + string name = tstruct->get_name(); + const vector& fields = tstruct->get_sorted_members(); + vector::const_iterator f_iter; + + + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + + indent_impl(code_block) << "struc := TStructImpl.Create('" << name << "');" << endl; + + indent_impl(code_block) << "oprot.WriteStructBegin(struc);" << endl; + + if (fields.size() > 0) { + indent_impl(code_block) << "field_ := TFieldImpl.Create;" << endl; + bool first = true; + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + if (! first) { + indent_impl(code_block) << "end else" << endl; + } + + indent_impl(code_block) << "if (__isset_" << prop_name(*f_iter) << ") then" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + indent_impl(code_block) << + "field_.Name := '" << (*f_iter)->get_name() << "';" << endl; + indent_impl(code_block) << + "field_.Type_ := " << type_to_enum((*f_iter)->get_type()) << ";" << endl; + indent_impl(code_block) << + "field_.ID := " << (*f_iter)->get_key() << ";" << endl; + indent_impl(code_block) << + "oprot.WriteFieldBegin(field_);" << endl; + generate_serialize_field(code_block, is_exception, *f_iter, "", local_vars); + indent_impl(code_block) << "oprot.WriteFieldEnd();" << endl; + indent_down_impl(); + } + + if (! first) { + indent_impl(code_block) << "end;" << endl; + } + + } + + + indent_impl(code_block) << "oprot.WriteFieldStop();" << endl; + indent_impl(code_block) << "oprot.WriteStructEnd();" << endl; + + indent_down_impl(); + indent_impl(code_block) << "end;" << endl << endl; + + string cls_nm; + + cls_nm = type_name(tstruct,true,false,is_exception,is_exception); + + indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Write( oprot: IProtocol);" << endl; + indent_impl(out) << "var" << endl; + indent_up_impl(); + indent_impl(out) << "struc : IStruct;" << endl; + + if (fields.size() > 0) { + indent_impl(out) << "field_ : IField;" << endl; + } + + out << local_vars.str(); + indent_down_impl(); + out << code_block.str(); + +} + +void t_delphi_generator::generate_delphi_struct_writer_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) { + + ostringstream local_vars; + ostringstream code_block; + + string name = tstruct->get_name(); + const vector& fields = tstruct->get_sorted_members(); + vector::const_iterator f_iter; + + + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + + indent_impl(code_block) << "struc := TStructImpl.Create('" << name << "');" << endl; + + indent_impl(code_block) << "oprot.WriteStructBegin(struc);" << endl; + + if (fields.size() > 0) { + indent_impl(code_block) << "field_ := TFieldImpl.Create;" << endl; + } + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + bool null_allowed = type_can_be_null((*f_iter)->get_type()); + if (null_allowed) { + indent_impl(code_block) << + "if ((" << prop_name((*f_iter)) << " <> nil) and __isset_" << prop_name(*f_iter) << ") then" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + } else { + indent_impl(code_block) << "if (__isset_" << prop_name(*f_iter) << ") then" << endl; + indent_impl(code_block) << "begin" << endl; + indent_up_impl(); + } + indent_impl(code_block) << + "field_.Name := '" << (*f_iter)->get_name() << "';" << endl; + indent_impl(code_block) << + "field_.Type_ := " << type_to_enum((*f_iter)->get_type()) << ";" << endl; + indent_impl(code_block) << + "field_.ID := " << (*f_iter)->get_key() << ";" << endl; + indent_impl(code_block) << + "oprot.WriteFieldBegin(field_);" << endl; + generate_serialize_field(code_block, is_exception, *f_iter, "", local_vars); + indent_impl(code_block) << "oprot.WriteFieldEnd();" << endl; + indent_down_impl(); + indent_impl(code_block) << "end;" << endl; + } + + indent_impl(code_block) << "oprot.WriteFieldStop();" << endl; + indent_impl(code_block) << "oprot.WriteStructEnd();" << endl; + + indent_down_impl(); + indent_impl(code_block) << "end;" << endl << endl; + + string cls_nm; + + cls_nm = type_name(tstruct,true,false,is_exception,is_exception); + + indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Write( oprot: IProtocol);" << endl; + indent_impl(out) << "var" << endl; + indent_up_impl(); + indent_impl(out) << "struc : IStruct;" << endl; + if (fields.size() > 0) { + indent_impl(out) << "field_ : IField;" << endl; + } + out << local_vars.str(); + indent_down_impl(); + out << code_block.str(); + +} + +void t_delphi_generator::generate_delphi_struct_tostring_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) { + + const vector& fields = tstruct->get_members(); + vector::const_iterator f_iter; + + string cls_nm; + + if (is_exception) { + cls_nm = type_name(tstruct,true,false,true,true); + } else { + cls_nm = type_name(tstruct,true,false); + } + + string tmp_sb = "sb"; + + indent_impl(out) << "function " << cls_prefix << cls_nm << ".ToString: string;" << endl; + indent_impl(out) << "var" << endl; + indent_up_impl(); + indent_impl(out) << tmp_sb << " : TThriftStringBuilder;" << endl; + indent_down_impl(); + indent_impl(out) << "begin" << endl; + indent_up_impl(); + + indent_impl(out) << tmp_sb << " := TThriftStringBuilder.Create('(');" << endl; + indent_impl(out) << "try" << endl; + indent_up_impl(); + + bool first = true; + + for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) { + if (first) { + first = false; + indent_impl(out) << + tmp_sb << ".Append('" << prop_name((*f_iter)) << ": ');" << endl; + } else { + indent_impl(out) << + tmp_sb << ".Append('," << prop_name((*f_iter)) << ": ');" << endl; + } + t_type* ttype = (*f_iter)->get_type(); + if (ttype->is_xception() || ttype->is_struct()) { + indent_impl(out) << + "if (" << prop_name((*f_iter)) << " = nil) then " << tmp_sb << ".Append('') else " << tmp_sb << ".Append("<< prop_name((*f_iter)) << ".ToString());" << endl; + } else if (ttype->is_enum()) { + indent_impl(out) << + tmp_sb << ".Append(Integer(" << prop_name((*f_iter)) << "));" << endl; + } else { + indent_impl(out) << + tmp_sb << ".Append(" << prop_name((*f_iter)) << ");" << endl; + } + } + + indent_impl(out) << + tmp_sb << ".Append(')');" << endl; + indent_impl(out) << + "Result := " << tmp_sb << ".ToString;" << endl; + + indent_down_impl(); + indent_impl(out) << "finally" << endl; + indent_up_impl(); + indent_impl(out) << tmp_sb << ".Free;" << endl; + indent_down_impl(); + indent_impl(out) << "end;" << endl; + + indent_down_impl(); + indent_impl(out) << "end;" << endl << endl; +} + +bool t_delphi_generator::is_void( t_type* type ) { + while (type->is_typedef()) { + type = ((t_typedef*)type)->get_type(); + } + + if (type->is_base_type()) { + t_base_type::t_base tbase = ((t_base_type*)type)->get_base(); + if (tbase == t_base_type::TYPE_VOID) { + return true; + } + } + return false; +} + +THRIFT_REGISTER_GENERATOR(delphi, "delphi", +" ansistr_binary: Use AnsiString as binary properties.\n" \ +" suppress_guid: Suppress GUID for interface declaretion.\n") + diff --git a/compiler/cpp/src/main.cc b/compiler/cpp/src/main.cc index 175dbbe9..c12b31ab 100644 --- a/compiler/cpp/src/main.cc +++ b/compiler/cpp/src/main.cc @@ -184,6 +184,7 @@ bool gen_ocaml = false; bool gen_hs = false; bool gen_cocoa = false; bool gen_csharp = false; +bool gen_delphi = false; bool gen_st = false; bool gen_recurse = false; @@ -1045,6 +1046,8 @@ int main(int argc, char** argv) { gen_st = true; } else if (strcmp(arg, "-csharp") == 0) { gen_csharp = true; + } else if (strcmp(arg, "-delphi") == 0) { + gen_delphi = true; } else if (strcmp(arg, "-cpp_use_include_prefix") == 0) { g_cpp_use_include_prefix = true; } else if (strcmp(arg, "-I") == 0) { @@ -1124,6 +1127,10 @@ int main(int argc, char** argv) { pwarning(1, "-csharp is deprecated. Use --gen csharp"); generator_strings.push_back("csharp"); } + if (gen_delphi) { + pwarning(1, "-delphi is deprecated. Use --gen delphi"); + generator_strings.push_back("delphi"); + } if (gen_py) { pwarning(1, "-py is deprecated. Use --gen py"); generator_strings.push_back("py"); diff --git a/compiler/cpp/src/thriftl.ll b/compiler/cpp/src/thriftl.ll index ab0976ef..bdc41b1b 100644 --- a/compiler/cpp/src/thriftl.ll +++ b/compiler/cpp/src/thriftl.ll @@ -120,6 +120,7 @@ literal_begin (['\"]) "java_package" { return tok_java_package; } "cocoa_prefix" { return tok_cocoa_prefix; } "csharp_namespace" { return tok_csharp_namespace; } +"delphi_namespace" { return tok_delphi_namespace; } "php_namespace" { return tok_php_namespace; } "py_module" { return tok_py_module; } "perl_package" { return tok_perl_package; } diff --git a/compiler/cpp/src/thrifty.yy b/compiler/cpp/src/thrifty.yy index c916604d..cc024a1a 100644 --- a/compiler/cpp/src/thrifty.yy +++ b/compiler/cpp/src/thrifty.yy @@ -110,6 +110,7 @@ const int struct_is_union = 1; %token tok_smalltalk_prefix %token tok_cocoa_prefix %token tok_csharp_namespace +%token tok_delphi_namespace /** * Base datatype keywords @@ -393,6 +394,15 @@ Header: g_program->set_namespace("csharp", $2); } } +/* TODO(dreiss): Get rid of this once everyone is using the new hotness. */ +| tok_delphi_namespace tok_identifier + { + pwarning(1, "'delphi_namespace' is deprecated. Use 'namespace delphi' instead"); + pdebug("Header -> tok_delphi_namespace tok_identifier"); + if (g_parse_mode == PROGRAM) { + g_program->set_namespace("delphi", $2); + } + } Include: tok_include tok_literal diff --git a/configure.ac b/configure.ac index 9759a5a6..2dfe95c1 100644 --- a/configure.ac +++ b/configure.ac @@ -528,7 +528,6 @@ fi if test "$have_ruby" = "yes" ; then echo echo "Using Ruby ................... : $RUBY" - echo "Using rspec .................. : $RSPEC" fi if test "$have_haskell" = "yes" ; then echo diff --git a/lib/delphi/src/Thrift.Collections.pas b/lib/delphi/src/Thrift.Collections.pas new file mode 100644 index 00000000..abc401fc --- /dev/null +++ b/lib/delphi/src/Thrift.Collections.pas @@ -0,0 +1,618 @@ +(* + * 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.Collections; + +interface + +uses + Generics.Collections, Generics.Defaults, Thrift.Utils; + +type + +{$IF CompilerVersion < 21.0} + TArray = array of T; +{$IFEND} + + IThriftContainer = interface + ['{93DEF5A0-D162-461A-AB22-5B4EE0734050}'] + function ToString: string; + end; + + IThriftDictionary = interface(IThriftContainer) + ['{25EDD506-F9D1-4008-A40F-5940364B7E46}'] + function GetEnumerator: TEnumerator>; + + function GetKeys: TDictionary.TKeyCollection; + function GetValues: TDictionary.TValueCollection; + function GetItem(const Key: TKey): TValue; + procedure SetItem(const Key: TKey; const Value: TValue); + function GetCount: Integer; + + procedure Add(const Key: TKey; const Value: TValue); + procedure Remove(const Key: TKey); +{$IF CompilerVersion >= 21.0} + function ExtractPair(const Key: TKey): TPair; +{$IFEND} + procedure Clear; + procedure TrimExcess; + function TryGetValue(const Key: TKey; out Value: TValue): Boolean; + procedure AddOrSetValue(const Key: TKey; const Value: TValue); + function ContainsKey(const Key: TKey): Boolean; + function ContainsValue(const Value: TValue): Boolean; + function ToArray: TArray>; + + property Items[const Key: TKey]: TValue read GetItem write SetItem; default; + property Count: Integer read GetCount; + property Keys: TDictionary.TKeyCollection read GetKeys; + property Values: TDictionary.TValueCollection read GetValues; + end; + + TThriftDictionaryImpl = class( TInterfacedObject, IThriftDictionary) + private + FDictionaly : TDictionary; + protected + function GetEnumerator: TEnumerator>; + + function GetKeys: TDictionary.TKeyCollection; + function GetValues: TDictionary.TValueCollection; + function GetItem(const Key: TKey): TValue; + procedure SetItem(const Key: TKey; const Value: TValue); + function GetCount: Integer; + + procedure Add(const Key: TKey; const Value: TValue); + procedure Remove(const Key: TKey); +{$IF CompilerVersion >= 21.0} + function ExtractPair(const Key: TKey): TPair; +{$IFEND} + procedure Clear; + procedure TrimExcess; + function TryGetValue(const Key: TKey; out Value: TValue): Boolean; + procedure AddOrSetValue(const Key: TKey; const Value: TValue); + function ContainsKey(const Key: TKey): Boolean; + function ContainsValue(const Value: TValue): Boolean; + function ToArray: TArray>; + property Items[const Key: TKey]: TValue read GetItem write SetItem; default; + property Count: Integer read GetCount; + property Keys: TDictionary.TKeyCollection read GetKeys; + property Values: TDictionary.TValueCollection read GetValues; + public + constructor Create(ACapacity: Integer = 0); + destructor Destroy; override; + end; + + IThriftList = interface(IThriftContainer) + ['{29BEEE31-9CB4-401B-AA04-5148A75F473B}'] + function GetEnumerator: TEnumerator; + function GetCapacity: Integer; + procedure SetCapacity(Value: Integer); + function GetCount: Integer; + procedure SetCount(Value: Integer); + function GetItem(Index: Integer): T; + procedure SetItem(Index: Integer; const Value: T); + function Add(const Value: T): Integer; + procedure AddRange(const Values: array of T); overload; + procedure AddRange(const Collection: IEnumerable); overload; + procedure AddRange(Collection: TEnumerable); overload; + procedure Insert(Index: Integer; const Value: T); + procedure InsertRange(Index: Integer; const Values: array of T); overload; + procedure InsertRange(Index: Integer; const Collection: IEnumerable); overload; + procedure InsertRange(Index: Integer; const Collection: TEnumerable); overload; + function Remove(const Value: T): Integer; + procedure Delete(Index: Integer); + procedure DeleteRange(AIndex, ACount: Integer); + function Extract(const Value: T): T; +{$IF CompilerVersion >= 21.0} + procedure Exchange(Index1, Index2: Integer); + procedure Move(CurIndex, NewIndex: Integer); + function First: T; + function Last: T; +{$IFEND} + procedure Clear; + function Contains(const Value: T): Boolean; + function IndexOf(const Value: T): Integer; + function LastIndexOf(const Value: T): Integer; + procedure Reverse; + procedure Sort; overload; + procedure Sort(const AComparer: IComparer); overload; + function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; + function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; + procedure TrimExcess; + function ToArray: TArray; + property Capacity: Integer read GetCapacity write SetCapacity; + property Count: Integer read GetCount write SetCount; + property Items[Index: Integer]: T read GetItem write SetItem; default; + end; + + TThriftListImpl = class( TInterfacedObject, IThriftList) + private + FList : TList; + protected + function GetEnumerator: TEnumerator; + function GetCapacity: Integer; + procedure SetCapacity(Value: Integer); + function GetCount: Integer; + procedure SetCount(Value: Integer); + function GetItem(Index: Integer): T; + procedure SetItem(Index: Integer; const Value: T); + function Add(const Value: T): Integer; + procedure AddRange(const Values: array of T); overload; + procedure AddRange(const Collection: IEnumerable); overload; + procedure AddRange(Collection: TEnumerable); overload; + procedure Insert(Index: Integer; const Value: T); + procedure InsertRange(Index: Integer; const Values: array of T); overload; + procedure InsertRange(Index: Integer; const Collection: IEnumerable); overload; + procedure InsertRange(Index: Integer; const Collection: TEnumerable); overload; + function Remove(const Value: T): Integer; + procedure Delete(Index: Integer); + procedure DeleteRange(AIndex, ACount: Integer); + function Extract(const Value: T): T; +{$IF CompilerVersion >= 21.0} + procedure Exchange(Index1, Index2: Integer); + procedure Move(CurIndex, NewIndex: Integer); + function First: T; + function Last: T; +{$IFEND} + procedure Clear; + function Contains(const Value: T): Boolean; + function IndexOf(const Value: T): Integer; + function LastIndexOf(const Value: T): Integer; + procedure Reverse; + procedure Sort; overload; + procedure Sort(const AComparer: IComparer); overload; + function BinarySearch(const Item: T; out Index: Integer): Boolean; overload; + function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer): Boolean; overload; + procedure TrimExcess; + function ToArray: TArray; + property Capacity: Integer read GetCapacity write SetCapacity; + property Count: Integer read GetCount write SetCount; + property Items[Index: Integer]: T read GetItem write SetItem; default; + public + constructor Create; + destructor Destroy; override; + end; + + IHashSet = interface(IThriftContainer) + ['{0923A3B5-D4D4-48A8-91AD-40238E2EAD66}'] + function GetEnumerator: TEnumerator; + function GetIsReadOnly: Boolean; + function GetCount: Integer; + property Count: Integer read GetCount; + property IsReadOnly: Boolean read GetIsReadOnly; + procedure Add( item: TValue); + procedure Clear; + function Contains( item: TValue): Boolean; + procedure CopyTo(var A: TArray; arrayIndex: Integer); + function Remove( item: TValue ): Boolean; + end; + + THashSetImpl = class( TInterfacedObject, IHashSet) + private + FDictionary : IThriftDictionary; + FIsReadOnly: Boolean; + protected + function GetEnumerator: TEnumerator; + function GetIsReadOnly: Boolean; + function GetCount: Integer; + property Count: Integer read GetCount; + property IsReadOnly: Boolean read FIsReadOnly; + procedure Add( item: TValue); + procedure Clear; + function Contains( item: TValue): Boolean; + procedure CopyTo(var A: TArray; arrayIndex: Integer); + function Remove( item: TValue ): Boolean; + public + constructor Create; + end; + +implementation + +{ THashSetImpl } + +procedure THashSetImpl.Add(item: TValue); +begin + if not FDictionary.ContainsKey(item) then + begin + FDictionary.Add( item, 0); + end; +end; + +procedure THashSetImpl.Clear; +begin + FDictionary.Clear; +end; + +function THashSetImpl.Contains(item: TValue): Boolean; +begin + Result := FDictionary.ContainsKey(item); +end; + +procedure THashSetImpl.CopyTo(var A: TArray; arrayIndex: Integer); +var + i : Integer; + Enumlator : TEnumerator; +begin + Enumlator := GetEnumerator; + while Enumlator.MoveNext do + begin + A[arrayIndex] := Enumlator.Current; + Inc(arrayIndex); + end; +end; + +constructor THashSetImpl.Create; +begin + inherited; + FDictionary := TThriftDictionaryImpl.Create; +end; + +function THashSetImpl.GetCount: Integer; +begin + Result := FDictionary.Count; +end; + +function THashSetImpl.GetEnumerator: TEnumerator; +begin + Result := FDictionary.Keys.GetEnumerator; +end; + +function THashSetImpl.GetIsReadOnly: Boolean; +begin + Result := FIsReadOnly; +end; + +function THashSetImpl.Remove(item: TValue): Boolean; +begin + Result := False; + if FDictionary.ContainsKey( item ) then + begin + FDictionary.Remove( item ); + Result := not FDictionary.ContainsKey( item ); + end; +end; + +{ TThriftDictionaryImpl } + +procedure TThriftDictionaryImpl.Add(const Key: TKey; + const Value: TValue); +begin + FDictionaly.Add( Key, Value); +end; + +procedure TThriftDictionaryImpl.AddOrSetValue(const Key: TKey; + const Value: TValue); +begin + FDictionaly.AddOrSetValue( Key, Value); +end; + +procedure TThriftDictionaryImpl.Clear; +begin + FDictionaly.Clear; +end; + +function TThriftDictionaryImpl.ContainsKey( + const Key: TKey): Boolean; +begin + Result := FDictionaly.ContainsKey( Key ); +end; + +function TThriftDictionaryImpl.ContainsValue( + const Value: TValue): Boolean; +begin + Result := FDictionaly.ContainsValue( Value ); +end; + +constructor TThriftDictionaryImpl.Create(ACapacity: Integer); +begin + FDictionaly := TDictionary.Create( ACapacity ); +end; + +destructor TThriftDictionaryImpl.Destroy; +begin + FDictionaly.Free; + inherited; +end; + +{$IF CompilerVersion >= 21.0} +function TThriftDictionaryImpl.ExtractPair( + const Key: TKey): TPair; +begin + Result := FDictionaly.ExtractPair( Key); +end; +{$IFEND} + +function TThriftDictionaryImpl.GetCount: Integer; +begin + Result := FDictionaly.Count; +end; + +function TThriftDictionaryImpl.GetEnumerator: TEnumerator>; +begin + Result := FDictionaly.GetEnumerator; +end; + +function TThriftDictionaryImpl.GetItem(const Key: TKey): TValue; +begin + Result := FDictionaly.Items[Key]; +end; + +function TThriftDictionaryImpl.GetKeys: TDictionary.TKeyCollection; +begin + Result := FDictionaly.Keys; +end; + +function TThriftDictionaryImpl.GetValues: TDictionary.TValueCollection; +begin + Result := FDictionaly.Values; +end; + +procedure TThriftDictionaryImpl.Remove(const Key: TKey); +begin + FDictionaly.Remove( Key ); +end; + +procedure TThriftDictionaryImpl.SetItem(const Key: TKey; + const Value: TValue); +begin + FDictionaly.AddOrSetValue( Key, Value); +end; + +function TThriftDictionaryImpl.ToArray: TArray>; +{$IF CompilerVersion < 22.0} +var + x : TPair; + i : Integer; +{$IFEND} +begin +{$IF CompilerVersion < 22.0} + SetLength(Result, Count); + i := 0; + for x in FDictionaly do + begin + Result[i] := x; + Inc( i ); + end; +{$ELSE} + Result := FDictionaly.ToArray; +{$IFEND} +end; + +procedure TThriftDictionaryImpl.TrimExcess; +begin + FDictionaly.TrimExcess; +end; + +function TThriftDictionaryImpl.TryGetValue(const Key: TKey; + out Value: TValue): Boolean; +begin + Result := FDictionaly.TryGetValue( Key, Value); +end; + +{ TThriftListImpl } + +function TThriftListImpl.Add(const Value: T): Integer; +begin + Result := FList.Add( Value ); +end; + +procedure TThriftListImpl.AddRange(Collection: TEnumerable); +begin + FList.AddRange( Collection ); +end; + +procedure TThriftListImpl.AddRange(const Collection: IEnumerable); +begin + FList.AddRange( Collection ); +end; + +procedure TThriftListImpl.AddRange(const Values: array of T); +begin + FList.AddRange( Values ); +end; + +function TThriftListImpl.BinarySearch(const Item: T; + out Index: Integer): Boolean; +begin + Result := FList.BinarySearch( Item, Index); +end; + +function TThriftListImpl.BinarySearch(const Item: T; out Index: Integer; + const AComparer: IComparer): Boolean; +begin + Result := FList.BinarySearch( Item, Index, AComparer); +end; + +procedure TThriftListImpl.Clear; +begin + FList.Clear; +end; + +function TThriftListImpl.Contains(const Value: T): Boolean; +begin + Result := FList.Contains( Value ); +end; + +constructor TThriftListImpl.Create; +begin + FList := TList.Create; +end; + +procedure TThriftListImpl.Delete(Index: Integer); +begin + FList.Delete( Index ) +end; + +procedure TThriftListImpl.DeleteRange(AIndex, ACount: Integer); +begin + FList.DeleteRange( AIndex, ACount) +end; + +destructor TThriftListImpl.Destroy; +begin + FList.Free; + inherited; +end; + +{$IF CompilerVersion >= 21.0} +procedure TThriftListImpl.Exchange(Index1, Index2: Integer); +begin + FList.Exchange( Index1, Index2 ) +end; +{$IFEND} + +function TThriftListImpl.Extract(const Value: T): T; +begin + Result := FList.Extract( Value ) +end; + +{$IF CompilerVersion >= 21.0} +function TThriftListImpl.First: T; +begin + Result := FList.First; +end; +{$IFEND} + +function TThriftListImpl.GetCapacity: Integer; +begin + Result := FList.Capacity; +end; + +function TThriftListImpl.GetCount: Integer; +begin + Result := FList.Count; +end; + +function TThriftListImpl.GetEnumerator: TEnumerator; +begin + Result := FList.GetEnumerator; +end; + +function TThriftListImpl.GetItem(Index: Integer): T; +begin + Result := FList[Index]; +end; + +function TThriftListImpl.IndexOf(const Value: T): Integer; +begin + Result := FList.IndexOf( Value ); +end; + +procedure TThriftListImpl.Insert(Index: Integer; const Value: T); +begin + FList.Insert( Index, Value); +end; + +procedure TThriftListImpl.InsertRange(Index: Integer; + const Collection: TEnumerable); +begin + FList.InsertRange( Index, Collection ); +end; + +procedure TThriftListImpl.InsertRange(Index: Integer; + const Values: array of T); +begin + FList.InsertRange( Index, Values); +end; + +procedure TThriftListImpl.InsertRange(Index: Integer; + const Collection: IEnumerable); +begin + FList.InsertRange( Index, Collection ); +end; + +{$IF CompilerVersion >= 21.0} +function TThriftListImpl.Last: T; +begin + Result := FList.Last; +end; +{$IFEND} + +function TThriftListImpl.LastIndexOf(const Value: T): Integer; +begin + Result := FList.LastIndexOf( Value ); +end; + +{$IF CompilerVersion >= 21.0} +procedure TThriftListImpl.Move(CurIndex, NewIndex: Integer); +begin + FList.Move( CurIndex, NewIndex); +end; +{$IFEND} + +function TThriftListImpl.Remove(const Value: T): Integer; +begin + Result := FList.Remove( Value ); +end; + +procedure TThriftListImpl.Reverse; +begin + FList.Reverse; +end; + +procedure TThriftListImpl.SetCapacity(Value: Integer); +begin + FList.Capacity := Value; +end; + +procedure TThriftListImpl.SetCount(Value: Integer); +begin + FList.Count := Value; +end; + +procedure TThriftListImpl.SetItem(Index: Integer; const Value: T); +begin + FList[Index] := Value; +end; + +procedure TThriftListImpl.Sort; +begin + FList.Sort; +end; + +procedure TThriftListImpl.Sort(const AComparer: IComparer); +begin + FList.Sort; +end; + +function TThriftListImpl.ToArray: TArray; +{$IF CompilerVersion < 22.0} +var + x : T; + i : Integer; +{$IFEND} +begin +{$IF CompilerVersion < 22.0} + SetLength(Result, Count); + i := 0; + for x in FList do + begin + Result[i] := x; + Inc( i ); + end; +{$ELSE} + Result := FList.ToArray; +{$IFEND} +end; + +procedure TThriftListImpl.TrimExcess; +begin + FList.TrimExcess; +end; + +end. diff --git a/lib/delphi/src/Thrift.Console.pas b/lib/delphi/src/Thrift.Console.pas new file mode 100644 index 00000000..324efc3a --- /dev/null +++ b/lib/delphi/src/Thrift.Console.pas @@ -0,0 +1,132 @@ +(* + * 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.Console; + +interface + +uses + StdCtrls; + +type + TThriftConsole = class + public + procedure Write( const S: string); virtual; + procedure WriteLine( const S: string); virtual; + end; + + TGUIConsole = class( TThriftConsole ) + private + FLineBreak : Boolean; + FMemo : TMemo; + + procedure InternalWrite( const S: string; bWriteLine: Boolean); + public + procedure Write( const S: string); override; + procedure WriteLine( const S: string); override; + constructor Create( AMemo: TMemo); + end; + +function Console: TThriftConsole; +procedure ChangeConsole( AConsole: TThriftConsole ); +procedure RestoreConsoleToDefault; + +implementation + +var + FDefaultConsole : TThriftConsole; + FConsole : TThriftConsole; + +function Console: TThriftConsole; +begin + Result := FConsole; +end; + +{ TThriftConsole } + +procedure TThriftConsole.Write(const S: string); +begin + System.Write( S ); +end; + +procedure TThriftConsole.WriteLine(const S: string); +begin + System.Writeln( S ); +end; + +procedure ChangeConsole( AConsole: TThriftConsole ); +begin + FConsole := AConsole; +end; + +procedure RestoreConsoleToDefault; +begin + FConsole := FDefaultConsole; +end; + +{ TGUIConsole } + +constructor TGUIConsole.Create( AMemo: TMemo); +begin + FMemo := AMemo; + FLineBreak := True; +end; + +procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean); +var + idx : Integer; +begin + if FLineBreak then + begin + FMemo.Lines.Add( S ); + end else + begin + idx := FMemo.Lines.Count - 1; + if idx < 0 then + begin + FMemo.Lines.Add( S ); + end; + FMemo.Lines[idx] := FMemo.Lines[idx] + S; + end; + FLineBreak := bWriteLine; +end; + +procedure TGUIConsole.Write(const S: string); +begin + InternalWrite( S, False); +end; + +procedure TGUIConsole.WriteLine(const S: string); +begin + InternalWrite( S, True); +end; + +initialization +begin + FDefaultConsole := TThriftConsole.Create; + FConsole := FDefaultConsole; +end; + +finalization +begin + FDefaultConsole.Free; +end; + +end. + diff --git a/lib/delphi/src/Thrift.Protocol.pas b/lib/delphi/src/Thrift.Protocol.pas new file mode 100644 index 00000000..8fa60085 --- /dev/null +++ b/lib/delphi/src/Thrift.Protocol.pas @@ -0,0 +1,1178 @@ +(* + * 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; + +interface + +uses + Classes, + SysUtils, + Contnrs, + Thrift.Stream, + Thrift.Collections, + Thrift.Transport; + +type + + TType = ( + Stop = 0, + Void = 1, + Bool_ = 2, + Byte_ = 3, + Double_ = 4, + I16 = 6, + I32 = 8, + I64 = 10, + String_ = 11, + Struct = 12, + Map = 13, + Set_ = 14, + List = 15 + ); + + TMessageType = ( + Call = 1, + Reply = 2, + Exception = 3, + Oneway = 4 + ); + + IProtocol = interface; + IStruct = interface; + + IProtocolFactory = interface + ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}'] + function GetProtocol( trans: ITransport): IProtocol; + end; + + TThriftStringBuilder = class( TStringBuilder) + public + function Append(const Value: TBytes): TStringBuilder; overload; + function Append(const Value: IThriftContainer): TStringBuilder; overload; + end; + + TProtocolException = class( Exception ) + public + const + UNKNOWN : Integer = 0; + INVALID_DATA : Integer = 1; + NEGATIVE_SIZE : Integer = 2; + SIZE_LIMIT : Integer = 3; + BAD_VERSION : Integer = 4; + NOT_IMPLEMENTED : Integer = 5; + protected + FType : Integer; + public + constructor Create; overload; + constructor Create( type_: Integer ); overload; + constructor Create( type_: Integer; const msg: string); overload; + end; + + IMap = interface + ['{30531D97-7E06-4233-B800-C3F53CCD23E7}'] + function GetKeyType: TType; + procedure SetKeyType( Value: TType); + function GetValueType: TType; + procedure SetValueType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + property KeyType: TType read GetKeyType write SetKeyType; + property ValueType: TType read GetValueType write SetValueType; + property Count: Integer read GetCount write SetCount; + end; + + TMapImpl = class( TInterfacedObject, IMap) + private + FValueType: TType; + FKeyType: TType; + FCount: Integer; + protected + function GetKeyType: TType; + procedure SetKeyType( Value: TType); + function GetValueType: TType; + procedure SetValueType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + public + constructor Create( AValueType: TType; AKeyType: TType; ACount: Integer); overload; + constructor Create; overload; + end; + + IList = interface + ['{6763E1EA-A934-4472-904F-0083980B9B87}'] + function GetElementType: TType; + procedure SetElementType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + property ElementType: TType read GetElementType write SetElementType; + property Count: Integer read GetCount write SetCount; + end; + + TListImpl = class( TInterfacedObject, IList) + private + FElementType: TType; + FCount : Integer; + protected + function GetElementType: TType; + procedure SetElementType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + public + constructor Create( AElementType: TType; ACount: Integer); overload; + constructor Create; overload; + end; + + ISet = interface + ['{A8671700-7514-4C1E-8A05-62786872005F}'] + function GetElementType: TType; + procedure SetElementType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + property ElementType: TType read GetElementType write SetElementType; + property Count: Integer read GetCount write SetCount; + end; + + TSetImpl = class( TInterfacedObject, ISet) + private + FCount: Integer; + FElementType: TType; + protected + function GetElementType: TType; + procedure SetElementType( Value: TType); + function GetCount: Integer; + procedure SetCount( Value: Integer); + public + constructor Create( AElementType: TType; ACount: Integer); overload; + constructor Create; overload; + end; + + IMessage = interface + ['{9E368B4A-B1FA-43E7-8CF5-56C66D256CA7}'] + function GetName: string; + procedure SetName( const Value: string); + function GetType: TMessageType; + procedure SetType( Value: TMessageType); + function GetSeqID: Integer; + procedure SetSeqID( Value: Integer); + property Name: string read GetName write SetName; + property Type_: TMessageType read GetType write SetType; + property SeqID: Integer read GetSeqID write SetSeqID; + end; + + TMessageImpl = class( TInterfacedObject, IMessage ) + private + FName: string; + FMessageType: TMessageType; + FSeqID: Integer; + protected + function GetName: string; + procedure SetName( const Value: string); + function GetType: TMessageType; + procedure SetType( Value: TMessageType); + function GetSeqID: Integer; + procedure SetSeqID( Value: Integer); + public + property Name: string read FName write FName; + property Type_: TMessageType read FMessageType write FMessageType; + property SeqID: Integer read FSeqID write FSeqID; + constructor Create( AName: string; AMessageType: TMessageType; ASeqID: Integer); overload; + constructor Create; overload; + end; + + IField = interface + ['{F0D43BE5-7883-442E-83FF-0580CC632B72}'] + function GetName: string; + procedure SetName( const Value: string); + function GetType: TType; + procedure SetType( Value: TType); + function GetId: SmallInt; + procedure SetId( Value: SmallInt); + property Name: string read GetName write SetName; + property Type_: TType read GetType write SetType; + property Id: SmallInt read GetId write SetId; + end; + + TFieldImpl = class( TInterfacedObject, IField) + private + FName : string; + FType : TType; + FId : SmallInt; + protected + function GetName: string; + procedure SetName( const Value: string); + function GetType: TType; + procedure SetType( Value: TType); + function GetId: SmallInt; + procedure SetId( Value: SmallInt); + public + constructor Create( const AName: string; const AType: TType; AId: SmallInt); overload; + constructor Create; overload; + end; + + TProtocolUtil = class + public + class procedure Skip( prot: IProtocol; type_: TType); + end; + + IProtocol = interface + ['{FD95C151-1527-4C96-8134-B902BFC4B4FC}'] + function GetTransport: ITransport; + procedure WriteMessageBegin( message: IMessage); + procedure WriteMessageEnd; + procedure WriteStructBegin(struc: IStruct); + procedure WriteStructEnd; + procedure WriteFieldBegin(field: IField); + procedure WriteFieldEnd; + procedure WriteFieldStop; + procedure WriteMapBegin(map: IMap); + procedure WriteMapEnd; + procedure WriteListBegin( list: IList); + procedure WriteListEnd(); + procedure WriteSetBegin( set_: ISet ); + procedure WriteSetEnd(); + procedure WriteBool( b: Boolean); + procedure WriteByte( b: ShortInt); + procedure WriteI16( i16: SmallInt); + procedure WriteI32( i32: Integer); + procedure WriteI64( i64: Int64); + procedure WriteDouble( d: Double); + procedure WriteString( const s: string ); + procedure WriteAnsiString( const s: AnsiString); + procedure WriteBinary( const b: TBytes); + + function ReadMessageBegin: IMessage; + procedure ReadMessageEnd(); + function ReadStructBegin: IStruct; + procedure ReadStructEnd; + function ReadFieldBegin: IField; + procedure ReadFieldEnd(); + function ReadMapBegin: IMap; + procedure ReadMapEnd(); + function ReadListBegin: IList; + procedure ReadListEnd(); + function ReadSetBegin: ISet; + procedure ReadSetEnd(); + function ReadBool: Boolean; + function ReadByte: ShortInt; + function ReadI16: SmallInt; + function ReadI32: Integer; + function ReadI64: Int64; + function ReadDouble:Double; + function ReadBinary: TBytes; + function ReadString: string; + function ReadAnsiString: AnsiString; + property Transport: ITransport read GetTransport; + end; + + TProtocolImpl = class abstract( TInterfacedObject, IProtocol) + protected + FTrans : ITransport; + function GetTransport: ITransport; + public + procedure WriteMessageBegin( message: IMessage); virtual; abstract; + procedure WriteMessageEnd; virtual; abstract; + procedure WriteStructBegin(struc: IStruct); virtual; abstract; + procedure WriteStructEnd; virtual; abstract; + procedure WriteFieldBegin(field: IField); virtual; abstract; + procedure WriteFieldEnd; virtual; abstract; + procedure WriteFieldStop; virtual; abstract; + procedure WriteMapBegin(map: IMap); virtual; abstract; + procedure WriteMapEnd; virtual; abstract; + procedure WriteListBegin( list: IList); virtual; abstract; + procedure WriteListEnd(); virtual; abstract; + procedure WriteSetBegin( set_: ISet ); virtual; abstract; + procedure WriteSetEnd(); virtual; abstract; + procedure WriteBool( b: Boolean); virtual; abstract; + procedure WriteByte( b: ShortInt); virtual; abstract; + procedure WriteI16( i16: SmallInt); virtual; abstract; + procedure WriteI32( i32: Integer); virtual; abstract; + procedure WriteI64( i64: Int64); virtual; abstract; + procedure WriteDouble( d: Double); virtual; abstract; + procedure WriteString( const s: string ); virtual; + procedure WriteAnsiString( const s: AnsiString); virtual; + procedure WriteBinary( const b: TBytes); virtual; abstract; + + function ReadMessageBegin: IMessage; virtual; abstract; + procedure ReadMessageEnd(); virtual; abstract; + function ReadStructBegin: IStruct; virtual; abstract; + procedure ReadStructEnd; virtual; abstract; + function ReadFieldBegin: IField; virtual; abstract; + procedure ReadFieldEnd(); virtual; abstract; + function ReadMapBegin: IMap; virtual; abstract; + procedure ReadMapEnd(); virtual; abstract; + function ReadListBegin: IList; virtual; abstract; + procedure ReadListEnd(); virtual; abstract; + function ReadSetBegin: ISet; virtual; abstract; + procedure ReadSetEnd(); virtual; abstract; + function ReadBool: Boolean; virtual; abstract; + function ReadByte: ShortInt; virtual; abstract; + function ReadI16: SmallInt; virtual; abstract; + function ReadI32: Integer; virtual; abstract; + function ReadI64: Int64; virtual; abstract; + function ReadDouble:Double; virtual; abstract; + function ReadBinary: TBytes; virtual; abstract; + function ReadString: string; virtual; + function ReadAnsiString: AnsiString; virtual; + + property Transport: ITransport read GetTransport; + + constructor Create( trans: ITransport ); + end; + + IBase = interface + ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}'] + function ToString: string; + procedure Read( iprot: IProtocol); + procedure Write( iprot: IProtocol); + end; + + IStruct = interface + ['{5DCE39AA-C916-4BC7-A79B-96A0C36B2220}'] + procedure SetName(const Value: string); + function GetName: string; + property Name: string read GetName write SetName; + end; + + TStructImpl = class( TInterfacedObject, IStruct ) + private + FName: string; + protected + function GetName: string; + procedure SetName(const Value: string); + public + constructor Create( const AName: string); + end; + + TBinaryProtocolImpl = class( TProtocolImpl ) + protected + const + VERSION_MASK : Cardinal = $ffff0000; + VERSION_1 : Cardinal = $80010000; + protected + FStrictRead : Boolean; + FStrictWrite : Boolean; + FReadLength : Integer; + FCheckReadLength : Boolean; + + private + function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer; + function ReadStringBody( size: Integer): string; + procedure CheckReadLength( len: Integer ); + public + + type + TFactory = class( TInterfacedObject, IProtocolFactory) + protected + FStrictRead : Boolean; + FStrictWrite : Boolean; + public + function GetProtocol(trans: ITransport): IProtocol; + constructor Create( AStrictRead, AStrictWrite: Boolean ); overload; + constructor Create; overload; + end; + + constructor Create( trans: ITransport); overload; + constructor Create( trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload; + + procedure WriteMessageBegin( message: 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 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 ReadBinary: TBytes; override; + + procedure SetReadLength( readLength: Integer ); + end; + +implementation + +function ConvertInt64ToDouble( n: Int64): Double; +begin + ASSERT( SizeOf(n) = SizeOf(Result)); + System.Move( n, Result, SizeOf(Result)); +end; + +function ConvertDoubleToInt64( d: Double): Int64; +begin + ASSERT( SizeOf(d) = SizeOf(Result)); + System.Move( d, Result, SizeOf(Result)); +end; + +{ TFieldImpl } + +constructor TFieldImpl.Create(const AName: string; const AType: TType; + AId: SmallInt); +begin + FName := AName; + FType := AType; + FId := AId; +end; + +constructor TFieldImpl.Create; +begin + FName := ''; + FType := Low(TType); + FId := 0; +end; + +function TFieldImpl.GetId: SmallInt; +begin + Result := FId; +end; + +function TFieldImpl.GetName: string; +begin + Result := FName; +end; + +function TFieldImpl.GetType: TType; +begin + Result := FType; +end; + +procedure TFieldImpl.SetId(Value: SmallInt); +begin + FId := Value; +end; + +procedure TFieldImpl.SetName(const Value: string); +begin + FName := Value; +end; + +procedure TFieldImpl.SetType(Value: TType); +begin + FType := Value; +end; + +{ TProtocolImpl } + +constructor TProtocolImpl.Create(trans: ITransport); +begin + inherited Create; + FTrans := trans; +end; + +function TProtocolImpl.GetTransport: ITransport; +begin + Result := FTrans; +end; + +function TProtocolImpl.ReadAnsiString: AnsiString; +var + b : TBytes; + len : Integer; +begin + Result := ''; + b := ReadBinary; + len := Length( b ); + if len > 0 then + begin + SetLength( Result, len); + System.Move( b[0], Pointer(Result)^, len ); + end; +end; + +function TProtocolImpl.ReadString: string; +begin + Result := TEncoding.UTF8.GetString( ReadBinary ); +end; + +procedure TProtocolImpl.WriteAnsiString(const s: AnsiString); +var + b : TBytes; + len : Integer; +begin + len := Length(s); + SetLength( b, len); + if len > 0 then + begin + System.Move( Pointer(s)^, b[0], len ); + end; + WriteBinary( b ); +end; + +procedure TProtocolImpl.WriteString(const s: string); +var + b : TBytes; +begin + b := TEncoding.UTF8.GetBytes(s); + WriteBinary( b ); +end; + +{ TProtocolUtil } + +class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType); +begin + +end; + +{ TStructImpl } + +constructor TStructImpl.Create(const AName: string); +begin + inherited Create; + FName := AName; +end; + +function TStructImpl.GetName: string; +begin + Result := FName; +end; + +procedure TStructImpl.SetName(const Value: string); +begin + FName := Value; +end; + +{ TMapImpl } + +constructor TMapImpl.Create(AValueType, AKeyType: TType; ACount: Integer); +begin + inherited Create; + FValueType := AValueType; + FKeyType := AKeyType; + FCount := ACount; +end; + +constructor TMapImpl.Create; +begin + +end; + +function TMapImpl.GetCount: Integer; +begin + Result := FCount; +end; + +function TMapImpl.GetKeyType: TType; +begin + Result := FKeyType; +end; + +function TMapImpl.GetValueType: TType; +begin + Result := FValueType; +end; + +procedure TMapImpl.SetCount(Value: Integer); +begin + FCount := Value; +end; + +procedure TMapImpl.SetKeyType(Value: TType); +begin + FKeyType := Value; +end; + +procedure TMapImpl.SetValueType(Value: TType); +begin + FValueType := Value; +end; + +{ IMessage } + +constructor TMessageImpl.Create(AName: string; AMessageType: TMessageType; + ASeqID: Integer); +begin + inherited Create; + FName := AName; + FMessageType := AMessageType; + FSeqID := ASeqID; +end; + +constructor TMessageImpl.Create; +begin + inherited; +end; + +function TMessageImpl.GetName: string; +begin + Result := FName; +end; + +function TMessageImpl.GetSeqID: Integer; +begin + Result := FSeqID; +end; + +function TMessageImpl.GetType: TMessageType; +begin + Result := FMessageType; +end; + +procedure TMessageImpl.SetName(const Value: string); +begin + FName := Value; +end; + +procedure TMessageImpl.SetSeqID(Value: Integer); +begin + FSeqID := Value; +end; + +procedure TMessageImpl.SetType(Value: TMessageType); +begin + FMessageType := Value; +end; + +{ ISet } + +constructor TSetImpl.Create( AElementType: TType; ACount: Integer); +begin + inherited Create; + FCount := ACount; + FElementType := AElementType; +end; + +constructor TSetImpl.Create; +begin + +end; + +function TSetImpl.GetCount: Integer; +begin + Result := FCount; +end; + +function TSetImpl.GetElementType: TType; +begin + Result := FElementType; +end; + +procedure TSetImpl.SetCount(Value: Integer); +begin + FCount := Value; +end; + +procedure TSetImpl.SetElementType(Value: TType); +begin + FElementType := Value; +end; + +{ IList } + +constructor TListImpl.Create( AElementType: TType; ACount: Integer); +begin + inherited Create; + FCount := ACount; + FElementType := AElementType; +end; + +constructor TListImpl.Create; +begin + +end; + +function TListImpl.GetCount: Integer; +begin + Result := FCount; +end; + +function TListImpl.GetElementType: TType; +begin + Result := FElementType; +end; + +procedure TListImpl.SetCount(Value: Integer); +begin + FCount := Value; +end; + +procedure TListImpl.SetElementType(Value: TType); +begin + FElementType := Value; +end; + +{ TBinaryProtocolImpl } + +constructor TBinaryProtocolImpl.Create( trans: ITransport); +begin + Create( trans, False, True); +end; + +procedure TBinaryProtocolImpl.CheckReadLength(len: Integer); +begin + if FCheckReadLength then + begin + Dec( FReadLength, len); + if FReadLength < 0 then + begin + raise Exception.Create( 'Message length exceeded: ' + IntToStr( len ) ); + end; + end; +end; + +constructor TBinaryProtocolImpl.Create(trans: ITransport; strictRead, + strictWrite: Boolean); +begin + inherited Create( trans ); + FStrictRead := strictRead; + FStrictWrite := strictWrite; +end; + +function TBinaryProtocolImpl.ReadAll( var buf: TBytes; off, + len: Integer): Integer; +begin + CheckReadLength( len ); + Result := FTrans.ReadAll( buf, off, len ); +end; + +function TBinaryProtocolImpl.ReadBinary: TBytes; +var + size : Integer; + buf : TBytes; +begin + size := ReadI32; + CheckReadLength( size ); + SetLength( buf, size ); + FTrans.ReadAll( buf, 0, size); + Result := buf; +end; + +function TBinaryProtocolImpl.ReadBool: Boolean; +begin + Result := ReadByte = 1; +end; + +function TBinaryProtocolImpl.ReadByte: ShortInt; +var + bin : TBytes; +begin + SetLength( bin, 1); + ReadAll( bin, 0, 1 ); + Result := ShortInt( bin[0]); +end; + +function TBinaryProtocolImpl.ReadDouble: Double; +begin + Result := ConvertInt64ToDouble( ReadI64 ) +end; + +function TBinaryProtocolImpl.ReadFieldBegin: IField; +var + field : IField; +begin + field := TFieldImpl.Create; + field.Type_ := TType( ReadByte); + if ( field.Type_ <> TType.Stop ) then + begin + field.Id := ReadI16; + end; + Result := field; +end; + +procedure TBinaryProtocolImpl.ReadFieldEnd; +begin + +end; + +function TBinaryProtocolImpl.ReadI16: SmallInt; +var + i16in : TBytes; +begin + SetLength( i16in, 2 ); + ReadAll( i16in, 0, 2); + Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF)); +end; + +function TBinaryProtocolImpl.ReadI32: Integer; +var + i32in : TBytes; +begin + SetLength( i32in, 4 ); + ReadAll( i32in, 0, 4); + + Result := Integer( + ((i32in[0] and $FF) shl 24) or + ((i32in[1] and $FF) shl 16) or + ((i32in[2] and $FF) shl 8) or + (i32in[3] and $FF)); + +end; + +function TBinaryProtocolImpl.ReadI64: Int64; +var + i64in : TBytes; +begin + SetLength( i64in, 8); + ReadAll( i64in, 0, 8); + Result := + (Int64( i64in[0] and $FF) shl 56) or + (Int64( i64in[1] and $FF) shl 48) or + (Int64( i64in[2] and $FF) shl 40) or + (Int64( i64in[3] and $FF) shl 32) or + (Int64( i64in[4] and $FF) shl 24) or + (Int64( i64in[5] and $FF) shl 16) or + (Int64( i64in[6] and $FF) shl 8) or + (Int64( i64in[7] and $FF)); +end; + +function TBinaryProtocolImpl.ReadListBegin: IList; +var + list : IList; +begin + list := TListImpl.Create; + list.ElementType := TType( ReadByte ); + list.Count := ReadI32; + Result := list; +end; + +procedure TBinaryProtocolImpl.ReadListEnd; +begin + +end; + +function TBinaryProtocolImpl.ReadMapBegin: IMap; +var + map : IMap; +begin + map := TMapImpl.Create; + map.KeyType := TType( ReadByte ); + map.ValueType := TType( ReadByte ); + map.Count := ReadI32; + Result := map; +end; + +procedure TBinaryProtocolImpl.ReadMapEnd; +begin + +end; + +function TBinaryProtocolImpl.ReadMessageBegin: IMessage; +var + size : Integer; + version : Integer; + message : IMessage; +begin + message := TMessageImpl.Create; + size := ReadI32; + if (size < 0) then + begin + version := size and Integer( VERSION_MASK); + if ( version <> Integer( VERSION_1)) then + begin + raise TProtocolException.Create(TProtocolException.BAD_VERSION, 'Bad version in ReadMessageBegin: ' + IntToStr(version) ); + end; + message.Type_ := TMessageType( size and $000000ff); + message.Name := ReadString; + message.SeqID := ReadI32; + end else + begin + if FStrictRead then + begin + raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Missing version in readMessageBegin, old client?' ); + end; + message.Name := ReadStringBody( size ); + message.Type_ := TMessageType( ReadByte ); + message.SeqID := ReadI32; + end; + Result := message; +end; + +procedure TBinaryProtocolImpl.ReadMessageEnd; +begin + inherited; + +end; + +function TBinaryProtocolImpl.ReadSetBegin: ISet; +var + set_ : ISet; +begin + set_ := TSetImpl.Create; + set_.ElementType := TType( ReadByte ); + set_.Count := ReadI32; + Result := set_; +end; + +procedure TBinaryProtocolImpl.ReadSetEnd; +begin + +end; + +function TBinaryProtocolImpl.ReadStringBody( size: Integer): string; +var + buf : TBytes; +begin + CheckReadLength( size ); + SetLength( buf, size ); + FTrans.ReadAll( buf, 0, size ); + Result := TEncoding.UTF8.GetString( buf); +end; + +function TBinaryProtocolImpl.ReadStructBegin: IStruct; +begin + Result := TStructImpl.Create(''); +end; + +procedure TBinaryProtocolImpl.ReadStructEnd; +begin + inherited; + +end; + +procedure TBinaryProtocolImpl.SetReadLength(readLength: Integer); +begin + FReadLength := readLength; + FCheckReadLength := True; +end; + +procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes); +begin + WriteI32( Length(b)); + FTrans.Write(b, 0, Length( b)); +end; + +procedure TBinaryProtocolImpl.WriteBool(b: Boolean); +begin + if b then + begin + WriteByte( 1 ); + end else + begin + WriteByte( 0 ); + end; +end; + +procedure TBinaryProtocolImpl.WriteByte(b: ShortInt); +var + a : TBytes; +begin + SetLength( a, 1); + a[0] := Byte( b ); + FTrans.Write( a, 0, 1 ); +end; + +procedure TBinaryProtocolImpl.WriteDouble(d: Double); +begin + WriteI64(ConvertDoubleToInt64(d)); +end; + +procedure TBinaryProtocolImpl.WriteFieldBegin(field: IField); +begin + WriteByte(ShortInt(field.Type_)); + WriteI16(field.ID); +end; + +procedure TBinaryProtocolImpl.WriteFieldEnd; +begin + +end; + +procedure TBinaryProtocolImpl.WriteFieldStop; +begin + WriteByte(ShortInt(TType.Stop)); +end; + +procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt); +var + i16out : TBytes; +begin + SetLength( i16out, 2); + i16out[0] := Byte($FF and (i16 shr 8)); + i16out[1] := Byte($FF and i16); + FTrans.Write( i16out ); +end; + +procedure TBinaryProtocolImpl.WriteI32(i32: Integer); +var + i32out : TBytes; +begin + SetLength( i32out, 4); + i32out[0] := Byte($FF and (i32 shr 24)); + i32out[1] := Byte($FF and (i32 shr 16)); + i32out[2] := Byte($FF and (i32 shr 8)); + i32out[3] := Byte($FF and i32); + FTrans.Write( i32out, 0, 4); +end; + +procedure TBinaryProtocolImpl.WriteI64(i64: Int64); +var + i64out : TBytes; +begin + SetLength( i64out, 8); + i64out[0] := Byte($FF and (i64 shr 56)); + i64out[1] := Byte($FF and (i64 shr 48)); + i64out[2] := Byte($FF and (i64 shr 40)); + i64out[3] := Byte($FF and (i64 shr 32)); + i64out[4] := Byte($FF and (i64 shr 24)); + i64out[5] := Byte($FF and (i64 shr 16)); + i64out[6] := Byte($FF and (i64 shr 8)); + i64out[7] := Byte($FF and i64); + FTrans.Write( i64out, 0, 8); +end; + +procedure TBinaryProtocolImpl.WriteListBegin(list: IList); +begin + WriteByte(ShortInt(list.ElementType)); + WriteI32(list.Count); +end; + +procedure TBinaryProtocolImpl.WriteListEnd; +begin + +end; + +procedure TBinaryProtocolImpl.WriteMapBegin(map: IMap); +begin + WriteByte(ShortInt(map.KeyType)); + WriteByte(ShortInt(map.ValueType)); + WriteI32(map.Count); +end; + +procedure TBinaryProtocolImpl.WriteMapEnd; +begin + +end; + +procedure TBinaryProtocolImpl.WriteMessageBegin( message: IMessage); +var + version : Cardinal; +begin + if FStrictWrite then + begin + version := VERSION_1 or Cardinal( message.Type_); + WriteI32( Integer( version) ); + WriteString( message.Name); + WriteI32(message.SeqID); + end else + begin + WriteString(message.Name); + WriteByte(ShortInt(message.Type_)); + WriteI32(message.SeqID); + end; +end; + +procedure TBinaryProtocolImpl.WriteMessageEnd; +begin + +end; + +procedure TBinaryProtocolImpl.WriteSetBegin(set_: ISet); +begin + WriteByte(ShortInt(set_.ElementType)); + WriteI32(set_.Count); +end; + +procedure TBinaryProtocolImpl.WriteSetEnd; +begin + +end; + +procedure TBinaryProtocolImpl.WriteStructBegin(struc: IStruct); +begin + +end; + +procedure TBinaryProtocolImpl.WriteStructEnd; +begin + +end; + +{ TProtocolException } + +constructor TProtocolException.Create; +begin + inherited Create(''); + FType := UNKNOWN; +end; + +constructor TProtocolException.Create(type_: Integer); +begin + inherited Create(''); + FType := type_; +end; + +constructor TProtocolException.Create(type_: Integer; const msg: string); +begin + inherited Create( msg ); + FType := type_; +end; + +{ TThriftStringBuilder } + +function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder; +begin + Result := Append( string( RawByteString(Value)) ); +end; + +function TThriftStringBuilder.Append( + const Value: IThriftContainer): TStringBuilder; +begin + Result := Append( Value.ToString ); +end; + +{ TBinaryProtocolImpl.TFactory } + +constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean); +begin + FStrictRead := AStrictRead; + FStrictWrite := AStrictWrite; +end; + +constructor TBinaryProtocolImpl.TFactory.Create; +begin + Create( False, True ) +end; + +function TBinaryProtocolImpl.TFactory.GetProtocol(trans: ITransport): IProtocol; +begin + Result := TBinaryProtocolImpl.Create( trans ); +end; + +end. + diff --git a/lib/delphi/src/Thrift.Server.pas b/lib/delphi/src/Thrift.Server.pas new file mode 100644 index 00000000..0a7fdc60 --- /dev/null +++ b/lib/delphi/src/Thrift.Server.pas @@ -0,0 +1,325 @@ +(* + * 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 + +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. diff --git a/lib/delphi/src/Thrift.Stream.pas b/lib/delphi/src/Thrift.Stream.pas new file mode 100644 index 00000000..a02677ec --- /dev/null +++ b/lib/delphi/src/Thrift.Stream.pas @@ -0,0 +1,298 @@ +(* + * 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.Stream; + +interface + +uses + Classes, + SysUtils, + SysConst, + RTLConsts, + Thrift.Utils, + ActiveX; + +type + + IThriftStream = interface + ['{732621B3-F697-4D76-A1B0-B4DD5A8E4018}'] + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; + procedure Open; + procedure Close; + procedure Flush; + function IsOpen: Boolean; + function ToArray: TBytes; + end; + + TThriftStreamImpl = class( TInterfacedObject, IThriftStream) + private + procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer); + protected + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual; + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual; + procedure Open; virtual; abstract; + procedure Close; virtual; abstract; + procedure Flush; virtual; abstract; + function IsOpen: Boolean; virtual; abstract; + function ToArray: TBytes; virtual; abstract; + end; + + TThriftStreamAdapterDelphi = class( TThriftStreamImpl ) + private + FStream : TStream; + FOwnsStream : Boolean; + protected + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override; + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override; + procedure Open; override; + procedure Close; override; + procedure Flush; override; + function IsOpen: Boolean; override; + function ToArray: TBytes; override; + public + constructor Create( AStream: TStream; AOwnsStream : Boolean); + destructor Destroy; override; + end; + + TThriftStreamAdapterCOM = class( TThriftStreamImpl) + private + FStream : IStream; + protected + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override; + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override; + procedure Open; override; + procedure Close; override; + procedure Flush; override; + function IsOpen: Boolean; override; + function ToArray: TBytes; override; + public + constructor Create( AStream: IStream); + end; + +implementation + +{ TThriftStreamAdapterCOM } + +procedure TThriftStreamAdapterCOM.Close; +begin + FStream := nil; +end; + +constructor TThriftStreamAdapterCOM.Create(AStream: IStream); +begin + FStream := AStream; +end; + +procedure TThriftStreamAdapterCOM.Flush; +begin + if IsOpen then + begin + if FStream <> nil then + begin + FStream.Commit( STGC_DEFAULT ); + end; + end; +end; + +function TThriftStreamAdapterCOM.IsOpen: Boolean; +begin + Result := FStream <> nil; +end; + +procedure TThriftStreamAdapterCOM.Open; +begin + +end; + +function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; +begin + inherited; + Result := 0; + if FStream <> nil then + begin + if count > 0 then + begin + FStream.Read( @buffer[offset], count, @Result); + end; + end; +end; + +function TThriftStreamAdapterCOM.ToArray: TBytes; +var + statstg: TStatStg; + len : Integer; + NewPos : Int64; + cbRead : Integer; +begin + FillChar( statstg, SizeOf( statstg), 0); + len := 0; + if IsOpen then + begin + if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then + begin + len := statstg.cbSize; + end; + end; + + SetLength( Result, len ); + + if len > 0 then + begin + if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then + begin + FStream.Read( @Result[0], len, @cbRead); + end; + end; +end; + +procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer); +var + nWritten : Integer; +begin + inherited; + if IsOpen then + begin + if count > 0 then + begin + FStream.Write( @buffer[0], count, @nWritten); + end; + end; +end; + +{ TThriftStreamImpl } + +procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset, + count: Integer); +var + len : Integer; +begin + if count > 0 then + begin + len := Length( buffer ); + if (offset < 0) or ( offset >= len) then + begin + raise ERangeError.Create( SBitsIndexError ); + end; + if count > len then + begin + raise ERangeError.Create( SBitsIndexError ); + end; + end; +end; + +function TThriftStreamImpl.Read(var buffer: TBytes; offset, + count: Integer): Integer; +begin + Result := 0; + CheckSizeAndOffset( buffer, offset, count ); +end; + +procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer); +begin + CheckSizeAndOffset( buffer, offset, count ); +end; + +{ TThriftStreamAdapterDelphi } + +procedure TThriftStreamAdapterDelphi.Close; +begin + FStream.Free; + FStream := nil; + FOwnsStream := False; +end; + +constructor TThriftStreamAdapterDelphi.Create(AStream: TStream; AOwnsStream: Boolean); +begin + FStream := AStream; + FOwnsStream := AOwnsStream; +end; + +destructor TThriftStreamAdapterDelphi.Destroy; +begin + if FOwnsStream then + begin + FStream.Free; + end; + inherited; +end; + +procedure TThriftStreamAdapterDelphi.Flush; +begin + +end; + +function TThriftStreamAdapterDelphi.IsOpen: Boolean; +begin + Result := FStream <> nil; +end; + +procedure TThriftStreamAdapterDelphi.Open; +begin + +end; + +function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset, + count: Integer): Integer; +begin + inherited; + Result := 0; + if count > 0 then + begin + Result := FStream.Read( Pointer(@buffer[offset])^, count) + end; +end; + +function TThriftStreamAdapterDelphi.ToArray: TBytes; +var + OrgPos : Integer; + len : Integer; +begin + len := 0; + if FStream <> nil then + begin + len := FStream.Size; + end; + + SetLength( Result, len ); + + if len > 0 then + begin + OrgPos := FStream.Position; + try + FStream.Position := 0; + FStream.ReadBuffer( Pointer(@Result[0])^, len ); + finally + FStream.Position := OrgPos; + end; + end +end; + +procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset, + count: Integer); +begin + inherited; + if count > 0 then + begin + FStream.Write( Pointer(@buffer[offset])^, count) + end; +end; + +end. diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas new file mode 100644 index 00000000..0e6f8255 --- /dev/null +++ b/lib/delphi/src/Thrift.Transport.pas @@ -0,0 +1,1250 @@ +(* + * 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.Transport; + +interface + +uses + Classes, + SysUtils, + Sockets, + Generics.Collections, + Thrift.Collections, + Thrift.Utils, + Thrift.Stream, + ActiveX, + msxml; + +type + ITransport = interface + ['{A4A9FC37-D620-44DC-AD21-662D16364CE4}'] + function GetIsOpen: Boolean; + property IsOpen: Boolean read GetIsOpen; + function Peek: Boolean; + procedure Open; + procedure Close; + function Read(var buf: TBytes; off: Integer; len: Integer): Integer; + function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; + procedure Write( const buf: TBytes); overload; + procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; + procedure Flush; + end; + + TTransportImpl = class( TInterfacedObject, ITransport) + protected + function GetIsOpen: Boolean; virtual; abstract; + property IsOpen: Boolean read GetIsOpen; + function Peek: Boolean; + procedure Open(); virtual; abstract; + procedure Close(); virtual; abstract; + function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract; + function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; + procedure Write( const buf: TBytes); overload; virtual; + procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; virtual; abstract; + procedure Flush; virtual; + end; + + TTransportException = class( Exception ) + public + type + TExceptionType = ( + Unknown, + NotOpen, + AlreadyOpen, + TimedOut, + EndOfFile + ); + private + FType : TExceptionType; + public + constructor Create( AType: TExceptionType); overload; + constructor Create( const msg: string); overload; + constructor Create( AType: TExceptionType; const msg: string); overload; + property Type_: TExceptionType read FType; + end; + + IHTTPClient = interface( ITransport ) + ['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}'] + procedure SetConnectionTimeout(const Value: Integer); + function GetConnectionTimeout: Integer; + procedure SetReadTimeout(const Value: Integer); + function GetReadTimeout: Integer; + function GetCustomHeaders: IThriftDictionary; + procedure SendRequest; + property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout; + property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout; + property CustomHeaders: IThriftDictionary read GetCustomHeaders; + end; + + THTTPClientImpl = class( TTransportImpl, IHTTPClient) + private + FUri : string; + FInputStream : IThriftStream; + FOutputStream : IThriftStream; + FConnectionTimeout : Integer; + FReadTimeout : Integer; + FCustomHeaders : IThriftDictionary; + + function CreateRequest: IXMLHTTPRequest; + protected + function GetIsOpen: Boolean; override; + procedure Open(); override; + procedure Close(); override; + function Read( var buf: TBytes; off: Integer; len: Integer): Integer; override; + procedure Write( const buf: TBytes; off: Integer; len: Integer); override; + procedure Flush; override; + + procedure SetConnectionTimeout(const Value: Integer); + function GetConnectionTimeout: Integer; + procedure SetReadTimeout(const Value: Integer); + function GetReadTimeout: Integer; + function GetCustomHeaders: IThriftDictionary; + procedure SendRequest; + property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout; + property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout; + property CustomHeaders: IThriftDictionary read GetCustomHeaders; + public + constructor Create( const AUri: string); + destructor Destroy; override; + end; + + IServerTransport = interface + ['{BF6B7043-DA22-47BF-8B11-2B88EC55FE12}'] + procedure Listen; + procedure Close; + function Accept: ITransport; + end; + + TServerTransportImpl = class( TInterfacedObject, IServerTransport) + protected + function AcceptImpl: ITransport; virtual; abstract; + public + procedure Listen; virtual; abstract; + procedure Close; virtual; abstract; + function Accept: ITransport; + end; + + ITransportFactory = interface + ['{DD809446-000F-49E1-9BFF-E0D0DC76A9D7}'] + function GetTransport( ATrans: ITransport): ITransport; + end; + + TTransportFactoryImpl = class( TInterfacedObject, ITransportFactory) + function GetTransport( ATrans: ITransport): ITransport; virtual; + end; + + TTcpSocketStreamImpl = class( TThriftStreamImpl ) + private + FTcpClient : TCustomIpClient; + protected + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override; + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override; + procedure Open; override; + procedure Close; override; + procedure Flush; override; + + function IsOpen: Boolean; override; + function ToArray: TBytes; override; + public + constructor Create( ATcpClient: TCustomIpClient); + end; + + IStreamTransport = interface( ITransport ) + ['{A8479B47-2A3E-4421-A9A0-D5A9EDCC634A}'] + function GetInputStream: IThriftStream; + function GetOutputStream: IThriftStream; + property InputStream : IThriftStream read GetInputStream; + property OutputStream : IThriftStream read GetOutputStream; + end; + + TStreamTransportImpl = class( TTransportImpl, IStreamTransport) + protected + FInputStream : IThriftStream; + FOutputStream : IThriftStream; + protected + function GetIsOpen: Boolean; override; + + function GetInputStream: IThriftStream; + function GetOutputStream: IThriftStream; + public + property InputStream : IThriftStream read GetInputStream; + property OutputStream : IThriftStream read GetOutputStream; + + procedure Open; override; + procedure Close; override; + procedure Flush; override; + function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override; + procedure Write( const buf: TBytes; off: Integer; len: Integer); override; + constructor Create( AInputStream : IThriftStream; AOutputStream : IThriftStream); + destructor Destroy; override; + end; + + TBufferedStreamImpl = class( TThriftStreamImpl) + private + FStream : IThriftStream; + FBufSize : Integer; + FBuffer : TMemoryStream; + protected + procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override; + function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override; + procedure Open; override; + procedure Close; override; + procedure Flush; override; + function IsOpen: Boolean; override; + function ToArray: TBytes; override; + public + constructor Create( AStream: IThriftStream; ABufSize: Integer); + destructor Destroy; override; + end; + + TServerSocketImpl = class( TServerTransportImpl) + private + FServer : TTcpServer; + FPort : Integer; + FClientTimeout : Integer; + FUseBufferedSocket : Boolean; + FOwnsServer : Boolean; + protected + function AcceptImpl: ITransport; override; + public + constructor Create( AServer: TTcpServer ); overload; + constructor Create( AServer: TTcpServer; AClientTimeout: Integer); overload; + constructor Create( APort: Integer); overload; + constructor Create( APort: Integer; AClientTimeout: Integer); overload; + constructor Create( APort: Integer; AClientTimeout: Integer; + AUseBufferedSockets: Boolean); overload; + destructor Destroy; override; + procedure Listen; override; + procedure Close; override; + end; + + TBufferedTransportImpl = class( TTransportImpl ) + private + FInputBuffer : IThriftStream; + FOutputBuffer : IThriftStream; + FTransport : IStreamTransport; + FBufSize : Integer; + + procedure InitBuffers; + function GetUnderlyingTransport: ITransport; + protected + function GetIsOpen: Boolean; override; + procedure Flush; override; + public + procedure Open(); override; + procedure Close(); override; + function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override; + procedure Write( const buf: TBytes; off: Integer; len: Integer); override; + constructor Create( ATransport : IStreamTransport ); overload; + constructor Create( ATransport : IStreamTransport; ABufSize: Integer); overload; + property UnderlyingTransport: ITransport read GetUnderlyingTransport; + property IsOpen: Boolean read GetIsOpen; + end; + + TSocketImpl = class(TStreamTransportImpl) + private + FClient : TCustomIpClient; + FOwnsClient : Boolean; + FHost : string; + FPort : Integer; + FTimeout : Integer; + + procedure InitSocket; + protected + function GetIsOpen: Boolean; override; + public + procedure Open; override; + constructor Create( AClient : TCustomIpClient); overload; + constructor Create( const AHost: string; APort: Integer); overload; + constructor Create( const AHost: string; APort: Integer; ATimeout: Integer); overload; + destructor Destroy; override; + procedure Close; override; + property TcpClient: TCustomIpClient read FClient; + property Host : string read FHost; + property Port: Integer read FPort; + end; + + TFramedTransportImpl = class( TTransportImpl) + private const + FHeaderSize : Integer = 4; + private class var + FHeader_Dummy : array of Byte; + protected + FTransport : ITransport; + FWriteBuffer : TMemoryStream; + FReadBuffer : TMemoryStream; + + procedure InitWriteBuffer; + procedure ReadFrame; + public + type + TFactory = class( TTransportFactoryImpl ) + public + function GetTransport( ATrans: ITransport): ITransport; override; + end; + +{$IF CompilerVersion >= 21.0} + class constructor Create; +{$IFEND} + constructor Create; overload; + constructor Create( ATrans: ITransport); overload; + destructor Destroy; override; + + procedure Open(); override; + function GetIsOpen: Boolean; override; + + procedure Close(); override; + function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override; + procedure Write( const buf: TBytes; off: Integer; len: Integer); override; + procedure Flush; override; + end; + +{$IF CompilerVersion < 21.0} +procedure TFramedTransportImpl_Initialize; +{$IFEND} + +implementation + +{ TTransportImpl } + +procedure TTransportImpl.Flush; +begin + +end; + +function TTransportImpl.Peek: Boolean; +begin + Result := IsOpen; +end; + +function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer; +var + got : Integer; + ret : Integer; +begin + got := 0; + while ( got < len) do + begin + ret := Read( buf, off + got, len - got); + if ( ret <= 0 ) then + begin + raise TTransportException.Create( 'Cannot read, Remote side has closed' ); + end; + got := got + ret; + end; + Result := got; +end; + +procedure TTransportImpl.Write( const buf: TBytes); +begin + Self.Write( buf, 0, Length(buf) ); +end; + +{ THTTPClientImpl } + +procedure THTTPClientImpl.Close; +begin + FInputStream := nil; + FOutputStream := nil; +end; + +constructor THTTPClientImpl.Create(const AUri: string); +begin + inherited Create; + FUri := AUri; + FCustomHeaders := TThriftDictionaryImpl.Create; + FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True); +end; + +function THTTPClientImpl.CreateRequest: IXMLHTTPRequest; +var + pair : TPair; +begin +{$IF CompilerVersion >= 21.0} + Result := CoXMLHTTP.Create; +{$ELSE} + Result := CoXMLHTTPRequest.Create; +{$IFEND} + + Result.open('POST', FUri, False, '', ''); + Result.setRequestHeader( 'Content-Type', 'application/x-thrift'); + Result.setRequestHeader( 'Accept', 'application/x-thrift'); + Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient'); + + for pair in FCustomHeaders do + begin + Result.setRequestHeader( pair.Key, pair.Value ); + end; +end; + +destructor THTTPClientImpl.Destroy; +begin + Close; + inherited; +end; + +procedure THTTPClientImpl.Flush; +begin + try + SendRequest; + finally + FOutputStream := nil; + FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True); + end; +end; + +function THTTPClientImpl.GetConnectionTimeout: Integer; +begin + Result := FConnectionTimeout; +end; + +function THTTPClientImpl.GetCustomHeaders: IThriftDictionary; +begin + Result := FCustomHeaders; +end; + +function THTTPClientImpl.GetIsOpen: Boolean; +begin + Result := True; +end; + +function THTTPClientImpl.GetReadTimeout: Integer; +begin + Result := FReadTimeout; +end; + +procedure THTTPClientImpl.Open; +begin + +end; + +function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer; +begin + if FInputStream = nil then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, + 'No request has been sent'); + end; + try + Result := FInputStream.Read( buf, off, len ) + except + on E: Exception do + begin + raise TTransportException.Create( TTransportException.TExceptionType.Unknown, + E.Message); + end; + end; +end; + +procedure THTTPClientImpl.SendRequest; +var + xmlhttp : IXMLHTTPRequest; + ms : TMemoryStream; + a : TBytes; + len : Integer; +begin + xmlhttp := CreateRequest; + + ms := TMemoryStream.Create; + try + a := FOutputStream.ToArray; + len := Length(a); + if len > 0 then + begin + ms.WriteBuffer( Pointer(@a[0])^, len); + end; + ms.Position := 0; + xmlhttp.send( IUnknown( TStreamAdapter.Create( ms, soReference ))); + FInputStream := nil; + FInputStream := TThriftStreamAdapterCOM.Create( IUnknown( xmlhttp.responseStream) as IStream); + finally + ms.Free; + end; +end; + +procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer); +begin + FConnectionTimeout := Value; +end; + +procedure THTTPClientImpl.SetReadTimeout(const Value: Integer); +begin + FReadTimeout := Value +end; + +procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer); +begin + FOutputStream.Write( buf, off, len); +end; + +{ TTransportException } + +constructor TTransportException.Create(AType: TExceptionType); +begin + Create( AType, '' ) +end; + +constructor TTransportException.Create(AType: TExceptionType; + const msg: string); +begin + inherited Create(msg); + FType := AType; +end; + +constructor TTransportException.Create(const msg: string); +begin + inherited Create(msg); +end; + +{ TServerTransportImpl } + +function TServerTransportImpl.Accept: ITransport; +begin + Result := AcceptImpl; + if Result = nil then + begin + raise TTransportException.Create( 'accept() may not return NULL' ); + end; +end; + +{ TTransportFactoryImpl } + +function TTransportFactoryImpl.GetTransport(ATrans: ITransport): ITransport; +begin + Result := ATrans; +end; + +{ TServerSocket } + +constructor TServerSocketImpl.Create(AServer: TTcpServer; AClientTimeout: Integer); +begin + FServer := AServer; + FClientTimeout := AClientTimeout; +end; + +constructor TServerSocketImpl.Create(AServer: TTcpServer); +begin + Create( AServer, 0 ); +end; + +constructor TServerSocketImpl.Create(APort: Integer); +begin + Create( APort, 0 ); +end; + +function TServerSocketImpl.AcceptImpl: ITransport; +var + ret : TCustomIpClient; + ret2 : IStreamTransport; + ret3 : ITransport; +begin + if FServer = nil then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, + 'No underlying server socket.'); + end; + + try + ret := TCustomIpClient.Create(nil); + if ( not FServer.Accept( ret )) then + begin + ret.Free; + Result := nil; + Exit; + end; + + if ret = nil then + begin + Result := nil; + Exit; + end; + + ret2 := TSocketImpl.Create( ret ); + if FUseBufferedSocket then + begin + ret3 := TBufferedTransportImpl.Create(ret2); + Result := ret3; + end else + begin + Result := ret2; + end; + + except + on E: Exception do + begin + raise TTransportException.Create( E.ToString ); + end; + end; +end; + +procedure TServerSocketImpl.Close; +begin + if FServer <> nil then + begin + try + FServer.Active := False; + except + on E: Exception do + begin + raise TTransportException.Create('Error on closing socket : ' + E.Message); + end; + end; + end; +end; + +constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer; + AUseBufferedSockets: Boolean); +begin + FPort := APort; + FClientTimeout := AClientTimeout; + FUseBufferedSocket := AUseBufferedSockets; + FOwnsServer := True; + FServer := TTcpServer.Create( nil ); + FServer.BlockMode := bmBlocking; +{$IF CompilerVersion >= 21.0} + FServer.LocalPort := AnsiString( IntToStr( FPort)); +{$ELSE} + FServer.LocalPort := IntToStr( FPort); +{$IFEND} +end; + +destructor TServerSocketImpl.Destroy; +begin + if FOwnsServer then + begin + FServer.Free; + end; + inherited; +end; + +procedure TServerSocketImpl.Listen; +begin + if FServer <> nil then + begin + try + FServer.Active := True; + except + on E: Exception do + begin + raise TTransportException.Create('Could not accept on listening socket: ' + E.Message); + end; + end; + end; +end; + +constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer); +begin + Create( APort, AClientTimeout, False ); +end; + +{ TSocket } + +constructor TSocketImpl.Create(AClient : TCustomIpClient); +var + stream : IThriftStream; +begin + FClient := AClient; + stream := TTcpSocketStreamImpl.Create( FClient); + FInputStream := stream; + FOutputStream := stream; +end; + +constructor TSocketImpl.Create(const AHost: string; APort: Integer); +begin + Create( AHost, APort, 0); +end; + +procedure TSocketImpl.Close; +begin + inherited Close; + if FClient <> nil then + begin + FClient.Free; + FClient := nil; + end; +end; + +constructor TSocketImpl.Create(const AHost: string; APort, ATimeout: Integer); +begin + FHost := AHost; + FPort := APort; + FTimeout := ATimeout; + InitSocket; +end; + +destructor TSocketImpl.Destroy; +begin + if FOwnsClient then + begin + FClient.Free; + end; + inherited; +end; + +function TSocketImpl.GetIsOpen: Boolean; +begin + Result := False; + if FClient <> nil then + begin + Result := FClient.Connected; + end; +end; + +procedure TSocketImpl.InitSocket; +var + stream : IThriftStream; +begin + if FClient <> nil then + begin + if FOwnsClient then + begin + FClient.Free; + FClient := nil; + end; + end; + FClient := TTcpClient.Create( nil ); + FOwnsClient := True; + + stream := TTcpSocketStreamImpl.Create( FClient); + FInputStream := stream; + FOutputStream := stream; + +end; + +procedure TSocketImpl.Open; +begin + if IsOpen then + begin + raise TTransportException.Create( TTransportException.TExceptionType.AlreadyOpen, + 'Socket already connected'); + end; + + if FHost = '' then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, + 'Cannot open null host'); + end; + + if Port <= 0 then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, + 'Cannot open without port'); + end; + + if FClient = nil then + begin + InitSocket; + end; + + FClient.RemoteHost := TSocketHost( Host); + FClient.RemotePort := TSocketPort( IntToStr( Port)); + FClient.Connect; + + FInputStream := TTcpSocketStreamImpl.Create( FClient); + FOutputStream := FInputStream; +end; + +{ TBufferedStream } + +procedure TBufferedStreamImpl.Close; +begin + Flush; + FStream := nil; + FBuffer.Free; + FBuffer := nil; +end; + +constructor TBufferedStreamImpl.Create(AStream: IThriftStream; ABufSize: Integer); +begin + FStream := AStream; + FBufSize := ABufSize; + FBuffer := TMemoryStream.Create; +end; + +destructor TBufferedStreamImpl.Destroy; +begin + Close; + inherited; +end; + +procedure TBufferedStreamImpl.Flush; +var + buf : TBytes; + len : Integer; +begin + if IsOpen then + begin + len := FBuffer.Size; + if len > 0 then + begin + SetLength( buf, len ); + FBuffer.Position := 0; + FBuffer.Read( Pointer(@buf[0])^, len ); + FStream.Write( buf, 0, len ); + end; + FBuffer.Clear; + end; +end; + +function TBufferedStreamImpl.IsOpen: Boolean; +begin + Result := (FBuffer <> nil) and ( FStream <> nil); +end; + +procedure TBufferedStreamImpl.Open; +begin + +end; + +function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; +var + nRead : Integer; + tempbuf : TBytes; +begin + inherited; + Result := 0; + if count > 0 then + begin + if IsOpen then + begin + if FBuffer.Position >= FBuffer.Size then + begin + FBuffer.Clear; + SetLength( tempbuf, FBufSize); + nRead := FStream.Read( tempbuf, 0, FBufSize ); + if nRead > 0 then + begin + FBuffer.WriteBuffer( Pointer(@tempbuf[0])^, nRead ); + FBuffer.Position := 0; + end; + end; + + if FBuffer.Position < FBuffer.Size then + begin + Result := FBuffer.Read( Pointer(@buffer[offset])^, count ); + end; + end; + end; +end; + +function TBufferedStreamImpl.ToArray: TBytes; +var + len : Integer; +begin + len := 0; + + if IsOpen then + begin + len := FBuffer.Size; + end; + + SetLength( Result, len); + + if len > 0 then + begin + FBuffer.Position := 0; + FBuffer.Read( Pointer(@Result[0])^, len ); + end; +end; + +procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer); +begin + inherited; + if count > 0 then + begin + if IsOpen then + begin + FBuffer.Write( Pointer(@buffer[offset])^, count ); + if FBuffer.Size > FBufSize then + begin + Flush; + end; + end; + end; +end; + +{ TStreamTransportImpl } + +procedure TStreamTransportImpl.Close; +begin + if FInputStream <> FOutputStream then + begin + if FInputStream <> nil then + begin + FInputStream := nil; + end; + if FOutputStream <> nil then + begin + FOutputStream := nil; + end; + end else + begin + FInputStream := nil; + FOutputStream := nil; + end; +end; + +constructor TStreamTransportImpl.Create( AInputStream : IThriftStream; AOutputStream : IThriftStream); +begin + FInputStream := AInputStream; + FOutputStream := AOutputStream; +end; + +destructor TStreamTransportImpl.Destroy; +begin + FInputStream := nil; + FOutputStream := nil; + inherited; +end; + +procedure TStreamTransportImpl.Flush; +begin + if FOutputStream = nil then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot flush null outputstream' ); + end; + + FOutputStream.Flush; +end; + +function TStreamTransportImpl.GetInputStream: IThriftStream; +begin + Result := FInputStream; +end; + +function TStreamTransportImpl.GetIsOpen: Boolean; +begin + Result := True; +end; + +function TStreamTransportImpl.GetOutputStream: IThriftStream; +begin + Result := FInputStream; +end; + +procedure TStreamTransportImpl.Open; +begin + +end; + +function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer; +begin + if FInputStream = nil then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null inputstream' ); + end; + Result := FInputStream.Read( buf, off, len ); +end; + +procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer); +begin + if FOutputStream = nil then + begin + raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null outputstream' ); + end; + + FOutputStream.Write( buf, off, len ); +end; + +{ TBufferedTransportImpl } + +constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport); +begin + Create( ATransport, 1024 ); +end; + +procedure TBufferedTransportImpl.Close; +begin + FTransport.Close; +end; + +constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport; + ABufSize: Integer); +begin + FTransport := ATransport; + FBufSize := ABufSize; + InitBuffers; +end; + +procedure TBufferedTransportImpl.Flush; +begin + if FOutputBuffer <> nil then + begin + FOutputBuffer.Flush; + end; +end; + +function TBufferedTransportImpl.GetIsOpen: Boolean; +begin + Result := FTransport.IsOpen; +end; + +function TBufferedTransportImpl.GetUnderlyingTransport: ITransport; +begin + Result := FTransport; +end; + +procedure TBufferedTransportImpl.InitBuffers; +begin + if FTransport.InputStream <> nil then + begin + FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize ); + end; + if FTransport.OutputStream <> nil then + begin + FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize ); + end; +end; + +procedure TBufferedTransportImpl.Open; +begin + FTransport.Open +end; + +function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer; +begin + Result := 0; + if FInputBuffer <> nil then + begin + Result := FInputBuffer.Read( buf, off, len ); + end; +end; + +procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer); +begin + if FOutputBuffer <> nil then + begin + FOutputBuffer.Write( buf, off, len ); + end; +end; + +{ TFramedTransportImpl } + +{$IF CompilerVersion < 21.0} +procedure TFramedTransportImpl_Initialize; +begin + SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize); + FillChar( TFramedTransportImpl.FHeader_Dummy[0], + Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0); +end; +{$ELSE} +class constructor TFramedTransportImpl.Create; +begin + SetLength( FHeader_Dummy, FHeaderSize); + FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0); +end; +{$IFEND} + +constructor TFramedTransportImpl.Create; +begin + InitWriteBuffer; +end; + +procedure TFramedTransportImpl.Close; +begin + FTransport.Close; +end; + +constructor TFramedTransportImpl.Create(ATrans: ITransport); +begin + InitWriteBuffer; + FTransport := ATrans; +end; + +destructor TFramedTransportImpl.Destroy; +begin + FWriteBuffer.Free; + FReadBuffer.Free; + inherited; +end; + +procedure TFramedTransportImpl.Flush; +var + buf : TBytes; + len : Integer; + data_len : Integer; + +begin + len := FWriteBuffer.Size; + SetLength( buf, len); + if len > 0 then + begin + System.Move( FWriteBuffer.Memory^, buf[0], len ); + end; + + data_len := len - FHeaderSize; + if (data_len < 0) then + begin + raise Exception.Create( 'TFramedTransport.Flush: data_len < 0' ); + end; + + InitWriteBuffer; + + buf[0] := Byte($FF and (data_len shr 24)); + buf[1] := Byte($FF and (data_len shr 16)); + buf[2] := Byte($FF and (data_len shr 8)); + buf[3] := Byte($FF and data_len); + + FTransport.Write( buf, 0, len ); + FTransport.Flush; +end; + +function TFramedTransportImpl.GetIsOpen: Boolean; +begin + Result := FTransport.IsOpen; +end; + +type + TAccessMemoryStream = class(TMemoryStream) + end; + +procedure TFramedTransportImpl.InitWriteBuffer; +begin + FWriteBuffer.Free; + FWriteBuffer := TMemoryStream.Create; + TAccessMemoryStream(FWriteBuffer).Capacity := 1024; + FWriteBuffer.Write( Pointer(@FHeader_Dummy[0])^, FHeaderSize); +end; + +procedure TFramedTransportImpl.Open; +begin + FTransport.Open; +end; + +function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer; +var + got : Integer; +begin + if FReadBuffer <> nil then + begin + got := FReadBuffer.Read( Pointer(@buf[0])^, len ); + if got > 0 then + begin + Result := got; + Exit; + end; + end; + + ReadFrame; + Result := FReadBuffer.Read( Pointer(@buf[0])^, len ); +end; + +procedure TFramedTransportImpl.ReadFrame; +var + i32rd : TBytes; + size : Integer; + buff : TBytes; +begin + SetLength( i32rd, FHeaderSize ); + FTransport.ReadAll( i32rd, 0, FHeaderSize); + size := + ((i32rd[0] and $FF) shl 24) or + ((i32rd[1] and $FF) shl 16) or + ((i32rd[2] and $FF) shl 8) or + (i32rd[3] and $FF); + SetLength( buff, size ); + FTransport.ReadAll( buff, 0, size ); + FReadBuffer.Free; + FReadBuffer := TMemoryStream.Create; + FReadBuffer.Write( Pointer(@buff[0])^, size ); + FReadBuffer.Position := 0; +end; + +procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer); +begin + FWriteBuffer.Write( Pointer(@buf[0])^, len ); +end; + +{ TFramedTransport.TFactory } + +function TFramedTransportImpl.TFactory.GetTransport(ATrans: ITransport): ITransport; +begin + Result := TFramedTransportImpl.Create( ATrans ); +end; + +{ TTcpSocketStreamImpl } + +procedure TTcpSocketStreamImpl.Close; +begin + FTcpClient.Close; +end; + +constructor TTcpSocketStreamImpl.Create(ATcpClient: TCustomIpClient); +begin + FTcpClient := ATcpClient; +end; + +procedure TTcpSocketStreamImpl.Flush; +begin + +end; + +function TTcpSocketStreamImpl.IsOpen: Boolean; +begin + Result := FTcpClient.Active; +end; + +procedure TTcpSocketStreamImpl.Open; +begin + FTcpClient.Open; +end; + +function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset, + count: Integer): Integer; +begin + inherited; + Result := FTcpClient.ReceiveBuf( Pointer(@buffer[offset])^, count); +end; + +function TTcpSocketStreamImpl.ToArray: TBytes; +var + len : Integer; +begin + len := 0; + if IsOpen then + begin + len := FTcpClient.BytesReceived; + end; + + SetLength( Result, len ); + + if len > 0 then + begin + FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len); + end; +end; + +procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer); +begin + inherited; + FTcpClient.SendBuf( Pointer(@buffer[offset])^, count); +end; + +{$IF CompilerVersion < 21.0} +initialization +begin + TFramedTransportImpl_Initialize; +end; +{$IFEND} + + +end. diff --git a/lib/delphi/src/Thrift.Utils.pas b/lib/delphi/src/Thrift.Utils.pas new file mode 100644 index 00000000..72c0dc10 --- /dev/null +++ b/lib/delphi/src/Thrift.Utils.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 Thrift.Utils; + +interface + +function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string; + +implementation + +function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string; +begin + if B then + Result := TrueValue + else + Result := FalseValue; +end; + +end. diff --git a/lib/delphi/src/Thrift.pas b/lib/delphi/src/Thrift.pas new file mode 100644 index 00000000..6f352b1a --- /dev/null +++ b/lib/delphi/src/Thrift.pas @@ -0,0 +1,156 @@ +(* + * 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; + +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; + +implementation + +{ 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 new file mode 100644 index 00000000..b3c90178 --- /dev/null +++ b/lib/delphi/test/TestClient.pas @@ -0,0 +1,597 @@ +(* + * 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 TestClient; + +interface + +uses + SysUtils, Classes, Thrift.Protocol, Thrift.Transport, Thrift.Test, + Generics.Collections, Thrift.Collections, Windows, Thrift.Console, + DateUtils; + +type + + TThreadConsole = class + private + FThread : TThread; + public + procedure Write( const S : string); + procedure WriteLine( const S : string); + constructor Create( AThread: TThread); + end; + + TClientThread = class( TThread ) + private + FTransport : ITransport; + FNumIteration : Integer; + FConsole : TThreadConsole; + + procedure ClientTest; + protected + procedure Execute; override; + public + constructor Create(ATransport: ITransport; ANumIteration: Integer); + destructor Destroy; override; + end; + + TTestClient = class + private + class var + FNumIteration : Integer; + FNumThread : Integer; + public + class procedure Execute( const args: array of string); + end; + +implementation + +{ TTestClient } + +class procedure TTestClient.Execute(const args: array of string); +var + i : Integer; + host : string; + port : Integer; + url : string; + bBuffered : Boolean; + bFramed : Boolean; + s : string; + n : Integer; + threads : array of TThread; + dtStart : TDateTime; + test : Integer; + thread : TThread; + trans : ITransport; + streamtrans : IStreamTransport; + http : IHTTPClient; + +begin + bBuffered := False;; + bFramed := False; + try + host := 'localhost'; + port := 9090; + url := ''; + i := 0; + try + while ( i < Length(args) ) do + begin + try + if ( args[i] = '-h') then + begin + Inc( i ); + s := args[i]; + n := Pos( ':', s); + if ( n > 0 ) then + begin + host := Copy( s, 1, n - 1); + port := StrToInt( Copy( s, n + 1, MaxInt)); + end else + begin + host := s; + end; + end else + if (args[i] = '-u') then + begin + Inc( i ); + url := args[i]; + end else + if (args[i] = '-n') then + begin + Inc( i ); + FNumIteration := StrToInt( args[i] ); + end else + if (args[i] = '-b') then + begin + bBuffered := True; + Console.WriteLine('Using buffered transport'); + end else + if (args[i] = '-f' ) or ( args[i] = '-framed') then + begin + bFramed := True; + Console.WriteLine('Using framed transport'); + end else + if (args[i] = '-t') then + begin + Inc( i ); + FNumThread := StrToInt( args[i] ); + end; + finally + Inc( i ); + end; + end; + except + on E: Exception do + begin + Console.WriteLine( E.Message ); + end; + end; + + SetLength( threads, FNumThread); + dtStart := Now; + + for test := 0 to FNumThread - 1 do + begin + if url = '' then + begin + streamtrans := TSocketImpl.Create( host, port ); + trans := streamtrans; + if bBuffered then + begin + trans := TBufferedTransportImpl.Create( streamtrans ); + end; + + if bFramed then + begin + trans := TFramedTransportImpl.Create( trans ); + end; + end else + begin + http := THTTPClientImpl.Create( url ); + trans := http; + end; + thread := TClientThread.Create( trans, FNumIteration); + threads[test] := thread; +{$WARN SYMBOL_DEPRECATED OFF} + thread.Resume; +{$WARN SYMBOL_DEPRECATED ON} + end; + + for test := 0 to FNumThread - 1 do + begin + threads[test].WaitFor; + end; + + for test := 0 to FNumThread - 1 do + begin + threads[test].Free; + end; + + Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart))); + + except + on E: Exception do + begin + Console.WriteLine( E.Message + ' ST: ' + E.StackTrace ); + end; + end; + + Console.WriteLine(''); + Console.WriteLine('done!'); +end; + +{ TClientThread } + +procedure TClientThread.ClientTest; +var + binaryProtocol : TBinaryProtocolImpl; + client : TThriftTest.Iface; + s : string; + i8 : ShortInt; + i32 : Integer; + i64 : Int64; + dub : Double; + o : IXtruct; + o2 : IXtruct2; + i : IXtruct; + i2 : IXtruct2; + mapout : IThriftDictionary; + mapin : IThriftDictionary; + j : Integer; + first : Boolean; + key : Integer; + listout : IThriftList; + listin : IThriftList; + setout : IHashSet; + setin : IHashSet; + ret : TNumberz; + uid : Int64; + mm : IThriftDictionary>; + m2 : IThriftDictionary; + k2 : Integer; + insane : IInsanity; + truck : IXtruct; + whoa : IThriftDictionary>; + key64 : Int64; + val : IThriftDictionary; + k2_2 : TNumberz; + k3 : TNumberz; + v2 : IInsanity; + userMap : IThriftDictionary; + xtructs : IThriftList; + x : IXtruct; + arg0 : ShortInt; + arg1 : Integer; + arg2 : Int64; + multiDict : IThriftDictionary; + arg4 : TNumberz; + arg5 : Int64; + StartTick : Cardinal; + k : Integer; + proc : TThreadProcedure; + +begin + binaryProtocol := TBinaryProtocolImpl.Create( FTransport ); + client := TThriftTest.TClient.Create( binaryProtocol ); + try + if not FTransport.IsOpen then + begin + FTransport.Open; + end; + except + on E: Exception do + begin + Console.WriteLine( E.Message ); + Exit; + end; + end; + + Console.Write('testException()'); + try + client.testException('Xception'); + except + on E: TXception do + begin + Console.WriteLine( ' = ' + IntToStr(E.ErrorCode) + ', ' + E.Message_ ); + end; + end; + + Console.Write('testVoid()'); + client.testVoid(); + Console.WriteLine(' = void'); + + Console.Write('testString(''Test'')'); + s := client.testString('Test'); + Console.WriteLine(' := ''' + s + ''''); + + Console.Write('testByte(1)'); + i8 := client.testByte(1); + Console.WriteLine(' := ' + IntToStr( i8 )); + + Console.Write('testI32(-1)'); + i32 := client.testI32(-1); + Console.WriteLine(' := ' + IntToStr(i32)); + + Console.Write('testI64(-34359738368)'); + i64 := client.testI64(-34359738368); + Console.WriteLine(' := ' + IntToStr( i64)); + + Console.Write('testDouble(5.325098235)'); + dub := client.testDouble(5.325098235); + Console.WriteLine(' := ' + FloatToStr( dub)); + + Console.Write('testStruct({''Zero'', 1, -3, -5})'); + o := TXtructImpl.Create; + o.String_thing := 'Zero'; + o.Byte_thing := 1; + o.I32_thing := -3; + o.I64_thing := -5; + i := client.testStruct(o); + Console.WriteLine(' := {''' + + i.String_thing + ''', ' + + IntToStr( i.Byte_thing) + ', ' + + IntToStr( i.I32_thing) + ', ' + + IntToStr( i.I64_thing) + '}'); + + Console.Write('testNest({1, {''Zero'', 1, -3, -5}, 5})'); + o2 := TXtruct2Impl.Create; + o2.Byte_thing := 1; + o2.Struct_thing := o; + o2.I32_thing := 5; + i2 := client.testNest(o2); + i := i2.Struct_thing; + Console.WriteLine(' := {' + IntToStr( i2.Byte_thing) + ', {''' + + i.String_thing + ''', ' + + IntToStr( i.Byte_thing) + ', ' + + IntToStr( i.I32_thing) + ', ' + + IntToStr( i.I64_thing) + '}, ' + + IntToStr( i2.I32_thing) + '}'); + + + mapout := TThriftDictionaryImpl.Create; + + for j := 0 to 4 do + begin + mapout.AddOrSetValue( j, j - 10); + end; + Console.Write('testMap({'); + first := True; + for key in mapout.Keys do + begin + if first then + begin + first := False; + end else + begin + Console.Write( ', ' ); + end; + Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key])); + end; + Console.Write('})'); + + mapin := client.testMap( mapout ); + Console.Write(' = {'); + first := True; + for key in mapin.Keys do + begin + if first then + begin + first := False; + end else + begin + Console.Write( ', ' ); + end; + Console.Write( IntToStr( key) + ' => ' + IntToStr( mapin[key])); + end; + Console.WriteLine('}'); + + setout := THashSetImpl.Create; + for j := -2 to 2 do + begin + setout.Add( j ); + end; + Console.Write('testSet({'); + first := True; + for j in setout do + begin + if first then + begin + first := False; + end else + begin + Console.Write(', '); + end; + Console.Write(IntToStr( j)); + end; + Console.Write('})'); + + Console.Write(' = {'); + + first := True; + setin := client.testSet(setout); + for j in setin do + begin + if first then + begin + first := False; + end else + begin + Console.Write(', '); + end; + Console.Write(IntToStr( j)); + end; + Console.WriteLine('}'); + + Console.Write('testEnum(ONE)'); + ret := client.testEnum(TNumberz.ONE); + Console.WriteLine(' = ' + IntToStr( Integer( ret))); + + Console.Write('testEnum(TWO)'); + ret := client.testEnum(TNumberz.TWO); + Console.WriteLine(' = ' + IntToStr( Integer( ret))); + + Console.Write('testEnum(THREE)'); + ret := client.testEnum(TNumberz.THREE); + Console.WriteLine(' = ' + IntToStr( Integer( ret))); + + Console.Write('testEnum(FIVE)'); + ret := client.testEnum(TNumberz.FIVE); + Console.WriteLine(' = ' + IntToStr( Integer( ret))); + + Console.Write('testEnum(EIGHT)'); + ret := client.testEnum(TNumberz.EIGHT); + Console.WriteLine(' = ' + IntToStr( Integer( ret))); + + Console.Write('testTypedef(309858235082523)'); + uid := client.testTypedef(309858235082523); + Console.WriteLine(' = ' + IntToStr( uid)); + + Console.Write('testMapMap(1)'); + mm := client.testMapMap(1); + Console.Write(' = {'); + for key in mm.Keys do + begin + Console.Write( IntToStr( key) + ' => {'); + m2 := mm[key]; + for k2 in m2.Keys do + begin + Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', '); + end; + Console.Write('}, '); + end; + Console.WriteLine('}'); + + insane := TInsanityImpl.Create; + insane.UserMap := TThriftDictionaryImpl.Create; + insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000); + truck := TXtructImpl.Create; + truck.String_thing := 'Truck'; + truck.Byte_thing := 8; + truck.I32_thing := 8; + truck.I64_thing := 8; + insane.Xtructs := TThriftListImpl.Create; + insane.Xtructs.Add( truck ); + Console.Write('testInsanity()'); + whoa := client.testInsanity( insane ); + Console.Write(' = {'); + for key64 in whoa.Keys do + begin + val := whoa[key64]; + Console.Write( IntToStr( key64) + ' => {'); + for k2_2 in val.Keys do + begin + v2 := val[k2_2]; + Console.Write( IntToStr( Integer( k2_2)) + ' => {'); + userMap := v2.UserMap; + Console.Write('{'); + if userMap <> nil then + begin + for k3 in userMap.Keys do + begin + Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', '); + end; + end else + begin + Console.Write('null'); + end; + Console.Write('}, '); + xtructs := v2.Xtructs; + Console.Write('{'); + + if xtructs <> nil then + begin + for x in xtructs do + begin + Console.Write('{"' + x.String_thing + '", ' + + IntToStr( x.Byte_thing) + ', ' + + IntToStr( x.I32_thing) + ', ' + + IntToStr( x.I32_thing) + '}, '); + end; + end else + begin + Console.Write('null'); + end; + Console.Write('}'); + Console.Write('}, '); + end; + Console.Write('}, '); + end; + Console.WriteLine('}'); + + arg0 := 1; + arg1 := 2; + arg2 := High(Int64); + + multiDict := TThriftDictionaryImpl.Create; + multiDict.AddOrSetValue( 1, 'one'); + + arg4 := TNumberz.FIVE; + arg5 := 5000000; + Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' + + IntToStr( arg1) + ',' + IntToStr( arg2) + ',' + + multiDict.ToString + ',' + IntToStr( Integer( arg4)) + ',' + + IntToStr( arg5) + ')'); + + Console.WriteLine('Test Oneway(1)'); + client.testOneway(1); + + Console.Write('Test Calltime()'); + StartTick := GetTIckCount; + + for k := 0 to 1000 - 1 do + begin + client.testVoid(); + end; + Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' ); + +end; + +constructor TClientThread.Create(ATransport: ITransport; ANumIteration: Integer); +begin + inherited Create( True ); + FNumIteration := ANumIteration; + FTransport := ATransport; + FConsole := TThreadConsole.Create( Self ); +end; + +destructor TClientThread.Destroy; +begin + FConsole.Free; + inherited; +end; + +procedure TClientThread.Execute; +var + i : Integer; + proc : TThreadProcedure; +begin + for i := 0 to FNumIteration - 1 do + begin + ClientTest; + end; + + proc := procedure + begin + if FTransport <> nil then + begin + FTransport.Close; + FTransport := nil; + end; + end; + + Synchronize( proc ); +end; + +{ TThreadConsole } + +constructor TThreadConsole.Create(AThread: TThread); +begin + FThread := AThread; +end; + +procedure TThreadConsole.Write(const S: string); +var + proc : TThreadProcedure; +begin + proc := procedure + begin + Console.Write( S ); + end; + TThread.Synchronize( FThread, proc); +end; + +procedure TThreadConsole.WriteLine(const S: string); +var + proc : TThreadProcedure; +begin + proc := procedure + begin + Console.WriteLine( S ); + end; + TThread.Synchronize( FThread, proc); +end; + +initialization +begin + TTestClient.FNumIteration := 1; + TTestClient.FNumThread := 1; +end; + +end. diff --git a/lib/delphi/test/TestServer.pas b/lib/delphi/test/TestServer.pas new file mode 100644 index 00000000..c120712d --- /dev/null +++ b/lib/delphi/test/TestServer.pas @@ -0,0 +1,460 @@ +(* + * 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(); + function testString(thing: string): string; + function testByte(thing: ShortInt): ShortInt; + function testI32(thing: Integer): Integer; + function testI64(thing: Int64): Int64; + function testDouble(thing: Double): Double; + function testStruct(thing: IXtruct): IXtruct; + function testNest(thing: IXtruct2): IXtruct2; + function testMap(thing: IThriftDictionary): IThriftDictionary; + function testStringMap(thing: IThriftDictionary): IThriftDictionary; + function testSet(thing: IHashSet): IHashSet; + function testList(thing: IThriftList): IThriftList; + function testEnum(thing: TNumberz): TNumberz; + function testTypedef(thing: Int64): Int64; + function testMapMap(hello: Integer): IThriftDictionary>; + function testInsanity(argument: IInsanity): IThriftDictionary>; + function testMulti(arg0: ShortInt; arg1: Integer; arg2: Int64; arg3: IThriftDictionary; arg4: TNumberz; arg5: Int64): IXtruct; + 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. diff --git a/lib/delphi/test/client.dpr b/lib/delphi/test/client.dpr new file mode 100644 index 00000000..d0152bf1 --- /dev/null +++ b/lib/delphi/test/client.dpr @@ -0,0 +1,61 @@ +(* + * 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 + 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. + diff --git a/lib/delphi/test/maketest.sh b/lib/delphi/test/maketest.sh new file mode 100644 index 00000000..8f0639c0 --- /dev/null +++ b/lib/delphi/test/maketest.sh @@ -0,0 +1,23 @@ +#!/bin/sh + +# +# 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. +# + +../../../compiler/cpp/thrift --gen delphi -o . ../../../test/ThriftTest.thrift + diff --git a/lib/delphi/test/server.dpr b/lib/delphi/test/server.dpr new file mode 100644 index 00000000..768de014 --- /dev/null +++ b/lib/delphi/test/server.dpr @@ -0,0 +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 + 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. + + + diff --git a/test/ThriftTest.thrift b/test/ThriftTest.thrift index 51f42b4f..69185848 100644 --- a/test/ThriftTest.thrift +++ b/test/ThriftTest.thrift @@ -33,6 +33,7 @@ namespace py ThriftTest namespace py.twisted ThriftTest namespace go ThriftTest namespace php ThriftTest +namespace delphi Thrift.Test namespace * thrift.test /** -- 2.17.1