1package Google::ProtocolBuffers::CodeGen; 2use strict; 3use warnings; 4 5use Google::ProtocolBuffers::Constants qw/:types :labels :complex_types/; 6 7my %primitive_types = reverse ( 8 TYPE_DOUBLE => TYPE_DOUBLE, 9 TYPE_FLOAT => TYPE_FLOAT, 10 TYPE_INT64 => TYPE_INT64, 11 TYPE_UINT64 => TYPE_UINT64, 12 TYPE_INT32 => TYPE_INT32, 13 TYPE_FIXED64=> TYPE_FIXED64, 14 TYPE_FIXED32=> TYPE_FIXED32, 15 TYPE_BOOL => TYPE_BOOL, 16 TYPE_STRING => TYPE_STRING, 17 TYPE_GROUP => TYPE_GROUP, ## 18 TYPE_MESSAGE=> TYPE_MESSAGE, ## should never appear, because 'message' is a 'complex type' 19 TYPE_BYTES => TYPE_BYTES, 20 TYPE_UINT32 => TYPE_UINT32, 21 TYPE_ENUM => TYPE_ENUM, ## 22 TYPE_SFIXED32=>TYPE_SFIXED32, 23 TYPE_SFIXED64=>TYPE_SFIXED64, 24 TYPE_SINT32 => TYPE_SINT32, 25 TYPE_SINT64 => TYPE_SINT64, 26); 27 28my %labels = reverse ( 29 LABEL_OPTIONAL => LABEL_OPTIONAL, 30 LABEL_REQUIRED => LABEL_REQUIRED, 31 LABEL_REPEATED => LABEL_REPEATED, 32); 33 34sub _get_perl_literal { 35 my $v = shift; 36 my $opts = shift; 37 38 if ($v =~ /^-?\d+$/) { 39 ## integer literal 40 if ($v>0x7fff_ffff || $v<-0x8000_0000) { 41 return "Math::BigInt->new('$v')"; 42 } else { 43 return "$v"; 44 } 45 } elsif ($v =~ /[-+]?\d*\.\d+([Ee][\+-]?\d+)?|[-+]?\d+[Ee][\+-]?\d+/i) { 46 ## floating point literal 47 return "$v"; 48 } else { 49 ## string literal 50 $v =~ s/([\x00-\x1f'"\\$@%\x80-\xff])/ '\\x{' . sprintf("%02x", ord($1)) . '}' /ge; 51 return qq["$v"]; 52 } 53} 54 55sub generate_code_of_enum { 56 my $self = shift; 57 my $opts = shift; 58 59 my $class_name = ref($self) || $self; 60 my $fields_text; 61 foreach my $f (@{ $self->_pb_fields_list }) { 62 my ($name, $value) = @$f; 63 $value = _get_perl_literal($value, $opts); 64 $fields_text .= " ['$name', $value],\n"; 65 } 66 67 return <<"CODE"; 68 unless ($class_name->can('_pb_fields_list')) { 69 Google::ProtocolBuffers->create_enum( 70 '$class_name', 71 [ 72$fields_text 73 ] 74 ); 75 } 76 77CODE 78} 79 80 81sub generate_code_of_message_or_group { 82 my $self = shift; 83 my $opts = shift; 84 85 my $create_what = 86 ($self->_pb_complex_type_kind==MESSAGE) ? 'create_message' : 87 ($self->_pb_complex_type_kind==GROUP) ? 'create_group' : die; 88 89 my $class_name = ref($self) || $self; 90 91 my $fields_text = ''; # may be empty, as empty messages are allowed 92 foreach my $f (@{ $self->_pb_fields_list }) { 93 my ($label, $type, $name, $field_number, $default_value) = @$f; 94 95 die unless $labels{$label}; 96 $label = "Google::ProtocolBuffers::Constants::$labels{$label}()"; 97 98 if ($primitive_types{$type}) { 99 $type = "Google::ProtocolBuffers::Constants::$primitive_types{$type}()"; 100 } else { 101 $type = "'$type'"; 102 } 103 104 $default_value = (defined $default_value) ? 105 _get_perl_literal($default_value, $opts) : 'undef'; 106 $fields_text .= <<"FIELD"; 107 [ 108 $label, 109 $type, 110 '$name', $field_number, $default_value 111 ], 112FIELD 113 } 114 115 my $oneofs_text = " undef,\n"; 116 if ($self->can('_pb_oneofs')) { 117 $oneofs_text = " {\n"; 118 while (my ($name, $fields) = each %{$self->_pb_oneofs}) { 119 $oneofs_text .= " '$name' => [\n"; 120 foreach my $f (@$fields) { 121 $oneofs_text .= " '$f',\n"; 122 } 123 $oneofs_text .= " ],\n"; 124 } 125 $oneofs_text .= " },\n"; 126 } 127 128 my $options = ''; 129 foreach my $opt_name (qw/create_accessors follow_best_practice/) { 130 if ($opts->{$opt_name}) { 131 $options .= "'$opt_name' => 1, " 132 } 133 } 134 135 return <<"CODE"; 136 unless ($class_name->can('_pb_fields_list')) { 137 Google::ProtocolBuffers->$create_what( 138 '$class_name', 139 [ 140$fields_text 141 ], 142$oneofs_text 143 { $options } 144 ); 145 } 146 147CODE 148 149} 150 1511; 152