package INSTALL::ini;

use INSTALL::common;
use strict;

my $debug = 0;

#------------------------------------------------------------------------------
# Encode newline characters into \, and \ into \\.
#------------------------------------------------------------------------------
sub encode
{
  (@_ == 1) || die "Invalid number of arguments.";

  my ($value) = @_;
  $value =~ s@\\@\\\\@;
  $value =~ s@\n@\\@;
  return($value);
}

#------------------------------------------------------------------------------
# Encode \\ into \, and \ into a newline.  Also remove trailing carriage
# returns from the output.
#------------------------------------------------------------------------------
sub decode
{
  (@_ == 1) || die "Invalid number of arguments.";

  my ($value) = @_;
  $value =~ s@([^\\])\\@$1\n@;
  $value =~ s@\\\\@\\@;
  $value =~ s@\r$@@;
  return($value);
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# External functions
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#------------------------------------------------------------------------------
# Open an ini file, returning a reference to an internally maintained structure
# which represents the ini file.  The specified ini file need not exist.  If
# it does not exist, a new ini file will be created.
#------------------------------------------------------------------------------
sub open
{
  (@_ == 1) || die "Error: Invalid number of parameters (must be 1).";
  my ($fileName) = @_;

  if (stat($fileName)) {
    return(load($fileName));
  }
  elsif (CORE::open(FILE,">>$fileName")) {
    chmod(0644,$fileName);
    close(FILE);
    return(load($fileName));
  }
  else {
    return(error("Unable to open $fileName for writing - open.\nReason: $!"));
  }
}

#------------------------------------------------------------------------------
# Given an ini tree, it will traverse all references, cloning throughout.
#------------------------------------------------------------------------------
sub clone_tree
{
  my @result;

  foreach my $value (@_) {
    my $refval = ref($value);

    unless ($refval) {
      push @result,$value;
    }
    elsif ($refval eq 'ARRAY') {
      push @result,[clone_tree(@$value)];
    }
    elsif ($refval eq 'HASH') {
      push @result,{clone_tree(%$value)};
    }
    else {
      push @result,$refval->clone($value);
    }
  }

  if (@result == 1) {
    return($result[0]);
  }
  else {
    return(@result);
  }
}

#------------------------------------------------------------------------------
# Iterate through the tree, printing each element as it is found.  Initially,
# print_tree should be used like:
#   print_tree(0,$pRoot);
#------------------------------------------------------------------------------
sub print_tree
{
  (@_ >= 1) || die "Invalid number of arguments.";

  my $depth = shift @_;

  foreach my $value (@_) {
    my $refval = ref($value);

    print("  " x $depth, $value);
    if ($refval eq 'HASH') {
      print(":");
      print_tree($depth + 1, %$value);
    }
    elsif ($refval eq 'ARRAY') {
      print(":");
      print_tree($depth + 1, @$value);
    }
    print("\n");
  }
}

#------------------------------------------------------------------------------
# Opens an existing ini file.  If the file does not exist, an error will be
# returned.  Otherwise, a reference to an ini structure will be returned.
# NOTE: The functionality of load is identical to open, except for the
# requirement of the ini file to already exist.
#------------------------------------------------------------------------------

sub load
{
  (@_ == 1) || die "Error: Invalid number of parameters (must be 1).";

  my ($fileName) = @_;

  unless (CORE::open(FILE,"<$fileName")) {
    return(error("Unable to open $fileName for reading - load\nReason: $!."));
  }
  else {
    my $line;
    my $pNewSection;
    my $newSectionName;

    my $pResult = {};
    my $pSectionOrder = [];
    my $pComments = {};

    while($line = <FILE>) {
      if ($line =~ /^\s.*$/) {
        # Ignore empty lines.
        next;
      }
      elsif ($line =~ /^\s*\#\s*(.*)$/) {
        if (defined $pNewSection) {
          push @{$pComments->{$newSectionName}},decode($1);
        }
        else {
          # Global comment name = [
          push @{$pComments->{'['}},decode($1);
        }
        next;
      }
      elsif ($line =~ /^\s*\[([^\]]*)\]\s*$/) {
        if (defined $pNewSection) {
          $pResult->{$newSectionName} = $pNewSection;
        }

        $newSectionName = $1;
        $pNewSection = {};
        push @$pSectionOrder,$newSectionName;
      }
      elsif ($line =~ /^\s*([^=\s]+)\s*=\s*(.*)$/) {
        my $key = decode($1);
        my $value = decode($2);

        # For backware compatibility reasons, if there is a double-quote at
        # the head and tail of a value, strip them.
        $value =~ s@^\"(.*)\"$@$1@;
        $pNewSection->{$key} = $value;
      }
      elsif ($line =~ /^\s*([^=\s]+)\s*$/) {
        $pNewSection->{decode($1)} = undef;
      }
      else {
        if ($debug) {
          note_log("Skipping garbage line: $line");
        }
      }
    }

    if (defined $pNewSection) {
      $pResult->{$newSectionName} = $pNewSection;
    }

    # Store the section order.
    $pResult->{']section_order'} = $pSectionOrder;

    # And the comments block.
    $pResult->{']comments'} = $pComments;

    close(FILE);

    return($pResult);
  }
}

