package ElchemeaConfig;
#$Id: ElchemeaConfig.pm,v 1.45 2016/03/09 09:44:39 sofc Exp $

# Ignore leading dashes on some lines as they indicate that the line should be parsed
# verbatim to Latex!

####################################################################################
#
#
#      Package ElchemeaConfig
#
# Use: 
#
# my $id = ElchemeaConfig->new($filename);
#
# my $id = ElchemeaConfig->new(SemaforeFile_instance);
#
# Or
#
# my $id = ElchemeaConfig->new($filename,$lockfilename);
#
#
# This class is intended to be used for accessing a file where the data is stored
# in the way of key = value pairs inside sections delimited by SECTION $name - ENDSECTION
# pairs (example below)
#
# -- \begin{tabular}{l}
# -- SECTION testsection \\
# -- key1 = value1 \\
# -- key2 = value2 \\
# -- ENDSECTION \\
# -- \end{tabular}
# 
# In the example above any leading '#' should be removed as they indicate comments and the 
# ElchemeaConfig package honors this convention making it possible to include comments in
# the data file (configuration file). 
#
# The ElchemeaConfig module incorporates the possibility to use transactions.
#
# All ElchemeaConfig instances honors the following member functions:
# 
# $id->debug()          Sets or gets the debug level (inherited from Debug.pm).
# $id->die($)           Terminates current process with supplied string (with stacktrace)
#                       as errorcode (Inherited from debug.pm).
# $id->filename()       Returns the filename of the configuration file.
# $id->readlines()      Returns the content of the file, only allowed outside a transaction
# $id->writeline(@)     Write the supplied strings to the file (note owerwrites file!), 
#                       Only works outside a transaction.
# $id->modtime()        Returns the last time of modification for the file. Note that when a
#                       transaction is initiated the time reported will be the last time
#                       before transaction initiation!
# $id->get_config_value($$)
#                       Returns the value associated with the specified key in the specified
#                       section (arguments: $section, $key).
#                       If called in a list context, returns a list of values based on the
#                       value of the specified key (value split along commas, ignores spaces around commas)
# $id->get_sections()   Returns a list of the section names in the file.
# $id->get_keys($)      Returns a list of key names for the specified section name.
# $id->is_readonly()    Returns true if the file is read only, false if the file is writable.
# $id->section_exists($)
#                       Returns true if the specified section exists in the file.
# $id->exists($$)       Returns true if the specified key exists in the specified section.
#                       Arguments: section, key
# $id->change_config_value($$$[opt @values])
#                       Changes the value associated with the specified section - key pair
#                       to the specified value. If inside a transaction, the change is
#                       stored in an internal data structure and the file itself is not
#                       changed. subsequent calls to get_config_value() with this pair as
#                       argument will return the new (not yet commited) value instead of the
#                       value stored in the file. 
#                       Required arguments: $section,$key,$newvalue.
#                       If additional arguments all the additional values as well as the first
#                       are stored as a comma separated list (thus conforming with get_config_value
#                       called in a list context)
# $id->error()          Returns the errorstring (returns an empty string if no error).
# $id->begin()          Initiates a transaction.
# $id->commit()         Commits any changes (through calls to change_config_value()) to the file.
#                       If the file itself has changed between the initiation of the transaction
#                       and the commit, a warning is issued and no changes is written, thus 
#                       always check the return status of commit (1 for succes, 0 otherwise).
#                       If an error or warning orccours the error string is set.
# $id->rollback()       Discards any changes not yet committed.
#
# Note that if a transaction is initiated and no commit is issued, aotumatic rollback occours 
# uppon instance destruction and/or program termination.
#
#
####################################################################################


use strict;
use warnings;
use SemaforeFile;
use Fcntl qw(:DEFAULT :flock);
use Debug;
our @ISA = qw(Debug);

my $configlock = '/tmp/ElchemeaConfig.lock';

