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