# -------------------------------------------------------------------------------------
# lib::Config
# -------------------------------------------------------------------------------------
#
#       Author : Jean-Michel Hiver (jhiver@cisedi.com).
#    Copyright : (c) Jean-Michel Hiver, 2000.
# 
#      Unauthorized modification, use, reuse, distribution or redistribution
#      of this module is stricly forbidden.
#
#    Description:
#
#      A simple class that can be used to quickly parse config files.
#      It is meant to parse config files which are a set of key / value pairs
#      separared by spaces or tabs.
#
#      Lines which start with # are comments.
#
# -------------------------------------------------------------------------------------
package lib::Config::Line;
use strict;


##
# __PACKAGE__->new ($string);
# ---------------------------
#   Construct a new lib::Config::Line object from $string
#   which should be a file config line.
##
sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $self = bless {}, $class;

    $self->init (@_);
    return $self;
}


##
# $obj->init ($string);
# ---------------------
#   Initializes the lib::Config::Line object properties
#   by splitting $string up.
##
sub init
{
    my $self = shift;
    my $string = shift;
    chomp ($string);

    # if the string is empty, just don't do anything
    $string =~ /^\s*$/ and return;

    # if the line starts with a comment, then it's all a comment
    if ($string =~ /^\#.*/) { $self->cmt ($string) }
    else
    {
	# else has this line got comments ?
	if ($string =~ /(?<!\\)\#/)
	{
	    my ($key, $val, $cmt) = $string =~ /(.*?)\s+(.*?)\s+(.*)/;
	    $self->key ($key);
	    $self->val ($val);
	    $self->cmt ($cmt);
	}
	else
	{
	    if ($string =~ /\S+(\s+)\S+/)
	    {
		my ($key, $val) = $string =~ /(.*?)\s+(.*)/;
		$self->key ($key);
		$self->val ($val);
	    }
	    else
	    {
		my $key = $string;
		my $val = 1;
		$self->key ($key);
		$self->val ($val);
	    }
	}
    }
}


##
# $obj->to_string();
# ------------------
#   Returns the string representation of this
#   lib::Config::Line object.
##
sub to_string
{
    my $self = shift;
    unless ($self->key or $self->val or $self->cmt) { return "" }

    my $val = $self->val;
    $val =~ s/\#/\\\#/g;
    if ($self->cmt)
    {
	if ($self->key or $self->val) { return $self->key . "\t" . $val . "\t" . $self->cmt }
	else                          { return $self->cmt }
    }
    else { return $self->key . "\t" . $val }
}


##
# $obj->key;
# ----------
#   property accessor.
##
sub key
{
    my $self = shift;
    if (@_) { $self->{key} = shift }
    else    { return $self->{key}  }
}


##
# $obj->val;
# ----------
#   property accessor.
##
sub val
{
    my $self = shift;
    if (@_)
    {
	my $val = shift;
	$val =~ s/\\(.)/$1/g;
	$self->{val} = $val;
    }
    else    { return $self->{val} }
}

##
# $obj->cmt;
# ----------
#   property accessor.
##
sub cmt
{
    my $self = shift;
    if (@_) { $self->{cmt} = shift }
    else    { return $self->{cmt} }
}


package lib::Config;
use strict;
use vars qw /$DIR $MPH/;
use MKDoc::System::MPH;

$DIR = ".";


##
# $obj->new;
# ----------
#   Constructs a new lib::Config object.
#
# $obj->new ($file);
# ------------------
#   Constructs a new lib::Config object and loads $file info.
##
sub new
{
    $DIR =~ s/\/$//;
    my $class = shift;
    $class    = ref $class || $class;

    # if the config was already loaded for that file,
    # then return it rather than re-parsing everything
    my $file = shift;
    defined $MPH->{$file} and return $MPH->{$file};
    
    my $self = bless {
	file  => undef,
	line  => []
	}, $class;

    $self->file ($file);
    $self->load if (defined $self->file);

    # saves the current object for the next time it will
    # be requested, and returns it
    $MPH->{$file} = $self;
    return $self;
}


##
# $obj->keys;
# -----------
#   Returns the keys of the current lib::Config file.
##
sub keys
{
    my $self = shift;
    my @res  = ();
    foreach my $line (@{$self->{line}})
    {
	push @res, $line->{key} if (defined $line->{key});
    }
    return @res;
}


##
# $obj->get ($key);
# -----------------
#   Returns the attribute matching $key.
##
sub get
{
    my $self = shift;
    my $key  = shift;
    foreach my $line (@{$self->{line}})
    {
	if (defined $line->{key} and $line->{key} eq $key)
	{
	    return $line->val;
	}
    }
    return undef;
}


##
# $obj->set ($key, $attr);
# ------------------------
#   Sets the attribute for $key to $attr.
##
sub set
{
    my $self = shift;
    my $key  = shift;
    foreach my $line (@{$self->{line}})
    {
	if (defined $line->{key} and $line->{key} eq $key)
	{
	    $line->val (shift());
	    return;
	}
    }
    $self->add ($key, shift);
}


##
# $obj->add ( $key, $value, $comment );
# -------------------------------------
##
sub add
{
    my $self = shift;
    if (@_ == 1) { push @{$self->{line}}, new lib::Config::Line ( shift() ) }
    else
    {
	my $line = new lib::Config::Line();
	$line->key (shift());
	$line->val (shift());
	$line->cmt (shift()) if (@_);
	push @{$self->{line}}, $line;
    }
}


##
# $obj->file;
# -----------
#   Accessor for file property.
##
sub file
{
    my $self = shift;
    if (@_) { $self->{file} = shift }
    else    { return $self->{file}  }
}


##
# $obj->write;
# ------------
#   Writes the config file.
##
sub write
{
    my $self = shift;
    my $file = shift;
    $file = $self->file unless (defined $file);
    $file or die "Cannot write-open an Unknown file";
    open FP, ">$DIR/$file" or die "Cannot write-open $DIR/$self->{file}. Reason $@"; 
    for (@{$self->{line}}) { print FP $_->to_string . "\n" }
    close FP;
}


##
# $obj->load;
# -----------
#   Loads the config file. # comments are ignored.
#   \ backslashes every character.
##
sub load
{
    my $self = shift;
    my $file = shift || $self->file || die "Cannot read-open an Unknown file";
    $self->{line} = [];
    open FP, "<$DIR/$file" or die "Cannot read-open $DIR/$self->{file}. Reason $@"; 
    while (<FP>) { $self->add ($_) }
    close FP;
}


##
# $obj->hash;
# -----------
#   Returns a hashref that can be used in place of a lib::Config object.
##
sub hash
{
    my $self = shift;
    my %hash = map { $_ => $self->get ($_) } $self->keys;
    return \%hash;
}


1;


=head1 DESCRIPTION

------------------------------------------------------------------------------------
lib::Config
------------------------------------------------------------------------------------

      Author : Jean-Michel Hiver (jhiver@cisedi.com).
   Copyright : (c) Jean-Michel Hiver, 2000.
 
     Unauthorized modification, use, reuse, distribution or redistribution
     of this module is stricly forbidden.

   Description:

     A simple class that can be used to quickly parse config files.
     It is meant to parse config files which are a set of key / value pairs
     separared by spaces or tabs.

     Lines which start with # are comments.

------------------------------------------------------------------------------------

=head2 Overview

lib::Config is a module that easily lets you parse user configuration files.
It support comments.

=head2 In a nutshell

A config file could look like:

    # da          Danish
    nl          Dutch
    en          English
    en-gb       English (United Kingdom)
    en-us       English (United States)
    fr          French
    # fr-be       French (Belgium)
    # fr-ca       French (Canada)


If config/ is your base config files directory, in the beginning of your
script you would do:

    use lib::Config;

    # no trailing slash
    # the default directory is '.' if you don't specify it
    lib::Config::DIR = '/home/httpd/config';
    
    $config = new lib::Config ('my_config_file.cfg');
    
    # the modules works like a hash, at some point in the
    # future I'll have to implement a tied version
    
    # prints all the key / value pairs for that config file
    print join "\n", map { $_ . " : " . $config->get ($_) } $config->keys;
    
    # set some properties and saves the config file
    $config->set ('foo', 'bar');
    $config->write;
