[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [OT] Example for Perlwrapper around cvs login?
From: |
Joi Ellis |
Subject: |
Re: [OT] Example for Perlwrapper around cvs login? |
Date: |
Thu, 2 May 2002 13:31:51 -0500 (CDT) |
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(), address@hidden, 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", address@hidden, address@hidden);
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: address@hidden";
return ($?,0);
}
warn("Open3 returned: address@hidden");
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>address@hidden<gt>.
=head1 COPYRIGHT
Copyright © Aravox Technologies, Inc.
=head1 SEE ALSO
see-also links goes here
EOF
--
Joi Ellis Software Engineer
Aravox Technologies address@hidden, address@hidden
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