package Google::ProtocolBuffers::CodeGen; use strict; use warnings; use Google::ProtocolBuffers::Constants qw/:types :labels :complex_types/; my %primitive_types = reverse ( TYPE_DOUBLE => TYPE_DOUBLE, TYPE_FLOAT => TYPE_FLOAT, TYPE_INT64 => TYPE_INT64, TYPE_UINT64 => TYPE_UINT64, TYPE_INT32 => TYPE_INT32, TYPE_FIXED64=> TYPE_FIXED64, TYPE_FIXED32=> TYPE_FIXED32, TYPE_BOOL => TYPE_BOOL, TYPE_STRING => TYPE_STRING, TYPE_GROUP => TYPE_GROUP, ## TYPE_MESSAGE=> TYPE_MESSAGE, ## should never appear, because 'message' is a 'complex type' TYPE_BYTES => TYPE_BYTES, TYPE_UINT32 => TYPE_UINT32, TYPE_ENUM => TYPE_ENUM, ## TYPE_SFIXED32=>TYPE_SFIXED32, TYPE_SFIXED64=>TYPE_SFIXED64, TYPE_SINT32 => TYPE_SINT32, TYPE_SINT64 => TYPE_SINT64, ); my %labels = reverse ( LABEL_OPTIONAL => LABEL_OPTIONAL, LABEL_REQUIRED => LABEL_REQUIRED, LABEL_REPEATED => LABEL_REPEATED, ); sub _get_perl_literal { my $v = shift; my $opts = shift; if ($v =~ /^-?\d+$/) { ## integer literal if ($v>0x7fff_ffff || $v<-0x8000_0000) { return "Math::BigInt->new('$v')"; } else { return "$v"; } } elsif ($v =~ /[-+]?\d*\.\d+([Ee][\+-]?\d+)?|[-+]?\d+[Ee][\+-]?\d+/i) { ## floating point literal return "$v"; } else { ## string literal $v =~ s/([\x00-\x1f'"\\$@%\x80-\xff])/ '\\x{' . sprintf("%02x", ord($1)) . '}' /ge; return qq["$v"]; } } sub generate_code_of_enum { my $self = shift; my $opts = shift; my $class_name = ref($self) || $self; my $fields_text; foreach my $f (@{ $self->_pb_fields_list }) { my ($name, $value) = @$f; $value = _get_perl_literal($value, $opts); $fields_text .= " ['$name', $value],\n"; } return <<"CODE"; unless ($class_name->can('_pb_fields_list')) { Google::ProtocolBuffers->create_enum( '$class_name', [ $fields_text ] ); } CODE } sub generate_code_of_message_or_group { my $self = shift; my $opts = shift; my $create_what = ($self->_pb_complex_type_kind==MESSAGE) ? 'create_message' : ($self->_pb_complex_type_kind==GROUP) ? 'create_group' : die; my $class_name = ref($self) || $self; my $fields_text = ''; # may be empty, as empty messages are allowed foreach my $f (@{ $self->_pb_fields_list }) { my ($label, $type, $name, $field_number, $default_value) = @$f; die unless $labels{$label}; $label = "Google::ProtocolBuffers::Constants::$labels{$label}()"; if ($primitive_types{$type}) { $type = "Google::ProtocolBuffers::Constants::$primitive_types{$type}()"; } else { $type = "'$type'"; } $default_value = (defined $default_value) ? _get_perl_literal($default_value, $opts) : 'undef'; $fields_text .= <<"FIELD"; [ $label, $type, '$name', $field_number, $default_value ], FIELD } my $oneofs_text = " undef,\n"; if ($self->can('_pb_oneofs')) { $oneofs_text = " {\n"; while (my ($name, $fields) = each %{$self->_pb_oneofs}) { $oneofs_text .= " '$name' => [\n"; foreach my $f (@$fields) { $oneofs_text .= " '$f',\n"; } $oneofs_text .= " ],\n"; } $oneofs_text .= " },\n"; } my $options = ''; foreach my $opt_name (qw/create_accessors follow_best_practice/) { if ($opts->{$opt_name}) { $options .= "'$opt_name' => 1, " } } return <<"CODE"; unless ($class_name->can('_pb_fields_list')) { Google::ProtocolBuffers->$create_what( '$class_name', [ $fields_text ], $oneofs_text { $options } ); } CODE } 1;