#!/usr/bin/perl use strict; use warnings; use IO::File; use Fcntl ':flock'; use Storable; use Benchmark 'cmpthese'; my $data={ map{join('',map{chr(rand(26)+65)}(0..rand(30))) => int(rand(400))}(0..100) }; my $file1="storage_test_a.bin"; my $file2="storage_test_b.bin"; ######################################################################## unlink($file1); unlink($file2); cmpthese(10_000, { 'store' => sub { store($data, $file1); unlink($file1), }, 'serialize' => sub { serialize($file2,$data); unlink($file2); }, }); ######################################################################## store($data, $file1); serialize($file2,$data); cmpthese(10_000, { 'retrieve' => sub { retrieve($file1); }, 'deserialize' => sub { deserialize($file2); }, }); ######################################################################## ######################################################################## ######################################################################## # hash to file sub serialize{ my ($file,$data)=@_; my $fh=IO::File->new($file, O_CREAT|O_BINARY|O_RDWR) or die("ERROR open $file ($!)\n"); if(defined $fh){ truncate $fh, 0; seek $fh, 0, 0; while(my ($k, $v) = each %$data){ print $fh pack("N", length $k).$k.pack("N", $v); } } } # hash from $file sub deserialize{ my $file = shift; my %rep; my $fh=IO::File->new($file, O_CREAT|O_BINARY|O_RDWR) or die("ERROR open $file ($!)\n"); flock($fh, LOCK_EX) or die "Your system does not support flock()!"; binmode $fh, ':raw'; seek $fh, 0, 0; my ($buffer, $key, $klen, $number) = (undef, undef, undef, undef); while(read $fh, $buffer, 4){ $klen = unpack "N", $buffer; read $fh, $key, $klen; read $fh, $buffer, 4; $rep{$key} = unpack "N", $buffer; } return \%rep; }