On Thu, 2 May 2002, Oliver Fischer wrote: > Sorry, may be a little bit offtopic... > > Does someone have example perl script to wrap cvs login via open2/3 > and IO::Select? I am not able to get my one working. > > Thanks... >
Yes. Here's one I use in a SOAP-based distributed build system. I've expressed the routine and the stuff it calls as shell 'here' documents just because I'm feeling geeky today. My code is OO and passes in a target object whose fields contain the info needed to access the repository. You can easily change this to pass in the stuff as string scalars instead. To use: require cvsLogin.pl; require services.pl; &_cvsLogin( $target ); cat >cvsLogin.pl <<EOF; sub _cvsLogin { # # this routine expects to receive a SOAPMaker::Target object. # info needed to build the cvs command is retrieved from the target object. # my $target = shift; my $workDir = $target->workdir(); my $repository= $target->repository(); my $cmd = "export CVS_PASSFILE=$workDir/.cvspass; cvs -d $repository login"; my @input = ( $target->userpw() ); my ($i,$j) = &logTick( $cmd, $target->buildlog(), \@input, 0); } EOF cat >services.pl <<EOF; =head1 NAME services.pl =head1 SYNOPSIS &logTick( "command", $outputArrayRef, [ $inputArrayRef ] ); =head1 REQUIRES IPC::Open3, IO::Select =head1 DESCRIPTION This library provides a wrapper for executing native commands and capturing their output. =over 4 =item ($returnCode,$signal)=&logTick("command", \@output, \@input); This routine expects a string containing a command to be executed, and a reference to an ARRAY to which the command's stdout and stderr will be appended. Optionally, any necessary input can be provided by passing a additional ARRAY reference containing the input. If an input array is provided, the $command string is pushed onto the @output array to simulate a command prompt. The entire content of the input array is printed to the command's STDIN before any output is retrieved. (This routine isn't intended to be a true interactive commincator to a long-running child-process.) =cut use IPC::Open3; use IO::Select; sub logTick { my $cmd = shift; my $output = shift; my $input = shift; my $logWarnings = shift || 0; my @foo = (); my $pid; # # if the user has input, then we need to use open3 and handle stdout # ourselves. # if ( ref $input ) { push(@$output,"\n\$$cmd\n"); eval { $pid = open3(\*KIDSTDIN, \*KIDSTDOUT, \*KIDSTDERR, $cmd ) || die; }; if ($@) { if ($@ =~ /^open\d/) { warn "open failed: $!\n$@\n"; return ($?,0); } warn("Open3 returned: $!\n$@\n"); return ($?,0); } my $selector = IO::Select->new(); $selector->add(*KIDSTDOUT,*KIDSTDERR); print KIDSTDIN join("\n", @$input ), "\n"; push(@$output, &getsome( $selector, 0.25 ) ); $selector->remove(*KIDSTDOUT,*KIDSTDERR); close(KIDSTDIN); close(KIDSTDOUT); close(KIDSTDERR); waitpid($pid,0); my $ierr = $? >> 8; my $isig = $? & 255; my $msg = "Execution Summary:\n\tCmd=$cmd\n\tRC=$ierr\n\tSignal=$isig\n"; push(@$output,$msg); if ( $ierr != 0 ) { warn($msg) if $logWarnings; } return ($ierr,$isig); # # no input provided, do it the easy way, with backticks. # } else { push(@$output,"\n\$$cmd\n"); @foo = `( $cmd )2>&1`; push(@$output,@foo); my $ierr = $? >> 8; my $isig = $? & 255; my $msg = "Execution Summary:\n\tCmd=$cmd\n\tRC=$ierr\n\tSignal=$isig\n"; push(@$output,$msg); if ( $ierr != 0 ) { warn($msg) if $logWarnings; } return ($ierr,$isig); } } sub getsome { my ($selector)=shift; my ($wait)=shift || 0.5; my $output = ""; my @output = (); my @temp = (); my @ready = (); my $len = 0; my $buf = 0; #warn("Getsome checking selector."); while ( @ready = $selector->can_read( $wait )) { #warn( "Getsome has " . (scalar @ready ) . " file handles with waiting data "); foreach my $fh (@ready) { #if (fileno($fh) == fileno(KIDSTDOUT) ) { #$output = scalar <KIDSTDOUT>; #warn("calling sysread..."); #$len = sysread( KIDSTDOUT, $buf, 2048, 0 ); $len = sysread( $fh, $buf, 2048, 0 ); #warn( "GOT $len bytes: ", $buf ); $output .= $buf ; # } if ( $len == 0 ) { #warn( "EOF on filehandle detected, removed from selector" ); $selector->remove($fh); } } } @temp = split(/\n/,$output); foreach (@temp) { push(@output,$_ . "\n"); } # push(@output, split(/\n/,$output )); #warn("Getsome exiting"); return @output ; } 1; =back =head1 AUTHOR Joi Ellis =head1 BUGS Undoubtedly. =head1 REPORTING BUGS Send Email to Joi Ellis E<lt>[EMAIL PROTECTED]<gt>. =head1 COPYRIGHT Copyright © Aravox Technologies, Inc. =head1 SEE ALSO see-also links goes here EOF -- Joi Ellis Software Engineer Aravox Technologies [EMAIL PROTECTED], [EMAIL PROTECTED] No matter what we think of Linux versus FreeBSD, etc., the one thing I really like about Linux is that it has Microsoft worried. Anything that kicks a monopoly in the pants has got to be good for something. - Chris Johnson _______________________________________________ Info-cvs mailing list [EMAIL PROTECTED] http://mail.gnu.org/mailman/listinfo/info-cvs