vishi has asked for the wisdom of the Perl Monks concerning the following question:

Hi Monks,

I am using the Expect.pm module to automate some routine tasks across different servers. I am using threads to do this. I have one main thread, called "threadA" (a long running job) and other smaller jobs running on other threads, called threadB and threadC.

Here's my problem: I need to connect to 2 different servers to accomplish one task. Using Expect.pm, I connect to ServerB using threadB and ServerC using threadC. All this is happening in parallel - while threadA is connected to ServerA.

Now, I need to run the stuff in threadC only when the statements in threadB finish. To achieve this, I am using shared variables across the threads using $varName:shared; . This task of "B completes ... then C completes" needs to be done 2 times. I have this in a while loop, checking the counter as well as a flag for the conditions.

My code runs perfectly for the first iteration of the loop. Somehow, on the second iteration, threads are getting spawned correctly, but threadB gets blocked. Because threadB is blocked, threadC waits forever and never finishes. As I am waiting for these threads to complete using a "join" my code simply hangs. How do I resolve this?

Here's my code

#### Main Program ###
$count = 0;

our $sshFD = Expect->spawn("ssh $User\@$mtHostName");
$sshFD->log_stdout(0);

our $sshCI = Expect->spawn("ssh $User\@$dbHost1");
$sshCI->log_stdout(0);

while (($deltaFound eq "true") && ($count < 2))
{
        
    print "******** LOOP ".$count." *******\n";
        
    our $thrFD = threads->create('findDelta',$sshFD);
    our $thrCI = threads->create('checkInv',$sshCI);
        
    $thrFD->join();
    $thrCI1->join();
        
    $sshFD->close();
    $sshCI1->close();
} 

sub checkInv()
{

        our $compInvFlag = '';
    our $fndDeltaFlag:shared;
    my $sshAuth = shift;

#### this passes the first time... but just keeps printing dots in the
+ second iteration ######
 
        while ($fndDeltaFlag ne "true")
    {
        sleep(1);
        print ".";
    }


#### Crunch some numbers here #####

    $sshAuth->close();
}


sub findDelta()
{
    our $deltaFound;
    our $fndDeltaFlag = '';
    my $counter = 0;
    
    my $sshAuth = shift;
    
##### Do some stuff here #######
        
        $counter = 0;
        $deltaFound = "false";
        while ($counter <2 )
    {
        $deltaFound = "true";
        $counter++;
    }
    
    $fndDeltaFlag = "true";
    $sshAuth->close();      
}

[download]

Replies are listed 'Best First'.
Re: Using Perl Threads with Expect.pm
by bart (Canon) on Feb 17, 2011 at 12:32 UTC
    Just one question.
    Now, I need to run the stuff in threadC only when the statements in threadB finish.
    Then why are you running this in separate threads? Use a single thread for both tasks, and do them as a single normal, sequential, script.
[reply]
      I am using threads to run B and C because threadA is also running. I believe that threadA would block the main thread until I do a join on it. Is my understanding wrong?
[reply]
        According to : http://search.cpan.org/~rgiersig/Expect-1.21/Expect.pod#Is_it_possible_to_use_threads_with_Expect?

        Is it possible to use threads with Expect? Basically yes, with one restriction: you must spawn() your programs in the main thread and then pass the Expect objects to the handling threads.

        If I don't do this, or call create an Expect object in the main thread, the remote session is 'blocked', unless I pass the expect object to the thread subroutine...
[reply]
        You misunderstand me. What I tried to say was not "Why threads?" but "Why 2 child threads, B and C?", thus: why are B and C 2 different threads instead of just one?
[reply]
Re: Using Perl Threads with Expect.pm
by olibertu (Initiate) on Feb 29, 2012 at 20:58 UTC
    Hi, I had same problem as you, so I created own spawn subroutine, with more pseudoterminals. I using it for parallel connection to servers:

    Constructor: 

    sub new
{
    my $class = shift;
    my $self = {};
    bless $self, $class;

    my $log = Log::Log4perl->get_logger("$class");
    $self->{LOGGER} = $log;

    my $pty = $self->spawn("/bin/bash");  # spawn() defined below
    $self->{PTY} = $pty;
    my $exp = Expect->exp_init($pty);

    my $ref = $exp->expect(TIMEOUT,
        [ $shell_prompts ]
    );
    if (!$ref){
        $log->warn("Timeout received!");
        return -1;
    } 

    $exp->clear_accum();

    #$exp->log_stdout(1);
    $exp->raw_pty(1);
    #$exp->debug(3);
    $Expect::Multiline_Matching = 0 ;

    $self->{EXPECT} = $exp;

    $log->debug("Creating instance $class");
    return $self;
}

    [download]
    SPAWN subroutine: 
    sub spawn {

    my($cmd) = @_;
    my($pid, $pty, $tty, $tty_fd);

    ## Create a new pseudo terminal.
    $pty = new IO::Pty
        or die $!;

    ## Execute the program in another process.
    unless ($pid = fork) {  # child process
        die "problem spawning program: $!\n" unless defined $pid;

        ## Disassociate process from existing controlling terminal.

        use POSIX ();
        POSIX::setsid
            or die "setsid failed: $!";

        ## Associate process with a new controlling terminal.
        $tty = $pty->slave;
        $pty->make_slave_controlling_terminal();
        $tty_fd = $tty->fileno;
        close $pty;

        ## Make stdio use the new controlling terminal.
        open STDIN, "<&$tty_fd" or die $!;
        open STDOUT, ">&$tty_fd" or die $!;
        open STDERR, ">&STDOUT" or die $!;
        close $tty;

        ## Execute requested program.
        exec "/bin/bash"
        #exec $cmd
            or die "problem executing /bin/bash\n";

    } # end child process

    return $pty;
} # end sub spawn

    [download]
    Then you can create new expect process in you each child in your main method : 
    my $pm = new Parallel::ForkManager(5);
for (1...10) {
    my $pid = $pm->start and next;
    my $exp = Expect_common->new();
    # expect send
    ...
    #
    $pm->finish; # Terminates the child process
}
$pm->wait_all_children;

    [download]
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom