package Hash::Persistent;
our $VERSION = '1.01'; # VERSION
# ABSTRACT: nested hashref serializable to the file
use strict;
use warnings;
use autodie qw( open close chmod rename );
use Data::Dumper;
use Storable qw(thaw nfreeze);
use JSON;
use Carp;
use Lock::File 1.01 qw(lockfile);
my %defaults = (
read_only => 0,
auto_commit => 0,
format => 'auto',
lock => 1,
write_only => 0,
);
my $meta = {};
sub new {
my $class = shift;
my ($fname, $options, $lock_options) = @_;
$lock_options ||= {};
$options ||= {};
my $_self = {%defaults, %$options};
if ($options->{read_only} and $options->{auto_commit}) {
croak "Only one of 'read_only' and 'auto_commit' options can be true";
}
if ($_self->{read_only}) {
$_self->{auto_commit} = 0;
$_self->{lock} = 0;
}
if ($_self->{lock}) {
$lock_options = $_self->{lock} if ref $_self->{lock};
my $lock = lockfile("$fname.lock", { mode => $_self->{mode}, blocking => 1, remove => 1, %$lock_options });
unless (defined $lock) {
return;
}
$_self->{lock} = $lock;
}
$_self->{fname} = $fname;
my $self;
if (-e $fname and not $_self->{write_only}) {
open my $fh, '<', $fname;
my $data;
local $/;
my $str = <$fh>;
if ($str =~ m{^\$data = }) {
eval $str;
die "Can't eval $fname: $@" unless $data;
die "Invalid data in $fname: $data" unless ref $data;
$self = $data;
$_self->{format} = 'dumper' if $_self->{format} eq 'auto';
} elsif ($str =~ /^{/) {
$self = JSON->new->decode($str);
$_self->{format} = 'json' if $_self->{format} eq 'auto';
}
else {
$self = thaw($str);
$_self->{format} = 'storable' if $_self->{format} eq 'auto';
}
} else {
$_self->{format} = 'json' if $_self->{format} eq 'auto'; # default format for new files
$self = {};
}
bless $self => $class;
$meta->{$self} = $_self;
return $self;
}
sub commit {
my $self = shift;
my $_self = $meta->{$self};
if ($_self->{removed}) {
croak "$_self->{fname} is already removed and can't be commited";
}
if ($_self->{read_only}) {
croak "Can't commit to $_self->{fname}, object is read only";
}
my $fname = $_self->{fname};
my $tmp_fname = "$fname.tmp";
open my $tmp, '>', $tmp_fname;
my $serialized;
if ($_self->{format} eq 'dumper') {
my $dumper = Data::Dumper->new([ { %$self } ], [ qw(data) ]);
$dumper->Terse(0); # somebody could enable terse mode globally; TODO - explicitly specify other options too?
$dumper->Purity(1);
$dumper->Sortkeys(1);
$serialized = $dumper->Dump;
}
elsif ($_self->{format} eq 'json') {
$serialized = JSON->new->encode({ %$self });
}
else {
$serialized = nfreeze({ %$self });
}
print {$tmp} $serialized or die "print failed: $!";
chmod $_self->{mode}, $tmp_fname if defined $_self->{mode};
rename $tmp_fname => $fname;
}
sub DESTROY {
local $@;
my $self = shift;
my $_self = $meta->{$self};
if ($_self->{auto_commit} and not $self->{removed}) {
my $commited = eval {
$self->commit();
1;
};
delete $meta->{$self}; # delete object anyway, commited or not
unless ($commited) {
ERROR $@;
}
}
else {
delete $meta->{$self};
}
}
sub remove {
my $self = shift;
my $_self = $meta->{$self};
if ($_self->{read_only}) {
croak "Can't remove $_self->{fname}, object is read only";
}
if (-e $_self->{fname}) {
unlink $_self->{fname} or die "Can't remove $_self->{fname}: $!";
}
if ($_self->{lock}) {
my $lock_fname = $_self->{lock}->name;
if (-e $lock_fname) {
unlink $lock_fname or die "Can't remove $lock_fname: $!";
}
}
$_self->{removed} = 1;
delete $self->{$_} for keys %$self;
}
1;
__END__
=pod
=head1 NAME
Hash::Persistent - nested hashref serializable to the file
=head1 VERSION
version 1.01
=head1 SYNOPSIS
use Hash::Persistent;
$obj = Hash::Persistent->new("./obj.state"); # give a file to keep state
$obj->{string} = "hello world"; # and use just like a regular perl hash
$obj->commit; # save the data to the state file
$obj->{string} = "world hello";
undef $obj; # force destroying; data will not be saved
$obj = Hash::Persistent->new("./obj.state", { auto_commit => 1 });
$obj->{string} = "hello world";
undef $obj; # the last update is commited
$obj = Hash::Persistent->new("./obj.state", { read_only => 1 }); # do not flock
print $obj->{string};
$obj->{string} = "hello"; # ok, local modifications
$obj->commit; # dies, cannot commit a readonly persistent
$obj = Hash::Persistent->new("./obj.state", {}, {blocking => 0}); # pass some options to flock call
$obj = Hash::Persistent->new("./obj.state", {format => "storable"});
undef $obj; # recode state into storable format
foreach my $key (%$obj) {} # $obj is guaranteed not to contain any internal keys
=head1 DESCRIPTION
C<Hash::Persistent> serializes its data to the single file using L<Data::Dumper>, L<Storable> or L<JSON>.
The object reads the state from given file when created, and writes the new state when destroyed.
No multithreading - the file is locked with C<flock> while object exists.
=head1 METHODS
=over
=item B<< new($options, $lock_options) >>
These constructor options are supported:
=over
=item I<auto_commit>
If true, state will be commited when object is destroyed.
It is recommended not to turn this option on and call C<commit()> explicitly every time, because perl ignores all exceptions thrown from destructors.
Off by default.
=item I<read_only>
If set, object can't be commited, I<auto_commit> can't be set, and object won't try to obtain a lock.
Off by default.
=item I<write_only>
Supressing the loading of data from an existing file. Useful for generating a new state and avoid failures if the previous one is currupted. It also can be used for minor performance improvements.
Off by default.
=item I<lock>
If true, take the global waiting lock for the whole lifetime of the object.
On by default.
=item I<mode>
If set, it will chmod the output file to the given value after each commit.
=item I<format>
Possible values: B<dumper>, B<storable>, B<json>.
If not specified and file already exists, will be detected automatically. If not specified and file doesn't exist, B<json> will be used as default.
B<json> format is fast, readable and secure, but can't serialize objects.
B<dumper> format is human-readable and can serialize objects, but insecure and slow.
B<storable> format can serialize objects and fast, but unreadable by humans and insecure.
=back
Additionally, any C<Lock::File> options can be passed as a third parameter.
=item B<< commit() >>
Write data on disk.
File will be written in atomic fashion, using tmpfile, so when disk is full, data will not be lost.
=item B<< remove() >>
Remove persistent file.
This method is lock-unsafe, which means that you shouldn't try to create persistent file again soon after this call.
=back
=head1 SEE ALSO
L<Hash::Persistent::Memory>
=head1 AUTHORS
=over 4
=item *
Vyacheslav Matyukhin <me@berekuk.ru>
=item *
Andrei Mishchenko <druxa@yandex-team.ru>
=item *
Artyom V. Kulikov <breqwas@yandex-team.ru>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2013 by Yandex LLC.
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