package Benchmark::Serialize::Library::ProtocolBuffers;

use Benchmark::Serialize::Library;
use Google::ProtocolBuffers;
use Google::ProtocolBuffers::Constants qw(:labels :types);

use Carp;
use Scalar::Util qw(looks_like_number);

=head1 NAME

Benchmark::Serialize::Library::ProtocolBuffers - Google::ProtocolBuffers benchmarks

=head1 SYNOPSIS

    # Load protocol specification from file:
    Benchmark::Serialize::Library::ProtocolBuffers->register( 
        ProtocolBuffer1 => "test.proto"
    );

    # Load protocol specification from string
    Benchmark::Serialize::Library::ProtocolBuffers->register( 
        ProtocolBuffer2 => \"
            message Person { ... }
        "
    );

    # Autogenerate specification from structure
    Benchmark::Serialize::Library::ProtocolBuffers->register( 
        ProtocolBuffer3 => { foo => 17, bar => [ qw( xyzzy plugh ) ] }
    );

=head1 DESCRIPTION

This module adds benchmarks for L<Google::ProtocolBuffers> to
L<Benchmark::Serialize>. The protocol class can either be defined by using
the interface definition language 'proto' or by autogeneration it from a
given structure.

All benchmarks generated by this module will have the benchmark tag 
C<:ProtocolBuffers>

=head1 METHODS

The following class methods is supported

=over 4

=item register $name => $proto, %options

Registers a benchmark of the protocol specified by C<$proto> with the
benchmark name C<$name>. The module make a best guess of the class name to use
for encoding. If this fails it can be forced by using a 
C<class =E<gt> $classname> option.

=back

=cut

my $msg = 0;

sub register {
    my $pkg    = shift;
    my $name   = shift;
    my $proto  = shift;
    my %args   = @_;

    my $class = $args{class};
    if ( ref $proto eq "HASH" ) {
        $class   = create( $proto );
    } elsif ( ref $proto eq "SCALAR" ) {
        my @classes = sort Google::ProtocolBuffers->parse($proto);
        $class ||= $classes[0];
    } else {
        my @classes = sort Google::ProtocolBuffers->parsefile($proto);
        $class ||= $classes[0];
    }

    Benchmark::Serialize::Library->register(
        $name => {
            deflate         => sub { $class->encode( $_[0] ) },
            inflate         => sub { $class->decode( $_[0] ) },
            packages        => [ 'Google::ProtocolBuffers' ],
            ProtocolBuffers => 1,
        }
    );
}

sub create {
    my $obj  = shift;
    my $path = shift || '/';

    croak("Can not create message type for $path")
        unless ref $obj eq "HASH";

    my $name = "Benchmark::Serialize::Library::ProtocolBuffers::Type" . $msg++;
    my $spec = [];

    my $field = 1;
    for my $key (keys %$obj) {
        my $value = $obj->{$key};
	my $label = LABEL_OPTIONAL;        

	if ( ref $value eq "ARRAY" ) {
            $label = LABEL_REPEATED;
            $value = $value->[0]; 
	}

	if ( ref $value eq "HASH" ) {
            my $message = create( $value, "$path/$key" );
	    push @$spec, [ $label, $message, $key, $field++ ];
        } elsif ( looks_like_number $value ) {
	    push @$spec, [ $label, TYPE_INT32, $key, $field++ ];
        } else {
	    push @$spec, [ $label, TYPE_STRING, $key, $field++ ];
        }
    }

    Google::ProtocolBuffers->create_message( $name, $spec, { } );
    return $name;
}

=head1 SEE ALSO

L<Google::ProtocolBuffers>

=head1 AUTHOR

Peter Makholm, C<< <peter at makholm.net> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-benchmark-serialize at
rt.cpan.org>, or through
the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Benchmark-Serialize>.  I will
be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2009-2010 Peter Makholm.

This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.


=cut


1;