package Tie::Cfg;

use strict;
use LockFile::Simple;
use vars qw($VERSION %cnf);

$VERSION="0.32";

sub TIEHASH {
  my $class = shift;
  my $args  = { READ       => undef,
                WRITE      => undef,
                MODE       => 0640,
                LOCK       => undef,
                SEP		   => "=",
                REGSEP     => undef,
                COMMENT    => ";",
                REGCOMMENT => undef,
		CHANGE     => undef,
                @_
              };
  my $file    = $args->{READ};
  my $outfile = $args->{WRITE};
  my $lock    = $args->{LOCK};
  my $mode    = $args->{MODE};
  my $sep     = $args->{SEP};
  my $splitsep= $args->{REGSEP};
  my $comment = $args->{COMMENT};
  my $regcmnt = $args->{REGCOMMENT};
  
  if (not $splitsep) { $splitsep=$sep; }
  if (not $regcmnt)  { $regcmnt=$comment; }

  my %cnf = ();
  my $fh;
  my $val;
  my $key;
  my $prekey="";
  
  $outfile="" if (not $outfile);

  my $node = {
     CNF   => {},
     FILE  => $outfile,
     MODE  => $mode,
     LOCK  => undef,
     SEP   => $sep,
     SSEP  => $splitsep,
     CMNT  => $comment,
     SCMNT => $regcmnt,
  };

  if ($lock and $outfile) {
      $node->{LOCK}=LockFile::Simple->make(-max => 30, -delay => 1, -nfs => 1);
      $node->{LOCK}->lock($outfile);
  }

  if (-e $file) {

    my $section="";
    
    open $fh, $file;
    
    while (<$fh>) {
      next if /^\s*$/;
      next if /^\s*$regcmnt/;
      
      if (/^\s*\[.*\]\s*$/) {
	      $section=$_;
	      $section=~s/^\s*\[//;
	      $section=~s/\]\s*$//;
	      $section=~s/^\s+//;
	      $section=~s/\s+$//;
	      
	      $prekey="";
	      for (split /\./,$section) {
		      $prekey.="{$_}";
	      }
	      
	      next;
      }
      
      ($key,$val) = split /$splitsep/,$_,2;
      $key=~s/^\s+//;$key=~s/\s+$//;
      $val=~s/^\s+//;$val=~s/\s+$//;

      for my $chg (@{$args->{CHANGE}}) {
        $val=__change($chg,$val);
      }
      
      if ($key=~/([\[][0-9]+[\]])$/) {
	      my $index;
	      $index=$key;
	      
	      $key=~s/([\[][0-9]+[\]])$//;
	      
	      $index=substr($index,length($key));
	      $index=~s/[\[]//;
	      $index=~s/[\]]//;
	      
	      eval('$cnf'."$prekey"."{$key}[$index]=".'"'."$val".'"');
      }
      else {
	      eval('$cnf'."$prekey"."{$key}=".'"'."$val".'"');
      }
    }
    close $fh;
    
    $node->{CNF}=\%cnf;
  }

  my $this=bless $node, $class;


return $this;
}

sub getHash {
	my $s=shift;
	my $r;
	($s,$r)=split /\./,$s,2;
	my %c;
	
	return $c{s}
}

sub __change {
  my $change=shift;
  my $value=shift;
  my $from;
  my $to;
  my $g;

  if (not $to) {
    if ($change=~/g$/) {
      $g="g";
    }
    $change=~s/^s//;
    $change=~s/^\///;
    $change=~s/g$//;
    $change=~s/\/$//;
    ($from,$to)=split /\//,$change,2;
  }

  if (not defined $g) { $g=""; }

  if ($g eq "g") {
    $value=~s/$from/$to/g;
  }
  else {
    $value=~s/$from/$to/;
  }


$value;
}


sub FETCH {
  my $self = shift;
  my $key  = shift;
  return $self->{CNF}->{$key};
}

sub STORE {
  my $self = shift;
  my $key  = shift;
  my $val  = shift;
  $self->{CNF}->{$key}=$val;
return $val;
}

sub DELETE {
  my $self = shift;
  my $key  = shift;
  delete $self->{CNF}->{$key};
}

sub EXISTS {
  my $self = shift;
  my $key  = shift;
  return exists $self->{CNF}->{$key};
}

sub FIRSTKEY {
  my $self = shift;
  my $temp = keys %{$self->{CNF}};
  return scalar each %{$self->{CNF}};
}

sub NEXTKEY {
  my $self = shift;
  return scalar each %{$self->{CNF}};
}

sub DESTROY {
  my $self = shift;
  my $fh;
  
  if ($self->{FILE}) {
    open $fh,">",$self->{FILE};
    
    print $fh $self->{CMNT}," Tie::Cfg version $VERSION (c) H. Oesterholt-Dijkema, license perl\n";
    print $fh "\n";
    
    __write_self($self->{CNF},$fh,0,$self->{SEP},$self->{CMNT},"");
    
    close $fh;
    chmod $self->{MODE},$self->{FILE};

    if ($self->{LOCK}) {
      $self->{LOCK}->unlock($self->{FILE});
    }
  }
}


