package ZConf;

use ZeusOS;

# $zc = new ZConf([$filename])       # Create new ZConfig object
 
# $zc->ZConf::load([$filename])      # read in a file

# In memory functions after load

# $value = $zc->ZConf::get( $key )   # Gets a value given a full key
# $zc->ZConf::add( $key, $value )    # Inserts or changes a key-value
# @list = $zc->ZConf::list($prefix)  # gets a list of the next level keys
#                                       matching the given prefix            
# $zc->ZConf::exists( $key )         # Test whether the given key/branch exists
# $zc->ZConf::delete( $key )         # remove a key branch or value

# $zc->ZConf::save([$filename])      # write out the file

# undef is returned on failure
# See $! for system errors

# Internally
# $self->{filename}  # source filename of current file
# $self->{file}      # loaded file contents

# Fnctl flags

$O_RDONLY = $ZeusOS::O_RDONLY;
$O_WRONLY = $ZeusOS::O_WRONLY;
$O_CREAT = $ZeusOS::O_CREAT;
$O_TRUNC = $ZeusOS::O_TRUNC;


##################################################################
#
# $zc = new ZConf([$filename]); 
#
##################################################################

sub new {
   my $class = shift;
   my $self = {};

   $self->{filename} = shift if @_;

   bless $self, $class;
}
    
##################################################################
#
# $zc->ZConf::load([$filename]) : string
#
# returns contents of a file or undef
#
##################################################################

sub load {
   my $self = shift;

   my $filename;
   if ( @_ ) {
      $filename = shift @_;
      $self->{filename} = $filename;
   } else {
      $filename = $self->{filename};
   }

   local *FILE;

   # read in and return file or undef

   # Check that the file is a plain text file
   return undef if ( ! -f $filename or ! -T _ );

   sysopen( FILE, $filename, $O_RDONLY );# or return undef;
   local $/ = undef;
   $self->{file} = <FILE>;
   close( FILE ) or return undef;

   return $self->{file};
}
    

##################################################################
#
# $zc->ZConf::save([$filename])
#
# Returns the error given if this fails
#
# No locking just a temporary file and moves
#
##################################################################

sub save {
   my $self = shift;
   
   my $filename;
   if ( @_ ) {
      $filename = shift;
   } else {
      $filename = $self->{filename};
   }
   
   my $temporary_filename = &temporary_filename( $filename );
   
   local *FILE;
   local $/ = undef;
   
   # write out the contents of the temp file   
   sysopen( FILE, $temporary_filename, $O_WRONLY|$O_TRUNC|$O_CREAT, 0666 ) or 
      return undef;
   print FILE $self->{file} or return undef;
   close FILE or return undef;
   
   if ( ! rename $temporary_filename, $filename ) {
      # unlink temp file
      unlink $temporary_filename;
      return undef;
   }      
   
   return 1;
}


##################################################################
#
# $value = $zc->ZConf::get($key) : string
#
# Looks in the config file for the given virtual server and gets the
# value corresponding to the full key given.
# This may be "" if nothing matches or the value is null.
# To differentiate between this case use exists
#
##################################################################

sub get {
   my ( $self, $key ) = @_;
   my $value = "";    
   
   return undef if ! defined $self->{file}; 
   
   my @file = split /\n/, $self->{file};
   local $_;
   
LINE:
   foreach $_ ( @file ) {
      next LINE if substr( $_, 0, 1 ) eq '#'; # comments start with ^#
      
      if ( ( $value ) = /^\Q$key\E[ \t]*(.*)/ )    # value can be ""
      {
         last LINE;     # doesn't cater for multiple matching keys
      }
   }
   
   return $value;    # "" or value
}



##################################################################
#
# $zc->ZConf::add( key, value )
#
# set a key value pair in memory
#
##################################################################

sub add {
   my ( $self, $key, $value ) = @_;
   
   return undef if ! defined $self->{file};     
   
   if ( $value =~ /[\n]/ms ) {
      # Having these characters in our value will break things
      # The function setting this field should cater for escaping them 
      # if necessary  --  pass an error back by some mechanism
      return undef;
   }
   
   if ( $key =~ /^#/ ) {
      # Comments are hash at the start of a line so 
      # you can't have one in a key
      # pass an error back
      return undef;
   }
     
   # replace line
   
   my $line = "$key $value";

   if ( ! ( $self->{file} =~ s/^\Q$key\E[ \t]*.*/$line/m ) ) {
      # or append it
      
      $self->{file} =~ s/\n+$/\n/s; # try and keep the end of the file neat
      $self->{file} .= "$line\n";
   }

   # this shouldn't have messed up anything in the file like comments
   
   return 1;
}



