in reply to Re: WMI query with Threads
in thread WMI query with Threads

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.

[download]

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

[download]

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.

[download]

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;

[download]

Replies are listed 'Best First'.
Re^3: WMI query with Threads
by BrowserUk (Patriarch) on Feb 14, 2013 at 05:17 UTC
    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;

    [download]

    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;

    [download]

    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.
[reply]
[d/l]
[select]

      Personally, I would try to avoid mixing threads and Win32::OLE, as I fear to omit relevant parts of the dance described in the documentation for Win32::OLE->Initialize(). I would look at the WMI command line tool wmic.exe as an alternative approach to multiprocessing, and launch that from multiple threads. There is some documentation in the MS technet.

[reply]
[d/l]
[select]
        I would try to avoid mixing threads and Win32::OLE, as I fear to omit relevant parts of the dance described in the documentation for Win32::OLE->Initialize().

        I'm aware that running multiple instances of OLE in separate threads may not make for complete isolation even using require, but the failure appeared to be rooted entirely in Perl code rather than the underlying DLL's (which by default are initialised for multithreading).

        Hence requireing it into each thread does appear to provide isolation at the perl level; at least as far as the few trivial tests I've done go. It certainly fixes up the free to wrong pool error that was the cause of his headline problem.

        Over the years I've found several modules that "aren't threadsafe" work just fine if you require them into the thread where they are used rather than letting them be duplicated there at thread creation time. Usually I advocate only requiring them into a single thread, at which point they do not see any difference between being one thread is a multi threaded process and the only thread in a single threaded process; but in this case I thought I try requiring into multiple threads and it seems to work. (Maybe I should go back and try the same thing with some others; like Tk).

        I guess we'll find out if the OP ever gets back to us.

        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.
[reply]
      Sorry for the delay in reply. i was stuck with few other tasks to complete and did not get chance to work on this. i just tested this and it worked fine. thank you sooo much for your help!
[reply]

In Section Seekers of Perl Wisdom