package PersistentCounter;

use strict;
use warnings;
use IO::File;
use File::Spec;
use Carp;
use Fcntl ':flock';
use Tie::Hash;
use base 'Tie::ExtraHash';
use Storable qw(fd_retrieve store_fd);

# VARs intern
our %files;

# Constructor
sub TIEHASH
{
  my $class = shift;
  my $ref = shift or return;

  croak ('No ref HASH in Arg') if ref $ref ne 'HASH';
  croak('No file is given, use {-file => $file} in Args') if not exists $ref->{-file};

  # autoincrement
  my $inc=$ref->{-increment};
  $inc=[] if(!$inc || ref($inc) ne 'ARRAY');

  # force initialize keys
  my $keys=$ref->{-keys};
  $keys=[] if(!$keys || ref($keys) ne 'ARRAY');

  my $self=_initialize($class,$ref->{-file}) or return undef; # IO-Error

  croak('No keys given, use {-keys => [...]} or {-increment => [...]}') if(!%{$self->[0]} && !(@$keys || @$inc));

  for(@$keys)
  { $self->[0]->{$_}=0 unless(defined($self->[0]->{$_})); }

  # apply autoincrement for custom keys like 'foo', 'bar'
  $self->[0]->{$_}++ for(@$inc);

  return $self;
}

# Overload method, make sure that value is numeric and the key exisis
sub STORE
{
  my $self = shift;
  my $key = shift;
  my $value = shift;
  if(exists($self->[0]->{$key}))
  {
    if($value =~ /^\d+$/)
    { $self->[0]->{$key} = $value; }
    else
    { carp "Value is not numeric"; }
  }
  else
  { carp "Key not predefined"; }
}

sub FETCH
{
  my $self = shift;
  my $key = shift;
  return $self->[0]->{$key} if(exists($self->[0]->{$key}));

  carp "Key not predefined";
  return undef;
}

sub DESTROY
{
  my $self = shift;
  _serialize($self);
}

########################################################################

# hash from $file
sub _initialize
{
  my $class=shift;
  my $file = shift;
  $file=File::Spec->rel2abs($file);

  # return same object for one file;
  return $files{$file} if($files{$file});

  my $self=[{},{ fh=>undef, file=>undef }];

  my $fh=__file_open($file) or return undef;
  $self->[1]->{fh}=$fh;
  $self->[1]->{file}=$file;

  my $ref = {};
  eval { $ref = fd_retrieve($fh) };
  # caught exception: file is void
  $ref={} if($@);

  $self->[0]=$ref;

  bless($self,$class);
  $files{$file}=$self;

  return $self;
}

# hash to file
sub _serialize
{
  my $self = shift;

  # get all important values
  my $file=$self->[1]->{file};
  my $fh=$self->[1]->{fh};
  my $data=$self->[0];

  # clean up object
  delete($self->[1]->{fh});
  delete($self->[1]->{file});
  $self->[0]=undef;
  $self->[1]=undef;
  @$self=();

  unless($fh)
  { $fh=__file_open($file) or return; }

  $fh->seek(0,0);
  truncate($fh,0);
  store_fd($data, $fh);
  $fh->close();

  delete($files{$file});
}

sub __file_open
{
  my $file=shift;
  my $fh=IO::File->new($file, O_CREAT|O_BINARY|O_RDWR) or return undef;
  flock($fh,LOCK_EX) or carp "Your system does not support flock()!";
  $fh->binmode(':raw');
  return $fh;
}

1;