BEGIN {
    use Exporter ();
    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0;
    %EXPORT_TAGS = (
        'standard'=>[],
                    );
    Exporter::export_ok_tags('standard');
    Exporter::export_tags('standard');
    @ISA = qw(Exporter);
    $configlock = '/tmp/ElchemeaConfig.lock';
    if (!-e $configlock)
    {
	sysopen(FH, $configlock, O_WRONLY | O_CREAT) or CORE::die "Error: Could not open $configlock $!";
	chmod 0666, $configlock;
	close FH;
    }
}



sub new
{
    my $class = shift;
    my $self = $class->SUPER::new();
    my $fn = shift;
    if (ref($fn) && ref($fn) eq 'SemaforeFile')
    {
	$self->{'_filename'} = $fn;	
    }
    else
    {
	if (@_)
	{
	    my $lock = shift;
	    $self->{'_filename'} = SemaforeFile->new($fn,$lock);	
	}
	else
	{
	    $self->{'_filename'} = SemaforeFile->new($fn,$configlock);	
	}
    }
    $self->{'_data'} = undef;
    $self->{'_modtime'} = 0;
    $self->{'_transaction'} = 0;
    $self->{'_error'} = '';
    $self->{'_transaction_data'} = [];
    bless $self,$class;
    return $self;
};

return 1;

sub error()
{
    my $self = shift;
    return $self->{'_error'};
}

sub filename()
{
    my $self = shift;
    return $self->{'_filename'}->filename;
}

sub begin()
{
    my $self = shift;
    if ($self->{'_transaction'})
    {
	$self->die("A new transaction can not be initiated while inside anoter transaction!");
    }
    $self->{'_transaction'} = 1;
}

sub commit()
{
    my $self = shift;
    unless ($self->{'_transaction'})
    {
        $self->die("Error: Attempting to commit outside a transaction!");	
    }
    unless (@{$self->{'_transaction_data'}})
    {
	$self->writedebug('Warning, no data changes to commit, no changes made!');
	$self->{'_transaction'} = 0;
	return 1;
    }
    $self->{'_transaction'} = 2;
    $self->{'_filename'}->lock_ex;
    if ($self->{'_modtime'} != $self->{'_filename'}->mtime)
    {
	$self->{'_error'} = "Could not commit changes as file appears to have changed since transaction was initiated!";
	$self->writedebug($self->{'_error'},1); 
	return 0;
    }
    while ( my $item = shift(@{$self->{'_transaction_data'}}))
    {
	$self->change_config_value($$item{'section'},$$item{'key'},$$item{'value'});
    }
    $self->{'_filename'}->lock_un;
    $self->{'_transaction'} = 0;
    return 1;
}

sub rollback()
{
    my $self = shift;
    $self->writedebug('Rolling back changes!');
    $self->{'_transaction'} = 0;
}


sub readlines()
{
    my $self = shift;
    if ($self->{'_transaction'} == 1)
    {
        $self->die("Error: You can not issue readlines within a transaction!");	
    }
    return $self->{'_filename'}->readlines();
}

sub writeline(@)
{
    my $self = shift;
    if ($self->{'_transaction'} == 1)
    {
        $self->die("Error: You can not issue writeline within a transaction!");	
    }
    return $self->{'_filename'}->writeline(@_);
}

sub modtime()
{
    my $self = shift;
    return $self->{'_modtime'};
}

sub debug()
{
    my $self = shift;
    $self->SUPER::debug(@_);
    if (@_)
    {
	$self->{'_filename'}->debug($self->{'_debug'});
    }
    return $self->{'_debug'};
}

sub exists($$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    unless (defined($section) && defined($key))
    {
	$self->writedebug("Undefined section or key specified",1);
	return undef;
    }
    $self->load_config unless ($self->{'_data'} || $self->{'_transaction'} == 1);
    return ($self->section_exists($section) && (ref($self->{'_data'}{$section}) eq 'HASH') && exists($self->{'_data'}{$section}{$key}));
}

sub section_exists($)
{
    my $self = shift;
    my $section = shift;
    unless (defined($section))
    {
	$self->writedebug("Undefined section specified",1);
	return undef;
    }
    $self->load_config unless ($self->{'_data'} || $self->{'_transaction'} == 1);
    return exists($self->{'_data'}{$section});
}

