Hello,
Can you please help me to conver this perl file to powershell?
# 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;
}
