#------------------------------------------------------------------------------- # Class for standardising all tests for P4Perl #------------------------------------------------------------------------------- package P4::Test; use Cwd; our $START_DIR = cwd(); our $ROOT_DIR = qw( testroot ); our $P4D = qw( p4d ); sub new { my $class = shift; my $self = {}; bless $self, $class; my $root = $self->ServerRoot(); $self->{ 'P4PORT' } = "rsh:$P4D -r $root -L log -vserver=3 -i"; $self->{ 'P4CLIENT' } = "test-client"; delete $ENV{ 'PWD' }; return $self; } sub InitClient() { my $self = shift; chdir( $self->ClientRoot() ) or die( "Can't go to client workspace" ); my $p4 = new P4; $p4->SetPort( $self->{ 'P4PORT' } ); $p4->SetClient( $self->{ 'P4CLIENT' } ); $p4->SetCwd( $self->ClientRoot() ); # Make sure the client knows # where it is. return $p4; } sub CreateTestTree() { my $self = shift; if( -d $self->ServerRoot() ) { #printf( "Removing old test tree!" ); $self->CleanupTestTree() or die( "Can't remove old test tree" ); } mkdir( $self->ServerRoot() ); mkdir( $self->ClientRoot() ); $self->CreateP4ConfigFile(); } sub CleanupTestTree() { my $self = shift; $self->Rmdir( $self->ServerRoot() ); } sub ServerRoot() { return $START_DIR . "/" . $ROOT_DIR; } sub ClientRoot() { my $self = shift; return $self->ServerRoot() . "/workspace"; } # Private sub Rmdir( $ ) { my $self = shift; my $path = shift; opendir( DH, $path ) or die( "Can't read directory $path" ); foreach my $d ( readdir( DH ) ) { next if( $d eq "." || $d eq ".." ); my $p = "$path/$d"; if( -d $p ) { $self->Rmdir( $p ); } else { unlink( $p ) or die( "Can't remove file $p" ); } } closedir( DH ); rmdir( $path ) or die( "Can't remove directory $path" ); } sub CreateP4ConfigFile() { my $self = shift; return unless defined( $ENV{ 'P4CONFIG' } ); my $cfg_file = $self->ServerRoot() . '/' . $ENV{ 'P4CONFIG' }; my $p4port = $self->{ 'P4PORT' }; my $p4client = $self->{ 'P4CLIENT' }; open( FH, ">$cfg_file" ) or die( "Can't create P4CONFIG file" ); print( FH "P4PORT=$p4port\n" ); print( FH "P4CLIENT=$p4client\n" ); close( FH ); } 1;