Hash-Persistent
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Hash/Persistent.pm view on Meta::CPAN
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};
close $tmp;
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};
}
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.775 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )