#1
|
|||
|
|||
PerlScript support
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. ************************************************** ******************** |
#2
|
|||
|
|||
PerlScript support (cont.)
# create a new temporary macro with the value or add a string to end of the given
# temporary macro, separating each string with Tab char delimiter, and return the updated value sub vbld_AddDelimValue($$) { my($macroName, $val) = @_; my $macros = $Application->Macros(vbldMacroTemporary); my $macro = $macros->Item($macroName); if (!defined($macro)) # create initial value if it doesn't exist { $macro = $macros->Add($macroName, $val); } else # add delimiter and value if already exists { $macro->{Value} .= "\t" . $val; } return $macro->Value(); } # given the name of a macro containing delimited strings (populated via # vbld_AddDelimValue), remove the *first* delimited string from the value # and return or return Null if the macro does not exist sub vbld_NextDelimValue($) { my($macroName) = @_; my $macros = $Application->Macros(vbldMacroTemporary); my $val = undef; { my $macro = $macros->Item($macroName); $val = $macro->Value() if (defined($macro)); } return undef if (!defined($val)); # macro doesn't exist, return null my $ret; my $pos = index($val, "\t"); # find next delimiter if ($pos < 0) # if no more delimiters, return the remaining value { $ret = $val; $macros->Remove($macroName); # and delete the macro } else { $ret = substr($val, 0, $pos); # retrieve the next value $macros->Add($macroName, substr($val, $pos+1)); # and remove from the macro } return $ret; } # alternate name for adding delimited value to end of a macro sub vbld_PushDelimValue($$) { my($macroName, $value) = @_; return vbld_AddDelimValue($macroName, $value); } # given the name of a macro containing delimited strings (populated via # vbld_AddDelimValue), remove the *last* delimited string from the value # and return or return Null if the macro does not exist sub vbld_PopDelimValue($) { my($macroName) = @_; my $macros = $Application->Macros(vbldMacroTemporary); my $val = undef; { my $macro = $macros->Item($macroName); $val = $macro->Value() if (defined($macro)); } return undef if (!defined($val)); # macro doesn't exist, return null my $ret; my $pos = rindex($val, "\t"); # find last delimiter if ($pos < 0) # if no more delimiters, return the remaining value { $ret = $val; $macros->Remove($macroName); # and delete the macro } else { $ret = substr($val, $pos+1); # retrieve last delimited value $macros->Add($macroName, substr($val, 0, $pos));# and remove from the macro } return $ret; } ]]></code> </script> ************************************************** ******************** 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. ************************************************** ******************** |
#3
|
|||
|
|||
Bugs in 5.1
Thanks for a great response in getting this added to 5.1 guys. Unf. you've got a few bugs.
First of all there are some typos in vbld_FileDateModified that break it completely. 614: "time" s/b "Time" 617: "time" s/b "Time", in date format need "M" not "m" 621: "time::local" s/b "Time::Local" Second, you have 2 copies of vbld_AddDelimValue. The second should just override the first without really causing a problem, but it could cause maintenance issues for you in the future. Finally, just a note on style. On lines 635 and 799(781 if you deal with #2 first) you have trailing "if" modifiers. It is not required but generally considered good style to add an extra prefix tab to make these really obvious. ************************************************** ********************* 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. ************************************************** ********************* |
#4
|
|||
|
|||
Argh. The editor so helpfully lowercased those strings when they were pasted in (you'll probably want to disable the 'Fixup text case' option in the script editor right-click options dialog when editing PerlScript). The download has been updated with a fix for the typos (except that I couldn't see any formatting difference in the last two lines you mentioned).
|
#5
|
|||
|
|||
Quote:
As for the formatting difference, the issue is that in C/C++, Java, etc you can do this: Code:
if(x < 1) x = 1; Code:
if($x < 1) { $x = 1; } Code:
$x = 1 if($x < 1); Code:
$x = 1 if($x < 1); |
|
|