# modules used
use File::Copy;
use Getopt::Std;
use XML::Simple;
use Win32API::File::Time;

# program name and command line
$program_name = $0;
$program_name =~ s/\\/\//g;
$program_name = (split "/", $program_name)[-1];
$command_line = "$0 @ARGV";

# usage statement
$usage =
"Usage:

  $program_name [-rtD] -f <filename> -m <metafile> -d <directory>
                 -c <configfile> -e <environment> -C <client>

Parameters:
  -r              recurse subdirectories
  -t              test mode (files copied but no files edited)
  -D              debug mode (additional output)
  -f filename     file to modify
  -m metafile     metafile with names of files to modify
  -d directory    directory with files to modify
  -c configfile   configuration file
  -e environment  environment portion of configuration file
  -C client       client portion of configuration file\n";

# get command line options and print usage if incorrect
printout ("$command_line\n");
$usage_error = FALSE;
$usage_error = TRUE unless getopts('rtDf:m:d:c:e:C:');
die "\n$usage" if ($usage_error eq TRUE);
unless (($opt_f) or ($opt_m) or ($opt_d))
{
    $usage_error = TRUE;
    $error_message = "Missing argument, at least one of -f <filename>, -m <metafile>, or -d <directory> must be specified.\n";
}
unless ($opt_c)
{
    $usage_error = TRUE;
    $error_message = "Missing argument -c <configfile>.\n";
}
unless ($opt_e)
{
    $usage_error = TRUE;
    $error_message = "Missing argument -e <environment>.\n";
}
unless ($opt_C)
{
    $usage_error = TRUE;
    $error_message = "Missing argument -C <client>.\n";
}
die "${error_message}\n${usage}" if ($usage_error eq TRUE);

# copy command line options into well-named variables
$cl_recurse     = (defined $opt_r) ? TRUE : FALSE;
$TESTMODE       = (defined $opt_t) ? TRUE : FALSE;
$DEBUG          = (defined $opt_D) ? TRUE : FALSE;
$cl_filename    = $opt_f;
$cl_metafile    = $opt_m;
$cl_directory   = $opt_d;
$cl_configfile  = $opt_c;
$cl_environment = $opt_e;
$cl_client      = $opt_C;

# add the "-f" parameter to the filearr
@filearr = ($cl_filename)
    if (defined $cl_filename);
# add the file contents of the "-m" parameter to the filearr
push @filearr, read_metafile ($cl_metafile, $cl_recurse)
    if (defined $cl_metafile);
# add the directory contents of the "-d" parameter to the filearr
push @filearr, read_directory ($cl_directory, $cl_recurse)
    if (defined $cl_directory);
# read in the configuration data
$confighashref = read_config ($cl_configfile, $cl_environment, $cl_client)
    if (defined $cl_configfile);
# perform the replacement operations on the filearr
$rc = string_replace($confighashref, @filearr);

# indicate success or failure
die "ERROR: $program_name returned $rc!\n" if ($rc);
print "$program_name completed.\n" unless ($rc);

### end of main body



### subroutines

# sub read_metafile ($$)
#   PARAMETERS: scalar metafile - name of the metafile
#               scalar recurse  - flag for recursing into subdirectories
#   RETURNCODE: list - files contained in the metafile
#   DESCRIPTION:
#     this subroutine opens a metafile passed as a paremeter and reads lines from it.  if the line refers to a
#     normal file, it is added to the return list.  if the line refers to a directory, the directory contents are
#     added via a call to read_directory.  otherwise, a warning is printed (shouldn't explicitly list items that are
#     not normal files or not directories).

sub read_metafile($$)
{
    # parameters
    my $metafile  = shift;
    my $recurse   = shift;
    # local variables
    my @readfiles = ();
    my $readitem  = "";
    debugout ("read_metafile: called with \"$metafile\"\n");

    # open the metafile or error and return an empty list
    unless (open METAFILEHANDLE, $metafile)
    {
        print "WARNING: unable to open metafile \"$metafile\"!\n";
        return ();
    }## end unless

    # read items from the metafile
    while ($readitem = <METAFILEHANDLE>)
    {
        # strip any newline
        chomp $readitem;
        # skip empty lines
        next if $readitem =~ /^\s*$/;
        # add normal files
        if (-f $readitem)
        {
            debugout ("read_metafile: added file \"$readitem\"\n");
            push @readfiles, $readitem;
        }## end if

        # add contents of directories
        elsif (-d $readitem)
        {
            debugout ("read_metafile: adding directory \"$readitem\"\n");
            push @readfiles, read_directory ($readitem, $recurse);
        }## end elsif

        # warn on anything else (shouldn't be in metafile)
        else
        {
            print "WARNING: item \"$readitem\" skipped!\n";
        }## end else

    }## end while

    # close the handle and return the list of files
    close METAFILEHANDLE;
    return @readfiles;
}## end sub read_metafile



