InSilicoSpectro::Utils::FileCached - InSilicoSpectro::Utils::FileCached documentation

use strict;

package InSilicoSpectro::Utils::FileCached;
require Exporter;
use Carp;

use File::Temp qw /tempdir tempfile/;
use Data::Serializer;

our (@ISA, @EXPORT, @EXPORT_OK);
@ISA = qw(Exporter);

our $REMOVE_TEMP_FILES=1;
our $QUEUE_MAX_LEN=500;

@EXPORT = qw($REMOVE_TEMP_FILES $QUEUE_MAX_LEN &verbose &queueMaxSize &dump_all $keyCpt);
@EXPORT_OK = ();

our %key2queueEl;
our %serializeParams;#=(serializer=>'Data::Dumper');
our %dictionary;

our ($queueHead, $queueTail);
our $queueLen=0;

our $keyCpt=0;

our ($verbose, $tempDir);

sub new{
    my $pkg=shift;
    my %h=@_;
    my $self={
	      FC_key=>$keyCpt++,
	     };
    bless $self, $pkg;
    unless ($h{persistent}){
      $self->queueShift;
    }else{
      $self->FC_persistent(1);
    }
    $dictionary{$self->FC_key}=$self;
#     warn $dictionary{$self->FC_key}." == ".$self;
#     Carp::confess ("".$dictionary{$self->FC_key} eq "".$self) unless("".$dictionary{$self->FC_key} eq "".$self);
    return $self;
}


sub verbose{
  my $v=shift;
  if(defined $v){
    $verbose=$v;
  }
  return $v;
}

sub FC_tempdir{
  unless ($tempDir){
    $tempDir=tempdir(File::Spec->tmpdir()."/File-Cached-XXXXXX", CLEANUP=>$REMOVE_TEMP_FILES, UNLINK=>$REMOVE_TEMP_FILES);
    warn "tempdir=$tempDir" if $verbose;
  }
  return $tempDir;
}
sub FC_getme{
  my $self=shift;

  return $self if $self->FC_persistent;
  #warn "FC_getme\t".$self->FC_key."\t(".$self->FC_file.") [$self] \n" if $verbose;

  if($self->FC_file){
    $self->FC_load;
  }else{
    $self->FC_refresh;
  }
  return $self;
}

sub FC_save{
  my $self=shift;
  my ($fh, $fname)=tempfile(DIR=>FC_tempdir(), UNLINK=>$REMOVE_TEMP_FILES, SUFFIX=>".fccached");
  my $serializer = Data::Serializer->new(%serializeParams);
  $serializer->store($self, $fh);
  close $fh;
  $self->FC_file($fname);
  #warn "FC\t".$self->FC_key." [$self] save in $fname\n";

  foreach (keys %$self){
    next if /^FC_/;
    delete $self->{$_};
  }
}

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

sub FC_persistent{
  my $self=shift;
  if(exists $_[0]){
    $self->{FC_persistent}=shift;
    if($self->{FC_persistent}){
      $self->queueRemove;
    }
  }
  return $self->{FC_persistent};
}

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

sub FC_load{
  my $self=shift;
  my $fname=$self->FC_file or croak "cannot FC_load an object when file does not exits";
  my $serializer = Data::Serializer->new(%serializeParams);
  my $h=$serializer->retrieve($fname) or croak "could not retrieved from serialized file [$fname]: $!";
  foreach (keys %$h){
    $self->{$_}=$h->{$_};
  }
  #warn "FC\t".$self->FC_key." [$self] retrieved from $fname\n";
  #  TODO check if has side effect not to delete the file?
  #unlink $fname;
  delete $self->{FC_file};
  $self->queueShift;

}

sub FC_eject{
  my $self=shift;
  delete $queueTail->{prev}{next};
  delete $key2queueEl{$queueTail->{object}->FC_key};
  $queueTail->{object}->FC_save;
  $queueTail=$queueTail->{prev};
  delete $queueTail->{next};
  $queueLen--;
}

sub FC_refresh{
  my $self=shift;
  return if $queueHead->{object}->FC_key==$self->FC_key;
  if($self->FC_file){
    $self->FC_load;
  }else{
  
    my $qel=$key2queueEl{$self->FC_key};
    my $second=$queueHead;
    $qel->{prev}{next}= $qel->{next};
    $qel->{next}{prev}=$qel->{prev} if  $qel->{next};
    $queueTail=$qel->{prev} if $queueTail==$qel;

    $queueHead=$qel;
    # HEHEHE just commentedq
    #$self->queueShift;
    $queueHead->{next}=$second;
    $second->{prev}=$queueHead;
    $queueHead->{prev}=undef;
  
  }
}

#
sub queueShift{
  my $self=shift;
  my $h={
	 object=>$self,
	 prev=>undef,
	 next=>undef,
	};
  if( exists $key2queueEl{$self->FC_key}){
    Carp::cluck "[".$self->FC_key."] AREADY IN QUEUE!";
  }else{
    $key2queueEl{$self->FC_key}=$h;
    if ($queueHead){
      $queueHead->{prev}=$h;
      $h->{next}=$queueHead;
      $queueHead=$h;
    }else{
      $queueHead=$h;
      $queueTail=$h;
    }
    $dictionary{$self->FC_key}=$self;

    $queueLen++;
    if(queueOverflow()){
      warn "queueOverflow" if $verbose>2;
      $queueTail->{object}->FC_eject;
    }
  }
}

sub queueRemove{
  my $self=shift;
  if(exists $key2queueEl{$self->FC_key}){
    my $qel=$key2queueEl{$self->FC_key};
    $qel->{prev}{next}=$qel->{next} if $qel->{prev};
    $qel->{next}{prev}=$qel->{prev} if $qel->{next};
    $queueHead= $qel->{next} if($qel==$queueHead);
    $queueTail= $qel->{prev} if($qel==$queueTail);
    delete $qel->{prev};
    delete $qel->{next};
    delete $key2queueEl{$self->FC_key};
    $queueLen--;
  }

}

sub queueMaxSize{
  my %h=@_;
  if($h{nbobj}>0){
    $QUEUE_MAX_LEN=$h{nbobj};
  }
  return $QUEUE_MAX_LEN;
}

sub queueOverflow{
  return scalar(keys %key2queueEl)>$QUEUE_MAX_LEN;
}

sub queueDump{
  return unless $queueHead;
  print "queue len=$queueLen\n";
  my $qel=$queueHead;

  while ($qel){
    Carp::cluck unless $qel->{object};
    print $qel->{object}->FC_key;
    print "*" if $qel->{object}->FC_persistent;

    print "\t".ref($qel->{object})."\t".($qel->{prev} or 'NOPREV')."\t".($qel->{next} or 'NONEXT')."\t[".$qel->{object}->FC_persistent."]\n";
    $qel=$qel->{next};
  }
}

sub dump_all{
  foreach (sort {$a <=> $b} keys %dictionary){
    print "$_\t".$dictionary{$_}."\t".$dictionary{$_}->FC_key;
    print "*" if $dictionary{$_}->FC_persistent;
    print "\t".($dictionary{$_}->FC_file or "in_mem")."\n";
  }
}

return 1;