Check Registry Version using Perl - windows

I need to go to the registry and check a programs installed version. I am using perl to a whole lot of others things but the registry checking part isn't working. The program version has to be 9.7 and up so it could be 9.8 or 9.7.5.
When I install the program it shows 9.7.4 but I just need the 9.7 to be checked.
Bellow is me going to DisplayVersion which is a REG_SZ which shows 9.7.4.
OR
I could use VersionMajor and VersionMinor together which is a REG_DWORD. Which for Major is 9 and Minor is 7.
$ProgVersion= `$rootpath\\system32\\reg\.exe query \\\\$ASSET\\HKLM\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\{9ACB414D-9347-40B6-A453-5EFB2DB59DFA} \/v DisplayVersion`;
if ($ProgVersion == /9.7/)
This doesn't work I could make it 9.200 and it still works. I tried to use this instead and it still wouldn't work. This next part is assuming that a new client needs to be install if it goes from 9.7. I was trying to use Great than or equal to, but it didn't work.
$ProgVersionMajor= `$rootpath\\system32\\reg\.exe query \\\\$ASSET\\HKLM\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\{9ACB414D-9347-40B6-A453-5EFB2DB59DFA} \/v VersionMajor`;
$ProgVersionMinor= `$rootpath\\system32\\reg\.exe query \\\\$ASSET\\HKLM\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\{9ACB414D-9347-40B6-A453-5EFB2DB59DFA} \/v VersionMinor`;
if (($ProgVersionMajor=~ /9/) && ($ProgVersionMinor=~ /7/))
Any help on doing this correctly or fixing what I am doing.

Several things:
You don't mention it, but are you using the Perl module Win32::TieRegistry? If not, you should. It'll make handling the Windows registry much easier.
In the Perl documentation, you can look at Version String under Scalar Value Constructors. This will make manipulating version strings much, much easier. Version strings have either more than one decimal place in them, or start with the letter v. I always prefix them with v to make it obvious what it is.
Here's a sample program below showing you how they can be used in comparisons:
#! /usr/bin/env perl
#
use strict;
use warnings;
my $version = v4.10.3;
for my $testVersion (v3.5.2, v4.4.1, v5.0.1) {
if ($version gt $testVersion) {
printf qq(Version %vd is greater than test %vd\n), $version, $testVersion;
}
else {
printf qq(Version %vd is less than test %vd\n), $version, $testVersion;
}
}
Note that I can't just print version strings. I have to use printf and sprintf and use the %vd vector decimal format to print them out. Printing version strings via a regular print statement can cause all sorts of havoc since they're really unicode representations. You put them in a print statement and you don't know what you're getting.
Also notice that you do not put quotes around them! Otherwise, you'll just make them regular strings.
NEW ANSWER
I was trying to find a way to convert a string into a v-string without downloading an optional package like Perl::Version or (Version), and I suddenly read that v-strings are deprecated, and I don't want to use a deprecated feature.
So, let's try something else...
We could simply divide up version numbers into their constituent components as arrays:
v1.2.3 => $version[0] = 1, $version[1] = 2, $version[2] = 3
By using the following bit of code:
my #version = split /\./, "9.7.5";
my #minVersion = split /\./, "9.7"
Now, we can each part of the version string against the other. In the above example, I compare the 9 of #version with the 9 of #version, etc. If #version was 9.6 I would have compared the 6 in #version against the 7 in #minVersion and quickly discovered that #minVersion is a higher version number. However, in both the second parts are 7. I then look at the third section. Whoops! #minVersion consists of only two sections. Thus, #version is bigger.
Here's a subroutine that does the comparison. Note that I also verify that each section is an integer via the /^\d+$/ regular expression. My subroutine can return four values:
0: Both are the same size
1: First Number is bigger
2: Second Number is bigger
undef: There is something wrong.
Here's the program:
my $minVersion = "10.3.1.3";
my $userVersion = "10.3.2";
# Create the version arrays
my $result = compare($minVersion, $userVersion);
if (not defined $results) {
print "Non-version string detected!\n";
}
elsif ($result == 0) {
print "$minVersion and $userVersion are the same\n";
}
elsif ($result == 1) {
print "$minVersion is bigger than $userVersion\n";
}
elsif ($result == 2) {
print "$userVersion is bigger than $minVersion\n";
}
else {
print "Something is wrong\n";
}
sub compare {
my $version1 = shift;
my $version2 = shift;
my #versionList1 = split /\./, $version1;
my #versionList2 = split /\./, $version2;
my $result;
while (1) {
# Shift off the first value for comparison
# Returns undef if there are no more values to parse
my $versionCompare1 = shift #versionList1;
my $versionCompare2 = shift #versionList2;
# If both are empty, Versions Matched
if (not defined $versionCompare1 and not defined $versionCompare2) {
return 0;
}
# If $versionCompare1 is empty $version2 is bigger
if (not defined $versionCompare1) {
return 2;
}
# If $versionCompare2 is empty $version1 is bigger
if (not defined $versionCompare2) {
return 1;
}
# Make sure both are numeric or else there's an error
if ($versionCompare1 !~ /\^d+$/ or $versionCompare2 !~ /\^\d+$/) {
return;
}
if ($versionCompare1 > $versionCompare2) {
return 1;
}
if ($versionCompare2 > $versionCompare1) {
return 2;
}
}
}

