package PersistentCounter;

use strict;
use warnings;
use IO::File;
use Cwd 'abs_path';
use Carp;
use Fcntl ':flock';
use base 'Tie::Hash';
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');

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

  # get object data
  my $data=$self->_get_data();

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

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

  # apply autoincrement for custom keys like 'foo', 'bar'
  $data->{$_}++ 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;
  my $data=$self->_get_data();
  if(exists($data->{$key}))
  {
    if($value =~ /^\d+$/)
    { $data->{$key} = $value; }
    else
    { carp "Value is not numeric"; }
  }
  else
  { carp "Key not predefined"; }
}

sub FETCH
{
  my $self = shift;
  my $key = shift;
  my $data=$self->_get_data();
  return $data->{$key} if(exists($data->{$key}));

  carp "Key not predefined";
  return undef;
}

sub EXISTS
{
  my $self = shift;
  my $key = shift;
  my $data=$self->_get_data();
  return exists($data->{$key});
}

sub DELETE
{
  my $self = shift;
  my $key = shift;
  my $data=$self->_get_data();
  return delete($data->{$key}) if(exists($data->{$key}));

  carp "Key not predefined";
  return undef
}

sub FIRSTKEY
{
  my $self = shift;
  my $data=$self->_get_data();
  $self->{keys}=[keys(%$data)];
  return shift(@{$self->{keys}});
}

sub NEXTKEY
{
  my $self = shift;
  return shift(@{$self->{keys}});
}

sub CLEAR
{
  my $self = shift;
  my $data=$self->_get_data();
  %$data=();
}

sub SCALAR
{
  my $self=shift;
  return $self->{file};
}

sub UNTIE
{
  my $self = shift;
  $self->_serialize();
}

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

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

# get the Loaded Hash
sub _get_data
{
  my $self=shift;
  return $files{$self->{file}}->{data};
}

# hash from $file
sub _initialize
{
  my $class=shift;
  $class=ref($class) if(ref($class));
  my $file = shift;
  # absolut path for identification

  $file=abs_path($file);

  # return same object for one file;
  unless($files{$file})
  {
    my $fh=__file_open($file) or return undef;
    $files{$file}->{fh}=$fh;
    $files{$file}->{file}=$file;

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

    $files{$file}->{data}=$ref;
  }

  my $self={file=>$file, keys=>[]};
  bless($self,$class);

  # object count
  # only save and close file if all objects are distroyd
  $files{$file}->{objcount}++;

  return $self;
}

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

  # should be ok every time
  if(exists($files{$file}))
  {
    $files{$file}->{objcount}--;

    # make sure no more Objects using the file
    if($files{$file}->{objcount}==0)
    {
      my $data=$files{$file}->{data};
      my $fh=$files{$file}->{fh};
      delete($files{$file}->{fh});

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

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

      delete($files{$file});
    }
  }
}

# open and lock 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;