package JSON_File;
BEGIN {
$JSON_File::AUTHORITY = 'cpan:GETTY';
}
# ABSTRACT: Tie a hash or an array to a JSON
$JSON_File::VERSION = '0.004';
use Moo;
use JSON::MaybeXS;
use Path::Class;
use autodie;
has json => (
is => 'ro',
lazy => 1,
default => sub {
my $self = shift;
my $json = JSON->new()->utf8(1)->canonical(1);
$json = $json->convert_blessed($self->convert_blessed) if $self->has_convert_blessed;
$json = $json->allow_blessed($self->allow_blessed) if $self->has_allow_blessed;
$json = $json->allow_unknown($self->allow_unknown) if $self->has_allow_unknown;
$json = $json->pretty($self->pretty) if $self->has_pretty;
return $json;
},
);
has pretty => (
is => 'ro',
lazy => 1,
predicate => 1,
);
has allow_unknown => (
is => 'ro',
lazy => 1,
predicate => 1,
);
has allow_blessed => (
is => 'ro',
lazy => 1,
predicate => 1,
);
has convert_blessed => (
is => 'ro',
lazy => 1,
predicate => 1,
);
has filename => (
is => 'ro',
required => 1,
);
has abs_filename => (
is => 'ro',
lazy => 1,
default => sub { file(shift->filename)->absolute },
);
has tied => (
is => 'ro',
required => 1,
);
sub BUILD {
my ( $self ) = @_;
$self->abs_filename;
}
sub data {
my ( $self ) = @_;
if (-f $self->abs_filename) {
return $self->load_file;
} else {
if ($self->tied eq 'HASH') {
return {};
} elsif ($self->tied eq 'ARRAY') {
return [];
}
}
}
sub add_data {
my ( $self, $key, $value ) = @_;
my $data = $self->data;
if ($self->tied eq 'HASH') {
$data->{$key} = $value;
} elsif ($self->tied eq 'ARRAY') {
$data->[$key] = $value;
}
$self->save_file($data);
}
sub remove_data {
my ( $self, $key, $value ) = @_;
my $data = $self->data;
if ($self->tied eq 'HASH') {
delete $data->{$key};
} elsif ($self->tied eq 'ARRAY') {
delete $data->[$key];
}
$self->save_file($data);
}
sub load_file {
my ( $self ) = @_;
local $/;
open( my $fh, '<', $self->abs_filename );
my $json_text = <$fh>;
return $self->json->decode( $json_text );
}
sub save_file {
my ( $self, $data ) = @_;
local $/;
open( my $fh, '>', $self->abs_filename );
my $json_text = $self->json->encode( $data );
print $fh $json_text;
close($fh);
}
sub TIEHASH {shift->new(
filename => shift,
tied => 'HASH',
@_,
)}
sub TIEARRAY {shift->new(
filename => shift,
tied => 'ARRAY',
@_,
)}
sub FETCH {
my ( $self, $key ) = @_;
if ($self->tied eq 'HASH') {
return $self->data->{$key};
} elsif ($self->tied eq 'ARRAY') {
return $self->data->[$key];
}
}
sub STORE {
my ( $self, $key, $value ) = @_;
$self->add_data($key,$value);
}
sub FETCHSIZE {
my ( $self ) = @_;
return scalar @{$self->data};
}
sub PUSH {
my ( $self, @values ) = @_;
my @array = @{$self->data};
push @array, @values;
$self->save_file(\@array);
}
sub UNSHIFT {
my ( $self, @values ) = @_;
my @array = @{$self->data};
unshift @array, @values;
$self->save_file(\@array);
}
sub POP {
my ( $self ) = @_;
my @array = @{$self->data};
my $value = pop @array;
$self->save_file(\@array);
return $value;
}
sub SHIFT {
my ( $self ) = @_;
my @array = @{$self->data};
my $value = shift @array;
$self->save_file(\@array);
return $value;
}
sub SPLICE {
my $self = shift;
return splice(@{$self->data},@_);
}
sub DELETE {
my ( $self, $key ) = @_;
$self->remove_data($key)
}
sub EXISTS {
my ( $self, $key ) = @_;
if ($self->tied eq 'HASH') {
return exists $self->data->{$key};
} elsif ($self->tied eq 'ARRAY') {
return exists $self->data->[$key];
}
}
sub SCALAR {
my ( $self ) = @_;
return scalar %{$self->data};
}
sub CLEAR {
my ( $self ) = @_;
if ($self->tied eq 'HASH') {
$self->save_file({});
} elsif ($self->tied eq 'ARRAY') {
$self->save_file([]);
}
}
sub EXTEND {}
sub STORESIZE {}
sub FIRSTKEY {
my ( $self ) = @_;
if ($self->tied eq 'HASH') {
my ( $first ) = sort { $a cmp $b } keys %{$self->data};
return defined $first ? ($first) : ();
} elsif ($self->tied eq 'ARRAY') {
return scalar @{$self->data} ? (0) : ();
}
}
sub NEXTKEY {
my ( $self, $last ) = @_;
if ($self->tied eq 'HASH') {
my @sorted_keys = sort { $a cmp $b } keys %{$self->data};
while (@sorted_keys) {
my $key = shift @sorted_keys;
if ($key eq $last) {
if (@sorted_keys) {
return (shift @sorted_keys);
} else {
return;
}
}
}
} elsif ($self->tied eq 'ARRAY') {
my $last_index = (scalar @{$self->data}) - 1;
if ($last < $last_index) {
return $last+1;
} else {
return;
}
}
}
sub UNTIE {}
sub DESTROY {}
1;
__END__
=pod
=head1 NAME
JSON_File - Tie a hash or an array to a JSON
=head1 VERSION
version 0.004
=head1 SYNOPSIS
use JSON_File;
tie( my %data, 'JSON_File', 'data.json' );
$data{key} = "value"; # data directly stored in file
print $data{key}; # data is always read from file, not cached
$data{hash} = { attribute => "value" };
# DON'T set $data{hash}->{attribute} directly, it will not get saved
tie( my @array, 'JSON_File', 'array.json' );
push @array, "value";
# you can enable functions of the JSON object:
tie( my %other, 'JSON_File', 'other.json',
pretty => 1,
allow_unknown => 1,
allow_blessed => 1,
convert_blessed => 1,
);
=head1 DESCRIPTION
This module is allowing you to bind a perl hash or array to a file. The data
is always read directly from the file and also directly written to the file.
This means also that if you add several keys to the hash or several elements
to the array, that every key and every element will let the complete json file
be rewritten.
=encoding utf8
=head1 SUPPORT
IRC
Join #sycontent on irc.perl.org. Highlight Getty for fast reaction :).
Repository
http://github.com/Getty/p5-json_file
Pull request and additional contributors are welcome
Issue Tracker
http://github.com/Getty/p5-json_file/issues
=head1 AUTHOR
Torsten Raudssus <torsten@raudss.us>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Torsten Raudssus.
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