##################################################################
#
# @list = $zc->ZConf::list( $prefix ) : list of next key level
#
# match the leaf nodes matching the given prefix
# these can then be used to look up values
#
##################################################################

sub list {
   my ( $self, $prefix ) = @_;
   
   return undef if ! defined $self->{file};
   
   my @file = split /\n/, $self->{file};          
   
   my %keys = ();
   my $key;
   
   local $_;
   
LINE:
   foreach $_ ( @file ) {
      next LINE if substr( $_, 0, 1 ) eq '#'; # comments start with ^#            
      ( $key ) = $prefix?/^\Q$prefix\E\!([^!\s]+)\s*/:/^([^!\s]+)\s/;
      $keys{$key} = 1 if ( defined $key and $key ne "" );
   }
   
   my @keys_unsorted = keys %keys;
   my @keys;
   
   if ( grep /^\D/, @keys_unsorted ) {
      # sort lexically if not all of the keys start with a number
      @keys = sort @keys_unsorted;
   } else {
      # otherwise sort numerically
      @keys = sort { $a <=> $b } @keys_unsorted;
   }
   
   return @keys;
}
           

##################################################################
#
# @list = $zc->ZConf::listb( $prefix ) : list whole branch of keys
#
# match the branch  matching the given prefix
# these can then be used to look up values
#
##################################################################

sub listb {
   my ( $self, $prefix ) = @_;
   
   return undef if ! defined $self->{file};
   
   my @file = split /\n/, $self->{file};          
   
   my %keys = ();
   my $key;
   
   local $_;

LINE:
   foreach $_ ( @file ) {
      next LINE if substr( $_, 0, 1 ) eq '#'; # comments start with ^#            
      ( $key ) = $prefix?/^\Q$prefix\E\!(\S+)\s*/:/^(\S+)\s/;
      $keys{$key} = 1 if ( $key );
   }
   
   my @keys_unsorted = keys %keys;
   my @keys;
   
   if ( grep /^\D/, @keys_unsorted ) {
      # sort lexically if not all of the keys start with a number
      @keys = sort @keys_unsorted;
   } else {
      # otherwise sort numerically
      @keys = sort { $a <=> $b } @keys_unsorted;
   }
   
   return @keys;
}
           
    

##################################################################
#
# $zc->ZConf::exists( $key ) && &foo;
#
# See if a key exists 
#
##################################################################

sub exists {
   my ( $self, $key ) = @_;
   
   return undef if ! defined $self->{file};
   
   my @file = split /\n/, $self->{file};    
   my $existance = 0;
   
   local $_;
   
LINE:
   foreach $_ ( @file ) {
      next LINE if substr( $_, 0, 1 ) eq '#'; # comments start with ^#      
      if ( /^$key((\!.*)|\s*)/ )
      {
         $existance++;
      }
   }
   
   # match subkeys also i.e. modules!mime(!types...) exists
   
   return $existance;
}
    


##################################################################
#
# $zc->ZConf::delete( $key )
# 
# delete a key 
#
##################################################################


sub delete {
   my ( $self, $key ) = @_;
   
   return undef if ! defined $self->{file};
   
   # remove instances of this key on any line including the last one 
   # subkey deletes entire branch
   
   $key = quotemeta( $key );
   
   my @file = split /\n/, $self->{file};
   
   for( my $i=0; $i<@file; $i++ ) {
      if ( $file[$i] =~ m/^$key(?=\!.*|\s*)/ ) {
         splice( @file, $i, 1 );
         $i--;
      }
   }
   
   $self->{file} = join "\n", @file;
   $self->{file} .= "\n" if( $self->{file} !~ /\n$/ );
   
   return 1;
}    





##################################################################
# Get a filename for the temporary file
##################################################################

sub temporary_filename {
   my $path = shift @_;
   
   my @path = &split_path( $path );
   
   my $filename = pop @path;    
   $filename = '.' . $filename;  # make the temporary file a dot file
   push @path, $filename;
   
   $path = &join_path( @path );
   
   my $temporary_filename = $path . ".tmp.$$";
   my $temporary_filename_base = $temporary_filename;
   my $i = 0;
   
   # ensure uniqueness
   
   while ( -e $temporary_filename ) {
      $i++;
      $temporary_filename = $temporary_filename_base . $i;
   }
   
   return $temporary_filename;
}


##################################################################
# Split a path into an array
##################################################################

sub split_path {
   my ($path) = @_;
   
   my @path = split /\//, $path;
   
   return @path;
}


##################################################################
# Join a path from a array
##################################################################

sub join_path {
   my @path = @_;
   
   my $path = join '/', @path;
   
   return $path;
}

1;

