#!/opt/perl5/bin/perl -w
#
# ---------------------------------------------------------------
# install.pl
#
# This perl script modifies a set of files, replacing tokens
# embedded in the file with values read from a config file.
#
# This allows a new installation of a group of files to be
# customised according to a set of properties appropriate
# to the environment in which the install is being done.
#
# There are two configuration files required for this program:
# (a) The "install.cfg" file that defines what files are to
#     be modified, and what character string defines a modifiable 
#     item within a file.
# (b) The "installTokens.cfg" file that defines all the 
#     (token, value) pairs for replacement operations.
#
# ---------------------------------------------------------------
# The install.cfg configuration file is expected to have 
# the following entries (keys are literal, values are examples):
# 
#   installPattern = .install
#   replacePattern = @([\\c]*)@
# ---------------------------------------------------------------
# The installTokens.cfg configuration file is expected to have 
# the following format:
# 
#  token_name_1 = token_value_1
#  token_name_2 = token_value_2
#
# ---------------------------------------------------------------
# This program then:
# (a) Finds any file whose name matches the "installPattern".
#     Normally, this installPattern will match a file suffix,
#     eg "\.install$", which will match any file name which
#     ends in ".install".
# (b) For each matched file, copies the contents to a file with
#     the same name, but without the installPattern. As the
#     file contents are copied, each line is inspected for a
#     pattern matching the replacePattern. Occurrences of this
#     pattern are replaced by the corresponding entry from the
#     installTokens.cfg file.
#
# Error handling:
# * if a replacePattern is found in a file, but no such token
#   exists in the config file, this is considered an error.
# * if a token exists in installTokens.cfg, but no such pattern
#   is found, this is not an error.
# ---------------------------------------------------------------

use strict;
use English;
use DirHandle;
use FileHandle;
use File::Basename;

sub main();
sub installFiles($$$$);
sub updateFiles($$$$$$$);
sub copyFile($$$$);
sub mkList($);
sub isIncluded($$$);
sub getFileList($$$$$);
sub readConfigFile($);
sub printHash($);
sub printList($);

main();

sub main()
{
  print "Hello, welcome to the installer program.\n";

  my $config;
  my $tokens;

  my $installConfigFileName = "./install.cfg";
  my $installTokenFileName = "../installTokens.cfg";

  print "Loading config file [$installConfigFileName]...\n";
  $config = readConfigFile($installConfigFileName);

  print "Loading token file [$installTokenFileName]...\n";
  $tokens = readConfigFile($installTokenFileName);

  my $installPattern = $config->{"installPattern"};
  my $replacePattern = $config->{"replacePattern"};

  if (!defined $installPattern)
  {
    die "installPattern not defined";
  }

  if (!defined $replacePattern)
  {
    die "replacePattern not defined";
  }

  installFiles(".", $installPattern, $replacePattern, $tokens);
}

#---------------------------------------------------------------------------
# installFiles
#
# PURPOSE:
# * Search the baseDir tree for any files with the given suffix, then
#   copy the file to a name without the suffix.
#---------------------------------------------------------------------------
sub installFiles($$$$)
{
  print "installing files...\n";

  my ($baseDir, $installPattern, $replacePattern, $tokens) = @_;

  my @includeDirs = ();
  my @excludeDirs = ();
  my @includeFiles = ($installPattern);
  my @excludeFiles = ();
  my @fileList = getFileList($baseDir, \@includeDirs, \@excludeDirs, \@includeFiles, \@excludeFiles);

  my $filename;
  foreach $filename (@fileList)
  {
    my $outfilename = $filename;
    $outfilename =~ s/$installPattern//;

    print "installing [$filename] to [$outfilename]\n";

    if (-e $outfilename)
    {
      print "target file exists: removing [$outfilename]\n";
      if (! -f $outfilename)
      {
        die "Can't copy a file to [$outfilename]: that target already exists, and is not a file";
      }

      chmod(0666, $outfilename); # necessary, as unlink won't delete read-only files
      unlink($outfilename);

      if (-e $outfilename)
      {
        die "Can't remove file [$outfilename]";
      }
      print "removed file [$outfilename]\n";
    }

    copyFile($filename, $outfilename, $replacePattern, $tokens);
  }
}

#---------------------------------------------------------------------------
# copyFile
#
# INPUTS:
# * input filename
# * output filename
# * pattern
# * tokens - ref to hash
#
#---------------------------------------------------------------------------
sub copyFile($$$$)
{
  my ($infilename, $outfilename, $pattern, $tokens) = @_;

  my $result;
  print "replacing text in file [$infilename]\n";

  my $inFile = new FileHandle;
  $result = $inFile->open($infilename, "<");
  if (!$result)
  {
    die "Could not open input file [$infilename]";
  }

  my $outFile = new FileHandle;
  $result = $outFile->open("${outfilename}", ">");
  if (!$result)
  {
    die "Could not create output file [$outfilename]";
  }

  my $line;
  while ($line = $inFile->getline())
  {
    while ($line =~ /$pattern/)
    {
      # ok, here comes the tricky bit - finding the actual
      # key sequence...we assume that the 

      my ($key) = $line =~ /$pattern/;
      if (!defined $key) 
      {
        die "Error: bad replacePattern in config file : no key defined";
      }
 

      my $value = $tokens->{$key};
      if (!defined $value)
      {
        die "Error: key [$key] has no defined value in config file";
      }
   
      print "replacing key [$key] with value [$value]\n";
      $line =~ s/$pattern/$value/;
    }

    $outFile->print($line);
  }

  $inFile->close();
  $outFile->close();
}

