Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

Re^10: Forks, Pipes and Exec (file descriptors)

by BrowserUk (Patriarch)
on Nov 08, 2008 at 15:12 UTC ( [id://722405]=note: print w/replies, xml ) Need Help??

in reply to Re^9: Forks, Pipes and Exec (file descriptors)
in thread Forks, Pipes and Exec

I've found another perl script that sounds like what I'm doing: logtail.

Here's a simplified and somewhat crude equivalent that uses threads and should run anywhere you have a threaded-perl and a tail command. Maybe it'll be useful to you.

#! perl -slw use strict; use threads ( stack_size => 4096 ); use threads::shared; use Thread::Queue; $|++; our $VERBOSE :shared; our $REMOTE :shared; my $stop :shared = 0; ## Set true to terminate threads my @logs = map glob, @ARGV; ## expand wildcards my $Q = new Thread::Queue; ## One trhead per log file threads->create( \&tail, $Q, $_, 1 )->detach for @logs; my $remote; ## Remote watcher socket if( $REMOTE ) { require IO::Socket; $remote = IO::Socket::INET->new( $REMOTE ) or warn "Couldn't connect to $REMOTE : $!, $^E"; print $remote "Hi there, Got your ears on?"; } ## Thread to monitor the Q, print locally and/or forward to remote my $relay = async { for( 1 .. @logs ) { ## Waits for all tals to terminate while( my $line = $Q->dequeue ){ chomp $line; print $line if $VERBOSE; print $remote $line if $remote; } } }; ## Local command loop while( <STDIN> ) { my( $command, $value ) = split; if( $command =~ m[^(END|QUIT)]i ) { $stop = 1; warn "Quiting...\n"; $relay->join; exit 0; } if( $command =~ m[^VERBOSE]i ) { $VERBOSE = $value; print "VERBOSE set to $value"; } elsif( $command eq 'qs' ) { print $Q->pending; } else { print "Unrecognised command: $command"; } } ## Tail threads sub tail { print threads->tid, ' : ', threads->self->get_stack_size; my( $Q, $path, $seconds ) = @_; $seconds = 1 unless $seconds; my $pid = open my $log, "tail -Fs $seconds $path |" or die $@; printf "Thread %d Following $path\n", threads->tid; $Q->enqueue( $_ ) while not $stop and defined( $_ = <$log> ); kill 3, $pid; close $log; $Q->enqueue( undef ); }

It happily follows 100 logs, simultaneously logging them local and transmitting them to a remote watcher. You can enter a few commands at the local console to turn local verbose on and off, monitor the size of the queue, and quit:

c:\test> -REMOTE=localhost:35007 log\log*.txt Thread 2 Following log\log0002.txt Thread 1 Following log\log0001.txt Thread 3 Following log\log0003.txt Thread 4 Following log\log0004.txt Thread 5 Following log\log0005.txt Thread 6 Following log\log0006.txt Thread 7 Following log\log0007.txt Thread 8 Following log\log0008.txt Thread 9 Following log\log0009.txt Thread 10 Following log\log0010.txt verbose 1 VERBOSE set to 1 Sat Nov 8 15:09:45.575 2008 : Message from log 6 Sat Nov 8 15:09:45.684 2008 : Message from log 0 Sat Nov 8 15:09:45.701 2008 : Message from log 3 Sat Nov 8 15:09:45.794 2008 : Message from log 3 ... ver ... Sat Nov 8 15:09:48.279 2008 : Message from log 9 ... bose 0 ... Sat Nov 8 15:09:48.309 2008 : Message from log 1 Sat Nov 8 15:09:48.419 2008 : Message from log 9 VERBOSE set to 0 qs 0 quit Quiting...

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.

Replies are listed 'Best First'.
Re^11: Forks, Pipes and Exec (file descriptors)
by diabelek (Beadle) on Nov 12, 2008 at 04:05 UTC

    I've switched to using sockets and threads but I've run into an interesting problem. On Windows only (shocker), I am unable to start a thread inside of another thread. I'm unclear on why it stops since depending on where I place the thread->new() it works or doesn't work. I've posted the module code here.

    You'll notice in ToolHandler the while loops grabs a command and executes it and then tries to read the queue for the other processes that are running the IO tool. If I place the thread->new() before the _CommandHandler call, it fails to start the new thread and just hangs indefintely.

    I'm working on putting together a simple version of the module as a script to see if simplifying it changes anything but if there is any advice on the module it would be appreciated.

        It's a command line IO tool that we use that isn't ours so I changed the name. I just place it in c:\windows since its in the %PATH% and easier to access

        Basically you have the standard output of any IO tool such as the options set, IO/s, errors, warnings, status, etc. If you have ever used iozone or dtstart in Linux, the output would be similar.

        The way the script is right now, the tool doesn't matter since I'm still trying to get the worker threads going that will handle gathering the output from each instance of wintool.exe. Unless there's a better way of implementing it in perl, I'm stuck on why the thread won't start.


        I slowed the script down so I could see whats going on and where its hanging and apparently it hangs completely in the StartIO function when I try to read back the results from the socket. If I change the <$rfh> to this:

        $rfh_select = new IO::Select( $rfh ) or die "Error setting up IO::S +elect: $!\n"; while( !(@ready = $rfh_select->can_read( .1 )) ) { #can_read hangs for .1 seconds so wait for it # need to add some code to stop the loop if we wait to long } sysread( $rfh, $results, 9999999 );
        It will run more or less like it should. Still a few bugs to work out but at least the thread isn't hanging when I ask it to start.

        So the million dollar question that I'm asking is what would a <$handle> in thread A stop a threads->new() from starting thread C & D from thread B?

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://722405]
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others lurking in the Monastery: (7)
As of 2024-06-14 19:41 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.