sub add_section($)
{
    my $self = shift;
    my $section = shift;
    return undef if $self->section_exists($section);
    $self->writedebug("Adding section '$section'") if ($self->debug > 1);
    $self->die("File ".$self->{'_filename'}->filename." is read only!") if ($self->{'_filename'}->readonly);
    my $string = "\n\nSECTION $section\nENDSECTION\n\n";
    $self->{'_filename'}->append($string);
    $self->load_config;
    return $section;
}

sub get_sections($)
{
    my $self = shift;
    if (($self->{'_modtime'} != $self->{'_filename'}->mtime) && ($self->{'_transaction'} == 0))
    {
	$self->writedebug("Modification time for file has changed, reloading configuration") if ($self->debug);
	$self->load_config() 
    }
    return keys %{$self->{'_data'}};
}

sub get_keys($)
{
    my $self = shift;
    if (($self->{'_modtime'} != $self->{'_filename'}->mtime) && ($self->{'_transaction'} == 0))
    {
	$self->writedebug("Modification time for file has changed, reloading configuration") if ($self->debug);
	$self->load_config() 
    }
    my $section = shift;
    return undef unless $self->section_exists($section);
    return keys %{$self->{'_data'}{$section}};
}

sub add_key($$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    $self->die("File ".$self->{'_filename'}->filename." is read only!") if ($self->{'_filename'}->readonly);
    $self->add_section($section) unless ($self->section_exists($section));
    return undef if ($self->exists($section,$key));
    $self->writedebug("Adding key '$key' to section '$section'") if ($self->debug > 1);
    my $newstring = "$key = \n";
    $self->{'_filename'}->lock_ex unless ($self->{'_transaction'} == 2);
    my $res = 0;
    my $count = 0;
    $self->{'_filename'}->open_read;
    my $found = 0;
    my @data = ();
    while (my $string = $self->{'_filename'}->readline)
    {
	$count++;
	if ($string =~ /^[\s\t]*\#/)
	{
	    push @data, $string;
	    next;
	}
	if ($found && $string =~ /ENDSECTION/)
	{
	    ### Writes the new key ###
	    push @data, $newstring;
	    $found = 0;
	    $res = $count;
	}
	push @data, $string;
	if ($string =~ /SECTION $section/)
	{
	    $found = 1;
	}
    }
    $self->{'_filename'}->close_unsafe;
    if ($res)
    {
	$self->{'_filename'}->writeline(@data);
    }
    $self->{'_filename'}->unlock unless ($self->{'_transaction'} == 2);
    $self->load_config;
    return $res;
}


sub is_readonly
{
    my $self = shift;
    return $self->{'_filename'}->readonly;
}

sub load_config
{
    my $self = shift;
    $self->writedebug("Loading configuration") if ($self->debug > 1);
    $self->{'_filename'}->lock_sh unless ($self->{'_transaction'} == 2);
    $self->{'_modtime'} = $self->{'_filename'}->mtime;
    $self->{'_filename'}->open_read;
    my $section_name = undef;
    my $res = 0;
    my %global = ();
    while(my $string = $self->{'_filename'}->readline)
    {
	next if ($string =~ /^[\s\t]*\#+/);
	chomp $string;
	if ($string =~ /ENDSECTION/)
	### Checks for end of section ###
	{
	    $section_name = undef;
	    next;
	}
	if ($string =~ /SECTION\s+([\w\-\.]+)\b/)
	    ### Checks for the requested section ###
	{
	    $section_name = $1;
	    ### Make sure that the section key exists even though no data is defined ###
	    $global{$section_name} = {};
	    next;
	}
	next unless ($section_name);
	if ($string =~ /^[\s\t]*([\w\.\-]+)[\s\t]*\=[\s\t]*(.*)/i)
	{
	    my $key = $1;
	    my $val = $2;
	    ### Remove any stray spaces, tabs or newlines at end of value ####
	    $val =~ s/[\s\t\r\n]*$// if (defined($val));
	    $global{$section_name}{$key} = $val;
	    $global{$section_name}{$key} = undef if (defined($val) && $val =~ /^[\s\t]*$/);
	    $res++;
	}
    }
    $self->{'_filename'}->close_unsafe;
    $self->{'_filename'}->unlock unless ($self->{'_transaction'} == 2);
    $self->{'_data'} = \%global;
}

sub get_config_value($$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    if ($self->{'_transaction'})
    {
	foreach my $item (@{$self->{'_transaction_data'}})
	{
	    next unless ($$item{'section'} eq $section);
	    next unless ($$item{'key'} eq $key);
	    my $val = $$item{'value'};
	    $val = undef if (defined($val) && $val =~ /^[\s\t]*$/);
	    if (wantarray)
	    {
		return () unless defined ($val);
		return split(/\s*\,\s*/,$val);
	    }
	    return $val;
	}
    }
    if ($self->{'_modtime'} != $self->{'_filename'}->mtime)
    {
	$self->writedebug("Modification time for file has changed, reloading configuration") if ($self->debug);
	$self->load_config() 
    }
    $self->writedebug("Getting configuration value for '$key' in section '$section'") if ($self->debug > 3);
    my $res = undef;
    $res = $self->{'_data'}{$section}{$key} if $self->exists($section,$key);
    if (wantarray)
    {
	$self->writedebug("Returning result as array split along commas as called in list context") if ($self->debug > 3);
	return () unless (defined($res));
	return split(/\s*\,\s*/,$res);
    }
    return $res;
}


sub change_config_value($$$)
{
    my $self = shift;
    my $section = shift;
    my $key = shift;
    my $newvalue = join(',',@_);
    if ($self->{'_transaction'} == 1)
    {
	### First look up transaction data and update if section-key pair exist here ##
	foreach my $item (@{$self->{'_transaction_data'}})
	{
	    next unless ($$item{'section'} eq $section);
	    next unless ($$item{'key'} eq $key);
	    $$item{'value'} = $newvalue;
	    return;
	}
	### Create new transaction data if no match found ###
	my %h = ('section'=>$section,'key'=>$key,'value'=>$newvalue);
	push @{$self->{'_transaction_data'}},\%h;
	return;
    } 
    $self->add_key($section,$key) unless ($self->exists($section,$key));
    $self->writedebug("Changing configuration value for '$key' to '$newvalue' in section '$section'") if ($self->debug > 1);
    $self->{'_modtime'} = 0;
    $self->die("File ".$self->{'_filename'}->filename." is read only!") if ($self->{'_filename'}->readonly);
    my $res = 0;
    $self->{'_filename'}->lock_ex unless ($self->{'_transaction'} == 2);
    $self->{'_filename'}->open_read;
    my $found = 0;
    my @data = ();
    my $count = 0;
    while(my $string = $self->{'_filename'}->readline)
    {
	$count++;
	push @data, $string;
	chomp $string;
	next if ($string =~ /^[\s\t]*\#/);
	if ($found)
	{
	    if ($string =~ /ENDSECTION/)
	    {
		$found = 0;
	    }
	    else
	    {
		if ($string =~ /^[\s\t]*$key\s+\=/)
		{
		    $res = $count - 1;	
		}
	    }
	}
	if ($string =~ /SECTION $section[\s\t]*$/)
	{
	    $found = 1;
	}
    }
    $self->{'_filename'}->close_unsafe;
    if ($res)
    {
	### Writes the new walue ###
	$data[$res] = $key.' = '.$newvalue."\n";
	$self->{'_filename'}->writeline(@data);
    }
    $self->{'_filename'}->unlock unless ($self->{'_transaction'} == 2);
    return $res;
}


sub DESTROY
{
    my $self = shift;
    if ($self->{'_transaction'})
    {
        $self->writedebug("Implicitly issuing rollback for incomplete transaction",1);
        $self->rollback;
    }
    $self->{'_filename'}->DESTROY() if ($self->{'_filename'});
}
