PerlScript support

[eric.zarko]

Consider adding "PerlScript" as a listed ProgId for scripts and adding the following XML chunk to VisBuildPro.System.scripts.

<script>
<language>PerlScript</language>
<code><![CDATA[# Predefined Visual Build System scripts available to all build projects
use constant {
# AppCreateContextEnum
vbldContextAutomation => 0,
vbldContextGUI => 1,
vbldContextCommandLine => 2,
vbldContextCount => 3,

# BuildCompletionStatusEnum
vbldBuildCompDone => 0,
vbldBuildCompFailed => 1,
vbldBuildCompAborted => 2,
vbldBuildCompCount => 3,

# BuildLaunchTypeEnum
vbldLaunchBuild => 0,
vbldLaunchRebuild => 1,
vbldLaunchRebuildSel => 2,
vbldLaunchNone => 3,
vbldLaunchCount => 4,

# BuildStatusEnum
vbldBuildStatDone => 0,
vbldBuildStatStarted => 1,
vbldBuildStatPauseReq => 2,
vbldBuildStatPaused => 3,
vbldBuildStatAborting => 4,
vbldBuildStatCount => 5,

# ExpandMacroResultEnum
vbldExpandSuccess => 0,
vbldExpandParseError => 1,
vbldExpandRecurseLimit => 2,
vbldExpandUnknownMacro => 3,
vbldExpandValueError => 4,

# MacroFilterEnum
vbldMacroFilterEnvVar => 0,

# MacroTypeEnum
vbldMacroAll => -1,
vbldMacroTemporary => 0,
vbldMacroProject => 1,
vbldMacroGlobal => 2,
vbldMacroSystem => 3,
vbldMacroCount => 4,

# OutputLocEnum
vbldOutputNone => 0,
vbldOutputStdout => 1,
vbldOutputFile => 2,
vbldOutputCount => 3,

# ProjectStatusSaveOptionsEnum
vbldSaveStatusInclude => -1,
vbldSaveStatusExclude => 0,
vbldSaveStatusUseDefault => 1,

# RedirectInputEnum
vbldRedirInputNone => 0,
vbldRedirInputFile => 1,
vbldRedirInputString => 2,
vbldRedirInputCount => 3,

# RuleComparisonEnum
vbldRuleNone => -1,
vbldRuleUndefined => 0,
vbldRuleDefined => 1,
vbldRuleContains => 2,
vbldRuleEqual => 3,
vbldRuleNotEqual => 4,
vbldRuleDoesNotContain => 5,
vbldRuleTrue => 6,
vbldRuleCount => 7,

# ScriptTypeEnum
vbldScriptAll => -1,
vbldScriptTemporary => 0,
vbldScriptProject => 1,
vbldScriptGlobal => 2,
vbldScriptSystem => 3,
vbldScriptCount => 4,

# StepStatusEnum
vbldStepStatNone => -1,
vbldStepStatSucceeded => 0,
vbldStepStatFailed => 1,
vbldStepStatAborted => 2,
vbldStepStatSkipped => 3,
vbldStepStatInProgress => 4,
vbldStepStatMacroError => 5,
vbldStepStatPartial => 6,
vbldStepStatCount => 7,

# StepTypeEnum
vbldStepMain => 0,
vbldStepSubroutine => 1,
vbldStepFailure => 2,
vbldStepGlobalSubroutine => 3,
vbldStepCount => 4,

# UndefMacroTreatmentEnum
vbldUndefPrompt => 0,
vbldUndefEmpty => 1,
vbldUndefError => 2,
vbldUndefLeave => 3,

};

# return the collection of all defined macros
sub vbld_AllMacros()
{
return $Application->Macros(vbldMacroAll);
}

# returns the current Date in a format valid for use in file/folder names:
# YYYYMMDD
sub vbld_FormatDate()
{
my @dte = localtime();
return ($dte[5]+1900) .
vbld_PadLeft(($dte[4]+1), 2, '0') .
vbld_PadLeft($dte[3], 2, '0');
}

# returns the current date+time in a format valid for use in file/folder names:
# DYYYYMMDDTHHMMSS
sub vbld_FormatDateTime()
{
my @dte = localtime();
return 'D' . ($dte[5]+1900) .
vbld_PadLeft(($dte[4]+1), 2, '0') .
vbld_PadLeft($dte[3], 2, '0') . 'T' .
vbld_PadLeft($dte[2], 2, "0") .
vbld_PadLeft($dte[1], 2, "0") .
vbld_PadLeft($dte[0], 2, "0")
}

# pads a string on the left with the given character to the specified length
sub vbld_PadLeft($$$)
{
my($str, $newLen, $padChar) = @_;
$str = $padChar . $str
while (length($str) < $newLen);
return $str;
}

# creates and returns a new FileSystemObject
sub vbld_FSO()
{
return Win32::OLE->new('Scripting.FileSystemObject');
}

# Copies a file
sub vbld_CopyFile($$$)
{
my($SourceFile, $DestFile, $Overwrite) = @_;
# ensure that the target file is not read-only
vbld_MakeFileWriteable($DestFile)
if ($Overwrite);
# copy
vbld_FSO()->GetFile($SourceFile)->Copy($DestFile, $Overwrite);
}

# Returns the modificiation date of a file
sub vbld_FileDateModified($;$) # note added second optional argument
{
my($FileSpec,$Type) = @_;
my $d = vbld_FSO()->GetFile($FileSpec)->DateLastModified();

# if they want a string
if (!defined($Type) && !wantarray)
{
# let's return it in the same format as VBScript and JScript
return $d->Date().' '.$d->Time();
}

my @d = split / /, $d->Time("s m H ").$d->Date("d M yyyy");
$d[4] -= 1;
$d[5] -= 1900;

use Time::Local;
$d = timelocal(@d);
return $d if ($Type eq 'raw'); # give them seconds since the epoch
return localtime($d); # call localtime for them (it respects wantarray)
}

# Ensure that a file is writeable and return True if found and succeeded
sub vbld_MakeFileWriteable($)
{
my($Filename) = @_;
if (vbld_FSO()->FileExists($Filename))
{
my $f = vbld_FSO()->GetFile($Filename);
$f->{Attributes} -= 1
if ($f->{Attributes} & 1);
# return true as long as the file was found
return 1;
}
return;
}

# Provides a simple 'make' capability to compare a source and target file
# compare the date/timestamp of two files and return -1 if the
# target file does not exist or is older than the source file,
# 0 if they are equal, or 1 if the target file is newer than the source file
sub vbld_CompareFileDates($$)
{
my($TargetFile, $SourceFile) = @_;
if (!vbld_FSO()->FileExists($TargetFile))
{
# file is out of date if target does not exist
return -1;
}
else
{
# if target is older than source, target out of date
return vbld_FileDateModified($SourceFile,'raw') <=> vbld_FileDateModified($TargetFile,'raw');
}
}

# Compares files by version info if available or size+timestamp if not
# if the target file does not exist, returns True;
# otherwise if the files contain version information, the
# version info is compared and True is returned if the target
# file's version is older;
# if no version info is available, the files are compared by timestamp
# of last modification, returning True if the target file is older;
# if the timestamps match, a file size comparison is also performed
# and True returned if target file is older than the source file
sub vbld_FileOutOfDate($$)
{
my($TargetFile, $SourceFile) = @_;
my $fso = vbld_FSO();
if (!($fso->FileExists($TargetFile)))
{
# file is out of date if target does not exist
return 1;
}
else
{
my $strTargVer = $fso->GetFileVersion($TargetFile);
my $strSrcVer = $fso->GetFileVersion($SourceFile);

# if version info is available, compare versions
if (length($strTargVer) > 0 && length($strSrcVer) > 0)
{
my @arrTargVer = split /\./, $strTargVer;
my @arrSrcVer = split /\./, $strSrcVer;

# compare each element individually, starting with major
# if target's is greater, not out of Date; if target's
# is less, out of date; if equal, compare the next value
for (my $i = 0; $i < @arrTargVer; $i++)
{
if ($arrTargVer[$i] > $arrSrcVer[$i])
{
return undef;
}
elsif ($arrTargVer[$i] < $arrSrcVer[$i])
{
return 1;
}
}
}
else
{ # if version info not available, use timestamp comparison
# if target is older than source, target out of date
return vbld_CompareFileDates($TargetFile, $SourceFile) < 0;
}
}
return undef;
}

...


************************************************** ********************
The views and opinions expressed in this message are those of the author. The contents of this message have not been reviewed or approved by Intel.
************************************************** ********************