File Coverage

blib/lib/JSON/Lines.pm

Criterion	Covered	Total	%
statement	86	97	88.6
branch	27	46	58.7
condition	5	6	83.3
subroutine	15	16	93.7
pod	8	8	100.0
total	141	173	81.5

package JSON::Lines;
use 5.006; use strict; use warnings; our $VERSION = '0.02';
use JSON; use base 'Import::Export';

our ($JSON, $LINES, %EX);
BEGIN {
	$JSON = JSON->new;
	$LINES = qr{ ([\[\{] (?: (?> [^\[\]\{\}]+ ) | (??{ $LINES }) )* [\]\}]) }x;
	%EX = (
		jsonl => [qw/all/]
	);
}

sub jsonl {
	my %args = (scalar @_ == 1 ? %{$_[0]} : @_);
	my $self = __PACKAGE__->new(%args);
	return $args{file}
		? $self->encode_file($args{file}, $args{data})
		: $self->encode($args{data})
	if ($args{encode});
	return $args{file}
		? $self->decode_file($args{file})
		: $self->decode($args{data})
	if ($args{decode});
}

sub new {
	my ($pkg, %args) = (shift, scalar @_ == 1 ? %{$_[0]} : @_);
	my $self = bless { headers => [] }, $pkg;
	exists $args{$_} && $JSON->$_($args{$_}) for qw/json pretty canonical/;
	$self->{$_} = $args{$_} for qw/parse_headers error_cb success_cb/;
	$self;
}

sub encode {
	my ($self, @data) = (shift, scalar @_ == 1 ? @{$_[0]} : @_);
	@data = $self->_parse_headers(@data)
		if ($self->{parse_headers});
	my $stream;
	for (@data) {
		my $json = eval { $JSON->encode($_) };
		if ($@) {
			if ($self->{error_cb}) {
				$self->{error_cb}->($@, $_);
			} else {
				die $@;
			}
		} else {
			$self->{success_cb}->($json) if $self->{success_cb};
			$stream .= ($stream && $stream !~ m/\n$/ ? "\n" : "") .  $json;
		}
	}
	return $self->{stream} = $stream;
}

sub encode_file {
	my ($self, $file) = (shift, shift);
	open my $fh, '>', $file;
	print $fh $self->encode(@_);
	close $fh;
	return $file;
}

sub decode {
	my ($self, $string) = @_;
	my @lines;
	for ($string =~ m/$LINES/g) {
		my $struct = eval { $JSON->decode($_) };
		if ($@) {
			if ($self->{error_cb}) {
				$self->{error_cb}->($@, $_);
			} else {
				die $@;
			}
		} else {
			$self->{success_cb}->($struct) if $self->{success_cb};
			push @lines, $struct;
		}
	}
	@lines = $self->_deparse_headers(@lines)
		if ($self->{parse_headers});
	return wantarray ? @lines : \@lines;
}

sub decode_file {
	my ($self, $file) = (shift, shift);
	open my $fh, '<', $file;
	my $content = do { local $/; <$fh> };
	close $fh;
	return $self->decode($content);
}

sub add_line {
	my $stream = $_[0]->{stream};
	my $add = $_[0]->encode([$_[1]]);
	$_[0]->{stream} = ($stream ? "$stream\n" : "") . $add;
	$_[0]->{stream};
}

sub clear_stream {
	$_[0]->{stream} = '';
}

sub _parse_headers {
	my ($self, @data) = @_;
	my @headers = @{ $self->{headers} };
	unless (@headers) {
		if (ref $data[0] eq 'ARRAY') {
			@headers = @{ shift @data };
		} else {
			@headers = sort keys %{ $data[0] };
		}
		$self->{headers} = \@headers;
	}
	my @body;
	for my $d (@data) {
		push @body, (ref $d eq 'ARRAY')
			? $d
			: [
				map {
					$d->{$_}
				} @headers
			];
	}
	return (
		\@headers,
		@body
	);
}

sub _deparse_headers {
	my ($self, @data) = @_;
	return @data unless ref $data[0] eq 'ARRAY';
	my @headers = @{ shift @data };
	my @body;
	for my $d (@data) {
		my $i = 0;
		push @body, (ref $d eq 'HASH')
			? $d
			: {
				map {
					$_ => $d->[$i++]
				} @headers
			};
	}
 	return @body;
}

1;

__END__