# sub read_directory ($$)
#   PARAMETERS: scalar directory - name of the directory
#               scalar recurse  - flag for recursing into subdirectories
#   RETURNCODE: list - files contained in the directory
#   DESCRIPTION:
#     this subroutine opens a directory and reads all of the items it contains.  directory special aliases "." and
#     ".." are skipped.  for each entry, if the item is a directory and recurse is set to true, the read_directory
#     subroutine is recursively called on the the item, and the resulting list is added to the return list.
#     if the item is a regular file, the item is added to the return list.  otherwise, the item is skipped.

sub read_directory($$)
{
    #  parameters
    my $directory = shift;
    my $recurse   = shift;
    # local variables
    my $readitem  = "";
    my @readitems = ();
    my @readfiles = ();
    debugout ("read_directory: called with \"$directory\", \"$recurse\"\n");

    # skip the directory if it is one that was dynamically created in a previous run
    if ((split "/", $directory)[-1] =~ /set\w+/)
    {
        debugout ("read_directory: skipping dynamically created directory \"$directory\"\n");
        return ();
    }## end if

    # open the directory or warn and return an empty list
    unless (opendir DIRHANDLE, $directory)
    {
        print "WARNING: unable to open directory \"$directory\"\n";
        return ();
    }## end unless

    # read all of the directory contents at once and close the handle
    # this is to avoid a large number of open handles when recursing
    @readitems = readdir DIRHANDLE;
    closedir DIRHANDLE;

    # examine each item read from the directory
    foreach $readitem (@readitems)
    {
        # skip "." and ".."
        next if $readitem =~ /^\.{1,2}$/;

        # if the item is a directory and recurse is set to TRUE, then recursively examine it
        # and add its contents to the return list
        if ((-d "$directory/$readitem") and ($recurse eq TRUE))
        {
            debugout ("read_directory: recursing into \"$readitem\"\n");
            push @readfiles, read_directory ("$directory/$readitem", $recurse);
        }## end if

        # skip files that are not dependencies for the database builds
        #elsif (($readitem !~ /\.sq[pvtrx]$/) and ($readitem !~ /\.tgt$/))
        elsif ($readitem !~ /\.sq[pvtrx]$/)
        {
            debugout ("read_directory: skipping non-dbo-deployable file $readitem\n");
        }## end elsif

        ### skip extra copies created for deployment to environments with more than one db set
        ##elsif ($readitem =~ /_modifyset[^\.]+\....$/)
        ##{
        ##    debugout ("read_directory: not including auto-created file $readitem\n");
        ##}## end elsif

        # if the item is a normal file, then add it to the return list
        elsif (-f "$directory/$readitem")
        {
            debugout ("read_directory: adding file \"$readitem\"\n");
            push @readfiles, "$directory/$readitem";
        }## end elsif

        # otherwise, skip it
        else
        {
            debugout ("read_directory: skipping item \"$readitem\"\n");
        }## end else

    }## end foreach

    # return the list of files read
    return (@readfiles);
}## end sub read_directory



# sub read_config ($$)
#   PARAMETERS: scalar configfile - name of the xml config file
#               scalar env  - name of the env section of the config file to load
#   RETURNCODE: hashref - reference to a hash of configuration data
#   DESCRIPTION:
#     this subroutine reads in configuration data from an xml file and returns it as a hashref.  the
#     configuration data contains a hash called "op" where the keys are search patterns and the values
#     are replacement expressions.  only the op hash inside the named "env" block is returned.
#
#     EXAMPLE XML DATA:                        EXAMPLE HASHREF DATA (called with client="UAFC" and env="Dev"):
#
#       <config>                               hashref =>
#         <client name="UAFC">                     "set" =>
#           <env name="Dev">                           "1" =>
#             <set id="1">                                 "devstage" => "qastage1"
#               <op>                                   "2" =>
#                 <search>devstage</search>                "devstage" => "qastage2"
#                 <replace>qastage1</replace>
#               </op>
#             </set>
#             <set id="2">
#               <op>
#                 <search>devstage</search>
#                 <replace>qastage2</replace>
#               </op>
#             </set>
#           </env>
#         </client>
#       </config>