sub __write_self {
	my $cfg     = shift;
	my $fh      = shift;
	my $depth   = shift;
	my $sep	    = shift;
	my $cmnt    = shift;
	my $section = shift;
	
	my $key;
	my $value;
	
    # Pass 1, Keys that are no sections
    
    if ($section) {
	    print $fh "[$section]\n";
    }
    
    while (($key,$value) = each %{$cfg}) {
	    if (ref($value) ne "HASH") {
		    if (ref($value) eq "ARRAY") {
			    my $idx=0;
			    for my $element (@{$value}) {
				    print $fh "$key","[$idx]","$sep","$element\n";
				    $idx+=1;
			    }
		    }
		    else {
			    print $fh "$key","$sep","$value\n";
		    }
	    }
    }
    
    # Pass 2, keys that are sections
    
    while (($key,$value) = each %{$cfg}) {
		if (ref($value) eq "HASH") {
		    # OK, It's a section
		    
		    if ($depth==0) {
		        __write_self($value,$fh,$depth+1,$sep,$cmnt,$key);
	        }
	        else {
		        __write_self($value,$fh,$depth+1,$sep,$cmnt,$section.".".$key);
	        }
		    
	    }
    }
    
}

=pod

=head1 NAME

Tie::Cfg - Ties simple configuration (.ini) files to hashes.
           Handles arrays and recurrent sections.

=head1 WARNING

This version breaks previous versions as the default mode is '.ini' mode.

=head1 SYNOPSIS

  use Tie::Cfg;
  
  ### Sample 1

  tie my %conf, 'Tie::Cfg',
    READ   => "/etc/connect.cfg",
    WRITE  => "/etc/connect.cfg",
    MODE   => 0600,
    LOCK   => 1;

  $conf{test}="this is a test";

  untie %conf;
  
  ### Sample 2

  my $limit="10000k";

  tie my %files, 'Tie::Cfg',
    READ  => "find $dirs -xdev -type f -size +$limit -printf \"%h/%f:%k\\n\" |", SEP => ':';

  if (exists $files{"/etc/passwd"}) {
    print "You've got a /etc/passwd file!\n";
  }

  while (($file,$size) = each %newdb) {
    print "Wow! Another file bigger than $limit ($size)\n";
  }
  
  untie %files;
  
  ### Sample 3
  
  tie my %cfg, 'Tie::Cfg', READ => "config.cfg", WRITE => "config.cfg", SEP => ':', COMMENT => '#';
  
  my $counter=$cfg{"counter"};
  $counter+=1;
  $cfg{"counter"}=$counter;
  $cfg{"counter"}+=1;
  
  untie %cfg;
  
  ### Reading and writing an INI file
  
  tie my %ini, 'Tie::Cfg', READ => "config.ini", WRITE => "config.ini";
  
  my $counter=$ini{"section1"|{"counter1"};
  $counter+=1;
  $ini{"section1"}{"counter1"}=$counter;

  untie %ini;

  ### INI file with subsections
  
  tie my %ini, 'Tie::Cfg', READ => "config.ini";
  
  my $counter=$ini{"section1"}{"counter1"};
  $counter+=1;
  $ini{"section1"}{"counter1"}=$counter;
  
  $ini{"section1"}{"subsection1"}{"parameter"}="value";
  
  my @array;
  for(1..10) { push @array,$_; }
  $ini{"section1"}{"array"}{"a"}=@array;

  untie %ini;

  ### CHANGE option

  tie my %paths, 'Tie::Cfg', READ => "paths.ini", 
                             CHANGE => [ "s/PREFIX/$myprefix/", "s/CONF/$myconfidir/" ];

  # Do something here
  
  untie %paths;


=head1 DESCRIPTION

This module reads in a configuration file at 'tie' and writes it at 'untie'.

You can use file locking to prevent others from accessing the configuration file,
but this should only be used if the configuration file is used as a small data file 
to hold a few entries that can be concurrently accessed.
Note! In this case a persistent ".lock" file will be created.

Mode is used to set access permissions; defaults to 0640. It's only set
if a file should be written (i.e. using the WRITE keyword).

INIMODE lets you choose between Windows alike .ini configuration files and simple 
key[:=]value entried files.

Sections are addressed using a hash within a hash: For a tied %cfg the assignment:

  $cfg{"section"}{"key"}="value"
  
will write in the configuration file:

  [section]
  key=value

Keys that end on [\[][0-9]+[\]] will be interpreted as arrays and will show up
in the tied hash as an array element. For example:

  [array-section]
  var[0]=1
  var[1]=2
  var[2]=3

will show up in a tied %cfg hash like:

  for (0..2) {
    print $cfg{"array-section"}{"var"}[$_],"\n";
  }
  
Hashes of hashes are permitted:

	$cfg{"key"}{"subkey"}{"subsubkey"}{"subsubsubkey"}{"par"}="value";
	
will show up in the configuration file as:  

	[key.subkey.subsubkey.subsubsubkey]
	par=value


=head1 PREREQUISITE

Perl's Version >= 5.6.0! Please don't test this module with
anything earlier. 

=head1 AUTHOR

Hans Oesterholt-Dijkema <hans@oesterholt-dijkema.emailt.nl>

=head1 BUGS

Probably.

=head1 LICENCE

Perl.

=end


