2 * Licensed to the Apache Software Foundation (ASF) under one
3 * or more contributor license agreements. See the NOTICE file
4 * distributed with this work for additional information
5 * regarding copyright ownership. The ASF licenses this file
6 * to you under the Apache License, Version 2.0 (the
7 * "License"); you may not use this file except in compliance
8 * with the License. You may obtain a copy of the License at
10 * http://www.apache.org/licenses/LICENSE-2.0
12 * Unless required by applicable law or agreed to in writing,
13 * software distributed under the License is distributed on an
14 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 * KIND, either express or implied. See the License for the
16 * specific language governing permissions and limitations
29 #include "thrift/platform.h"
30 #include "thrift/version.h"
31 #include "thrift/generate/t_oop_generator.h"
35 using std::ostringstream
;
37 using std::stringstream
;
40 static const string endl
= "\n"; // avoid ostream << std::endl flushes
43 * PERL code generator.
46 class t_perl_generator
: public t_oop_generator
{
48 t_perl_generator(t_program
* program
,
49 const std::map
<std::string
, std::string
>& parsed_options
,
50 const std::string
& option_string
)
51 : t_oop_generator(program
), f_types_use_includes_emitted_(false) {
53 std::map
<std::string
, std::string
>::const_iterator iter
;
56 for( iter
= parsed_options
.begin(); iter
!= parsed_options
.end(); ++iter
) {
57 throw "unknown option perl:" + iter
->first
;
60 out_dir_base_
= "gen-perl";
66 * Init and close methods
69 void init_generator() override
;
70 void close_generator() override
;
73 * Program-level generation functions
76 void generate_typedef(t_typedef
* ttypedef
) override
;
77 void generate_enum(t_enum
* tenum
) override
;
78 void generate_const(t_const
* tconst
) override
;
79 void generate_struct(t_struct
* tstruct
) override
;
80 void generate_xception(t_struct
* txception
) override
;
81 void generate_service(t_service
* tservice
) override
;
83 std::string
render_const_value(t_type
* type
, t_const_value
* value
);
89 void generate_perl_struct(t_struct
* tstruct
, bool is_exception
);
90 void generate_perl_struct_definition(std::ostream
& out
,
92 bool is_xception
= false);
93 void generate_perl_struct_reader(std::ostream
& out
, t_struct
* tstruct
);
94 void generate_perl_struct_writer(std::ostream
& out
, t_struct
* tstruct
);
95 void generate_perl_function_helpers(t_function
* tfunction
);
98 * Service-level generation functions
101 void generate_service_helpers(t_service
* tservice
);
102 void generate_service_interface(t_service
* tservice
);
103 void generate_service_rest(t_service
* tservice
);
104 void generate_service_client(t_service
* tservice
);
105 void generate_service_processor(t_service
* tservice
);
106 void generate_process_function(t_service
* tservice
, t_function
* tfunction
);
107 void generate_use_includes(std::ostream
& os
, bool& done
, t_type
*type
, bool selfish
);
110 * Serialization constructs
113 void generate_deserialize_field(std::ostream
& out
,
115 std::string prefix
= "",
116 bool inclass
= false);
118 void generate_deserialize_struct(std::ostream
& out
, t_struct
* tstruct
, std::string prefix
= "");
120 void generate_deserialize_container(std::ostream
& out
, t_type
* ttype
, std::string prefix
= "");
122 void generate_deserialize_set_element(std::ostream
& out
, t_set
* tset
, std::string prefix
= "");
124 void generate_deserialize_map_element(std::ostream
& out
, t_map
* tmap
, std::string prefix
= "");
126 void generate_deserialize_list_element(std::ostream
& out
,
128 std::string prefix
= "");
130 void generate_serialize_field(std::ostream
& out
, t_field
* tfield
, std::string prefix
= "");
132 void generate_serialize_struct(std::ostream
& out
, t_struct
* tstruct
, std::string prefix
= "");
134 void generate_serialize_container(std::ostream
& out
, t_type
* ttype
, std::string prefix
= "");
136 void generate_serialize_map_element(std::ostream
& out
,
141 void generate_serialize_set_element(std::ostream
& out
, t_set
* tmap
, std::string iter
);
143 void generate_serialize_list_element(std::ostream
& out
, t_list
* tlist
, std::string iter
);
146 * Helper rendering functions
149 std::string
perl_includes();
150 std::string
declare_field(t_field
* tfield
, bool init
= false, bool obj
= false);
151 std::string
function_signature(t_function
* tfunction
, std::string prefix
= "");
152 std::string
argument_list(t_struct
* tstruct
);
153 std::string
type_to_enum(t_type
* ttype
);
155 std::string
autogen_comment() override
{
156 return std::string("#\n") + "# Autogenerated by Thrift Compiler (" + THRIFT_VERSION
+ ")\n"
157 + "#\n" + "# DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n" + "#\n";
160 void perl_namespace_dirs(t_program
* p
, std::list
<std::string
>& dirs
) {
161 std::string ns
= p
->get_namespace("perl");
162 std::string::size_type loc
;
165 while ((loc
= ns
.find(".")) != std::string::npos
) {
166 dirs
.push_back(ns
.substr(0, loc
));
167 ns
= ns
.substr(loc
+ 1);
176 std::string
perl_namespace(t_program
* p
) {
177 std::string ns
= p
->get_namespace("perl");
178 std::string result
= "";
179 std::string::size_type loc
;
182 while ((loc
= ns
.find(".")) != std::string::npos
) {
183 result
+= ns
.substr(0, loc
);
185 ns
= ns
.substr(loc
+ 1);
196 std::string
get_namespace_out_dir() {
197 std::string outdir
= get_out_dir();
198 std::list
<std::string
> dirs
;
199 perl_namespace_dirs(program_
, dirs
);
200 std::list
<std::string
>::iterator it
;
201 for (it
= dirs
.begin(); it
!= dirs
.end(); it
++) {
211 ofstream_with_content_based_conditional_update f_types_
;
212 ofstream_with_content_based_conditional_update f_consts_
;
213 ofstream_with_content_based_conditional_update f_helpers_
;
214 ofstream_with_content_based_conditional_update f_service_
;
216 bool f_types_use_includes_emitted_
;
220 * Prepares for file generation by opening up the necessary file output
223 * @param tprogram The program to generate
225 void t_perl_generator::init_generator() {
226 // Make output directory
227 MKDIR(get_out_dir().c_str());
229 string outdir
= get_out_dir();
230 std::list
<std::string
> dirs
;
231 perl_namespace_dirs(program_
, dirs
);
232 std::list
<std::string
>::iterator it
;
233 for (it
= dirs
.begin(); it
!= dirs
.end(); it
++) {
235 MKDIR(outdir
.c_str());
239 string f_types_name
= outdir
+ "Types.pm";
240 f_types_
.open(f_types_name
.c_str());
241 string f_consts_name
= outdir
+ "Constants.pm";
242 f_consts_
.open(f_consts_name
.c_str());
245 f_types_
<< autogen_comment() << perl_includes();
248 f_consts_
<< autogen_comment() << "package " << perl_namespace(program_
) << "Constants;" << endl
249 << perl_includes() << endl
;
253 * Prints standard java imports
255 string
t_perl_generator::perl_includes() {
258 inc
= "use 5.10.0;\n";
259 inc
+= "use strict;\n";
260 inc
+= "use warnings;\n";
261 inc
+= "use Thrift::Exception;\n";
262 inc
+= "use Thrift::MessageType;\n";
263 inc
+= "use Thrift::Type;\n\n";
269 * Close up (or down) some filez.
271 void t_perl_generator::close_generator() {
273 f_types_
<< "1;" << endl
;
276 f_consts_
<< "1;" << endl
;
281 * Generates a typedef. This is not done in PERL, types are all implicit.
283 * @param ttypedef The type definition
285 void t_perl_generator::generate_typedef(t_typedef
* ttypedef
) {
290 * Generates code for an enumerated type. Since define is expensive to lookup
291 * in PERL, we use a global array for this.
293 * @param tenum The enumeration
295 void t_perl_generator::generate_enum(t_enum
* tenum
) {
296 f_types_
<< "package " << perl_namespace(program_
) << tenum
->get_name() << ";" << endl
;
298 vector
<t_enum_value
*> constants
= tenum
->get_constants();
299 vector
<t_enum_value
*>::iterator c_iter
;
300 for (c_iter
= constants
.begin(); c_iter
!= constants
.end(); ++c_iter
) {
301 int value
= (*c_iter
)->get_value();
302 f_types_
<< "use constant " << (*c_iter
)->get_name() << " => " << value
<< ";" << endl
;
307 * Generate a constant value
309 void t_perl_generator::generate_const(t_const
* tconst
) {
310 t_type
* type
= tconst
->get_type();
311 string name
= tconst
->get_name();
312 t_const_value
* value
= tconst
->get_value();
314 f_consts_
<< "use constant " << name
<< " => ";
315 f_consts_
<< render_const_value(type
, value
);
316 f_consts_
<< ";" << endl
<< endl
;
320 * Prints the value of a constant with the given type. Note that type checking
321 * is NOT performed in this function as it is always run beforehand using the
322 * validate_types method in main.cc
324 string
t_perl_generator::render_const_value(t_type
* type
, t_const_value
* value
) {
325 std::ostringstream out
;
327 type
= get_true_type(type
);
329 if (type
->is_base_type()) {
330 t_base_type::t_base tbase
= ((t_base_type
*)type
)->get_base();
332 case t_base_type::TYPE_STRING
:
333 out
<< '"' << get_escaped_string(value
) << '"';
335 case t_base_type::TYPE_BOOL
:
336 out
<< (value
->get_integer() > 0 ? "1" : "0");
338 case t_base_type::TYPE_I8
:
339 case t_base_type::TYPE_I16
:
340 case t_base_type::TYPE_I32
:
341 case t_base_type::TYPE_I64
:
342 out
<< value
->get_integer();
344 case t_base_type::TYPE_DOUBLE
:
345 if (value
->get_type() == t_const_value::CV_INTEGER
) {
346 out
<< value
->get_integer();
348 out
<< value
->get_double();
352 throw "compiler error: no const of base type " + t_base_type::t_base_name(tbase
);
354 } else if (type
->is_enum()) {
355 out
<< value
->get_integer();
356 } else if (type
->is_struct() || type
->is_xception()) {
357 out
<< perl_namespace(type
->get_program()) << type
->get_name() << "->new({" << endl
;
360 const vector
<t_field
*>& fields
= ((t_struct
*)type
)->get_members();
361 vector
<t_field
*>::const_iterator f_iter
;
362 const map
<t_const_value
*, t_const_value
*, t_const_value::value_compare
>& val
= value
->get_map();
363 map
<t_const_value
*, t_const_value
*, t_const_value::value_compare
>::const_iterator v_iter
;
364 for (v_iter
= val
.begin(); v_iter
!= val
.end(); ++v_iter
) {
365 t_type
* field_type
= NULL
;
366 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
367 if ((*f_iter
)->get_name() == v_iter
->first
->get_string()) {
368 field_type
= (*f_iter
)->get_type();
371 if (field_type
== NULL
) {
372 throw "type error: " + type
->get_name() + " has no field " + v_iter
->first
->get_string();
374 indent(out
) << render_const_value(g_type_string
, v_iter
->first
);
376 out
<< render_const_value(field_type
, v_iter
->second
);
382 } else if (type
->is_map()) {
383 t_type
* ktype
= ((t_map
*)type
)->get_key_type();
384 t_type
* vtype
= ((t_map
*)type
)->get_val_type();
388 const map
<t_const_value
*, t_const_value
*, t_const_value::value_compare
>& val
= value
->get_map();
389 map
<t_const_value
*, t_const_value
*, t_const_value::value_compare
>::const_iterator v_iter
;
390 for (v_iter
= val
.begin(); v_iter
!= val
.end(); ++v_iter
) {
391 indent(out
) << render_const_value(ktype
, v_iter
->first
);
393 out
<< render_const_value(vtype
, v_iter
->second
);
398 } else if (type
->is_list() || type
->is_set()) {
400 if (type
->is_list()) {
401 etype
= ((t_list
*)type
)->get_elem_type();
403 etype
= ((t_set
*)type
)->get_elem_type();
408 const vector
<t_const_value
*>& val
= value
->get_list();
409 vector
<t_const_value
*>::const_iterator v_iter
;
410 for (v_iter
= val
.begin(); v_iter
!= val
.end(); ++v_iter
) {
412 indent(out
) << render_const_value(etype
, *v_iter
);
413 if (type
->is_set()) {
427 void t_perl_generator::generate_struct(t_struct
* tstruct
) {
428 generate_perl_struct(tstruct
, false);
432 * Generates a struct definition for a thrift exception. Basically the same
433 * as a struct but extends the Exception class.
435 * @param txception The struct definition
437 void t_perl_generator::generate_xception(t_struct
* txception
) {
438 generate_perl_struct(txception
, true);
442 * Structs can be normal or exceptions.
444 void t_perl_generator::generate_perl_struct(t_struct
* tstruct
, bool is_exception
) {
445 generate_use_includes(f_types_
, f_types_use_includes_emitted_
, tstruct
, false);
446 generate_perl_struct_definition(f_types_
, tstruct
, is_exception
);
450 * Generates a struct definition for a thrift data type. This is nothing in PERL
451 * where the objects are all just associative arrays (unless of course we
452 * decide to start using objects for them...)
454 * @param tstruct The struct definition
456 void t_perl_generator::generate_perl_struct_definition(ostream
& out
,
459 const vector
<t_field
*>& members
= tstruct
->get_members();
460 vector
<t_field
*>::const_iterator m_iter
;
462 out
<< "package " << perl_namespace(tstruct
->get_program()) << tstruct
->get_name() << ";\n";
464 out
<< "use base qw(Thrift::TException);\n";
467 // Create simple acessor methods
468 out
<< "use base qw(Class::Accessor);\n";
470 if (members
.size() > 0) {
471 out
<< perl_namespace(tstruct
->get_program()) << tstruct
->get_name() << "->mk_accessors( qw( ";
472 for (m_iter
= members
.begin(); m_iter
!= members
.end(); ++m_iter
) {
473 t_type
* t
= get_true_type((*m_iter
)->get_type());
474 if (!t
->is_xception()) {
475 out
<< (*m_iter
)->get_name() << " ";
486 out
<< "sub new {" << endl
<< indent() << "my $classname = shift;" << endl
<< indent()
487 << "my $self = {};" << endl
<< indent() << "my $vals = shift || {};" << endl
;
489 for (m_iter
= members
.begin(); m_iter
!= members
.end(); ++m_iter
) {
490 string dval
= "undef";
491 t_type
* t
= get_true_type((*m_iter
)->get_type());
492 if ((*m_iter
)->get_value() != NULL
&& !(t
->is_struct() || t
->is_xception())) {
493 dval
= render_const_value((*m_iter
)->get_type(), (*m_iter
)->get_value());
495 out
<< indent() << "$self->{" << (*m_iter
)->get_name() << "} = " << dval
<< ";" << endl
;
498 // Generate constructor from array
499 if (members
.size() > 0) {
501 for (m_iter
= members
.begin(); m_iter
!= members
.end(); ++m_iter
) {
502 t_type
* t
= get_true_type((*m_iter
)->get_type());
503 if ((*m_iter
)->get_value() != NULL
&& (t
->is_struct() || t
->is_xception())) {
504 indent(out
) << "$self->{" << (*m_iter
)->get_name()
505 << "} = " << render_const_value(t
, (*m_iter
)->get_value()) << ";" << endl
;
509 out
<< indent() << "if (UNIVERSAL::isa($vals,'HASH')) {" << endl
;
511 for (m_iter
= members
.begin(); m_iter
!= members
.end(); ++m_iter
) {
512 out
<< indent() << "if (defined $vals->{" << (*m_iter
)->get_name() << "}) {" << endl
513 << indent() << " $self->{" << (*m_iter
)->get_name() << "} = $vals->{"
514 << (*m_iter
)->get_name() << "};" << endl
<< indent() << "}" << endl
;
517 out
<< indent() << "}" << endl
;
520 out
<< indent() << "return bless ($self, $classname);" << endl
;
524 out
<< "sub getName {" << endl
<< indent() << " return '" << tstruct
->get_name() << "';" << endl
525 << indent() << "}" << endl
<< endl
;
527 generate_perl_struct_reader(out
, tstruct
);
528 generate_perl_struct_writer(out
, tstruct
);
532 * Generates the read() method for a struct
534 void t_perl_generator::generate_perl_struct_reader(ostream
& out
, t_struct
* tstruct
) {
535 const vector
<t_field
*>& fields
= tstruct
->get_members();
536 vector
<t_field
*>::const_iterator f_iter
;
538 out
<< "sub read {" << endl
;
542 out
<< indent() << "my ($self, $input) = @_;" << endl
<< indent() << "my $xfer = 0;" << endl
543 << indent() << "my $fname;" << endl
<< indent() << "my $ftype = 0;" << endl
<< indent()
544 << "my $fid = 0;" << endl
;
546 indent(out
) << "$xfer += $input->readStructBegin(\\$fname);" << endl
;
548 // Loop over reading in fields
549 indent(out
) << "while (1)" << endl
;
553 indent(out
) << "$xfer += $input->readFieldBegin(\\$fname, \\$ftype, \\$fid);" << endl
;
555 // Check for field STOP marker and break
556 indent(out
) << "if ($ftype == Thrift::TType::STOP) {" << endl
;
558 indent(out
) << "last;" << endl
;
560 indent(out
) << "}" << endl
;
562 // Switch statement on the field we are reading
563 indent(out
) << "SWITCH: for($fid)" << endl
;
567 // Generate deserialization code for known cases
568 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
570 indent(out
) << "/^" << (*f_iter
)->get_key() << "$/ && do{";
571 indent(out
) << "if ($ftype == " << type_to_enum((*f_iter
)->get_type()) << ") {" << endl
;
574 generate_deserialize_field(out
, *f_iter
, "self->");
577 indent(out
) << "} else {" << endl
;
579 indent(out
) << " $xfer += $input->skip($ftype);" << endl
;
581 out
<< indent() << "}" << endl
<< indent() << "last; };" << endl
;
583 // In the default case we skip the field
585 indent(out
) << " $xfer += $input->skip($ftype);" << endl
;
589 indent(out
) << "$xfer += $input->readFieldEnd();" << endl
;
593 indent(out
) << "$xfer += $input->readStructEnd();" << endl
;
595 indent(out
) << "return $xfer;" << endl
;
598 out
<< indent() << "}" << endl
<< endl
;
602 * Generates the write() method for a struct
604 void t_perl_generator::generate_perl_struct_writer(ostream
& out
, t_struct
* tstruct
) {
605 string name
= tstruct
->get_name();
606 const vector
<t_field
*>& fields
= tstruct
->get_sorted_members();
607 vector
<t_field
*>::const_iterator f_iter
;
609 out
<< "sub write {" << endl
;
612 indent(out
) << "my ($self, $output) = @_;" << endl
;
613 indent(out
) << "my $xfer = 0;" << endl
;
615 indent(out
) << "$xfer += $output->writeStructBegin('" << name
<< "');" << endl
;
617 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
618 out
<< indent() << "if (defined $self->{" << (*f_iter
)->get_name() << "}) {" << endl
;
621 indent(out
) << "$xfer += $output->writeFieldBegin("
622 << "'" << (*f_iter
)->get_name() << "', " << type_to_enum((*f_iter
)->get_type())
623 << ", " << (*f_iter
)->get_key() << ");" << endl
;
625 // Write field contents
626 generate_serialize_field(out
, *f_iter
, "self->");
628 indent(out
) << "$xfer += $output->writeFieldEnd();" << endl
;
631 indent(out
) << "}" << endl
;
634 out
<< indent() << "$xfer += $output->writeFieldStop();" << endl
<< indent()
635 << "$xfer += $output->writeStructEnd();" << endl
;
637 out
<< indent() << "return $xfer;" << endl
;
640 out
<< indent() << "}" << endl
<< endl
;
644 * Generates use clauses for included entities
646 * @param os The output stream
647 * @param done A flag reference to debounce the action
648 * @param type The type being processed
649 * @param selfish Flag to indicate if the current namespace types should be "use"d as well.
651 void t_perl_generator::generate_use_includes(std::ostream
& os
, bool& done
, t_type
*type
, bool selfish
) {
652 t_program
*current
= type
->get_program();
653 if (current
&& !done
) {
654 std::vector
<t_program
*>& currInc
= current
->get_includes();
655 std::vector
<t_program
*>::size_type numInc
= currInc
.size();
657 os
<< "use " << perl_namespace(current
) << "Types;" << endl
;
659 for (std::vector
<t_program
*>::size_type i
= 0; i
< numInc
; ++i
) {
660 t_program
* incProgram
= currInc
.at(i
);
661 os
<< "use " << perl_namespace(incProgram
) << "Types;" << endl
;
669 * Generates a thrift service.
671 * @param tservice The service definition
673 void t_perl_generator::generate_service(t_service
* tservice
) {
674 string f_service_name
= get_namespace_out_dir() + service_name_
+ ".pm";
675 f_service_
.open(f_service_name
.c_str());
677 f_service_
<< autogen_comment() << perl_includes();
680 generate_use_includes(f_service_
, done
, tservice
, true);
682 t_service
* extends_s
= tservice
->get_extends();
683 if (extends_s
!= NULL
) {
684 f_service_
<< "use " << perl_namespace(extends_s
->get_program()) << extends_s
->get_name() << ";"
690 // Generate the three main parts of the service (well, two for now in PERL)
691 generate_service_helpers(tservice
);
692 generate_service_interface(tservice
);
693 generate_service_rest(tservice
);
694 generate_service_client(tservice
);
695 generate_service_processor(tservice
);
697 // Close service file
698 f_service_
<< "1;" << endl
;
703 * Generates a service server definition.
705 * @param tservice The service to generate a server for.
707 void t_perl_generator::generate_service_processor(t_service
* tservice
) {
708 // Generate the dispatch methods
709 vector
<t_function
*> functions
= tservice
->get_functions();
710 vector
<t_function
*>::iterator f_iter
;
713 string extends_processor
= "";
714 t_service
* extends_s
= tservice
->get_extends();
715 if (extends_s
!= NULL
) {
716 extends
= perl_namespace(extends_s
->get_program()) + extends_s
->get_name();
717 extends_processor
= "use base qw(" + extends
+ "Processor);";
722 // Generate the header portion
723 f_service_
<< "package " << perl_namespace(program_
) << service_name_
<< "Processor;" << endl
724 << endl
<< "use strict;" << endl
<< extends_processor
<< endl
<< endl
;
726 if (extends
.empty()) {
727 f_service_
<< "sub new {" << endl
;
731 f_service_
<< indent() << "my ($classname, $handler) = @_;" << endl
<< indent()
732 << "my $self = {};" << endl
;
734 f_service_
<< indent() << "$self->{handler} = $handler;" << endl
;
736 f_service_
<< indent() << "return bless ($self, $classname);" << endl
;
740 f_service_
<< "}" << endl
<< endl
;
743 // Generate the server implementation
744 f_service_
<< "sub process {" << endl
;
747 f_service_
<< indent() << "my ($self, $input, $output) = @_;" << endl
;
749 f_service_
<< indent() << "my $rseqid = 0;" << endl
<< indent() << "my $fname = undef;" << endl
750 << indent() << "my $mtype = 0;" << endl
<< endl
;
752 f_service_
<< indent() << "$input->readMessageBegin(\\$fname, \\$mtype, \\$rseqid);" << endl
;
754 // HOT: check for method implementation
755 f_service_
<< indent() << "my $methodname = 'process_'.$fname;" << endl
<< indent()
756 << "if (!$self->can($methodname)) {" << endl
;
759 f_service_
<< indent() << "$input->skip(Thrift::TType::STRUCT);" << endl
<< indent()
760 << "$input->readMessageEnd();" << endl
<< indent()
761 << "my $x = Thrift::TApplicationException->new('Function '.$fname.' not implemented.', "
762 "Thrift::TApplicationException::UNKNOWN_METHOD);" << endl
<< indent()
763 << "$output->writeMessageBegin($fname, Thrift::TMessageType::EXCEPTION, $rseqid);" << endl
764 << indent() << "$x->write($output);" << endl
<< indent()
765 << "$output->writeMessageEnd();" << endl
<< indent()
766 << "$output->getTransport()->flush();" << endl
<< indent() << "return;" << endl
;
769 f_service_
<< indent() << "}" << endl
<< indent()
770 << "$self->$methodname($rseqid, $input, $output);" << endl
<< indent() << "return 1;"
775 f_service_
<< "}" << endl
<< endl
;
777 // Generate the process subfunctions
778 for (f_iter
= functions
.begin(); f_iter
!= functions
.end(); ++f_iter
) {
779 generate_process_function(tservice
, *f_iter
);
784 * Generates a process function definition.
786 * @param tfunction The function to write a dispatcher for
788 void t_perl_generator::generate_process_function(t_service
* tservice
, t_function
* tfunction
) {
790 f_service_
<< "sub process_" << tfunction
->get_name() << " {" << endl
;
794 f_service_
<< indent() << "my ($self, $seqid, $input, $output) = @_;" << endl
;
796 string argsname
= perl_namespace(tservice
->get_program()) + service_name_
+ "_"
797 + tfunction
->get_name() + "_args";
798 string resultname
= perl_namespace(tservice
->get_program()) + service_name_
+ "_"
799 + tfunction
->get_name() + "_result";
801 f_service_
<< indent() << "my $args = " << argsname
<< "->new();" << endl
<< indent()
802 << "$args->read($input);" << endl
;
804 f_service_
<< indent() << "$input->readMessageEnd();" << endl
;
806 t_struct
* xs
= tfunction
->get_xceptions();
807 const std::vector
<t_field
*>& xceptions
= xs
->get_members();
808 vector
<t_field
*>::const_iterator x_iter
;
810 // Declare result for non oneway function
811 if (!tfunction
->is_oneway()) {
812 f_service_
<< indent() << "my $result = " << resultname
<< "->new();" << endl
;
815 // Try block for a function with exceptions
816 if (xceptions
.size() > 0) {
817 f_service_
<< indent() << "eval {" << endl
;
821 // Generate the function call
822 t_struct
* arg_struct
= tfunction
->get_arglist();
823 const std::vector
<t_field
*>& fields
= arg_struct
->get_members();
824 vector
<t_field
*>::const_iterator f_iter
;
826 f_service_
<< indent();
827 if (!tfunction
->is_oneway() && !tfunction
->get_returntype()->is_void()) {
828 f_service_
<< "$result->{success} = ";
830 f_service_
<< "$self->{handler}->" << tfunction
->get_name() << "(";
832 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
838 f_service_
<< "$args->" << (*f_iter
)->get_name();
840 f_service_
<< ");" << endl
;
842 if (!tfunction
->is_oneway() && xceptions
.size() > 0) {
844 for (x_iter
= xceptions
.begin(); x_iter
!= xceptions
.end(); ++x_iter
) {
845 f_service_
<< indent() << "}; if( UNIVERSAL::isa($@,'"
846 << perl_namespace((*x_iter
)->get_type()->get_program())
847 << (*x_iter
)->get_type()->get_name() << "') ){ " << endl
;
850 f_service_
<< indent() << "$result->{" << (*x_iter
)->get_name() << "} = $@;" << endl
;
851 f_service_
<< indent() << "$@ = undef;" << endl
;
853 f_service_
<< indent();
855 f_service_
<< "}" << endl
;
857 // catch-all for unexpected exceptions (THRIFT-3191)
858 f_service_
<< indent() << "if ($@) {" << endl
;
860 f_service_
<< indent() << "$@ =~ s/^\\s+|\\s+$//g;" << endl
861 << indent() << "my $err = Thrift::TApplicationException->new(\"Unexpected Exception: \" . $@, Thrift::TApplicationException::INTERNAL_ERROR);" << endl
862 << indent() << "$output->writeMessageBegin('" << tfunction
->get_name() << "', Thrift::TMessageType::EXCEPTION, $seqid);" << endl
863 << indent() << "$err->write($output);" << endl
864 << indent() << "$output->writeMessageEnd();" << endl
865 << indent() << "$output->getTransport()->flush();" << endl
866 << indent() << "$@ = undef;" << endl
867 << indent() << "return;" << endl
;
869 f_service_
<< indent() << "}" << endl
;
872 // Shortcut out here for oneway functions
873 if (tfunction
->is_oneway()) {
874 f_service_
<< indent() << "return;" << endl
;
876 f_service_
<< "}" << endl
;
880 // Serialize the reply
881 f_service_
<< indent() << "$output->writeMessageBegin('" << tfunction
->get_name() << "', Thrift::TMessageType::REPLY, $seqid);" << endl
882 << indent() << "$result->write($output);" << endl
883 << indent() << "$output->writeMessageEnd();" << endl
884 << indent() << "$output->getTransport()->flush();" << endl
;
888 f_service_
<< "}" << endl
<< endl
;
892 * Generates helper functions for a service.
894 * @param tservice The service to generate a header definition for
896 void t_perl_generator::generate_service_helpers(t_service
* tservice
) {
897 vector
<t_function
*> functions
= tservice
->get_functions();
898 vector
<t_function
*>::iterator f_iter
;
900 f_service_
<< "# HELPER FUNCTIONS AND STRUCTURES" << endl
<< endl
;
902 for (f_iter
= functions
.begin(); f_iter
!= functions
.end(); ++f_iter
) {
903 t_struct
* ts
= (*f_iter
)->get_arglist();
904 string name
= ts
->get_name();
905 ts
->set_name(service_name_
+ "_" + name
);
906 generate_perl_struct_definition(f_service_
, ts
, false);
907 generate_perl_function_helpers(*f_iter
);
913 * Generates a struct and helpers for a function.
915 * @param tfunction The function
917 void t_perl_generator::generate_perl_function_helpers(t_function
* tfunction
) {
918 t_struct
result(program_
, service_name_
+ "_" + tfunction
->get_name() + "_result");
919 t_field
success(tfunction
->get_returntype(), "success", 0);
920 if (!tfunction
->get_returntype()->is_void()) {
921 result
.append(&success
);
924 t_struct
* xs
= tfunction
->get_xceptions();
925 const vector
<t_field
*>& fields
= xs
->get_members();
926 vector
<t_field
*>::const_iterator f_iter
;
927 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
928 result
.append(*f_iter
);
931 generate_perl_struct_definition(f_service_
, &result
, false);
935 * Generates a service interface definition.
937 * @param tservice The service to generate a header definition for
939 void t_perl_generator::generate_service_interface(t_service
* tservice
) {
940 string extends_if
= "";
941 t_service
* extends_s
= tservice
->get_extends();
942 if (extends_s
!= NULL
) {
943 extends_if
= "use base qw(" + perl_namespace(extends_s
->get_program()) + extends_s
->get_name()
947 f_service_
<< "package " << perl_namespace(program_
) << service_name_
<< "If;" << endl
<< endl
948 << "use strict;" << endl
<< extends_if
<< endl
<< endl
;
951 vector
<t_function
*> functions
= tservice
->get_functions();
952 vector
<t_function
*>::iterator f_iter
;
953 for (f_iter
= functions
.begin(); f_iter
!= functions
.end(); ++f_iter
) {
954 f_service_
<< "sub " << function_signature(*f_iter
) << endl
<< " die 'implement interface';\n}"
961 * Generates a REST interface
963 void t_perl_generator::generate_service_rest(t_service
* tservice
) {
965 string extends_if
= "";
966 t_service
* extends_s
= tservice
->get_extends();
967 if (extends_s
!= NULL
) {
968 extends
= extends_s
->get_name();
969 extends_if
= "use base qw(" + perl_namespace(extends_s
->get_program()) + extends_s
->get_name()
972 f_service_
<< "package " << perl_namespace(program_
) << service_name_
<< "Rest;" << endl
<< endl
973 << "use strict;" << endl
<< extends_if
<< endl
<< endl
;
975 if (extends
.empty()) {
976 f_service_
<< "sub new {" << endl
;
980 f_service_
<< indent() << "my ($classname, $impl) = @_;" << endl
<< indent()
981 << "my $self ={ impl => $impl };" << endl
<< endl
<< indent()
982 << "return bless($self,$classname);" << endl
;
986 f_service_
<< "}" << endl
<< endl
;
989 vector
<t_function
*> functions
= tservice
->get_functions();
990 vector
<t_function
*>::iterator f_iter
;
991 for (f_iter
= functions
.begin(); f_iter
!= functions
.end(); ++f_iter
) {
992 f_service_
<< "sub " << (*f_iter
)->get_name() << "{" << endl
;
996 f_service_
<< indent() << "my ($self, $request) = @_;" << endl
<< endl
;
998 const vector
<t_field
*>& args
= (*f_iter
)->get_arglist()->get_members();
999 vector
<t_field
*>::const_iterator a_iter
;
1000 for (a_iter
= args
.begin(); a_iter
!= args
.end(); ++a_iter
) {
1001 t_type
* atype
= get_true_type((*a_iter
)->get_type());
1002 string req
= "$request->{'" + (*a_iter
)->get_name() + "'}";
1003 f_service_
<< indent() << "my $" << (*a_iter
)->get_name() << " = (" << req
<< ") ? " << req
1004 << " : undef;" << endl
;
1005 if (atype
->is_string() && ((t_base_type
*)atype
)->is_string_list()) {
1006 f_service_
<< indent() << "my @" << (*a_iter
)->get_name() << " = split(/,/, $"
1007 << (*a_iter
)->get_name() << ");" << endl
<< indent() << "$"
1008 << (*a_iter
)->get_name() << " = \\@" << (*a_iter
)->get_name() << endl
;
1011 f_service_
<< indent() << "return $self->{impl}->" << (*f_iter
)->get_name() << "("
1012 << argument_list((*f_iter
)->get_arglist()) << ");" << endl
;
1014 indent(f_service_
) << "}" << endl
<< endl
;
1019 * Generates a service client definition.
1021 * @param tservice The service to generate a server for.
1023 void t_perl_generator::generate_service_client(t_service
* tservice
) {
1024 string extends
= "";
1025 string extends_client
= "";
1026 t_service
* extends_s
= tservice
->get_extends();
1027 if (extends_s
!= NULL
) {
1028 extends
= perl_namespace(extends_s
->get_program()) + extends_s
->get_name();
1029 extends_client
= "use base qw(" + extends
+ "Client);";
1032 f_service_
<< "package " << perl_namespace(program_
) << service_name_
<< "Client;" << endl
<< endl
1033 << extends_client
<< endl
<< "use base qw(" << perl_namespace(program_
)
1034 << service_name_
<< "If);" << endl
;
1036 // Constructor function
1037 f_service_
<< "sub new {" << endl
;
1041 f_service_
<< indent() << "my ($classname, $input, $output) = @_;" << endl
<< indent()
1042 << "my $self = {};" << endl
;
1044 if (!extends
.empty()) {
1045 f_service_
<< indent() << "$self = $classname->SUPER::new($input, $output);" << endl
;
1047 f_service_
<< indent() << "$self->{input} = $input;" << endl
<< indent()
1048 << "$self->{output} = defined $output ? $output : $input;" << endl
<< indent()
1049 << "$self->{seqid} = 0;" << endl
;
1052 f_service_
<< indent() << "return bless($self,$classname);" << endl
;
1056 f_service_
<< "}" << endl
<< endl
;
1058 // Generate client method implementations
1059 vector
<t_function
*> functions
= tservice
->get_functions();
1060 vector
<t_function
*>::const_iterator f_iter
;
1061 for (f_iter
= functions
.begin(); f_iter
!= functions
.end(); ++f_iter
) {
1062 t_struct
* arg_struct
= (*f_iter
)->get_arglist();
1063 const vector
<t_field
*>& fields
= arg_struct
->get_members();
1064 vector
<t_field
*>::const_iterator fld_iter
;
1065 string funname
= (*f_iter
)->get_name();
1068 f_service_
<< "sub " << function_signature(*f_iter
) << endl
;
1072 indent(f_service_
) << indent() << "$self->send_" << funname
<< "(";
1075 for (fld_iter
= fields
.begin(); fld_iter
!= fields
.end(); ++fld_iter
) {
1081 f_service_
<< "$" << (*fld_iter
)->get_name();
1083 f_service_
<< ");" << endl
;
1085 if (!(*f_iter
)->is_oneway()) {
1086 f_service_
<< indent();
1087 if (!(*f_iter
)->get_returntype()->is_void()) {
1088 f_service_
<< "return ";
1090 f_service_
<< "$self->recv_" << funname
<< "();" << endl
;
1095 f_service_
<< "}" << endl
<< endl
;
1097 f_service_
<< "sub send_" << function_signature(*f_iter
) << endl
;
1101 std::string argsname
= perl_namespace(tservice
->get_program()) + service_name_
+ "_"
1102 + (*f_iter
)->get_name() + "_args";
1104 // Serialize the request header
1105 f_service_
<< indent() << "$self->{output}->writeMessageBegin('" << (*f_iter
)->get_name()
1106 << "', " << ((*f_iter
)->is_oneway() ? "Thrift::TMessageType::ONEWAY" : "Thrift::TMessageType::CALL")
1107 << ", $self->{seqid});" << endl
;
1109 f_service_
<< indent() << "my $args = " << argsname
<< "->new();" << endl
;
1111 for (fld_iter
= fields
.begin(); fld_iter
!= fields
.end(); ++fld_iter
) {
1112 f_service_
<< indent() << "$args->{" << (*fld_iter
)->get_name() << "} = $"
1113 << (*fld_iter
)->get_name() << ";" << endl
;
1116 // Write to the stream
1117 f_service_
<< indent() << "$args->write($self->{output});" << endl
<< indent()
1118 << "$self->{output}->writeMessageEnd();" << endl
<< indent()
1119 << "$self->{output}->getTransport()->flush();" << endl
;
1123 f_service_
<< "}" << endl
;
1125 if (!(*f_iter
)->is_oneway()) {
1126 std::string resultname
= perl_namespace(tservice
->get_program()) + service_name_
+ "_"
1127 + (*f_iter
)->get_name() + "_result";
1128 t_struct
noargs(program_
);
1130 t_function
recv_function((*f_iter
)->get_returntype(),
1131 string("recv_") + (*f_iter
)->get_name(),
1134 f_service_
<< endl
<< "sub " << function_signature(&recv_function
) << endl
;
1138 f_service_
<< indent() << "my $rseqid = 0;" << endl
<< indent() << "my $fname;" << endl
1139 << indent() << "my $mtype = 0;" << endl
<< endl
;
1141 f_service_
<< indent() << "$self->{input}->readMessageBegin(\\$fname, \\$mtype, \\$rseqid);"
1142 << endl
<< indent() << "if ($mtype == Thrift::TMessageType::EXCEPTION) {" << endl
1143 << indent() << " my $x = Thrift::TApplicationException->new();" << endl
<< indent()
1144 << " $x->read($self->{input});" << endl
<< indent()
1145 << " $self->{input}->readMessageEnd();" << endl
<< indent() << " die $x;" << endl
1146 << indent() << "}" << endl
;
1148 f_service_
<< indent() << "my $result = " << resultname
<< "->new();" << endl
<< indent()
1149 << "$result->read($self->{input});" << endl
;
1151 f_service_
<< indent() << "$self->{input}->readMessageEnd();" << endl
<< endl
;
1153 // Careful, only return result if not a void function
1154 if (!(*f_iter
)->get_returntype()->is_void()) {
1155 f_service_
<< indent() << "if (defined $result->{success} ) {" << endl
<< indent()
1156 << " return $result->{success};" << endl
<< indent() << "}" << endl
;
1159 t_struct
* xs
= (*f_iter
)->get_xceptions();
1160 const std::vector
<t_field
*>& xceptions
= xs
->get_members();
1161 vector
<t_field
*>::const_iterator x_iter
;
1162 for (x_iter
= xceptions
.begin(); x_iter
!= xceptions
.end(); ++x_iter
) {
1163 f_service_
<< indent() << "if (defined $result->{" << (*x_iter
)->get_name() << "}) {"
1164 << endl
<< indent() << " die $result->{" << (*x_iter
)->get_name() << "};"
1165 << endl
<< indent() << "}" << endl
;
1168 // Careful, only return _result if not a void function
1169 if ((*f_iter
)->get_returntype()->is_void()) {
1170 indent(f_service_
) << "return;" << endl
;
1172 f_service_
<< indent() << "die \"" << (*f_iter
)->get_name() << " failed: unknown result\";"
1178 f_service_
<< "}" << endl
;
1184 * Deserializes a field of any type.
1186 void t_perl_generator::generate_deserialize_field(ostream
& out
,
1191 t_type
* type
= get_true_type(tfield
->get_type());
1193 if (type
->is_void()) {
1194 throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE: " + prefix
+ tfield
->get_name();
1197 string name
= tfield
->get_name();
1199 // Hack for when prefix is defined (always a hash ref)
1200 if (!prefix
.empty()) {
1201 name
= prefix
+ "{" + tfield
->get_name() + "}";
1204 if (type
->is_struct() || type
->is_xception()) {
1205 generate_deserialize_struct(out
, (t_struct
*)type
, name
);
1206 } else if (type
->is_container()) {
1207 generate_deserialize_container(out
, type
, name
);
1208 } else if (type
->is_base_type() || type
->is_enum()) {
1209 indent(out
) << "$xfer += $input->";
1211 if (type
->is_base_type()) {
1212 t_base_type::t_base tbase
= ((t_base_type
*)type
)->get_base();
1214 case t_base_type::TYPE_VOID
:
1215 throw "compiler error: cannot serialize void field in a struct: " + name
;
1217 case t_base_type::TYPE_STRING
:
1218 out
<< "readString(\\$" << name
<< ");";
1220 case t_base_type::TYPE_BOOL
:
1221 out
<< "readBool(\\$" << name
<< ");";
1223 case t_base_type::TYPE_I8
:
1224 out
<< "readByte(\\$" << name
<< ");";
1226 case t_base_type::TYPE_I16
:
1227 out
<< "readI16(\\$" << name
<< ");";
1229 case t_base_type::TYPE_I32
:
1230 out
<< "readI32(\\$" << name
<< ");";
1232 case t_base_type::TYPE_I64
:
1233 out
<< "readI64(\\$" << name
<< ");";
1235 case t_base_type::TYPE_DOUBLE
:
1236 out
<< "readDouble(\\$" << name
<< ");";
1239 throw "compiler error: no PERL name for base type " + t_base_type::t_base_name(tbase
);
1241 } else if (type
->is_enum()) {
1242 out
<< "readI32(\\$" << name
<< ");";
1247 printf("DO NOT KNOW HOW TO DESERIALIZE FIELD '%s' TYPE '%s'\n",
1248 tfield
->get_name().c_str(),
1249 type
->get_name().c_str());
1254 * Generates an unserializer for a variable. This makes two key assumptions,
1255 * first that there is a const char* variable named data that points to the
1256 * buffer for deserialization, and that there is a variable protocol which
1257 * is a reference to a TProtocol serialization object.
1259 void t_perl_generator::generate_deserialize_struct(ostream
& out
,
1262 out
<< indent() << "$" << prefix
<< " = " << perl_namespace(tstruct
->get_program())
1263 << tstruct
->get_name() << "->new();" << endl
<< indent() << "$xfer += $" << prefix
1264 << "->read($input);" << endl
;
1267 void t_perl_generator::generate_deserialize_container(ostream
& out
, t_type
* ttype
, string prefix
) {
1270 string size
= tmp("_size");
1271 string ktype
= tmp("_ktype");
1272 string vtype
= tmp("_vtype");
1273 string etype
= tmp("_etype");
1275 t_field
fsize(g_type_i32
, size
);
1276 t_field
fktype(g_type_i8
, ktype
);
1277 t_field
fvtype(g_type_i8
, vtype
);
1278 t_field
fetype(g_type_i8
, etype
);
1280 out
<< indent() << "my $" << size
<< " = 0;" << endl
;
1282 // Declare variables, read header
1283 if (ttype
->is_map()) {
1284 out
<< indent() << "$" << prefix
<< " = {};" << endl
<< indent() << "my $" << ktype
<< " = 0;"
1285 << endl
<< indent() << "my $" << vtype
<< " = 0;" << endl
;
1287 out
<< indent() << "$xfer += $input->readMapBegin("
1288 << "\\$" << ktype
<< ", \\$" << vtype
<< ", \\$" << size
<< ");" << endl
;
1290 } else if (ttype
->is_set()) {
1292 out
<< indent() << "$" << prefix
<< " = {};" << endl
<< indent() << "my $" << etype
<< " = 0;"
1293 << endl
<< indent() << "$xfer += $input->readSetBegin("
1294 << "\\$" << etype
<< ", \\$" << size
<< ");" << endl
;
1296 } else if (ttype
->is_list()) {
1298 out
<< indent() << "$" << prefix
<< " = [];" << endl
<< indent() << "my $" << etype
<< " = 0;"
1299 << endl
<< indent() << "$xfer += $input->readListBegin("
1300 << "\\$" << etype
<< ", \\$" << size
<< ");" << endl
;
1303 // For loop iterates over elements
1304 string i
= tmp("_i");
1305 indent(out
) << "for (my $" << i
<< " = 0; $" << i
<< " < $" << size
<< "; ++$" << i
<< ")"
1310 if (ttype
->is_map()) {
1311 generate_deserialize_map_element(out
, (t_map
*)ttype
, prefix
);
1312 } else if (ttype
->is_set()) {
1313 generate_deserialize_set_element(out
, (t_set
*)ttype
, prefix
);
1314 } else if (ttype
->is_list()) {
1315 generate_deserialize_list_element(out
, (t_list
*)ttype
, prefix
);
1320 // Read container end
1321 if (ttype
->is_map()) {
1322 indent(out
) << "$xfer += $input->readMapEnd();" << endl
;
1323 } else if (ttype
->is_set()) {
1324 indent(out
) << "$xfer += $input->readSetEnd();" << endl
;
1325 } else if (ttype
->is_list()) {
1326 indent(out
) << "$xfer += $input->readListEnd();" << endl
;
1333 * Generates code to deserialize a map
1335 void t_perl_generator::generate_deserialize_map_element(ostream
& out
, t_map
* tmap
, string prefix
) {
1336 string key
= tmp("key");
1337 string val
= tmp("val");
1338 t_field
fkey(tmap
->get_key_type(), key
);
1339 t_field
fval(tmap
->get_val_type(), val
);
1341 indent(out
) << declare_field(&fkey
, true, true) << endl
;
1342 indent(out
) << declare_field(&fval
, true, true) << endl
;
1344 generate_deserialize_field(out
, &fkey
);
1345 generate_deserialize_field(out
, &fval
);
1347 indent(out
) << "$" << prefix
<< "->{$" << key
<< "} = $" << val
<< ";" << endl
;
1350 void t_perl_generator::generate_deserialize_set_element(ostream
& out
, t_set
* tset
, string prefix
) {
1351 string elem
= tmp("elem");
1352 t_field
felem(tset
->get_elem_type(), elem
);
1354 indent(out
) << "my $" << elem
<< " = undef;" << endl
;
1356 generate_deserialize_field(out
, &felem
);
1358 indent(out
) << "$" << prefix
<< "->{$" << elem
<< "} = 1;" << endl
;
1361 void t_perl_generator::generate_deserialize_list_element(ostream
& out
,
1364 string elem
= tmp("elem");
1365 t_field
felem(tlist
->get_elem_type(), elem
);
1367 indent(out
) << "my $" << elem
<< " = undef;" << endl
;
1369 generate_deserialize_field(out
, &felem
);
1371 indent(out
) << "push(@{$" << prefix
<< "},$" << elem
<< ");" << endl
;
1375 * Serializes a field of any type.
1377 * @param tfield The field to serialize
1378 * @param prefix Name to prepend to field name
1380 void t_perl_generator::generate_serialize_field(ostream
& out
, t_field
* tfield
, string prefix
) {
1381 t_type
* type
= get_true_type(tfield
->get_type());
1383 // Do nothing for void types
1384 if (type
->is_void()) {
1385 throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " + prefix
+ tfield
->get_name();
1388 if (type
->is_struct() || type
->is_xception()) {
1389 generate_serialize_struct(out
, (t_struct
*)type
, prefix
+ "{" + tfield
->get_name() + "}");
1390 } else if (type
->is_container()) {
1391 generate_serialize_container(out
, type
, prefix
+ "{" + tfield
->get_name() + "}");
1392 } else if (type
->is_base_type() || type
->is_enum()) {
1394 string name
= tfield
->get_name();
1396 // Hack for when prefix is defined (always a hash ref)
1397 if (!prefix
.empty())
1398 name
= prefix
+ "{" + tfield
->get_name() + "}";
1400 indent(out
) << "$xfer += $output->";
1402 if (type
->is_base_type()) {
1403 t_base_type::t_base tbase
= ((t_base_type
*)type
)->get_base();
1405 case t_base_type::TYPE_VOID
:
1406 throw "compiler error: cannot serialize void field in a struct: " + name
;
1408 case t_base_type::TYPE_STRING
:
1409 out
<< "writeString($" << name
<< ");";
1411 case t_base_type::TYPE_BOOL
:
1412 out
<< "writeBool($" << name
<< ");";
1414 case t_base_type::TYPE_I8
:
1415 out
<< "writeByte($" << name
<< ");";
1417 case t_base_type::TYPE_I16
:
1418 out
<< "writeI16($" << name
<< ");";
1420 case t_base_type::TYPE_I32
:
1421 out
<< "writeI32($" << name
<< ");";
1423 case t_base_type::TYPE_I64
:
1424 out
<< "writeI64($" << name
<< ");";
1426 case t_base_type::TYPE_DOUBLE
:
1427 out
<< "writeDouble($" << name
<< ");";
1430 throw "compiler error: no PERL name for base type " + t_base_type::t_base_name(tbase
);
1432 } else if (type
->is_enum()) {
1433 out
<< "writeI32($" << name
<< ");";
1438 printf("DO NOT KNOW HOW TO SERIALIZE FIELD '%s%s' TYPE '%s'\n",
1440 tfield
->get_name().c_str(),
1441 type
->get_name().c_str());
1446 * Serializes all the members of a struct.
1448 * @param tstruct The struct to serialize
1449 * @param prefix String prefix to attach to all fields
1451 void t_perl_generator::generate_serialize_struct(ostream
& out
, t_struct
* tstruct
, string prefix
) {
1453 indent(out
) << "$xfer += $" << prefix
<< "->write($output);" << endl
;
1457 * Writes out a container
1459 void t_perl_generator::generate_serialize_container(ostream
& out
, t_type
* ttype
, string prefix
) {
1462 if (ttype
->is_map()) {
1463 indent(out
) << "$xfer += $output->writeMapBegin("
1464 << type_to_enum(((t_map
*)ttype
)->get_key_type()) << ", "
1465 << type_to_enum(((t_map
*)ttype
)->get_val_type()) << ", "
1466 << "scalar(keys %{$" << prefix
<< "}));" << endl
;
1467 } else if (ttype
->is_set()) {
1468 indent(out
) << "$xfer += $output->writeSetBegin("
1469 << type_to_enum(((t_set
*)ttype
)->get_elem_type()) << ", "
1470 << "scalar(@{$" << prefix
<< "}));" << endl
;
1472 } else if (ttype
->is_list()) {
1474 indent(out
) << "$xfer += $output->writeListBegin("
1475 << type_to_enum(((t_list
*)ttype
)->get_elem_type()) << ", "
1476 << "scalar(@{$" << prefix
<< "}));" << endl
;
1481 if (ttype
->is_map()) {
1482 string kiter
= tmp("kiter");
1483 string viter
= tmp("viter");
1484 indent(out
) << "while( my ($" << kiter
<< ",$" << viter
<< ") = each %{$" << prefix
<< "}) "
1488 generate_serialize_map_element(out
, (t_map
*)ttype
, kiter
, viter
);
1491 } else if (ttype
->is_set()) {
1492 string iter
= tmp("iter");
1493 indent(out
) << "foreach my $" << iter
<< " (@{$" << prefix
<< "})" << endl
;
1495 generate_serialize_set_element(out
, (t_set
*)ttype
, iter
);
1498 } else if (ttype
->is_list()) {
1499 string iter
= tmp("iter");
1500 indent(out
) << "foreach my $" << iter
<< " (@{$" << prefix
<< "}) " << endl
;
1502 generate_serialize_list_element(out
, (t_list
*)ttype
, iter
);
1508 if (ttype
->is_map()) {
1509 indent(out
) << "$xfer += $output->writeMapEnd();" << endl
;
1510 } else if (ttype
->is_set()) {
1511 indent(out
) << "$xfer += $output->writeSetEnd();" << endl
;
1512 } else if (ttype
->is_list()) {
1513 indent(out
) << "$xfer += $output->writeListEnd();" << endl
;
1520 * Serializes the members of a map.
1523 void t_perl_generator::generate_serialize_map_element(ostream
& out
,
1527 t_field
kfield(tmap
->get_key_type(), kiter
);
1528 generate_serialize_field(out
, &kfield
);
1530 t_field
vfield(tmap
->get_val_type(), viter
);
1531 generate_serialize_field(out
, &vfield
);
1535 * Serializes the members of a set.
1537 void t_perl_generator::generate_serialize_set_element(ostream
& out
, t_set
* tset
, string iter
) {
1538 t_field
efield(tset
->get_elem_type(), iter
);
1539 generate_serialize_field(out
, &efield
);
1543 * Serializes the members of a list.
1545 void t_perl_generator::generate_serialize_list_element(ostream
& out
, t_list
* tlist
, string iter
) {
1546 t_field
efield(tlist
->get_elem_type(), iter
);
1547 generate_serialize_field(out
, &efield
);
1551 * Declares a field, which may include initialization as necessary.
1553 * @param ttype The type
1555 string
t_perl_generator::declare_field(t_field
* tfield
, bool init
, bool obj
) {
1556 string result
= "my $" + tfield
->get_name();
1558 t_type
* type
= get_true_type(tfield
->get_type());
1559 if (type
->is_base_type()) {
1560 t_base_type::t_base tbase
= ((t_base_type
*)type
)->get_base();
1562 case t_base_type::TYPE_VOID
:
1564 case t_base_type::TYPE_STRING
:
1567 case t_base_type::TYPE_BOOL
:
1570 case t_base_type::TYPE_I8
:
1571 case t_base_type::TYPE_I16
:
1572 case t_base_type::TYPE_I32
:
1573 case t_base_type::TYPE_I64
:
1576 case t_base_type::TYPE_DOUBLE
:
1580 throw "compiler error: no PERL initializer for base type "
1581 + t_base_type::t_base_name(tbase
);
1583 } else if (type
->is_enum()) {
1585 } else if (type
->is_container()) {
1587 } else if (type
->is_struct() || type
->is_xception()) {
1589 result
+= " = " + perl_namespace(type
->get_program()) + type
->get_name() + "->new()";
1591 result
+= " = undef";
1595 return result
+ ";";
1599 * Renders a function signature of the form 'type name(args)'
1601 * @param tfunction Function definition
1602 * @return String of rendered function definition
1604 string
t_perl_generator::function_signature(t_function
* tfunction
, string prefix
) {
1608 str
= prefix
+ tfunction
->get_name() + "{\n";
1609 str
+= " my $self = shift;\n";
1611 // Need to create perl function arg inputs
1612 const vector
<t_field
*>& fields
= tfunction
->get_arglist()->get_members();
1613 vector
<t_field
*>::const_iterator f_iter
;
1615 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
1616 str
+= " my $" + (*f_iter
)->get_name() + " = shift;\n";
1623 * Renders a field list
1625 string
t_perl_generator::argument_list(t_struct
* tstruct
) {
1628 const vector
<t_field
*>& fields
= tstruct
->get_members();
1629 vector
<t_field
*>::const_iterator f_iter
;
1631 for (f_iter
= fields
.begin(); f_iter
!= fields
.end(); ++f_iter
) {
1637 result
+= "$" + (*f_iter
)->get_name();
1643 * Converts the parse type to a C++ enum string for the given type.
1645 string
t_perl_generator::type_to_enum(t_type
* type
) {
1646 type
= get_true_type(type
);
1648 if (type
->is_base_type()) {
1649 t_base_type::t_base tbase
= ((t_base_type
*)type
)->get_base();
1651 case t_base_type::TYPE_VOID
:
1652 throw "NO T_VOID CONSTRUCT";
1653 case t_base_type::TYPE_STRING
:
1654 return "Thrift::TType::STRING";
1655 case t_base_type::TYPE_BOOL
:
1656 return "Thrift::TType::BOOL";
1657 case t_base_type::TYPE_I8
:
1658 return "Thrift::TType::BYTE";
1659 case t_base_type::TYPE_I16
:
1660 return "Thrift::TType::I16";
1661 case t_base_type::TYPE_I32
:
1662 return "Thrift::TType::I32";
1663 case t_base_type::TYPE_I64
:
1664 return "Thrift::TType::I64";
1665 case t_base_type::TYPE_DOUBLE
:
1666 return "Thrift::TType::DOUBLE";
1668 } else if (type
->is_enum()) {
1669 return "Thrift::TType::I32";
1670 } else if (type
->is_struct() || type
->is_xception()) {
1671 return "Thrift::TType::STRUCT";
1672 } else if (type
->is_map()) {
1673 return "Thrift::TType::MAP";
1674 } else if (type
->is_set()) {
1675 return "Thrift::TType::SET";
1676 } else if (type
->is_list()) {
1677 return "Thrift::TType::LIST";
1680 throw "INVALID TYPE IN type_to_enum: " + type
->get_name();
1683 THRIFT_REGISTER_GENERATOR(perl
, "Perl", "")