sub read_config($$$)
{
    # parameters
    my $configfile = shift;
    my $env        = shift;
    my $client     = shift;
    # local variables
    my $confighashref = "";
    debugout ("read_config: called with \"$configfile\", \"$env\", \"$client\"\n");

    # if the named configfile is not a normal file, warn and return NULL
    unless (-f $configfile)
    {
        print "WARNING: \"$configfile\" is not a normal file!\n";
        return "";
    }## end unless

    # read the entire XML file into a hash reference
    # force "op" and "env" to be arrays, even if there is only one instance of each
    # if an item has an attribute of "search" or "name", use that attribute value as a key in a hash
    $confighashref = XMLin ($configfile,
        forcearray => ['op', 'env', 'set', 'client'],
        keyattr => ['search', 'name', 'id']);

    #debugout ("confighashref:\n" . Dumper ($confighashref) . "\n");

    # use only the env portion of the config data that matches $env
    $confighashref = $confighashref->{client}->{$client}->{env}->{$env};

    # warn if there is no config info at this point
    unless ($confighashref)
    {
        print "WARNING: no configuration information for environment \"$env\"\n";
    }## end unless

    # return the configuration hash reference
    return $confighashref;
}## end sub read_config



# sub string_replace ($@)
#   PARAMETERS: scalar directory - name of the directory
#               scalar recurse  - flag for recursing into subdirectories
#   RETURNCODE: list - files contained in the directory
#   DESCRIPTION:
#     this subroutine opens a directory and reads all of the items it contains.  directory special aliases "." and
#     ".." are skipped.  for each entry, if the item is a directory and recurse is set to true, the read_directory
#     subroutine is recursively called on the the item, and the resulting list is added to the return list.
#     if the item is a regular file, the item is added to the return list.  otherwise, the item is skipped.

