package JavaBin;
{
  $JavaBin::VERSION = '0.3';
}
# ABSTRACT: Apache Solr JavaBin (de)serializer

use strict;
use warnings;

use Filter::cpp;

# define BYTES($num) substr $bytes, 0, $num, ''
# define DISPATCH &{ $dispatch_shift[ ( $tag = ord BYTES(1) ) >> 5 ] || $dispatch[$tag] }

my ( $bytes, @dispatch, @dispatch_shift, @exts, $size, $tag );

@dispatch = (
    # null
    sub { undef },
    # bool true
    sub { 1 },
    # bool false
    sub { 0 },
    # byte
    sub { unpack 'c', BYTES(1) },
    # short
    sub { unpack 's>', BYTES(2) },
    # double
    sub { unpack 'd>', BYTES(8) },
    # int
    sub { unpack 'l>', BYTES(4) },
    # long
    sub { unpack 'q>', BYTES(8) },
    # float,
    sub { unpack 'f>', BYTES(4) },
    # date
    sub {
        my ( $s, $m, $h, $d, $M, $y ) = gmtime( unpack( 'q>', BYTES(8) ) / 1000 );

        sprintf '%d-%02d-%02dT%02d:%02d:%02dZ', $y + 1900, $M + 1, $d, $h, $m, $s;
    },
    # map
    sub { +{ map DISPATCH, 1 .. _vint() * 2 } },
    # solr doc
    sub { DISPATCH },
    # solr doc list
    sub {
        my %result;

        @result{qw/numFound start maxScore docs/} = ( @{ DISPATCH }, DISPATCH );

        \%result;
    },
    # byte array
    sub { [ unpack 'c*', BYTES(_vint()) ] },
    # iterator
    sub {
        my @array;

        push @array, &{ $dispatch_shift[ $tag >> 5 ] || $dispatch[$tag] }
            until ( $tag = ord BYTES(1) ) == 15;

        \@array;
    },
);

# These datatypes are matched by taking the tag byte, shifting it by 5 so to only read
# the first 3 bits of the tag byte, giving it a range or 0-7 inclusive.
#
# The remaining 5 bits can then be used to store the size of the datatype, e.g. how
# many chars in a string, this therefore has a range of 0-31, if the size exceeds or
# matches this then an additional vint is added.
#
# The overview of the tag byte is therefore TTTSSSSS with T and S being type and size.
@dispatch_shift = (
    undef,
    # string
    sub {
        utf8::decode my $string = BYTES( ( $size = $tag & 31 ) == 31 ? 31 + _vint() : $size );

        $string;
    },
    # small int
    sub { read_small_int() },
    # small long
    sub { read_small_int() },
    # array
    sub { [ map DISPATCH, 1 .. ( ( $size = $tag & 31 ) == 31 ? 31 + _vint() : $size ) ] },
    # ordered map
    sub { +{ map DISPATCH, 1 .. ( ( $size = $tag & 31 ) == 31 ? 31 + _vint() : $size ) * 2 } },
    # named list
    sub { +{ map DISPATCH, 1 .. ( ( $size = $tag & 31 ) == 31 ? 31 + _vint() : $size ) * 2 } },
    # extern string
    sub {
        if ( ( $size = $tag & 31 ) == 31 ? $size += _vint() : $size ) {
            $exts[$size - 1];
        }
        else {
            utf8::decode my $string = BYTES( ( $size = ord( BYTES(1) ) & 31 ) == 31 ? 31 + _vint() : $size );

            push @exts, $string;

            $string;
        }
    },
);

sub from_javabin($) {
    # Read the input into $bytes whilst skipping the version byte.
    $bytes = substr shift, 1;

    @exts = ();

    DISPATCH;
}

sub import {
    no strict 'refs';

    *{ caller() . '::from_javabin' } = \&from_javabin;
}

sub read_small_int {
    my $result = $tag & 0x0f;

    $result = _vint() << 4 | $result if $tag & 0x10;

    $result;
}

# A private setter of bytes to allow unit testing.
sub _bytes {
    $bytes = pop;

    shift;
}

# Lucene variable-length +ve integer, the MSB indicates whether you need another octet.
# http://lucene.apache.org/core/old_versioned_docs/versions/3_5_0/fileformats.html#VInt
sub _vint {
    my ( $byte, $shift, $value );

    $value = ( $byte = ord BYTES(1) ) & 127;

    $value |= ( ( $byte = ord BYTES(1) ) & 127 ) << ( $shift += 7 ) while $byte & 128;

    $value;
}

1;


=pod

=head1 NAME

JavaBin - Apache Solr JavaBin (de)serializer

=head1 VERSION

version 0.3

=head1 SYNOPSIS

 use JavaBin;

 my $result = from_javabin $binary_data;

=head1 DESCRIPTION

JavaBin is a compact binary format used by L<Apache Solr|http://lucene.apache.org/solr>.

For more information on this format see the L<Solr Wiki|http://wiki.apache.org/solr/javabin>.

This package provides a deserializer for this format, with a serializer planned.

=head1 FUNCTIONS

=head2 from_javabin

 my $result = from_javabin $binary_data;

Accepts one argument, a binary string of containing the JavaBin.

Returns a scalar representation of the data, be that undef, number, string, or reference.

This function does no error checking, hand it invalid JavaBin and it will probably die.

=head1 CAVEATS

To (de)serialize long floats and ints this package requires a 64bit Perl.
That said, it won't actually throw unless it encounters such data, and therefore
the tests for such data are skipped on 32bit platforms.

Technically this limitation could be worked around by use of L<bigint> or such.
But the added complexity and maintanace cost would outweight the benifit.

Due to the differences between Java and Perl not all data structures can be mapped one-to-one.

An example of such mapping is a Java interator whcih becomes a Perl array during deserialization.
Additionally a Java HashMap, Named List, or Ordered Map will become a Perl hash.

=head1 TODO

=over 4

=item *

C<to_javabin> serializer.

=item *

XS implementation.

=back

=head1 INSPIRATION

This package was inspired by the L<Ruby JavaBin library|https://github.com/kennyj/java_bin>.
Both that library and the Java JavaBin library proved very helpful in understanding JavaBin.

=head1 AUTHOR

James Raspass <jraspass@gmail.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by James Raspass <jraspass@gmail.com>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
