Re: [OT] Example for Perlwrapper around cvs login?

[Joi Ellis]

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 &#169; 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