Need help to convert perl file to Powershell

[Nickr]

# 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&colon; 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;
}