package VCP::TestUtils ; =head1 NAME VCP::TestUtils - support routines for VCP testing =cut use Exporter ; @EXPORT = qw( p4_options launch_p4d init_p4_client p4d_borken ) ; @ISA = qw( Exporter ) ; use strict ; use Carp ; use File::Spec ; use POSIX ':sys_wait_h' ; sub p4_options { my $prefix = shift || "" ; my $tmp = File::Spec->tmpdir ; return { repo => File::Spec->catdir( $tmp, "${prefix}p4repo" ), work => File::Spec->catdir( $tmp, "${prefix}p4work" ), user => "${prefix}t_user", client => "${prefix}t_client", port => 19666, } ; } sub p4d_borken { my $p4dV = `p4d -V` || 0 ; return "p4d not found" unless $p4dV ; my ( $p4d_version ) = $p4dV =~ m{^Rev[^/]*/[^/]*/([^/]*)}m ; my $min_version = 99.2 ; return "p4d version too old, need at least $min_version" unless $p4d_version >= $min_version ; return "" ; } sub launch_p4d { my $options = pop ; croak "No options passed" unless $options && %$options ; { my $borken = p4d_borken ; croak $borken if $borken ; } ## Ok, this is wierd: we need to fork & run p4d in foreground mode so that ## we can capture it's PID and kill it later. There doesn't seem to be ## the equivalent of a 'p4d.pid' file. If we let it daemonize, then I ## don't know how to get it's PID. my $p4d_pid = fork ; unless ( $p4d_pid ) { ## Ok, there's a tiny chance that this will fail due to a port ## collision. Oh, well. exec 'p4d', '-f', '-r', $options->{repo}, '-p', $options->{port} ; die "$!: p4d" ; } sleep 1 ; ## Wait for p4d to start. 'twould be better to wait for P4PORT to ## be seen. select( undef, undef, undef, 0.250 ) ; END { return unless defined $p4d_pid ; kill 'INT', $p4d_pid or die "$! $p4d_pid" ; my $t0 = time ; my $dead_child ; while ( $t0 + 15 > time ) { select undef, undef, undef, 0.250 ; $dead_child = waitpid $p4d_pid, WNOHANG ; warn "$!: $p4d_pid" if $dead_child == -1 ; last if $dead_child ; } unless ( defined $dead_child && $dead_child > 0 ) { print "terminating $p4d_pid\n" ; kill 'TERM', $p4d_pid or die "$! $p4d_pid" ; $t0 = time ; while ( $t0 + 15 > time ) { select undef, undef, undef, 0.250 ; $dead_child = waitpid $p4d_pid, WNOHANG ; warn "$!: $p4d_pid" if $dead_child == -1 ; last if $dead_child ; } } unless ( defined $dead_child && $dead_child > 0 ) { print "killing $p4d_pid\n" ; kill 'KILL', $p4d_pid or die "$! $p4d_pid" ; } } } sub init_p4_client { my $options = pop ; croak "No options passed" unless $options && %$options ; my $p4 = "p4 -c $options->{client} -u $options->{user} -p $options->{port}" ; my $client_desc = `$p4 client -o` ; die "$! running $p4 client -o\n" unless defined $client_desc ; die "$p4 client -o returned ", $? >> 8, "\n" if $? ; $client_desc =~ s(^Root.*)(Root:\t$options->{work})m ; $client_desc =~ s(^View.*)(View:\n\t//depot/...\t//$options->{client}/...\n)ms ; open( P4, "| $p4 client -i" ) or die "$! $p4 client -i" ; print P4 $client_desc ; unless ( close P4 ) { die "$p4 client -i returned $?" if $! eq "0" ; die qq{$! closing "| p4 client -i"} ; } } =head1 COPYRIGHT Copyright 2000, Perforce Software, Inc. All Rights Reserved. This module and the VCP package are licensed according to the terms given in the file LICENSE accompanying this distribution, a copy of which is included in L. =cut 1 ;