#---------------------------------------------------------------------------
# mkList
#
# Purpose:
# * converts a (possibly undef) string of comma-separated items into a
#   list.
#
# INPUTS:
# * arg : may be undef, or a string of one or more comma-separated items
#
# RETURNS:
# * an empty list if arg is undef
# * otherwise, a list of the items
#---------------------------------------------------------------------------
sub mkList($)
{
  my $arg = shift;
  my @list = ();

  if (defined $arg)
  {
    @list = split(",", $arg);
  }

  return \@list;
}

#---------------------------------------------------------------------------
# isIncluded
#
# Purpose:
# * determines if a string (eg filename) passes an "included/excluded" test
#
# INPUTS:
# * item is any string (but normally a file or directory name)
# * included is a ref to a list of regexps (size 0 or more). If non-empty,
#   then the item *must* match one of the regexps.
# * excluded is a ref to a list of regexps (size 0 or more). If non-empty,
#   then the item must *not* match any of the regexps.
#
# NOTES:
# * none
#---------------------------------------------------------------------------
sub isIncluded($$$)
{
  my ($item, $included, $excluded) = @_;

  if (@{$included} > 0)
  {
    # check that the item is in one of the
    # included patterns. If not, return false.
    # if it is found, then break out & go to
    # the excluded test

    my $found;
    my $incPattern = "";

    foreach $incPattern (@$included)
    {
      if ( $item =~ m/$incPattern/ )
      {
        $found = 1;
        last;
      }
    }

    if (!$found)
    {
      return 0;
    }
  }

  if (@{$excluded} > 0)
  {
    # check that the item is not in any
    # excluded pattern. If found, return false.

    my $exPattern = "";
    foreach $exPattern (@$excluded)
    {
      if ( $item =~ m/$exPattern/ )
      {
        return 0;
      }
    }
  }

  return 1;
}

#---------------------------------------------------------------------------
# getFileList
#
# Purpose:
# * generates a list of files matching a certain criteria
#
# INPUTS:
# * basedir : must be a directory name (relative or absolute)
# * includeDirs
# * excludeDirs
# * includeFiles
# * excludeFiles
#
# NOTES:
# * all the include and exclude params are refs to (possibly empty) lists.
# * if the include lists are empty, everything is included, otherwise
#   only the specified directories are included.
#---------------------------------------------------------------------------
sub getFileList($$$$$)
{
  my ($baseDirName, $includeDirs, $excludeDirs, $includeFiles, $excludeFiles) = @_;
  my @fileList = ();
  my $filename = "";

  my $baseDir = new DirHandle;
  my $ok = $baseDir->open($baseDirName);
  if (!$ok)
  {
    die "invalid base directory [$baseDirName]";
  }

  while ($filename = $baseDir->read())
  { 
    # skip ".", ".." and hidden files
    next if (substr($filename, 0, 1) eq "."); 

    # print "filename:[$filename]\n";
    if (-f "$baseDirName/$filename")
    {
      if (isIncluded($filename, $includeFiles, $excludeFiles))
      {
        # append this file to the list
        # print "adding file [$filename]\n";
        push(@fileList, "$baseDirName/$filename");
      }
    }
    elsif (-d "$baseDirName/$filename")
    {
      if (isIncluded($filename, $includeDirs, $excludeDirs))
      {
        # recurse
        push(
          @fileList,
          getFileList("$baseDirName/$filename", $includeDirs, $excludeDirs, $includeFiles, $excludeFiles));
      }
    }
    else
    {
      print "skipping file [$filename]\n";
    }
  }

  return @fileList;
}

#---------------------------------------------------------------------------
# readConfigFile
#
# PURPOSE:
# * reads a file of name=value pairs
#
# INPUTS:
# * file = name of file to read
#
# OUTPUTS:
# * none
#
# RETURNS:
# * a reference to a hash containing all the data in the file
#
# NOTES:
# * any characters following a # character are ignored
# * blank lines are ignored
#---------------------------------------------------------------------------
sub readConfigFile($)
{
  my $filename = shift;
  my $cfgFile = new FileHandle;
  my %config = ();
  my $line;

  my $ok = $cfgFile->open($filename, "<");
  if (!$ok)
  {
    die "Could not open config file [$filename]";
  }

  while ($line = $cfgFile->getline())
  {
    $line =~ s/#.*//;     # strip from hash to end-of-line
    $line =~ s/^\s+//;    # strip leading whitespace
    $line =~ s/\s+$//;    # strip trailing whitespace

    if (length($line) == 0)
    {
        # line is empty; skip it
		next;
    }

    my ($key, $value) = split(/\s*=\s*/, $line, 2);
    $config{$key} = $value;
  }

  return \%config;
}

#---------------------------------------------------------------------------
# printHash
#
# PURPOSE:
# * print the contents of a hash (associative array) for debugging.
#---------------------------------------------------------------------------
sub printHash($)
{
  my $hashRef = shift;
  my $key;

  foreach $key (keys %$hashRef)
  {
    print "[$key] = [$hashRef->{$key}]\n";
  }
}

#---------------------------------------------------------------------------
# printList
#
# PURPOSE:
# * print the contents of a list for debugging.
#---------------------------------------------------------------------------
sub printList($)
{
  my $listRef = shift;
  my $item;

  foreach $item (@$listRef)
  {
    print "listitem=$item\n";
  }
}