view release on metacpan or  search on metacpan

lib/Text/JSON/Nibble.pm  view on Meta::CPAN

package Text::JSON::Nibble;

=encoding utf8

=cut 

use 5.006;
use strict;
use warnings;

use Data::Dumper;

=head1 NAME

Text::JSON::Nibble - Nibble complete JSON objects from buffers

=head1 VERSION

Version 1.01

=cut

our $VERSION = '1.01';

=head1 WARNING

This module should be used with caution, it will not handle 'badly formed' json well, its entire purpose was because I was experiencing 
segfaults with Cpanel::XS's decode_prefix when dealing with a streaming socket buffer.

=head1 DESCRIPTION

This module is a 'character' crawling JSON extractor for plain TEXT, usable in both a 'streaming' or 'block' method, for when you need something that is not XS.

It is particularly handy for when you want to deal with JSON without decoding it.

=head1 SYNOPSIS 

	use Text::JSON::Nibble;

	my $json = '{"lol":{"a":[1,2,3],"b":"lol"}}';
	my $item = Text::JSON::Nibble->new();

	my @results = @{ $item->digest($json) };

=head1 EXAMPLES

=head2 Example1 (Basic usage)

	use Text::JSON::Nibble;

	my $json = '{"lol":{"a":[1,2,3],"b":"lol"}}{"lol":{"a":[1,2,3],"b":"lol"}}';
	my $item = Text::JSON::Nibble->new();

	foreach my $jsonBlock ( @{ $item->digest($json) } ) {
		print "Found: $jsonBlock\n";
	}

	# Will display the following:
	# Found: {"lol":{"a":[1,2,3],"b":"lol"}}
	# Found: {"lol":{"a":[1,2,3],"b":"lol"}}
	

=head2 Example2 (Basic usage - mangled JSON)

	use Text::JSON::Nibble;

	my $json = '\cxa4GL<A{"lol":{"a":[1,2,3],"b":"lol"}}He Random Stuf${"lol":{"a":[1,2,3],"b":"lol"}}\cxa4GL<A';
	my $item = Text::JSON::Nibble->new();

	foreach my $jsonBlock ( @{ $item->digest($json) } ) {
		print "Found: $jsonBlock\n";
	}

	# Will display the following:
	# Found: {"lol":{"a":[1,2,3],"b":"lol"}}
	# Found: {"lol":{"a":[1,2,3],"b":"lol"}}

=head2 Example3 (Streaming usage for POE and others)

	use Text::JSON::Nibble;
	
	my @jsonStream = qw( {"test":1} {"moreTest":2} {"part ial":3} );
	my $item = Text::JSON::Nibble->new();
	
	$item->process( shift @jsonStream );

	while( $item->stack ) {
		my $jsonBlock = $item->pull;
		print "Found $jsonBlock\n";

		while ( my $newJSON = shift @jsonStream ) {
			$item->process($newJSON);
		}
	}

=head1 Generic callers

=head2 new

Generate a new JSON Nibble object

=cut

sub new {
	my $class = shift;

	# Some private stuff for ourself
	my $self = { 
		jsonqueue => [],
		buffer => "",
		iChar => [],
	};
	
	# We are interested in characters of this code
	$self->{iChar}->[91] = 1;
	$self->{iChar}->[93] = 1;
	$self->{iChar}->[123] = 1;
	$self->{iChar}->[125] = 1;

	# Go with god my son
	bless $self, $class;
	return $self;
}

=head1 Block functions

=head2 digest

Digest the text that is fed in and attempt to return a complete an array of JSON object from it, returns either a blank array or an array of text-encoded-json.

Note you can call and use this at any time, even if you are using streaming functionality.

=cut

sub digest {
	my $self = shift;
	my $data = shift;

	# A place for our return
	my $return = [];
	
	# If we got passed a blank data scalar just return failure
	return $return if (!$data);

	# Save the current state for if we are dealing with a stream elsewhere.
	my $stateBackup = $self->{state} if ($self->{state});
	
	# Start with a fresh state
	$self->reset;
	
	# Load the digest data into the processor
	$self->process($data);
	
	# Generate our results
	while ($self->stack) { push @{$return},$self->pull }

	# Restore the previous state
	$self->{state} = $stateBackup if ($stateBackup);

	# Process the data and return the result
	return $return;
}

=head1 Streaming functions

=head2 process

Load data into the buffer for json extraction, can be called at any point.

This function will return the buffer length remaining after extraction has been attempted.

This function takes 1 optional argument, text to be added to the buffer.

=cut

sub process {
	my $self = shift;
	my $data = shift;

	# Add any data present to the buffer, elsewhere return the length of what we have.
	if ($data) { $self->{buffer} .= $data }
	else { return length($self->{buffer}) }
	
	# If we have no buffer return 0.
	if (!$self->{buffer}) { return 0 }
	
	# Load our state or establish a new one
	my $state;
	if ( $self->{state} ) {
		$state = $self->{state};
	} else {