Util::Properties - Java.util.properties like class

package Util::Properties;

#use warnings;
use strict;
use Carp qw(croak carp confess cluck);

our $VERSION = '0.18';

our $DEFAULT_FILE_LOCKER=1;
our $DEFAULT_FILE_ISMIRRORED=1;
our $VERBOSE=0;

use Object::InsideOut 'Exporter';
BEGIN{
  our @EXPORT = qw( &getUserList &getCGIUser );
  our @EXPORT_OK = ();
}

my @_file_locker :Field(Accessor => '_file_locker', 'Type' => 'LockFile::Simple', Permission => 'private');
my @_file_md5 :Field(Accessor => '_file_md5', Permission => 'private');
my @file_ismirrored :Field(Accessor => 'file_ismirrored' );
my @file_isghost :Field(Accessor => 'file_isghost');
my @file_name :Field(Accessor => 'file_name');
my @name :Field(Accessor => 'name' );
my @_properties :Field( Accessor => '_properties', Permission => 'private');

my %init_args :InitArgs = (
			   PROPERTIES=>qr/^prop(erties)?$/i,
			   COPY=>qr/^co?py?$/i,
			   FILE=>qr/^file$/i,
			   NEWFILE=>qr/^newfile$/i,
			  );
sub _init :Init{
  my ($self, $h) = @_;

  if(ref($h)eq 'HASH'){
    if ($h->{PROPERTIES}){    #just a set of properties
      $self->prop_clean;
      foreach (keys %{$h->{PROPERTIES}}){
	$self->prop_set($_, $h->{PROPERTIES}{$_});
      }
      $self->file_locker($DEFAULT_FILE_LOCKER);
      $self->file_ismirrored($DEFAULT_FILE_ISMIRRORED);
    }elsif($h->{COPY}){
      my $src= $h->{COPY};
      #copy constructor
      $self->prop_clean;
      $self->_file_locker($src->_file_locker()) if $src->_file_locker();
      $self->file_ismirrored($src->file_ismirrored());
      $self->file_isghost($src->file_isghost());
      $self->file_name($src->file_name());
      $self->name($src->name());
      my %p=$src->prop_list;
      $self->prop_clean;
      while(my ($k, $v)=each %p){
	$self->prop_set($k, $v);
      }
    }elsif($h->{FILE}){
      #thus $h is a file name;
      $self->file_locker($DEFAULT_FILE_LOCKER);
      $self->file_ismirrored($DEFAULT_FILE_ISMIRRORED);
      $self->file_name($h->{FILE});
      unless($h->{NEWFILE} && ! -f $h->{FILE}){
	$self->load() ;
      }else{
	$self->_properties({});
      }
    }elsif(scalar (keys %$h)){
      croak "cannot instanciate constructor if hahs key is not of (properties|copy|file)";
    }else{
      $self->file_locker($DEFAULT_FILE_LOCKER);
      $self->file_ismirrored($DEFAULT_FILE_ISMIRRORED);
      $self->prop_clean;
    }
  }else{
    die "empty init :Init constructor";
  }

}


#our @attr=qw(name file_md5 file_name file_ismirrored file_isghost);
#our $attrStr=join '|', @attr;
#our $attrRE=qr/\b($attrStr)\b/;

#sub AUTOMETHOD{
#  my ($self, $obj_ID, $val)=@_;
#  my $set=exists $_[2];

#  my $name=$_;
#  return undef unless $name=~$attrRE;
#  return sub {
#    $objref{$obj_ID}{$name}=$val; return $val} if($set);
#  return sub {return $objref{$obj_ID}{$name}};
#}

sub DEMOLISH{
  my ($self, $obj_ID) = @_;
}

sub file_locker{
  my $self=shift;
  my $a0=shift;
#  my $self=$objref{ident($a0)};
  my $val=shift;

  return $self->_file_locker()  unless($val);

  if(ref($val) eq 'LockFile::Simple'){
    $self->_file_locker($val);
  }else{
    require LockFile::Simple;
    $self->_file_locker(
			LockFile::Simple->make(-format => '%f.lck',
					       -max => 20,
					       -delay => 1,
					       -nfs => 1,
					       -autoclean => 1
					      )
		       );
  }
  return $self->_file_locker();
}

############### properties

sub prop_set{
  local $_;
  my $self=shift;

  my ($k, $val)=@_;
  croak "must prop_set on a defined property key" unless $k;
  croak "cannot define a key=[$k]" if $k=~/[\s=]/;

  my $valOrig=$self->_properties()->{$k};
  $self->_properties()->{$k}=$val;
  if($self->file_ismirrored && $self->file_name && ($val ne $valOrig)){
    $self->save();
  }
}

sub prop_get{
  local $_;
  my $self=shift;

  my $k=shift or croak "must prop_get on a defined property key";
  if($self->file_ismirrored && $self->file_name && -f $self->file_name && ($self->_file_md5() ne file_md5_hex($self->file_name))){
    warn "loading from [".$self->file_name."] because of file modified for  [$k]\n" if $VERBOSE >=1;
    $self->load();
  }
  return $self->_properties()->{$k};
}

sub prop_list{
  my $self=shift;

  return %{$self->_properties()};
}

sub prop_clean{
  my $self=shift;

  $self->_properties({});
}

sub isEmpty{
  my $self=shift;
  my %h=$self->prop_list();
  return  scalar(keys %h)==0;
}


############### I/O

use Digest::MD5::File qw(file_md5_hex);

sub load{
  my $self=shift;


  my $fname=$self->file_name;
  Carp::confess "cannot read file [$fname]" unless -r $fname;

  eval{
    my $lockmgr=$self->_file_locker;
    $lockmgr->trylock("$fname") || croak "can't lock [$fname]: $!\n" if $lockmgr;
    open (FD, "<$fname") or die "cannot topen for reading [$fname]: $!";
    my @contents=<FD>;
    close FD;
    $self->_file_md5(file_md5_hex($fname));
    $lockmgr->unlock("$fname") || croak "can't unlock [$fname]: $!\n" if $lockmgr;

    $self->prop_clean;
    foreach(@contents){
      next if /^#/;
      next unless /^(\S+?)\s*=\s*(.*?)\s*$/;
      $self->_properties()->{$1}=$2;
    }
  };
  if($@){
    croak $@ unless $self->file_isghost;
  }
}

sub save{
  my $self=shift;

  my $fname=$self->file_name;

  warn "saving to [$fname]\n" if $VERBOSE >=2;
  croak "cannot save file on undefined file" unless defined $fname;

  my $contents;
  my %h=%{$self->_properties()};
  foreach (sort keys %h){
    $contents.="$_=$h{$_}\n";
  }

  my $lockmgr=$self->_file_locker;
  eval{
    $lockmgr->trylock("$fname") || croak "can't lock [$fname]: $!\n" if $lockmgr;
    open (FD, ">$fname") or die "cannot topen for writing [$fname]: $!";
    print FD $contents;
    close FD;
    $self->_file_md5(file_md5_hex($fname)) if $self->file_ismirrored;
    $lockmgr->unlock("$fname") || croak "can't unlock [$fname]: $!\n" if $lockmgr;
  };
  if($@){
    croak $@ unless $self->file_isghost;
  }
}

use overload '""' => \&toSummaryString;

sub toSummaryString{
  my $self=shift;

  my $ret="prop_name=".($self->name or 'NO_NAME')."\t".($self->file_name or '')."\n";
  my %h=$self->prop_list;
  foreach (sort keys %h){
    $ret.="\t$_\t$h{$_}\n";
  }
  return $ret;
}



return 1; # End of Util::Properties