File Coverage

blib/lib/JSON/Lines.pm

Criterion	Covered	Total	%
statement	100	112	89.2
branch	30	50	60.0
condition	4	6	66.6
subroutine	18	19	94.7
pod	10	10	100.0
total	162	197	82.2

package JSON::Lines;
use 5.006; use strict; use warnings; our $VERSION = '1.00';
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 .= $json . ($json =~ m/\n$/ ? "" : "\n");
		}
	}
	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;
	push @lines, $self->_decode_line($_)
		for ($string =~ m/$LINES/g);
	@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 ($self, $line, $fh) = @_;
	if (defined $fh) {
		print $fh $self->encode([$line]);
	} else {
		my $stream = $self->{stream};
		my $add = $self->encode([$line]);
		$self->{stream} =  $stream .  $add;
		$self->{stream};
	}
}

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

sub get_lines {
	my ($self, $fh, $lines) = @_;
	my @lines;
	for (1 .. $lines) {
		my $line = $self->get_line($fh);
		push @lines, $line;
		last if eof($fh);
	}
	return wantarray ? @lines : \@lines;
}

sub get_line {
	my ($self, $fh) = @_;
	my $line = '';
	$line .= <$fh> while ($line !~ m/^$LINES/ && !eof($fh));
	return $self->_decode_line($line);
}

sub _decode_line {
	my ($self, $line) = @_;
	my $struct = eval { $JSON->decode($line) };
	if ($@) {
		if ($self->{error_cb}) {
			return $self->{error_cb}->($@, $line);
		} else {
			die $@;
		}
	}
	return $self->{success_cb}->($struct, $line) if $self->{success_cb};
	return $struct;
}

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__