Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

WMI query with Threads

by vamsinm (Initiate)
on Feb 13, 2013 at 17:53 UTC ( #1018589=perlquestion: print w/ replies, xml ) Need Help??
vamsinm has asked for the wisdom of the Perl Monks concerning the following question:

Hello PerlMonks, i am new to the perl programming. but managed to get some script put together to get the Time zone information for all the servers using WMI Query. i want to implement threads to make this run faster. i have zero knowledge on threads. but using one example i find i tried to implement wmi query. when i run the script with WMI, i was able to get the list of server names with thread. when i add WMI query, the script is crashing perl with the following messsage.

perl TimeZoneCheck.pl Starting main program 0 server1 1 server2 Host server1 is alive Host server2 is alive BPYTSM.JDNET.DEERE.COM India Standard Time (GMT+05:30) Chennai, Kolkata, Mumbai, New Delhi (GMT+05:30) Chennai, Kolkata, Mumbai, New Delhi Free to wrong pool 49c7480 not 163ea8, <FILE> line 5 during global destruction.

i have active perl version 5.10.0

This is perl, v5.10.0 built for MSWin32-x86-multi-thread (with 9 registered patches, see perl -V for more detail) Binary build 1005 290470 provided by ActiveState http://www.ActiveState.com Built May 24 2009 12:17:36

i also request if you have any suggestions on better error handling for wmi queries

Following is the script i am using.
use warnings; use threads; use threads::shared; use Net::Ping; use Switch; use Net::DNS; use Win32::OLE qw(in with); use Carp; use constant wbemFlagReturnImmediately => 0x10; use constant wbemFlagForwardOnly => 0x20; $Win32::OLE::Warn = 3; print "Starting main program\n"; open FILE, "c:\\serverping.txt" or die "could not open the file"; my @lines = <FILE>; $linecount = scalar @lines; $row = 0; $line =$lines[$row]; $line =~ s/^\s+//m; $line =~ s/\s+$//m; $mainparam = $row.':'.$lines[$row]; $thr0 = threads->new(\&GetTimeZone, $mainparam); $row++; $mainparam = $row.':'.$lines[$row]; $thr1 = threads->new(\&GetTimeZone, $mainparam); $row++; while(1){ if ($thr0->is_joinable()) { $thr0->join; if ($row<$linecount){ $mainparam = $row.':'.$lines[$row]; $thr0 = threads->new(\&GetTimeZone, $mainparam); $row++; } } if ($thr1->is_joinable()) { $thr1->join; if ($row<$linecount){ $mainparam = $row.':'.$lines[$row]; $thr1 = threads->new(\&GetTimeZone, $mainparam); $row++; } } $thread_count = threads->list(); #print "$thread_count \n"; last if ($row==$linecount && $thread_count == 0); } print "End of main program\n"; close FILE; sub GetTimeZone { my $paramsub = shift; my @subparam = split(/:/, $paramsub); my $subrow = $subparam[0]; my $subhost = $subparam[1]; $subhost =~ s/^\s+//m; $subhost =~ s/\s+$//m; # Create a new ping object $pingit = Net::Ping->new("icmp"); my $timeout = 10; print "\n$subrow \t $subhost \n"; my $user="domain\\username"; my $pwd="password"; my $locatorObj =Win32::OLE->new("WbemScripting.SWbemLocator") or d +ie "ERROR CREATING OBJ"; $locatorObj->{Security_}->{impersonationlevel} = 3; if( $pingit->ping($subhost, $timeout) ) { print "Host ".$subhost." is alive\n"; eval { my $objWMIService = $locatorObj->ConnectServer($subhost, + "root\\cimv2", $user, $pwd); if (Win32::OLE->LastError()) { print "$_\n"; Win32::OLE->LastError(0); # this clears your error } else { $colItems = $objWMIService->ExecQuery ("Select * from Win32_Timezone","WQL",wbemFlagRetu +rnImmediately | wbemFlagForwardOnly); if (Win32::GetLastError()) { print "$subhost : $_\n"; Win32::OLE->LastError(0); # this clears your error } else{ foreach my $objItem (in $colItems) { print "\n$subhost \t $objItem->{StandardNa +me} \t $objItem->{Caption} \t $objItem->{Description} \n"; } } } }; if ($@) { print "Warning: Error querying object $subhost: $@\n"; } } else { print "Warning: ".$subhost." appears to be down or icmp packets +are blocked by their server\n"; } $pingit->close(); }

Comment on WMI query with Threads
Download Code
Re: WMI query with Threads
by sundialsvc4 (Abbot) on Feb 13, 2013 at 20:16 UTC

    Obviously, the first order of business (after determining that the interface that you are using is, in fact, thread-safe), is to determine that implementing this process using multiple threads actually will be faster.   The only thing that multi-threading can realistically do is to overlap computation with I/O, and, to a certain but limited extent, to allow multiple I/O requests to be serviced in parallel.   Everything, in your scenario, will depend upon the implementation capabilities of the Win32 subsystem with which you are ultimately communicating.   If you, as you say, “know nothing about threads,” why do you have reason to believe that threads will actually help you?   (I mean that as a perfectly serious question.)

    Another often-overlooked strategy is simply to run multiple instances of the same Perl program on the same computer at the same time, arranging by some means for each of them to be issuing a different set of requests.   Thus, with no added internal complexity to any one of the systems at all, as many copies as desired “of the whole thing” can be run in parallel.

      The only thing that multi-threading can realistically do is to overlap computation with I/O, and, to a certain but limited extent, to allow multiple I/O requests to be serviced in parallel.

      That statement is garbage. There is nothing "limited" about the possibility of servicing multiple IO requests concurrently. And what about the possibility of performing concurrent computation on multiple cpus?

      Why do you insist of posting on subjects that you obviously have no useful knowledge of?

      Could it be that you know that even your garbage replies will often garner you a few upvotes?


      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

        I don’t make replies or comments that are intended to be “garbage,” nor would I for any reasoning as puerile as “upvotes” even if such a practice would garner any .. which I doubt.   Puh-leeuze.

        Multi-threading this particular program is of doubtful merit, and I simply made the comment in the context of what I see this program doing.   Yes, it will be able to overlap doing multiple network pings at one time.   That’s the only payoff that I see for what has suddenly become a very complicated design.   There is no computation to be done here; all of the threads are going to gang-up on the SQL server, and their printed outputs are going to pop out very piecemeal.   These threads have no real opportunity to “run free.”   They only ping in parallel ... that’s it.

        Hence, the warning-bells going off, hence the suggestion to “be sure” that a payoff, commensurate with the time already spent and the difficulty already encountered, actually exists in this case and for this program.   I think that this application is a very poor candidate for a multi-threaded implementation.

Re: WMI query with Threads
by BrowserUk (Pope) on Feb 13, 2013 at 23:05 UTC
    the script is crashing perl with the following messsage.

    Hm. Mixing up the trace output from your program with the error message (and posting it without <code></code> blocks so all the newlines get eaten by the html) makes life difficult for those of whom you are asking for help.

    The actual message you are receiving is just:

    Free to wrong pool 49c7480 not 163ea8, <FILE> line 5 during global des +truction.

    And the first thing to say about that is it isn't "a crash". This is an informational message issued only when the program has ended and Perl is freeing up the memory used by the program.

    Essentially, the program is finished, done and dusted, -- whether it has worked or not is a different matter -- and Perl has detected an anomaly in its usage of memory whilst cleaning up. It is telling you that you may want to look more closely at it, but it isn't actually crashing; and the program may have completely correctly despite that anomaly.

    What the message is telling you is that a piece of memory that was allocated by one thread; is being freed within the context of another thread. Whilst that can cause problems within your program; the fact that it is only being detected "during global destruction" often means that it didn't prevent the program from working or completing.

    Now to the possible causes of that anomaly.

    The usual cause of this cross-over of memory from one thread to another is accidental closure of a thread subroutine over a variable created (explicitly or implicitly) within the main thread code. And there are two main ways for that to happen.

    1. Non-shared, lexical (my) variables declared in your main thread, and re-used (without re-declaration) within thread subroutines.

      I do not see any of these in your code.

      This can often happen accidentally when thread subroutines are position at the end of the file. You use (and properly declare) a variable within your main program; and then re-use the name within the subroutine, but forget to declare it locally, and thus you get an accidental closure with no warnings.

      My tip for avoiding this is to put your subroutines -- especially those use as threads; but it works for all subroutines -- at the top of your program before your main line code.

      It flies in the face of certain conventions; but it is the conventions that are flawed here.

    2. The use of package-scoped, non-lexical variable -- ie. variables used but not declared with my -- within subroutines used as threads.

      Your thread procedure has two of these:

      Global symbol "$pingit" requires explicit package name at 1018589.pl l +ine 81. Global symbol "$colItems" requires explicit package name at 1018589.pl + line 91.

    You also have several other variables that you haven't declared with my:

    Global symbol "$linecount" requires explicit package name at 1018589.p +l line 21. Global symbol "$row" requires explicit package name at 1018589.pl line + 23. Global symbol "$line" requires explicit package name at 1018589.pl lin +e 24. Global symbol "$mainparam" requires explicit package name at 1018589.p +l line 28. Global symbol "$thr0" requires explicit package name at 1018589.pl lin +e 29. Global symbol "$thr1" requires explicit package name at 1018589.pl lin +e 33. Global symbol "$thread_count" requires explicit package name at 101858 +9.pl line 53. Global symbol "$pingit" requires explicit package name at 1018589.pl l +ine 67. Global symbol "$colItems" requires explicit package name at 1018589.pl + line 97. 1018589.pl had compilation errors.

    These would all be caught for you by use strict;

    So, my suggestions to you are:

    1. Add use strict; to the top of your program.

      And then eliminate all those errors by declaring all your variables with my.

    2. Move your GetTimeZone() subroutine to the top of your program.

      Just before print "Starting main program\n"; would be good.

    Then try re-running your program. The chances are that those two simple changes will make the problem 'go away', but if they do not, come back and post your modified code and we can try to help you further.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

      Thank you Very much for your reply and time. apologies for not posting it using the correct tags. i have moved the subrotine to the top of the program and declared all variables with my. but still have the same issue.

      i am sorry if i am wrong about crash. the reason, i said perl crashed was because i got a message window

      "Perl command line interpreter has stopped working" close the program or check online for solution and close the program. i copied the porgram details from the window. please see below.
      Problem signature: Problem Event Name: APPCRASH Application Name: perl.exe Application Version: 5.10.0.1005 Application Timestamp: 4a199d7b Fault Module Name: perl510.dll Fault Module Version: 5.10.0.1005 Fault Module Timestamp: 4a199d7a Exception Code: c0000005 Exception Offset: 0009b108 OS Version: 6.1.7601.2.1.0.256.4 Locale ID: 1033 Additional Information 1: 0a9e Additional Information 2: 0a9e372d3b4ad19135b953a78882e789 Additional Information 3: 0a9e Additional Information 4: 0a9e372d3b4ad19135b953a78882e789 Read our privacy statement online: http://go.microsoft.com/fwlink/?linkid=104288&clcid=0x0409 If the online privacy statement is not available, please read our priv +acy statement offline: C:\WINDOWS\system32\en-US\erofflps.txt

      following is the output

      perl TimeZoneCheck.pl Starting main program 0 server1 1 server2 Host server1 is alive Host server2 is alive server2 India Standard Time (GMT+05:30) Chennai, Kolkata, Mumbai +, New Delhi (GMT+05:30) Chennai, Kolkata, Mumbai, New Delhi Free to wrong pool 49cc3c8 not f3ea8, <FILE> line 5 during global dest +ruction.

      modified Code

      use strict; use warnings; use threads; use threads::shared; use Net::Ping; use Switch; use Net::DNS; #use Try::Tiny; #use DBI; use Win32::OLE qw(in with); use Carp; use constant wbemFlagReturnImmediately => 0x10; use constant wbemFlagForwardOnly => 0x20; $Win32::OLE::Warn = 3; sub GetTimeZone { my $paramsub = shift; my @subparam = split(/:/, $paramsub); my $subrow = $subparam[0]; my $subhost = $subparam[1]; $subhost =~ s/^\s+//m; $subhost =~ s/\s+$//m; # Create a new ping object my $pingit = Net::Ping->new("icmp"); my $timeout = 10; print "\n$subrow \t $subhost \n"; my $user="domain\\username"; my $pwd="password"; my $locatorObj =Win32::OLE->new("WbemScripting.SWbemLocator") or d +ie "ERROR CREATING OBJ"; $locatorObj->{Security_}->{impersonationlevel} = 3; #return ($subrow, $subhost); # perform the ping if( $pingit->ping($subhost, $timeout) ) { print "Host ".$subhost." is alive\n"; eval { my $objWMIService = $locatorObj->ConnectServer($subhost, + "root\\cimv2", $user, $pwd); if (Win32::OLE->LastError()) { #$sheet->Cells($row,5)->{'Value'} = "$_\n"; print "$_\n"; Win32::OLE->LastError(0); # this clears your error } else { my $colItems = $objWMIService->ExecQuery ("Select * from Win32_Timezone","WQL",wbemFlagRetu +rnImmediately | wbemFlagForwardOnly); if (Win32::GetLastError()) { #$sheet->Cells($row,5)->{'Value'} = "$_\n"; print "$subhost : $_\n"; Win32::OLE->LastError(0); # this clears your error } else{ foreach my $objItem (in $colItems) { print "\n$subhost \t $objItem->{StandardNa +me} \t $objItem->{Caption} \t $objItem->{Description} \n"; #$timezonename = $objItem->{StandardName}; #$timezonecaption =$objItem->{Caption}; #$timezonedescription = $objItem->{Descrip +tion}; ##objOS.CurrentTimeZone/60 & ":" & right(" +00" & objOS.CurrentTimeZone mod 60, 2) } } } }; if ($@) { print "Warning: Error querying object $subhost: $@\n"; #$sheet->Cells($row,5)->{'Value'} = "$@"; #$row++; next; } } else { print "Warning: ".$subhost." appears to be down or icmp packets +are blocked by their server\n"; #$sheet->Cells($row,5)->{'Value'} = "Warning: ".$netbiosname[0 +]." Down"; } $pingit->close(); } print "Starting main program\n"; open FILE, "c:\\serverping.txt" or die "could not open the file"; my @lines = <FILE>; my $linecount = scalar @lines; my $row = 0; my $line =$lines[$row]; $line =~ s/^\s+//m; $line =~ s/\s+$//m; my $mainparam = $row.':'.$lines[$row]; my $thr0 = threads->new(\&GetTimeZone, $mainparam); $row++; $mainparam = $row.':'.$lines[$row]; my $thr1 = threads->new(\&GetTimeZone, $mainparam); $row++; while(1){ if ($thr0->is_joinable()) { $thr0->join; if ($row<$linecount){ $mainparam = $row.':'.$lines[$row]; $thr0 = threads->new(\&GetTimeZone, $mainparam); $row++; } } if ($thr1->is_joinable()) { $thr1->join; if ($row<$linecount){ $mainparam = $row.':'.$lines[$row]; $thr1 = threads->new(\&GetTimeZone, $mainparam); $row++; } } my $thread_count = threads->list(); #print "$thread_count \n"; last if ($row==$linecount && $thread_count == 0); } print "End of main program\n"; close FILE;
        i am sorry if i am wrong about crash. the reason, i said perl crashed was because i got a message window

        That is kind of important information to have omitted from your post.

        The good news is that I have reproduced your problem and have a solution for you.

        The culprit is Win32::OLE. Even this simple threaded code that uses that module in the main thread, fails in exactly the same when when you try to join a thread. Even if that thread makes no use of the module:

        #! perl -slw use strict; use threads; use Win32::OLE qw[ in with ]; my $thread = async { sleep 3; }; $thread->join;

        However, if you require Win32::OLE in the thread(s) where you want to use it, it works fine:

        #! perl -slw use strict; use threads; #use Win32::OLE qw[ in with ]; my $thread = async { require Win32::OLE; Win32::OLE->import( qw[ in with ] ); sleep 3; }; $thread->join;

        So the solution to your immediate problem is to comment out the use Win32::OLE line at the top of your program and replace it with the require and import as shown above in the top of your thread subroutine.

        Try that and see how you get on.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1018589]
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (11)
As of 2014-09-23 16:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (232 votes), past polls