#------------------------------------------------------------------------------
# Saves the information contained in the specified passed ini reference into
# the specified file.
#------------------------------------------------------------------------------
sub save
{
  (@_ == 2) || die "Error: Invalid number of parameters (must be 2).";

  my ($pIniData,$fileName) = @_;

  unless (CORE::open(FILE,">$fileName")) {
    return(error("Unable to open $fileName for writing - save.\nReason: $!"));
  }
  else {
    chmod(0644,$fileName);

    # Handle external comments.
    my $pComments;

    if (exists $pIniData->{']comments'}) {
      $pComments = $pIniData->{']comments'};
    }

    if (exists $pComments->{"["}) {
      foreach my $comment (@{$pComments->{'['}}) {
        print FILE "# $comment\n";
      }

      print FILE "\n";
    }

    my $pSectionOrder;

    if (exists $pIniData->{']section_order'}) {
      $pSectionOrder = $pIniData->{']section_order'};
    }
    else {
      $pSectionOrder = [getSectionNames($pIniData)];
    }

    # For each section, print it out.
    foreach my $section (@$pSectionOrder) {
      print FILE "[$section]\n";

      my $pSection = $pIniData->{$section};

      foreach my $key (keys %$pSection) {
        print FILE encode($key), "=", encode($pSection->{$key}), "\n";
      }

      # Handle internal comments.
      if (exists $pComments->{$section}) {
        my $pSectionComments = $pComments->{$section};

        foreach my $comment (@$pSectionComments) {
          print FILE "# ",encode($comment),"\n";
        }
      }

      print FILE "\n";
    }

    close(FILE);
    return(1);
  }
}

#------------------------------------------------------------------------------
# Insert a new section into the passed ini structure.  If the named section
# already exists, the return value will be that section.  It is thus impossible
# to store more than one section of the same name in an ini structure.  Upon
# success, the return value will be a reference to a section structure (a hash).
# It should be noted that changes made to this structure will result in
# alterations to the passed ini structure (by design).
#------------------------------------------------------------------------------
sub insertSection
{
  (@_ == 2) || die "Error: Invalid number of parameters (must be 2).";

  my ($pIniData,$section) = @_;

  if (exists $pIniData->{$section}) {
    return(openSection($pIniData,$section));
  }
  else {
    $pIniData->{$section} = {};

    if (not grep { $section eq $_ } @{$pIniData->{']section_order'}}) {
      push @{$pIniData->{']section_order'}}, $section;
    }

    return($pIniData->{$section});
  }
}

#------------------------------------------------------------------------------
# Delete the specified section from the passed ini structure reference. The
# reutnr value is undef, if the operation failed, or non-undef on success.  It
# should be noted that the passed ini reference (or rather the ini structure to
# which that refers), will be altered via this method.
#------------------------------------------------------------------------------
sub deleteSection
{
  (@_ == 2) || die "Error: Invalid number of parameters (must be 2).";

  my ($pIniData,$section) = @_;

  if (exists $pIniData->{$section}) {
    my $pRemoved = $pIniData->{$section};
    delete $pIniData->{$section};

    $pIniData->{']section_order'} = [grep { $section ne $_ } @{$pIniData->{']section_order'}}];
    return($pRemoved);
  }
  else {
    return(undef);
  }
}

#------------------------------------------------------------------------------
# Retrieve a list of names from the passed ini structure reference.
#------------------------------------------------------------------------------
sub getSectionNames
{
  (@_ == 1) || die "Error: Invalid number of parameters (must be 1).";

  my ($pIniData) = @_;
  my %iniData = %{$pIniData};

  my @result;
  foreach(keys %iniData) {
    # Strip special fields.
    if (not /\]/) {
      push @result,$_;
    }
  }

  return(@result);
}

#------------------------------------------------------------------------------
# Open the specified section if the section exists.  If the section does not
# exist failure will be returned.  This method is identical to insertSection,
# except that if the section does not already exist, failure will be returned.
#------------------------------------------------------------------------------
sub openSection
{
  (@_ == 2) || die "Error: Invalid number of parameters (must be 2).";

  my ($pIniData,$section) = @_;

  if (exists $pIniData->{$section}) {
    return($pIniData->{$section});
  }
  else {
    return(undef);
  }
}

#------------------------------------------------------------------------------
# Each section also has associated with it a comments section.  This section
# of comments will be appended to the end of the section data as # <comment>
# ... for each comment contain in the list.  When read from the ini file in
# question, they will be output in the order read in.  This method returns a
# reference to an array.  In this way, by changing this array, you will be
# changing the ini data.  If the section named does not already exist, undef
# will be returned (see insertComments).
#------------------------------------------------------------------------------
sub openComments
{
  (@_ == 1) || (@_ == 2) || die "Invalid number of arguments.";

  my ($pIniData,$section) = @_;

  if ((not $section) || ($section eq "[")) {
    $section = "[";
  }
  elsif (not exists $pIniData->{$section}) {
    return(undef);
  }

  if (not exists $pIniData->{']comments'}) {
    $pIniData->{']comments'} = {};
  }

  if (not exists $pIniData->{']comments'}->{$section}) {
    $pIniData->{']comments'}->{$section} = [];
  }

  return($pIniData->{']comments'}->{$section});
}

#------------------------------------------------------------------------------
# Identical to openComments except that if the specified section does not exist
# it will be added.
#------------------------------------------------------------------------------
sub insertComments
{
  (@_ == 1) || (@_ == 2) || die "Invalid number of arguments.";

  my ($pIniData,$section) = @_;

  if (not $section) {
    $section = "[";
  }
  elsif (not exists $pIniData->{$section}) {
    $pIniData->{$section} = {};
  }

  return(openComments($pIniData,$section));
}

1;