The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
package My::Giant::Tuba;
use strict;
use warnings;
use blib;
use JSON::SL::Tuba;
use Getopt::Long;
use Data::Dumper::Concise;
use utf8;

GetOptions('f|file=s' => \my $InputFile,
           'c|chunk=i' => \my $ChunkSize,
           'i|iterations=i' => \my $Iterations,
           'a|accumulate' => \my $AccumAll,
           'q|quiet' => \my $Silent);

our @ISA = qw(JSON::SL::Tuba);
my $JSON;

$Iterations ||= 1;

if ($InputFile) {
    open my $fh, "<", $InputFile or die "$InputFile: $!";
    $JSON = join("", <$fh>);
    close($fh);
}
$JSON ||= <<'EOJ';
{
    "a" : "b",
    "c" : { "d" : "e" },
    "f" : [ "g", "h", "i", "j" ],
    "a number" : 0.4444444444,
    "a negative number" : -44,
    "a (false) boolean": false,
    "another (true) boolean" : true,
    "a null value" : null,
    "exponential" : 1.3413400E4,
    "an\tescaped key" : "a u-\u0065\u0073caped value",
    "שלום":"להראות"
    
}
EOJ

sub on_any {
    my ($tuba,$info,$data) = @_;
    #print Dumper(\@_);
    #use constant comparisons
    if ($info->{Type} == TUBA_TYPE_JSON) {
        printf STDERR ("JSON DOCUMENT: %c\n\n", $info->{Mode});
        return;
    }
    
    # or use the mnemonic ones
    if ($info->{Key} && $info->{Mode} =~ m,[>\+],) {
        printf ('"%s" : ', $info->{Key});
    }
    
    if ($info->{Type} == TUBA_TYPE_STRING) {
        printf('"%s",' . "\n", $data || "<NO DATA>");
        
    } elsif ($info->{Type} =~ m,[\[\{],) {
        if ($info->{Mode} eq '+') {
            print $info->{Type} . "\n";
        } else {  
            print $JSON::SL::Tuba::CloseTokens{$info->{Type}} . ",\n";
        }
    } else {
        if (@_ == 3) {
            print $data . ",\n"
        } else {
            die ("hrrm.. what have we here?")
                unless $info->{Type} == TUBA_TYPE_NULL;
            print "null\n";
        }
    }
}

sub new {
    my ($cls,%options) = @_;
    my $o = $cls->SUPER::new(%options);
    #the object itself is a hashref. Only a single key
    #is used by tuba, the very prominent '_TUBA' key. Don't delete it.
    $o->{my_private_data} = "hey there";
    
    #if you want to re-bless or do something funny, do it BEFORE
    #parse() is called..
    $o;
}

my @Chunks;
if ($ChunkSize) {
    @Chunks = unpack("(a$ChunkSize)*", $JSON);
} else {
    @Chunks = $JSON;
}

open my $devnull, ">", "/dev/null";
if ($Silent) {
    select $devnull;
}



foreach (1..$Iterations) {
    my $o = My::Giant::Tuba->new();
    $o->utf8(1);
    $o->parse($_) for @Chunks;
}