Using Win32::TieRegistry
You said in your answer you didn't use Win32::TieRegistry. I just want to show you what it can do for the readability of your program:
Your Way
$ProgVersion= `$rootpath\\system32\\reg\.exe query \\\\$ASSET\\HKLM\\SOFTWARE\\Wow6432Node\\Microsoft\\Windows\\CurrentVersion\\Uninstall\\{9ACB414D-9347-40B6-A453-5EFB2DB59DFA} \/v DisplayVersion`;
With Win32::TieRegistry
use Win32::TieRegistry ( TiedHash => '%RegHash', DWordsToHex => 0 );
my $key = $TiedHash->{LMachine}->{Software}->{Wow6432Node}->{Microsoft}->{Windows}->{CurrentVersion}->{Uninstall}->{9ACB414D-9347-40B6-A453-5EFB2DB59DFA}->{Version};
my $programValue = $key->GetValue;
my $stringValue = unpack("L", $programValue);
Or, you can split it up:
my $MSSoftware = $TiedHash->{LMachine}->{Software}->{Wow6432Node}->{Microsoft};
my $uninstall = $MSSoftware->{Windows}->{CurrentVersion}->{Uninstall};
my $programVersion = $uninstall->{9ACB414D-9347-40B6-A453-5EFB2DB59DFA}->{Version};
See how much easier that's to read. You can also use this to test keys too.
(Word 'o Warning: I don't have a Windows machine in front of me, so I didn't exactly check the validity of the code. Try playing around with it and see what you get.)

Related

Tcl syntax explanation

Tcl code:
for {local i 0 } { $i < $bsLen } { incr i } {
local topb [bs rhex $bsStream 1]
local botb [bs rhex $bsStream 1]
local hexStr [strcat $hexStr $topb $botb ]
}
What are some documents that can help to explain the above syntax?
Only for and incr are standard Tcl commands in that sample. If you know C or Java or C#, you'll probably be able to guess what those do without too much difficulty; the syntax is a little different but not very.
The other commands are these, but I know not who defines them:
local — appears to be setting a local variable. What's wrong with using set? I don't know…
bs — specifically bs rhex, and it appears to be getting a value (in hex?) from a stream (named in the bsStream variable). This one is totally guesswork.
strcat — I'd guess this is doing string concatenation of its arguments, as it has the name of a standard C function that does that (doing anything else would be weird and designed to trip its own programmer up).
That last line would be more conventionally written:
append hexStr $topb $botb
as the append command is optimised (in its memory management, which tends to dominate these sorts of things) for the building-a-string-piecemeal case. In particular, it doesn't demonstrate quadratic Shlemiel the painter misbehaviour.
There is nothing like the local standard keyword in Tcl.
for {set i 0 } { $i < $bsLen } { incr i } {
set topb [bs rhex $bsStream 1]
set botb [bs rhex $bsStream 1]
sethexStr [strcat $hexStr $topb $botb ]
}
for {initialize} {condition_check} {inclriment} {body to execute}

What is the most efficient way to replace a list of words without touching html attributes?

I absolutely disagree that this question is a duplicate! I am asking for an efficiency way to replace hundreds of words at once. This is an algorithm question! All the provided links are about to replace one word. Should I repeat that expensive operation hundreds of times? I'm sure that there are better ways as a suffix tree where I sort out html while building that tree. I removed that regex tag since for no good reason you are focusing on that part.
I want to translate a given set of words (more then 100) and translate them. My first idea was to use a simple regular expression that works better then expected. As sample:
const input = "I like strawberry cheese cake with apple juice"
const en2de = {
apple: "Apfel",
strawberry: "Erdbeere",
banana: "Banane",
/* ... */}
input.replace(new RegExp(Object.keys(en2de).join("|"), "gi"), match => en2de[match.toLowerCase()])
This works fine on the first view. However it become strange if you words which contains each other like "pineapple" that would return "pineApfel" which is totally nonsense. So I was thinking about checking word boundaries and similar things. While playing around I created this test case:
Apple is a company
That created the output:
Apfel is a company.
The translation is wrong, which is somehow tolerable, but the link is broken. That must not happen.
So I was thinking about extend the regex to check if there is a quote before. I know well that html parsing with regex is a bad idea, but I thought that this should work anyway. In the end I gave up and was looking for solutions of other devs and found on Stack Overflow a couple of questions, all without answers, so it seems to be a hard problem (or my search skills are bad).
So I went two steps back and was thinking to implement that myself with a parser or something like that. However since I have multiple inputs and I need to ignore the case I was thinking what the best way is.
Right now I think to build a dictionary with pointers to the position of the words. I would store the dict in lower case so that should be fast, I could also skip all words with the wrong prefix etc to get my matches. In the end I would replace the words from the end to the beginning to avoid breaking the indices. But is that way efficiency? Is there a better way to achieve that?
While my sample is in JavaScript the solution must not be in JS as long the solution doesn't include dozens of dependencies which cannot be translated easy to JS.
TL;DR:
I want to replace multiple words by other words in a case insensitive way without breaking html.
You may try a treeWalker and replace the text inplace.
To find words you may tokenize your text, lower case your words and map them.
const mapText = (dic, s) => {
return s.replace(/[a-zA-Z-_]+/g, w => {
return dic[w.toLowerCase()] || w
})
}
const dic = {
'grodzi': 'grodzila',
'laaaa': 'forever',
}
const treeWalker = document.createTreeWalker(
document.body,
NodeFilter.SHOW_TEXT
)
// skip body node
let currentNode = treeWalker.nextNode()
while(currentNode) {
const newS = mapText(dic, currentNode.data)
currentNode.data = newS
currentNode = treeWalker.nextNode()
}
p {background:#eeeeee;}
<p>
grodzi
LAAAA
</p>
The link stay untouched.
However mapping each word in an other language is bound to fail (be it missing representation of some word, humour/irony, or simply grammar construct). For this matter (which is a hard problem on its own) you may rely on some tools to translate data for you (neural networks, api(s), ...)
Here is my current work in progress solution of a suffix tree (or at least how I interpreted it). I'm building a dictionary with all words, which are not inside of a tag, with their position. After sorting the dict I replace them all. This works for me without handling html at all.
function suffixTree(input) {
const dict = new Map()
let start = 0
let insideTag = false
// define word borders
const borders = ' .,<"\'(){}\r\n\t'.split('')
// build dictionary
for (let end = 0; end <= input.length; end++) {
const c = input[end]
if (c === '<') insideTag = true
if (c === '>') {
insideTag = false
start = end + 1
continue
}
if (insideTag && c !== '<') continue
if (borders.indexOf(c) >= 0) {
if(start !== end) {
const word = input.substring(start, end).toLowerCase()
const entry = dict.get(word) || []
// save the word and its position in an array so when the word is
// used multiple times that we can use this list
entry.push([start, end])
dict.set(word, entry)
}
start = end + 1
}
}
// last word handling
const word = input.substring(start).toLowerCase()
const entry = dict.get(word) || []
entry.push([start, input.length])
dict.set(word, entry)
// create a list of replace operations, we would break the
// indices if we do that directly
const words = Object.keys(en2de)
const replacements = []
words.forEach(word => {
(dict.get(word) || []).forEach(match => {
// [0] is start, [1] is end, [2] is the replacement
replacements.push([match[0], match[1], en2de[word]])
})
})
// converting the input to a char array and replacing the found ranges.
// beginning from the end and replace the ranges with the replacement
let output = [...input]
replacements.sort((a, b) => b[0] - a[0])
replacements.forEach(match => {
output.splice(match[0], match[1] - match[0], match[2])
})
return output.join('')
}
Feel free to leave a comment how this can be improved.

Can an array of strings of size 1 be used like a string?

I'm translating a program from asp to asp.net. The creator has a few function that I'm scratching my head over. It seems to be passing back arrays but the results of the function are used as if they're strings in some situations and arrays in others.
Mostly it operates as if it returns a string but sometimes it'll do for each on the result which indicates that it's actually an array of strings. I've searched the web to see if there's some weird corner case logic but nothing specific to this comes up.
function textvalue(myPar)
{
eval("var anotherArray=" + myPar);
anotherArray.sort();
if (eval("datatype" + myPar)=="datetime")
{
//if (eval(myPar)==null || eval(myPar)=="null" || eval(myPar)=="")
if (anotherArray.toString()==null || anotherArray.toString()=="null" || anotherArray.toString()=="")
{
return anotherArray;
}
else
{
return new Array(convertFromAODdatetime(anotherArray.toString()));
}
}
else
{
return anotherArray;
}
}
USE 1
Response.Write(...existing status: " & theStructure.textvalue("structureItemStatus") & "....")
USE 2
For Each datum In fileData.textValue("fileNomenclature")
Response.Write(...
I'm ultimately wondering if I need to do something unique w/ these functions or maybe the resulting datatype to replicate the logic of the function properly.
I don't believe that an array works that way. You might be able to replace the array with a list and it work more in the way you are expecting.
Another option is to just run an if statement to see if the array length is greater than 1 then run a foreach loop otherwise just grab arry[0].

Returning multiple ints and passing them as multiple arguements in Lua

I have a function that takes a variable amount of ints as arguments.
thisFunction(1,1,1,2,2,2,2,3,4,4,7,4,2)
this function was given in a framework and I'd rather not change the code of the function or the .lua it is from. So I want a function that repeats a number for me a certain amount of times so this is less repetitive. Something that could work like this and achieve what was done above
thisFunction(repeatNum(1,3),repeatNum(2,4),3,repeatNum(4,2),7,4,2)
is this possible in Lua? I'm even comfortable with something like this:
thisFunction(repeatNum(1,3,2,4,3,1,4,2,7,1,4,1,2,1))
I think you're stuck with something along the lines of your second proposed solution, i.e.
thisFunction(repeatNum(1,3,2,4,3,1,4,2,7,1,4,1,2,1))
because if you use a function that returns multiple values in the middle of a list, it's adjusted so that it only returns one value. However, at the end of a list, the function does not have its return values adjusted.
You can code repeatNum as follows. It's not optimized and there's no error-checking. This works in Lua 5.1. If you're using 5.2, you'll need to make adjustments.
function repeatNum(...)
local results = {}
local n = #{...}
for i = 1,n,2 do
local val = select(i, ...)
local reps = select(i+1, ...)
for j = 1,reps do
table.insert(results, val)
end
end
return unpack(results)
end
I don't have 5.2 installed on this computer, but I believe the only change you need is to replace unpack with table.unpack.
I realise this question has been answered, but I wondered from a readability point of view if using tables to mark the repeats would be clearer, of course it's probably far less efficient.
function repeatnum(...)
local i = 0
local t = {...}
local tblO = {}
for j,v in ipairs(t) do
if type(v) == 'table' then
for k = 1,v[2] do
i = i + 1
tblO[i] = v[1]
end
else
i = i + 1
tblO[i] = v
end
end
return unpack(tblO)
end
print(repeatnum({1,3},{2,4},3,{4,2},7,4,2))

why are function calls in Perl loops so slow?

I was writing a file parser in Perl, so had to loop through file. File consists of fixed length records and I wanted to make a separate function that parses given record and call that function in a loop. However, final result turned to be slow with big files and my guess was that I shouldn't use external function. So I made some dummy tests with and without function call in a loop:
[A]
foreach (1 .. 10000000) {
$a = &get_string();
}
sub get_string {
return sprintf("%s\n", 'abc');
}
[B]
foreach (1 .. 10000000) {
$a = sprintf "%s\n", 'abc';
}
Measuring showed that A code runs about 3-4 times slower than code B. I knew beforehand that code A was supposed to run slower but still I was surprised that difference is that big. Also tried to run similar tests with Python and Java. In Python code A equivalent was about 20% slower than B and Java code was runing more or less at the same speed (as expected). Changing function from sprintf to something else didn't show any significant difference.
Is there any way to help Perl run such loops faster? Am I doing something totaly wrong here or is it Perl's feature that function calls are such overhead?
Perl function calls are slow. It sucks because the very thing you want to be doing, decomposing your code into maintainable functions, is the very thing that will slow your program down. Why are they slow? Perl does a lot of things when it enters a subroutine, a result of it being extremely dynamic (ie. you can mess with a lot of things at run time). It has to get the code reference for that name, check that it is a code ref, set up a new lexical scratchpad (to store my variables), a new dynamic scope (to store local variables), set up #_ to name a few, check what context it was called in and pass along the return value. Attempts have been made to optimize this process, but they haven't paid out. See pp_entersub in pp_hot.c for the gory details.
Also there was a bug in 5.10.0 slowing down functions. If you're using 5.10.0, upgrade.
As a result, avoid calling functions over and over again in a long loop. Especially if its nested. Can you cache the results, perhaps using Memoize? Does the work have to be done inside the loop? Does it have to be done inside the inner-most loop? For example:
for my $thing (#things) {
for my $person (#persons) {
print header($thing);
print message_for($person);
}
}
The call to header could be moved out of the #persons loop reducing the number of calls from #things * #persons to just #things.
for my $thing (#things) {
my $header = header($thing);
for my $person (#persons) {
print $header;
print message_for($person);
}
}
If your sub has no arguments and is a constant as in your example, you can get a major speed-up by using an empty prototype "()" in the sub declaration:
sub get_string() {
return sprintf(“%s\n”, ‘abc’);
}
However this is probably a special case for your example that do not match your real case. This is just to show you the dangers of benchmarks.
You'll learn this tip and many others by reading perlsub.
Here is a benchmark:
use strict;
use warnings;
use Benchmark qw(cmpthese);
sub just_return { return }
sub get_string { sprintf "%s\n", 'abc' }
sub get_string_with_proto() { sprintf "%s\n", 'abc' }
my %methods = (
direct => sub { my $s = sprintf "%s\n", 'abc' },
function => sub { my $s = get_string() },
just_return => sub { my $s = just_return() },
function_with_proto => sub { my $s = get_string_with_proto() },
);
cmpthese(-2, \%methods);
and its result:
Rate function just_return direct function_with_proto
function 1488987/s -- -65% -90% -90%
just_return 4285454/s 188% -- -70% -71%
direct 14210565/s 854% 232% -- -5%
function_with_proto 15018312/s 909% 250% 6% --
The issue you are raising does not have anything to do with loops. Both your A and B examples are the same in that regard. Rather, the issue is the difference between direct, in-line coding vs. calling the same code via a function.
Function calls do involve an unavoidable overhead. I can't speak to the issue of whether and why this overhead is costlier in Perl relative to other languages, but I can provide an illustration of a better way to measure this sort of thing:
use strict;
use warnings;
use Benchmark qw(cmpthese);
sub just_return { return }
sub get_string { my $s = sprintf "%s\n", 'abc' }
my %methods = (
direct => sub { my $s = sprintf "%s\n", 'abc' },
function => sub { my $s = get_string() },
just_return => sub { my $s = just_return() },
);
cmpthese(-2, \%methods);
Here's what I get on Perl v5.10.0 (MSWin32-x86-multi-thread). Very roughly, simply calling a function that does nothing is about as costly as directly running our sprintf code.
Rate function just_return direct
function 1062833/s -- -70% -71%
just_return 3566639/s 236% -- -2%
direct 3629492/s 241% 2% --
In general, if you need to optimize some Perl code for speed and you're trying to squeeze out every last drop of efficiency, direct coding is the way to go -- but that often comes with a price of less maintainability and readability. Before you get into the business of such micro-optimizing, however, you want to make sure that your underlying algorithm is solid and that you have a firm grasp on where the slow parts of your code actually reside. It's easy to waste a lot of effort working on the wrong thing.
The perl optimizer is constant-folding the sprintf calls in your sample code.
You can deparse it to see it happening:
$ perl -MO=Deparse sample.pl
foreach $_ (1 .. 10000000) {
$a = &get_string();
}
sub get_string {
return "abc\n";
}
foreach $_ (1 .. 10000000) {
$a = "abc\n";
}
- syntax OK

Resources