1package Google::ProtocolBuffers; 2 3use 5.008008; 4use warnings; 5use strict; 6 7use Google::ProtocolBuffers::Codec; 8use Google::ProtocolBuffers::Constants qw/:complex_types :labels/; 9use Class::Accessor; 10use Math::BigInt; 11use Carp; 12use Data::Dumper; 13 14our $VERSION = "0.12"; 15 16sub parsefile { 17 my $self = shift; 18 my $proto_filename = shift; 19 my $opts = shift || {}; 20 21 return $self->_parse({file=>$proto_filename}, $opts); 22} 23 24sub parse { 25 my $self = shift; 26 my $proto_text = shift; 27 my $opts = shift || {}; 28 29 return $self->_parse({text=>$proto_text}, $opts); 30} 31 32## Positional access is slightly faster than named one. 33## Currently, it's in the same order as text in proto file 34## "optional" (LABEL) int32 (type) foo (name) = 1 (number) [default=...] 35use constant { 36 F_LABEL => 0, 37 F_TYPE => 1, 38 F_NAME => 2, 39 F_NUMBER => 3, 40 F_DEFAULT => 4, 41}; 42 43sub _parse { 44 my $self = shift; 45 my $source = shift; 46 my $opts = shift; 47 48 require 'Google/ProtocolBuffers/Compiler.pm'; 49 my $types = Google::ProtocolBuffers::Compiler->parse($source, $opts); 50 51 ## 52 ## 1. Create enums - they will be used as default values for fields 53 ## 54 my @created_enums; 55 while (my ($type_name, $desc) = each %$types) { 56 next unless $desc->{kind} eq 'enum'; 57 my $class_name = $self->_get_class_name_for($type_name, $opts); 58 $self->create_enum($class_name, $desc->{fields}); 59 push @created_enums, $class_name; 60 } 61 62 ## 63 ## 2. Create groups and messages, 64 ## Fill default values of fields and convert their 65 ## types (my_package.message_a) into Perl classes names (MyPackage::MessageA) 66 ## 67 my @created_messages; 68 while (my ($type_name, $desc) = each %$types) { 69 my $kind = $desc->{kind}; 70 my @fields; 71 my %oneofs; 72 73 if ($kind =~ /^(enum|oneof)$/) { 74 next; 75 } elsif ($kind eq 'group') { 76 push @fields, @{$desc->{fields}}; 77 } elsif ($kind eq 'message') { 78 push @fields, @{$desc->{fields}}; 79 80 ## 81 ## Get names for extensions fields. 82 ## Original (full quilified) name is like 'package.MessageA.field'. 83 ## If 'simple_extensions' is true, it will be cut to the last element: 'field'. 84 ## Otherwise, it will be enclosed in brackets and all part common to message type 85 ## will be removed, e.g. for message 'package.MessageB' it will be '[MessageA.field]' 86 ## If message is 'other_package.MessageB', it will be '[package.MessageA.field]' 87 ## 88 foreach my $e (@{$desc->{extensions}}) { 89 my $field_name = $e->[F_NAME]; 90 my $new_name; 91 if ($opts->{simple_extensions}) { 92 $new_name = ($field_name =~ /\.(\w+)$/) ? $1 : $field_name; 93 } else { 94 ## remove common identifiers from start of f.q.i. 95 my @type_idents = split qr/\./, $type_name; 96 my @field_idents = split qr/\./, $field_name; 97 while (@type_idents && @field_idents) { 98 last if $type_idents[0] ne $field_idents[0]; 99 shift @type_idents; 100 shift @field_idents; 101 } 102 die "Can't create name for extension field '$field_name' in '$type_name'" 103 unless @field_idents; 104 $new_name = '[' . join('.', @field_idents) . ']'; 105 } 106 $e->[F_NAME] = $new_name; 107 push @fields, $e; 108 } 109 110 ## 111 ## Get names for oneof fields. 112 ## 113 foreach my $oneof_name (@{$desc->{oneofs}}) { 114 my $oneof = $types->{$oneof_name}; 115 my @oneof_fields = map { $_->[F_NAME] } @{$oneof->{fields}}; 116 my $new_name = ($oneof_name =~ /\.(\w+)$/) ? $1 : $oneof_name; 117 $oneofs{$new_name} = \@oneof_fields; 118 push @fields, @{$oneof->{fields}}; 119 } 120 } else { 121 die; 122 } 123 124 ## 125 ## Replace proto type names by Perl classes names 126 ## 127 foreach my $f (@fields) { 128 my $type = $f->[F_TYPE]; 129 if ($type !~ /^\d+$/) { 130 ## not a primitive type 131 $f->[F_TYPE] = $self->_get_class_name_for($type, $opts); 132 } 133 } 134 135 ## 136 ## Default values: replace references to enum idents by their values 137 ## 138 foreach my $f (@fields) { 139 my $default_value = $f->[F_DEFAULT]; 140 if ($default_value && ref $default_value) { 141 ## this default value is a literal 142 die "Unknown default value " . Data::Dumper::Dumper($default_value) 143 unless ref($default_value) eq 'HASH'; 144 $f->[F_DEFAULT] = $default_value->{value}; 145 } elsif ($default_value) { 146 ## this default is an enum value 147 my ($enum_name, $enum_field_name) = ($default_value =~ /(.*)\.(\w+)$/); 148 my $class_name = $self->_get_class_name_for($enum_name, $opts); 149 no strict 'refs'; 150 $f->[F_DEFAULT] = &{"${class_name}::$enum_field_name"}; 151 use strict; 152 } 153 } 154 155 ## 156 ## Create Perl classes 157 ## 158 my $class_name = $self->_get_class_name_for($type_name, $opts); 159 if ($kind eq 'message') { 160 $self->create_message($class_name, \@fields, \%oneofs, $opts); 161 } elsif ($kind eq 'group') { 162 $self->create_group($class_name, \@fields, $opts); 163 } 164 push @created_messages, $class_name; 165 } 166 167 my @created_classes = sort @created_enums; 168 push @created_classes, sort @created_messages; 169 170 ## Generate Perl code of created classes 171 if ($opts->{generate_code}) { 172 require 'Google/ProtocolBuffers/CodeGen.pm'; 173 my $fh; 174 if (!ref($opts->{generate_code})) { 175 open($fh, ">$opts->{generate_code}") 176 or die "Can't write to '$opts->{generate_code}': $!"; 177 } else { 178 $fh = $opts->{generate_code}; 179 } 180 181 my $package_str = ($opts->{'package_name'}) ? 182 "package $opts->{'package_name'};" : ""; 183 184 my $source_str = ($source->{'file'}) ? 185 "$source->{'file'}" : "inline text"; 186 187 print $fh <<"HEADER"; 188# Generated by the protocol buffer compiler (protoc-perl) DO NOT EDIT! 189# source: $source_str 190 191$package_str 192 193use strict; 194use warnings; 195 196use Google::ProtocolBuffers; 197{ 198HEADER 199 foreach my $class_name (@created_classes) { 200 print $fh $class_name->getPerlCode($opts); 201 } 202 print $fh "}\n1;\n"; 203 } 204 return @created_classes; 205} 206 207# Google::ProtocolBuffers->create_message( 208# 'AccountRecord', 209# [ 210# ## required string name = 1; 211# [LABEL_REQUIRED, TYPE_STRING, 'name', 1 ], 212# [LABEL_OPTIONAL, TYPE_INT32, 'id', 2 ], 213# ], 214# ); 215sub create_message { 216 my $self = shift; 217 my $class_name = shift; 218 my $fields = shift; 219 my $oneofs = shift; 220 my $opts = shift; 221 222 return $self->_create_message_or_group( 223 $class_name, $fields, $oneofs, $opts, 224 'Google::ProtocolBuffers::Message' 225 ); 226} 227 228sub create_group { 229 my $self = shift; 230 my $class_name = shift; 231 my $fields = shift; 232 my $opts = shift; 233 234 return $self->_create_message_or_group( 235 $class_name, $fields, undef, $opts, 236 'Google::ProtocolBuffers::Group' 237 ); 238} 239 240sub _create_message_or_group { 241 my $self = shift; 242 my $class_name = shift; 243 my $fields = shift; 244 my $oneofs = shift; 245 my $opts = shift; 246 my $base_class = shift; 247 248 ## 249 ## Sanity checks 250 ## 1. Class name must be a valid Perl class name 251 ## (should we check that this class doesn't exist yet?) 252 ## 253 die "Invalid class name: '$class_name'" 254 unless $class_name =~ /^[a-z_]\w*(?:::[a-z_]\w*)*$/i; 255 256 ## 257 ## 258 my (%field_names, %field_numbers); 259 foreach my $f (@$fields) { 260 my ($label, $type_name, $name, $field_number, $default_value) = @$f; 261 die Dumper $f unless $name; 262 263 ## 264 ## field names must be valid identifiers and be unique 265 ## 266 die "Invalid field name: '$name'" 267 unless $name && $name =~ /^\[?[a-z_][\w\.]*\]?$/i; 268 if ($field_names{$name}++) { 269 die "Field '$name' is defined more than once"; 270 } 271 272 ## 273 ## field number must be positive and unique 274 ## 275 die "Invalid field number: $field_number" unless $field_number>0; 276 if ($field_numbers{$field_number}++) { 277 die "Field number $field_number is used more than once"; 278 } 279 280 ## type is either a number (for primitive types) 281 ## or a class name. Can't check that complex $type 282 ## is valid, because it may not exist yet. 283 die "Field '$name' doesn't has a type" unless $type_name; 284 if ($type_name =~/^\d+$/) { 285 ## ok, this is an ID of primitive type 286 } else { 287 die "Type '$type_name' is not valid Perl class name" 288 unless $type_name =~ /^[a-z_]\w*(?:::[a-z_]\w*)*$/i; 289 } 290 291 die "Unknown label value: $label" 292 unless $label==LABEL_OPTIONAL || $label==LABEL_REQUIRED || $label==LABEL_REPEATED; 293 } 294 295 296 ## Make a copy of values and sort them so that field_numbers increase, 297 ## this is a requirement of protocol 298 ## Postitional addressation of field parts is sucks, TODO: replace by hash 299 my @field_list = sort { $a->[F_NUMBER] <=> $b->[F_NUMBER] } map { [@$_] } @$fields; 300 my %fields_by_field_name = map { $_->[F_NAME] => $_ } @field_list; 301 my %fields_by_field_number = map { $_->[F_NUMBER] => $_ } @field_list; 302 303 my $has_oneofs = defined($oneofs) && %$oneofs; 304 my %oneofs_rev; 305 306 if ($has_oneofs) { 307 while (my ($name, $fields) = each %$oneofs) { 308 %oneofs_rev = (%oneofs_rev, map { $_, $name } @$fields); 309 } 310 } 311 312 no strict 'refs'; 313 @{"${class_name}::ISA"} = $base_class; 314 *{"${class_name}::_pb_fields_list"} = sub { \@field_list }; 315 *{"${class_name}::_pb_fields_by_name"} = sub { \%fields_by_field_name }; 316 *{"${class_name}::_pb_fields_by_number"} = sub { \%fields_by_field_number }; 317 if ($has_oneofs) { 318 *{"${class_name}::_pb_oneofs"} = sub { $oneofs }; 319 *{"${class_name}::_pb_oneofs_rev"} = sub { \%oneofs_rev }; 320 } 321 use strict; 322 323 if ($opts->{create_accessors}) { 324 no strict 'refs'; 325 push @{"${class_name}::ISA"}, 'Class::Accessor'; 326 if ($has_oneofs) { 327 *{"${class_name}::new"} = \&Google::ProtocolBuffers::new; 328 *{"${class_name}::which_oneof"} = \&Google::ProtocolBuffers::which_oneof; 329 } 330 *{"${class_name}::get"} = \&Google::ProtocolBuffers::get; 331 *{"${class_name}::set"} = \&Google::ProtocolBuffers::set; 332 use strict; 333 334 if ($opts->{follow_best_practice}) { 335 $class_name->follow_best_practice; 336 } 337 my @accessors = grep { /^[a-z_]\w*$/i } map { $_->[2] } @$fields; 338 $class_name->mk_accessors(@accessors); 339 } 340} 341 342sub create_enum { 343 my $self = shift; 344 my $class_name = shift; 345 my $fields = shift; 346 my $options = shift; 347 348 ## 349 ## Sanity checks 350 ## 1. Class name must be a valid Perl class name 351 ## (should we check that this class doesn't exist yet?) 352 ## 2. Field names must be valid identifiers and be unique 353 ## 354 die "Invalid class name: '$class_name'" 355 unless $class_name =~ /^[a-z_]\w*(?:::[a-z_]\w*)*$/i; 356 my %names; 357 foreach my $f (@$fields) { 358 my ($name, $value) = @$f; 359 die "Invalid field name: '$name'" 360 unless $name && $name =~ /^[a-z_]\w*$/i; 361 if ($names{$name}++) { 362 die "Field '$name' is defined more than once"; 363 } 364 } 365 366 ## base class and constants export 367 no strict 'refs'; 368 @{"${class_name}::ISA"} = "Google::ProtocolBuffers::Enum"; 369 %{"${class_name}::EXPORT_TAGS"} = ('constants'=>[]); 370 use strict; 371 372 ## create the constants 373 foreach my $f (@$fields) { 374 my ($name, $value) = @$f; 375 no strict 'refs'; 376 *{"${class_name}::$name"} = sub { $value }; 377 push @{ ${"${class_name}::EXPORT_TAGS"}{'constants'} }, $name; 378 push @{"${class_name}::EXPORT_OK"}, $name; 379 use strict; 380 } 381 382 ## create a copy of fields for introspection/code generation 383 my @fields = map { [@$_] } @$fields; 384 no strict 'refs'; 385 *{"${class_name}::_pb_fields_list"} = sub { \@fields }; 386 387} 388 389## 390## Accessors 391## 392sub getExtension { 393 my $self = shift; 394 my $data = (ref $self) ? $self : shift(); 395 my $extension_name = shift; 396 397 unless($extension_name){ 398 return \%{$self->_pb_fields_by_name()}; 399 } 400 401 $extension_name =~ s/::/./g; 402 my $key = "[$extension_name]"; 403 404 my $field = $self->_pb_fields_by_name->{$key}; 405 if ($field) { 406 return (exists $data->{$key}) ? $data->{$key} : $field->[F_DEFAULT]; 407 } else { 408 my $class_name = ref $self || $self; 409 die "There is no extension '$extension_name' in '$class_name'"; 410 } 411} 412 413 414 415sub setExtension { 416 my $self = shift; 417 my $data = (ref $self) ? $self : shift(); 418 my $extension_name = shift; 419 my $value = shift; 420 421 $extension_name =~ s/::/./g; 422 my $key = "[$extension_name]"; 423 424 if ($self->_pb_fields_by_name->{$key}) { 425 $data->{$key} = $value; 426 } else { 427 my $class_name = ref $self || $self; 428 die "There is no extension '$extension_name' in '$class_name'"; 429 } 430} 431 432## 433## Overide the Class::Accessor new to handle oneof fields. 434## 435sub new { 436 my ($proto, $fields) = @_; 437 my ($class) = ref $proto || $proto; 438 439 $fields = {} unless defined $fields; 440 441 my $self = bless {}, $class; 442 443 ## Set the fields 444 while (my ($key, $value) = each %$fields) { 445 if (!defined($value)) { 446 $self->{$key} = undef; 447 } 448 else { 449 $self->set($key, $value); 450 } 451 } 452 453 return $self; 454} 455 456## 457## Return which field in a oneof is set 458## 459sub which_oneof { 460 my $self = shift; 461 my $oneof = shift; 462 463 return undef unless $self->can('_pb_oneofs') && 464 exists($self->_pb_oneofs->{$oneof}); 465 466 foreach my $f (@{$self->_pb_oneofs->{$oneof}}) { 467 if (defined($self->{$f})) { 468 return $f; 469 } 470 } 471 472 return undef; 473} 474 475## 476## This is for Class::Accessor read-accessors, will be 477## copied to classes from Message/Group. 478## If no value is set, the default one will be returned. 479## 480sub get { 481 my $self = shift; 482 483 if (@_==1) { 484 ## checking that $self->{$_[0]} exists is not enough, 485 ## since undef value may be set via Class::Accessor's new, e.g: 486 ## my $data = My::Message->new({ name => undef }) 487 return $self->{$_[0]} if defined $self->{$_[0]}; 488 my $field = $self->_pb_fields_by_name->{$_[0]}; 489 return $field->[F_DEFAULT]; 490 } elsif (@_>1) { 491 my @rv; 492 my $fields; 493 foreach my $key (@_) { 494 if (defined $self->{$key}) { 495 push @rv, $self->{$key}; 496 } else { 497 $fields ||= $self->_pb_fields_by_name; 498 push @rv, $fields->{$key}->[F_DEFAULT]; 499 } 500 } 501 return @rv; 502 } else { 503 Carp::confess("Wrong number of arguments received."); 504 } 505} 506 507sub set { 508 my $self = shift; 509 my $key = shift; 510 511 if (@_==1) { 512 if (defined $_[0]) { 513 $self->{$key} = $_[0]; 514 } else { 515 delete $self->{$key}; 516 } 517 } elsif (@_>1) { 518 $self->{$key} = [@_]; 519 } else { 520 Carp::confess("Wrong number of arguments received."); 521 } 522 523 # Is this a oneof field 524 if ($self->can('_pb_oneofs_rev') && exists($self->_pb_oneofs_rev->{$key})) { 525 foreach my $f (@{$self->_pb_oneofs->{$self->_pb_oneofs_rev->{$key}}}) { 526 delete $self->{$f} unless $f eq $key; 527 } 528 } 529} 530 531sub _get_class_name_for{ 532 my $self = shift; 533 my $type_name = shift; 534 my $opts = shift; 535 536 if ($opts->{no_camel_case}) { 537 my $class_name = $type_name; 538 $class_name =~ s/\./::/g; 539 return $class_name; 540 } else { 541 my @idents = split qr/\./, $type_name; 542 foreach (@idents) { 543 s/_(.)/uc($1)/ge; 544 $_ = "\u$_"; 545 } 546 return join("::", @idents); 547 } 548} 549 550package Google::ProtocolBuffers::Message; 551no warnings 'once'; 552## public 553*encode = \&Google::ProtocolBuffers::Codec::encode; 554*decode = \&Google::ProtocolBuffers::Codec::decode; 555*setExtension = \&Google::ProtocolBuffers::setExtension; 556*getExtension = \&Google::ProtocolBuffers::getExtension; 557*getPerlCode = \&Google::ProtocolBuffers::CodeGen::generate_code_of_message_or_group; 558## internal 559## _pb_complex_type_kind can be removed and $class->isa('Google::ProtocolBuffers::Message') 560## can be used instead, but current implementation is faster 561sub _pb_complex_type_kind { Google::ProtocolBuffers::Constants::MESSAGE() } 562# _pb_fields_list ## These 3 methods are created in 563# _pb_fields_by_name ## namespace of derived class 564# _pb_fields_by_number 565 566package Google::ProtocolBuffers::Group; 567*setExtension = \&Google::ProtocolBuffers::setExtension; 568*getExtension = \&Google::ProtocolBuffers::getExtension; 569*getPerlCode = \&Google::ProtocolBuffers::CodeGen::generate_code_of_message_or_group; 570sub _pb_complex_type_kind { Google::ProtocolBuffers::Constants::GROUP() } 571#_pb_fields_list 572#_pb_fields_by_name 573#_pb_fields_by_number 574 575package Google::ProtocolBuffers::Enum; 576use base 'Exporter'; 577*getPerlCode = \&Google::ProtocolBuffers::CodeGen::generate_code_of_enum; 578sub _pb_complex_type_kind { Google::ProtocolBuffers::Constants::ENUM() } 579#_pb_fields_list 580 5811; 582 583__END__ 584 585=pod 586 587=head1 NAME 588 589Google::ProtocolBuffers - simple interface to Google Protocol Buffers 590 591=head1 SYNOPSYS 592 593 ## 594 ## Define structure of your data and create serializer classes 595 ## 596 use Google::ProtocolBuffers; 597 Google::ProtocolBuffers->parse(" 598 message Person { 599 required string name = 1; 600 required int32 id = 2; // Unique ID number for this person. 601 optional string email = 3; 602 603 enum PhoneType { 604 MOBILE = 0; 605 HOME = 1; 606 WORK = 2; 607 } 608 609 message PhoneNumber { 610 required string number = 1; 611 optional PhoneType type = 2 [default = HOME]; 612 } 613 614 repeated PhoneNumber phone = 4; 615 } 616 ", 617 {create_accessors => 1 } 618 ); 619 620 ## 621 ## Serialize Perl structure and print it to file 622 ## 623 open my($fh), ">person.dat"; 624 binmode $fh; 625 print $fh Person->encode({ 626 name => 'A.U. Thor', 627 id => 123, 628 phone => [ 629 { number => 1234567890 }, 630 { number => 987654321, type=>Person::PhoneType::WORK() }, 631 ], 632 }); 633 close $fh; 634 635 ## 636 ## Decode data from serialized form 637 ## 638 my $person; 639 { 640 open my($fh), "<person.dat"; 641 binmode $fh; 642 local $/; 643 $person = Person->decode(<$fh>); 644 close $fh; 645 } 646 print $person->{name}, "\n"; 647 print $person->name, "\n"; ## ditto 648 649=head1 DESCRIPTION 650 651Google Protocol Buffers is a data serialization format. 652It is binary (and hence compact and fast for serialization) and as extendable 653as XML; its nearest analogues are Thrift and ASN.1. 654There are official mappings for C++, Java and Python languages; this library is a mapping for Perl. 655 656=head1 METHODS 657 658=head2 Google::ProtocolBuffers->parse($proto_text, \%options) 659 660=head2 Google::ProtocolBuffers->parsefile($proto_filename, \%options) 661 662Protocol Buffers is a typed protocol, so work with it starts with some kind 663of Interface Definition Language named 'proto'. 664For the description of the language, please see the official page 665(L<http://code.google.com/p/protobuf/>) 666Methods 'parse' and 'parsefile' take the description of data structure 667as text literal or as name of the proto file correspondently. 668After successful compilation, Perl serializer classes are created for each 669message, group or enum found in proto. In case of error, these methods will 670die. On success, a list of names of created classes is returned. 671Options are given as a hash reference, the recognizable options are: 672 673=over 4 674 675=item include_dir => [ $dir_name ] 676 677One proto file may include others, this option sets where to look for the 678included files. Multiple dirs should be specificed as an ARRAYREF. 679 680=item generate_code => $filename or $file_handler 681 682Compilation of proto source is a relatively slow and memory consuming 683operation, it is not recommended in production environment. Instead, 684with this option you may specify filename or filehandle where to save 685Perl code of created serializer classes for future use. Example: 686 687 ## in helper script 688 use Google::ProtocolBuffers; 689 Google::ProtocolBuffers->parse( 690 "message Foo {optional int32 a = 1; }", 691 { generate_code => 'Foo.pm' } 692 ); 693 694 ## then, in production code 695 use Foo; 696 my $str = Foo->encode({a => 100}); 697 698=item create_accessors (Boolean) 699 700If this option is set, then result of 'decode' will be a blessed structure 701with accessor methods for each field, look at L<Class::Accessor> for more info. 702Example: 703 704 use Google::ProtocolBuffers; 705 Google::ProtocolBuffers->parse( 706 "message Foo { optional int32 id = 1; }", 707 { create_accessors => 1 } 708 ); 709 my $foo = Foo->decode("\x{08}\x{02}"); 710 print $foo->id; ## prints 2 711 $foo->id(100); ## now it is set to 100 712 713=item follow_best_practice (Boolean) 714 715This option is from L<Class::Accessor> too; it has no effect without 716'create_accessors'. If set, names of getters (read accessors) will 717start with get_ and names of setter with set_: 718 719 use Google::ProtocolBuffers; 720 Google::ProtocolBuffers->parse( 721 "message Foo { optional int32 id = 1; }", 722 { create_accessors => 1, follow_best_practice => 1 } 723 ); 724 ## Class::Accessor provides a constructor too 725 my $foo = Foo->new({ id => 2 }); 726 print $foo->get_id; 727 $foo->set_id(100); 728 729=item simple_extensions (Boolean) 730 731If this option is set, then extensions are treated as if they were 732regular fields in messages or groups: 733 734 use Google::ProtocolBuffers; 735 use Data::Dumper; 736 Google::ProtocolBuffers->parse( 737 " 738 message Foo { 739 optional int32 id = 1; 740 extensions 10 to max; 741 } 742 extend Foo { 743 optional string name = 10; 744 } 745 ", 746 { simple_extensions=>1, create_accessors => 1 } 747 ); 748 my $foo = Foo->decode("\x{08}\x{02}R\x{03}Bob"); 749 print Dumper $foo; ## { id => 2, name => 'Bob' } 750 print $foo->id, "\n"; 751 $foo->name("Sponge Bob"); 752 753This option is off by default because extensions live in a separate namespace 754and may have the same names as fields. Compilation of such proto with 755'simple_extension' option will result in die. 756If the option is off, you have to use special accessors for extension fields - 757setExtension and getExtension, as in C++ Protocol Buffer API. Hash keys for 758extended fields in Plain Old Data structures will be enclosed in brackets: 759 760 use Google::ProtocolBuffers; 761 use Data::Dumper; 762 Google::ProtocolBuffers->parse( 763 " 764 message Foo { 765 optional int32 id = 1; 766 extensions 10 to max; 767 } 768 extend Foo { 769 optional string id = 10; // <-- id again! 770 } 771 ", 772 { simple_extensions => 0, ## <-- no simple extensions 773 create_accessors => 1, 774 } 775 ); 776 my $foo = Foo->decode("\x{08}\x{02}R\x{05}Kenny"); 777 print Dumper $foo; ## { id => 2, '[id]' => 'Kenny' } 778 print $foo->id, "\n"; ## 2 779 print $foo->getExtension('id'), "\n"; ## Kenny 780 $foo->setExtension("id", 'Kenny McCormick'); 781 782=item no_camel_case (Boolean) 783 784By default, names of created Perl classes are taken from 785"camel-cased" names of proto's packages, messages, groups and enums. 786First characters are capitalized, all underscores are removed and 787the characters following them are capitalized too. An example: 788a fully qualified name 'package_test.Message' will result in Perl class 789'PackageTest::Message'. Option 'no_camel_case' turns name-mangling off. 790Names of fields, extensions and enum constants are not affected anyway. 791 792=item package_name (String) 793 794Package name to be put into generated Perl code; has no effect on Perl classes names and 795has no effect unless 'generate_code' is also set. 796 797=back 798 799=head2 MessageClass->encode($hashref) 800 801This method may be called as class or instance method. 'MessageClass' must 802already be created by compiler. Input is a hash reference. 803Output is a scalar (string) with serialized data. 804Unknown fields in hashref are ignored. 805In case of errors (e.g. required field is not set and there is no default value 806for the required field) an exception is thrown. 807Examples: 808 809 use Google::ProtocolBuffers; 810 Google::ProtocolBuffers->parse( 811 "message Foo {optional int32 id = 1; }", 812 {create_accessors => 1} 813 ); 814 my $string = Foo->encode({ id => 2 }); 815 my $foo = Foo->new({ id => 2 }); 816 $string = $foo->encode; ## ditto 817 818=head2 MessageClass->decode($scalar) 819 820Class method. Input: serialized data string. Output: data object of class 821'MessageClass'. Unknown fields in serialized data are ignored. 822In case of errors (e.g. message is broken or partial) or data string is 823a wide-character (utf-8) string, an exception is thrown. 824 825=head1 PROTO ELEMENTS 826 827=head2 Enums 828 829For each enum in proto, a Perl class will be constructed with constants for 830each enum value. You may import these constants via 831ClassName->import(":constants") call. Please note that Perl compiler 832will know nothing about these constants at compile time, because this import 833occurs at run time, so parenthesis after constant's name are required. 834 835 use Google::ProtocolBuffers; 836 Google::ProtocolBuffers->parse( 837 " 838 enum Foo { 839 FOO = 1; 840 BAR = 2; 841 } 842 ", 843 { generate_code => 'Foo.pm' } 844 ); 845 print Foo::FOO(), "\n"; ## fully quailified name is fine 846 Foo->import(":constants"); 847 print FOO(), "\n"; ## now FOO is defined in our namespace 848 print FOO; ## <-- Error! FOO is bareword! 849 850Or, do the import inside a BEGIN block: 851 852 use Foo; ## Foo.pm was generated in previous example 853 BEGIN { Foo->import(":constants") } 854 print FOO, "\n"; ## ok, Perl compiler knows about FOO here 855 856=head2 Groups 857 858Though group are considered deprecated they are supported by Google::ProtocolBuffers. 859They are like nested messages, except that nested type definition and field 860definition go together: 861 862 use Google::ProtocolBuffers; 863 Google::ProtocolBuffers->parse( 864 " 865 message Foo { 866 optional group Bar = 1 { 867 optional int32 baz = 1; 868 } 869 } 870 ", 871 { create_accessors => 1 } 872 ); 873 my $foo = Foo->new; 874 $foo->Bar( Foo::Bar->new({ baz => 2 }) ); 875 print $foo->Bar->baz, ", ", $foo->{Bar}->{baz}, "\n"; # 2, 2 876 877 878=head2 Default values 879 880Proto file may specify a default value for a field. 881The default value is returned by accessor if there is no value for field 882or if this value is undefined. The default value is not accessible via 883plain old data hash, though. Default string values are always byte-strings, 884if you need wide-character (Unicode) string, use L<Encode/decode_utf8>. 885 886 use Google::ProtocolBuffers; 887 Google::ProtocolBuffers->parse( 888 "message Foo {optional string name=1 [default='Kenny'];} ", 889 {create_accessors => 1} 890 ); 891 892 ## no initial value 893 my $foo = Foo->new; 894 print $foo->name(), ", ", $foo->{name}, "\n"; # Kenny, (undef) 895 896 ## some defined value 897 $foo->name('Ken'); 898 print $foo->name(), ", ", $foo->{name}, "\n"; # Ken, Ken 899 900 ## empty, but still defined value 901 $foo->name(''); 902 print $foo->name(), ", ", $foo->{name}, "\n"; # (empty), (empty) 903 904 ## undef value == default value 905 $foo->name(undef); 906 print $foo->name(), ", ", $foo->{name}, "\n"; # Kenny, (undef) 907 908=head2 Extensions 909 910From the point of view of serialized data, there is no difference if a 911field is declared as regular field or if it is extension, as far 912as field number is the same. 913That is why there is an option 'simple_extensions' (see above) that treats extensions 914like regular fields. 915From the point of view of named accessors, however, extensions live in 916namespace different from namespace of fields, that's why they simple names 917(i.e. not fully qualified ones) may conflict. 918(And that's why this option is off by default). 919The name of extensions are obtained from their fully qualified names from 920which leading part, most common with the class name to be extended, 921is stripped. Names of hash keys enclosed in brackets; 922arguments to methods 'getExtension' and 'setExtension' do not. 923Here is the self-explanatory example to the rules: 924 925 use Google::ProtocolBuffers; 926 use Data::Dumper; 927 928 Google::ProtocolBuffers->parse( 929 " 930 package some_package; 931 // message Plugh contains one regular field and three extensions 932 message Plugh { 933 optional int32 foo = 1; 934 extensions 10 to max; 935 } 936 extend Plugh { 937 optional int32 bar = 10; 938 } 939 message Thud { 940 extend Plugh { 941 optional int32 baz = 11; 942 } 943 } 944 945 // Note: the official Google's proto compiler does not allow 946 // several package declarations in a file (as of version 2.0.1). 947 // To compile this example with the official protoc, put lines 948 // above to some other file, and import that file here. 949 package another_package; 950 // import 'other_file.proto'; 951 952 extend some_package.Plugh { 953 optional int32 qux = 12; 954 } 955 956 ", 957 { create_accessors => 1 } 958 ); 959 960 my $plugh = SomePackage::Plugh->decode( 961 "\x{08}\x{01}\x{50}\x{02}\x{58}\x{03}\x{60}\x{04}" 962 ); 963 print Dumper $plugh; 964 ## {foo=>1, '[bar]'=>2, '[Thud.baz]'=>3, [another_package.qux]=>4} 965 966 print $plugh->foo, "\n"; ## 1 967 print $plugh->getExtension('bar'), "\n"; ## 2 968 print $plugh->getExtension('Thud.baz'), "\n"; ## 3 969 print $plugh->getExtension('Thud::baz'), "\n"; ## ditto 970 971Another point is that 'extend' block doesn't create new namespace 972or scope, so the following proto declaration is invalid: 973 974 // proto: 975 package test; 976 message Foo { extensions 10 to max; } 977 message Bar { extensions 10 to max; } 978 extend Foo { optional int32 a = 10; } 979 extend Bar { optional int32 a = 20; } // <-- Error: name 'a' in package 980 // 'test' is already used! 981 982Well, extensions are the most complicated part of proto syntax, and I hope 983that you either got it or you don't need it. 984 985=head1 RUN-TIME MESSAGE CREATION 986 987You don't like to mess with proto files? 988Structure of your data is known at run-time only? 989No problem, create your serializer classes at run-time too with method 990Google::ProtocolBuffers->create_message('ClassName', \@fields, \%options); 991(Note: The order of field description parts is the same as in 992proto file. The API is going to change to accept named parameters, but 993backward compatibility will be preserved). 994 995 use Google::ProtocolBuffers; 996 use Google::ProtocolBuffers::Constants(qw/:labels :types/); 997 998 ## 999 ## proto: 1000 ## message Foo { 1001 ## message Bar { 1002 ## optional int32 a = 1 [default=12]; 1003 ## } 1004 ## required int32 id = 1; 1005 ## repeated Bar bars = 2; 1006 ## } 1007 ## 1008 Google::ProtocolBuffers->create_message( 1009 'Foo::Bar', 1010 [ 1011 ## optional int32 a = 1 [default=12] 1012 [LABEL_OPTIONAL, TYPE_INT32, 'a', 1, '12'] 1013 ], 1014 { create_accessors => 1 } 1015 ); 1016 Google::ProtocolBuffers->create_message( 1017 'Foo', 1018 [ 1019 [LABEL_REQUIRED, TYPE_INT32, 'id', 1], 1020 [LABEL_REPEATED, 'Foo::Bar', 'bars', 2], 1021 ], 1022 { create_accessors => 1 } 1023 ); 1024 my $foo = Foo->new({ id => 10 }); 1025 $foo->bars( Foo::Bar->new({a=>1}), Foo::Bar->new({a=>2}) ); 1026 print $foo->encode; 1027 1028There are methods 'create_group' and 'create_enum' also; the following constants 1029are exported: labels 1030(LABEL_OPTIONAL, LABEL_OPTIONAL, LABEL_REPEATED) 1031and types 1032(TYPE_INT32, TYPE_UINT32, TYPE_SINT32, TYPE_FIXED32, TYPE_SFIXED32, 1033TYPE_INT64, TYPE_UINT64, TYPE_SINT64, TYPE_FIXED64, TYPE_SFIXED64, 1034TYPE_BOOL, TYPE_STRING, TYPE_BYTES, TYPE_DOUBLE, TYPE_FLOAT). 1035 1036=head1 KNOWN BUGS, LIMITATIONS AND TODOs 1037 1038All proto options are ignored except default values for fields; 1039extension numbers are not checked. 1040Unknown fields in serialized data are skipped, 1041no stream API (encoding to/decoding from file handlers) is present. 1042Ask for what you need most. 1043 1044Introspection API is planned. 1045 1046Declarations of RPC services are currently ignored, but their support 1047is planned (btw, which Perl RPC implementation would you recommend?) 1048 1049=head1 SEE ALSO 1050 1051Official page of Google's Protocol Buffers project 1052(L<http://code.google.com/p/protobuf/>) 1053 1054Protobuf-PerlXS project (L<http://code.google.com/p/protobuf-perlxs/>) - 1055creates XS wrapper for C++ classes generated by official Google's 1056compiler protoc. You have to complile XS files every time you've 1057changed the proto description, however, this is the fastest way to work 1058with Protocol Buffers from Perl. 1059 1060Protobuf-Perl project L<http://code.google.com/p/protobuf-perl/> - 1061someday it may be part of official Google's compiler. 1062 1063Thrift L<http://developers.facebook.com/thrift/> 1064 1065ASN.1 L<http://en.wikipedia.org/wiki/ASN.1>, 1066L<JSON> and L<YAML> 1067 1068=head1 AUTHOR, ACKNOWLEDGEMENS, COPYRIGHT 1069 1070Author: Igor Gariev <gariev@hotmail.com> 1071 the CSIRT Gadgets Foundation <csirtgadgets.org> 1072 1073Proto grammar is based on work by Alek Storm 1074L<http://groups.google.com/group/protobuf/browse_thread/thread/1cccfc624cd612da> 1075 1076This library is free software; you can redistribute it and/or modify 1077it under the same terms as Perl itself, either Perl version 5.10.0 or, 1078at your option, any later version of Perl 5 you may have available. 1079