sub string_replace($@)
{
    # parameters
    my $confighashref = shift;
    my @filearr       = @_;
    # local variables
    my $file    = "";
    my @linearr = ();
    my $line    = "";
    my $pattern = "";
    my $matched = FALSE;
    my $set = "";
    my @setarr = ();
    my $setnum = 0;
    my $newfile = "";
    my $chompline = "";
    my $linenumber = 0;
    my $atime = "";
    my $mtime = "";
    my $ctime = "";
    my $modified = FALSE;
    my @newlinearr = ();
    my $origline = "";
    my %modlines = ();
    my $setdir = "";
    my %summary_hash = ();
    ##debugout ("string_replace: called with\n" . Dumper($confighashref) . "\n\"@filearr\"\n");
    if ($DEBUG eq TRUE)
    {
        print "string_replace: called with\n\n";
        require 'dumpvar.pl';
        dumpValue ($confighashref);
        print "\n" . (join "\n", @filearr) . "\n\n";
    }

    # if there are no files in the filearr, warn and return and return
    if ($#filearr < 0)
    {
        print "WARNING: no files to modify!\n";
        return 0;
    }## end if

    # if there is no data in the config hash ref, warn and return an error
    unless (defined $confighashref)
    {
        print "ERROR: no configuration data!\n";
        return 1;
    }## end if

    @setarr = (sort { $a <=> $b; } (keys (%{$confighashref->{set}})));
    debugout ("string_replace: setarr = " . (join " ", @setarr) . "\n");

    # open each file in the filearr, one at a time, or warn and skip it
    foreach $file (@filearr)
    {
        debugout ("\nstring_replace: checking file $file\n");

        # capture the file times before making any changes or copies
        ($atime, $mtime, $ctime) = Win32API::File::Time::GetFileTime ($file);

        # open the file or print a warning and skip to the next file
        unless (open FILEHANDLE, $file)
        {
            print "WARNING: unable to open file $file!\n";
            next;
        }## end unless

        # read in the entire contents of the file and close the handle
        @origlinearr = <FILEHANDLE>;
        close FILEHANDLE;

        $setnum = 0;

        foreach $set (@setarr)
        {
            $setnum++;

            debugout ("string_replace: applying ops from set $set\n");

            # if this is NOT the first set, copy the file and modify the copy for this set
            if ($setnum > 1)
            {
                # use a new subdir for each additional set beyond the first
                $setdir = $file;
                $setdir =~ s/[^\/]+$//;
                $setdir =~ s/\/set\w+\/$/\//;
                $setdir .= "set$set/";

                # construct a new unique filename for a copy of this file to be modified for this set
                $newfile = $setdir;
                $newfile .= (split "/", $file)[-1];

                if ($TESTMODE eq FALSE)
                {
                    # create the subdir if it doesn't exist
                    unless (-d $setdir)
                    {
                        unless (mkdir $setdir)
                        {
                            print "WARNING: unable to create directory $setdir: $!\n";
                            next;
                        }## end unless

                    }## end unless

                }## end if $TESTMODE

                else
                {
                    debugout ("string_replace: TESTMODE eq TRUE, no directories created\n");
                }## end else

                # change $file to $newfile so that we are now working with the new copy
                $file = $newfile;
            }## end if $setnum

            # go back to the original file data for each different set
            ## may not need this?
            @linearr = @origlinearr;

            # track whether the current file needs to be modified or not
            $modified = FALSE;

            # initialize the new file contents to nothing
            @newlinearr = ();

            # initialize the hash of modified lines for this file (used for logging changes)
            %modlines = ();

            # initialize the line number counter (used for logging changes)
            $linenumber = 0;

            # iterate through each line of the file, looking for any of the search strings
            foreach $line (@linearr)
            {
                $linenumber++;
                $origline = $line;
                chomp $origline;
                $origline =~ s/\s+/ /g;
                $matched = FALSE;
                foreach $search (keys %{$confighashref->{set}->{$set}->{op}})
                {
                    # if the line matches a search string, perform the replacement
                    if ($line =~ /$search/)
                    {
                        $replace = $confighashref->{set}->{$set}->{op}->{$search}->{replace};
                        debugout ("string_replace:   linenumber = $linenumber\n");
                        debugout ("string_replace:   search = \"$search\"\n");
                        debugout ("string_replace:   replace = \"$replace\"\n");

                        # immediately before the replacment, evaluate the replace expression
                        # this means the replace expression is perl code and may call functions/subroutines
                        # if the replace doesn't actually change the line, skip it
                        $updatedline = $line;
                        $updatedline =~ s/$search/eval $replace/ge;
                        if ($updatedline eq $line)
                        {
                            next;
                        }## end if
                        else
                        {
                            $line = $updatedline;
                        }## end else

                        if (defined $summary_hash{$replace})
                        {
                            $summary_hash{$replace}++;
                        }## end if

                        else
                        {
                            $summary_hash{$replace} = 1;
                        }## end else

                        # save the original and modified lines for later logging
                        $modlines{$linenumber}{orig} = $origline;
                        $modlines{$linenumber}{mod} = $line;

                        # indicated that the line was matched and the file was modified
                        $matched = TRUE;
                        $modified = TRUE;
                    }## end if

                }## end foreach $search

                # if this line was matched, save the original and modified lines for later logging
                if ($matched eq TRUE)
                {
                    chomp $modlines{$linenumber}{mod};
                    $modlines{$linenumber}{mod} =~ s/\s+/ /g;
                }## end if $matched

                # push all file lines (modified or not) back onto a new line array, for creating the new file
                push @newlinearr, $line;
            }## end foreach $line

            debugout ("done, modified = $modified; testmode = $TESTMODE\n");
            # if any of the lines were modified, rewrite the file with the modified lines
#            if ($modified eq TRUE)
#            {
                if ($TESTMODE eq FALSE)
                {
                    # open the file for writing or warn and skip to the next file
                    unless (open FILEHANDLE, "> $file")
                    {
                        # make the file writeable and try again
                        unless (chmod 0777, $file)
                        {
                            print "WARNING: unable to make output file writeable\n";
                            next;
                        }## end unless

                        unless (open FILEHANDLE, "> $file")
                        {
                            print "WARNING: unable to open file for writing: $file!\n";
                            next;
                        }## end unless

                    }## end unless

                    # print the new file contents into the file and close it
                    debugout ("string_replace: writing $file\n");
                    print FILEHANDLE @newlinearr;
                    close FILEHANDLE;
                }
                else
                {
                    debugout ("string_replace: TESTMODE eq TRUE, no file saved\n");
                }

                if ($DEBUG eq TRUE)
                {
                    foreach $linenumber (sort { $a <=> $b; } (keys %modlines))
                    {
                        printout ("  line $linenumber\t\"");
                        printout ($modlines{$linenumber}{orig} . "\"\n");
                        printout ("    chg to\t\"");
                        printout ($modlines{$linenumber}{mod} . "\"\n");
                    }## end foreach $linenumber

                }## end if

#            }## end if $modified

            # restore the file times as they were before any modifications or copies
            Win32API::File::Time::SetFileTime ($file, $atime, $mtime, $ctime);

        }## end foreach $set

    }## end foreach $files

    foreach $key (keys %summary_hash)
    {
        print "$summary_hash{$key}\t$key\n";
    }## end foreach

    printout ("\n");

    # return success
    return 0;
}## end sub string_replace



# sub debugout ($)
#   PARAMETERS: scalar outstring - string to (conditionally) be printed
#   RETURNCODE: none
#   DESCRIPTION:
#     this subroutine calls printout on the string parameter only if the $DEBUG global variable is set to TRUE.

sub debugout($)
{
    # parameter
    my $outstring = shift;
    printout ($outstring) if ($DEBUG eq TRUE);
}## end sub



# sub printout ($)
#   PARAMETERS: scalar outstring - string to be printed
#   RETURNCODE: none
#   DESCRIPTION:
#     this subroutine prints the string parameter

sub printout ($)
{
    my $outstring = shift;
    print $outstring;
}