package VCP::TestUtils ; =head1 NAME VCP::TestUtils - support routines for VCP testing =cut use Exporter ; @EXPORT = qw( assert_eq slurp mk_tmp_dir copy_dir_tree perl_cmd vcp_cmd compile_dtd_cmd parse_files_and_revids_from_revml parse_files_and_revids_from_p4_files parse_files_and_revids_from_cvs_history get_vcp_output p4d_borken launch_p4d cvs_borken init_cvsroot make_cvsroots vss_borken s_content rm_elts run run_p4 ) ; @ISA = qw( Exporter ) ; use strict ; use Carp ; use Cwd ; use File::Copy; use File::Find; use File::Path ; use File::Spec ; use IPC::Run qw( start kill_kill ) ; use POSIX ':sys_wait_h' ; use Text::Diff ; use VCP::Utils qw( shell_quote ); =head1 General utility functions =over =item mk_tmp_dir Creates one or more temporary directories, which will be removed upon exit in an END block =cut { my @tmp_dirs ; END { rmtree \@tmp_dirs unless $ENV{VCPNODELETE} } sub mk_tmp_dir { confess "undef!!!" if grep !defined, @_ ; rmtree \@_ ; mkpath \@_, 0, 0770 ; push @tmp_dirs, @_ ; } } =item copy_dir_tree copy_dir_tree <src-dir> <dest-dir> Copy source directory tree to a destination directory. Accepts absolute or relative directory names, but doesn't do tilde expansion. =cut # TODO: set permissions sub copy_dir_tree { croak "usage $0 <src-dir> <dest-dir>\n" unless @_ == 2; my ($src_dir, $dest_dir) = @_; $src_dir = File::Spec->rel2abs( $src_dir ); $dest_dir = File::Spec->rel2abs( $dest_dir ); croak "destination and source directories are the same\n" if $dest_dir eq $src_dir; croak "destination directory specified as a subdir of source directory, stopping.\n" if $dest_dir =~ /^$src_dir/ ; croak "source directory '$src_dir' doesn't exist\n" unless -e $src_dir; croak "source directory '$src_dir' isn't a directory\n" unless -d $src_dir; croak "destination '$dest_dir' already exists\n" if -e $dest_dir; find( { no_chdir => 1, wanted => sub { my $newname = $_; $newname =~ s/^$src_dir/$dest_dir/ ; my ( $perms, $uid, $gid ) = (stat)[2,4,5]; if ( -d ) { # source was a directory mkdir $newname or croak "couldn't create directory '$newname': $!\n"; } else { copy $_, $newname or croak "couldn't copy file from '$_' to '$newname'\n"; } chmod $perms, $newname or warn "$!: chmod()ing $newname\n"; chown $uid, $gid, $newname or warn "$!: chown()ing $newname\n"; }, }, $src_dir ); } =item assert_eq assert_eq $test_name, $in, $out ; dies with a useful diff in $@ is $in ne $out. Returns nothing. Requires a diff that knows about the -d and -U options. =cut sub assert_eq { my ( $name, $in, $out ) = @_ ; ## Doint this because Test::Differences isn't quite "real" yet... croak diff \$in, \$out, { CONTEXT => 10 } if $in ne $out ; } =item slurp $guts = slurp $filename ; read entire contents of file and return as a scalar. =cut sub slurp { my ( $fn ) = @_ ; open F, "<$fn" or croak "$!: $fn" ; binmode F ; local $/ ; my $s = <F>; close F; return $s; } =item perl_cmd @perl = perl_cmd Returns a list containing the Perl executable and some options to reproduce the current Perl options , like -I. =cut sub perl_cmd { my %seen ; return ( $^X, ( map { my $s = $_ ; $s = File::Spec->rel2abs( $_ ) ; "-I$s" ; } grep ! $seen{$_}++, @INC ) ) ; } =item find_command @vcp = find_command "vcp" Find a script within the main distro directory or one subdir under it. Looks for "bin/<cmd>" and "../bin/<cmd>". This should be adequate for almost all uses. =cut sub find_command { ## We always run vcp by doing a @perl, vcp, to make sure that vcp runs under ## the same version of perl that we are running under. my $cmd = shift; $cmd = "bin/$cmd" if -e "bin/$cmd" ; $cmd = "../bin/$cmd" if -e "../bin/$cmd" ; $cmd = File::Spec->rel2abs( $cmd ) ; return $cmd; } =item vcp_cmd @vcp = vcp_cmd Returns a list containing the Perl executable and some options to reproduce the current Perl options , like -I. vcp_cmd assumes it is called from within the main distro directory or one subdir under it, since it looks for "bin/vcp" and "../bin/vcp". This should be adequate for almost all uses. vcp_cmd caches it's results to allow it to be run from other directories after the first time it's called. (this is not a significant performance improvement; running the vcp process takes several orders of magnitude longer than the quick checks vcp_cmd does). =cut my @vcp_cmd ; sub vcp_cmd { unless ( @vcp_cmd ) { ## We always run vcp by doing a @perl, vcp, to make sure that ## vcp runs under the same version of perl that we are running under. @vcp_cmd = ( perl_cmd, find_command 'vcp' ) ; } return @vcp_cmd ; } =item compile_dtd_cmd @compile_dtd = compile_dtd_cmd Returns a list containing the Perl executable and some options to reproduce the current Perl options , like -I. compile_dtd_cmd assumes it is called from within the main distro directory or one subdir under it, since it looks for "bin/compile_dtd" and "../bin/compile_dtd". This should be adequate for almost all uses. compile_dtd_cmd caches it's results to allow it to be run from other directories after the first time it's called. =cut my @compile_dtd_cmd ; sub compile_dtd_cmd { unless ( @compile_dtd_cmd ) { ## We always run compile_dtd by doing a @perl, compile_dtd, to ## make sure that compile_dtd runs under the same version of ## perl that we are running under. @compile_dtd_cmd = ( perl_cmd, find_command 'compile_dtd' ) ; } return @compile_dtd_cmd ; } =item run Run a command using IPC::Run::run, but with logging and a verbose exception on non-0 result code. Arguments are the same as and are passed to IPC::Run =cut sub run { my @log_cmd = @{$_[0]}; ## print "--> #\$ ", shell_quote( @log_cmd ), "\n"; ## !!! if ( $log_cmd[0] eq $^X ) { # running a command via perl # replace all perl -I options with a "-I..." option to enhance # readability. @log_cmd = ( $log_cmd[0], "-I...", grep ! /^-I/, @log_cmd[1..$#log_cmd] ); # vcp is run using perl. get rid of perl and its lengthy # arguments in the log so the user doesn't need to see them. my $i; my @run_command = grep $i ||= /\bvcp\z/, @log_cmd[1..$#log_cmd]; @log_cmd = ( "vcp", @run_command[ 1..$#run_command ] ) if @run_command; } print "#\$ ", shell_quote( @log_cmd ), "\n"; my $start_time = time; IPC::Run::run( @_ ) or croak shell_quote( $_[0] ), " returned $?"; my $time = time - $start_time; my $mins = int( $time / 60 ); printf "# %02d:%02d\n", $mins, $time - $mins * 60; } =item run_p4 calls 'run' to run p4 binary after deciding which platform specific program to run. determines p4 executable name based on operating system. builds p4 options string from $p4_options hash examples: run_p4 \@args, \$stdin, \$stdout, \$stderr, $p4_options; run_p4 [ qw(files) ], \undef, \$stdout, $p4_options; arguments: =over =item 1. array of words to add to end of p4 command =item 2... remaining arguments passed on to 'run' sub (except final arg) =item final arg: p4_options hash (may contain: port, user, client, password ... ?) =back =cut sub run_p4 { die "usage: run_p4 <array-of-additional-p4-commands> <p4-options-hash> [args-to-run-cmd]..." unless @_ >= 2; my $extra_p4_commands = shift; my $p4_options = pop; croak "no options passed" unless ref $p4_options eq "HASH" ; my @p4_args; local $ENV{P4PASSWD} = $p4_options->{password} if defined $p4_options->{password} ; push @p4_args, '-p', $p4_options->{port} if defined $p4_options->{port} ; push @p4_args, '-c', $p4_options->{client} if defined $p4_options->{client} ; push @p4_args, '-u', $p4_options->{user} if defined $p4_options->{user} ; push @p4_args, @$extra_p4_commands; my $p4_binary = $^O =~ /Win32/ ? "p4.exe" : "p4" ; run [ $p4_binary, @p4_args ], @_ ; } =item parse_files_and_revids_from_revml given one or more revml filenames, slurp them up, parse out the <name> and <rev_id> elements within each <rev>, then return a string (sorted by line) of the form: <name1> <max_revision_num1> <name2> <max_revision_num2> <name3> <max_revision_num3> . . . The final (optional) argument may be a reference to a hash of parameters. Currently the only parameter is IGNORE_REVS_WITH_DELETE_FLAG, which if true, causes any revs containing the <delete /> or <delete/> tags to be ignored. examples: my $revs = parse_files_and_revids_from_revml $infile ; my $revs = parse_files_and_revids_from_revml $infile1, $infile2 ; =cut sub parse_files_and_revids_from_revml { my $options = @_ && ref $_[-1] ? pop : {} ; croak "usage: parse_files_revids_from_revml <infile> ... [options-hash-ref]" unless @_ >= 1; my $ignore_revs_with_delete_tag = $options->{IGNORE_REVS_WITH_DELETE_FLAG}; my $revs = {}; for( @_ ) { my $revml = slurp $_; # find <rev> tag while ( $revml =~ m{ < rev \b [^>] * > ( .*? ) < \/ rev > }gsx ) { my $rev = $1; # look for tags within <rev> tag my ($name, $rev_id); # <name> tag $name = $1 if $rev =~ m{ <name> ( [^<] * ) <\/name> }gx ; # <rev_id> tag $rev_id = $1 if $rev =~ m{ <rev_id> ( [^<] * ) <\/rev_id> }gx ; # <delete /> tag next if $ignore_revs_with_delete_tag && $rev =~ m{<delete ?\/>} ; croak "rev found without <name> tag at line $." unless defined $name; croak "rev found without <rev_id> tag at line $." unless defined $rev_id; # keep the greatest rev_id $revs->{$name} = $rev_id if ! exists $revs->{$name} || ! defined $revs->{$name} || $revs->{$name} lt $rev_id ; } } return join "", map { "$_ => $revs->{$_}\n" } sort keys %$revs; } =item parse_files_and_revids_from_p4_files Run p4 files command line to get list of changed files. Parse the output so it can be diffed with the output of parse_files_revids_from_revml. returns a string containing names and revision numbers, 1 per line. See that sub above for a description of the output format. arguments are: =over =item 1. revision root, e.g. "//depot/something/". This string will be removed from the output so it may be diffed with parse_files_revids_from_revml output. =item 2. p4_options hash as returned from launch_p4d =item 3... 1 or more file[revRange] spec for p4 files command (run 'p4 help files' and 'p4 help revisions' command line for formatting help) =back example usage: parse_files_revids_from_p4_files $p4_rev_root, $p4_options, "//..." =cut sub parse_files_and_revids_from_p4_files { croak "usage: parse_files_revids_from_p4_files <p4_rev_root>, <p4_options hash>, <file_spec>... " unless @_ >= 3; my ($p4_rev_root, $p4_options) = (shift, shift); my $output; run_p4 [ "files", @_ ], \undef, \$output, $p4_options; my $h = {}; while ( $output =~ m{(.*)#(\d+) - }g ) { die "'p4 files' output lines weren't preceeded by $p4_rev_root as expected" if index( $1, $p4_rev_root ) < 0 ; my $name = substr $1, length $p4_rev_root ; die "duplicate file names in p4 files output" if exists $h->{$name}; $h->{$name} = $2 ; } return join "", map { "$_ => $h->{$_}\n" } sort keys %$h; } =item parse_files_and_revids_from_cvs_history Run cvs history command line to get list of changed files. Parse the output so it can be diffed with the output of parse_files_revids_from_revml. returns a string containing names and revision numbers, 1 per line. See that sub above for a description of the output format. arguments are: =over =item 1. cvs root directory. =item 2. cvs module name. This string will be removed from the output so it may be diffed with parse_files_revids_from_revml output. =back example usage: parse_files_revids_from_cvs_history "/home/blah/blah/cvsroot_0/", "module-blah" =cut sub parse_files_and_revids_from_cvs_history { croak "usage: parse_files_revids_from_p4_files <cvs-root>, <cvs-module>" unless @_ == 2; my ($cvs_root, $cvs_module) = (shift, shift); my $output; # !!! TODO: run_cvs ??? # run [ "cvs", "-d", $cvs_root, "history", "-xAM" ], run [ "cvs", "-d", $cvs_root, "history", "-c" ], \undef, \$output; my $h = {}; my @lines = split /\n/, $output; for ( @lines ) { my @fields = split; my $name = "$fields[7]/$fields[6]"; die "'cvs history' output lines didn't contain module name '$cvs_module' as expected" if index( $name, $cvs_module ) != 0 ; # remove cvs_module name plus directory separator $name = substr $name, length( $cvs_module ) + 1; # keep the greatest rev_id my $rev_id = $fields[5]; $h->{$name} = $rev_id if ! exists $h->{$name} || ! defined $h->{$name} || $h->{$name} lt $rev_id ; } return join "", map { "$_ => $h->{$_}\n" } sort keys %$h; } =item get_vcp_output @vcp = get_vcp_output "foo:", "-bar" ; Does a: run [ vcp_cmd, @_, "revml:", ... ], \undef, \$out or croak "`vcp blahdy blah` returned $?"; and returns $out. The "..." refers to whatever output options are needed to make the test output agree with C<bin/gentrevml>'s test files (t/test-*.revml). =cut sub get_vcp_output { my $out ; my @args = ( @_, "revml:", "--sort-by=name,rev_id" ) ; run [ vcp_cmd, @args ], \undef, \$out; return $out ; } =back =head1 XML "cleanup" functions These are used to get rid of content or elements that are known to differ when comparing the revml fed in to a repository with the revml that comes out. =over =item s_content s_content $elt_type1, $elt_type2, ..., \$string1, \$string2, ..., $new_content ; Changes the contents of the elements, since some things, like suer id or mod_time can't be the same after going through a repository. If $new_val is not supplied, a constant string is used. =cut sub s_content { my $new_val = pop if @_ && ! ref $_[-1] ; $new_val = "<!-- deleted by test suite -->" unless defined $new_val ; my $elt_type_re = do { my @a ; push @a, quotemeta shift while @_ && ! ref $_[0] ; join "|", @a ; } ; $$_ =~ s{(<($elt_type_re)[^>]*?>).*?(</\2\s*>)} {$1$new_val$3}sg for @_ ; $$_ =~ s{(<($elt_type_re)[^>]*?>).*?(</\2\s*>)}{$1$new_val$3}sg for @_ ; } =item rm_elts rm_elts $elt_type1, $elt_type2, ..., \$string1, \$string2 rm_elts $elt_type1, $elt_type2, ..., qr/$content_re/, \$string1, \$string2 Removes the specified elements from the strings, including leading whitespace and trailing line separators. If the optional $content_re regular expression is provided, then only elements containing that pattern will be removed. =back =cut sub rm_elts { my $elt_type_re = do { my @a ; push @a, quotemeta shift while @_ && ! ref $_[0] ; join "|", @a ; } ; my $content_re = @_ && ref $_[0] eq "Regexp" ? shift : qr/.*?/s ; my $re = qr{^\s*<($elt_type_re)\b[^>]*?>$content_re</\1\s*>\r?\n}sm ; $$_ =~ s{$re}{}g for @_ ; } =head1 p4 repository mgmt functions =over =item p4_borken Returns true if the p4 is missing or too old (< 99.2). =cut 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 "" ; } =item launch_p4d launch_p4d "prefix_" ; Creates an empty repository and launches a p4d for it. The p4d will be killed and it's repository deleted on exit. Returns the options needed to access the repository, plus a handle to the IPC::Run harness for the p4d. May pass these options as a hash argument: repo_dir : name of repository directory rm_repo_dir : if true, remove existing repository directory before creating new one. copy_from_dir : copy repository from this directory. implies rm_repo_dir. =cut sub launch_p4d { my $options = @_ && ref $_[-1] ? pop : {} ; $options->{rm_repo_dir} ||= defined $options->{copy_from_dir} ; my $prefix = shift || "" ; { my $borken = p4d_borken ; croak $borken if $borken ; } my $tmp = File::Spec->tmpdir ; my $repo = $options->{repo_dir}; if ( defined $repo ) { rmtree [ $repo ] if $options->{rm_repo_dir}; mkpath [ $repo ] unless -e $repo || defined $options->{copy_from_dir} ; } else { $repo = File::Spec->catdir( $tmp, "vcp${$}_${prefix}p4repo" ) ; mk_tmp_dir $repo ; } copy_dir_tree $options->{copy_from_dir}, $repo if defined $options->{copy_from_dir} ; ## 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 $port ; my $tries ; my $h ; while () { ## 30_000 is because I vaguely recall some TCP stack that had problems ## with listening on really high ports. 2048 is because I vaguely recall ## that some OS required root privs up to 2047 instead of 1023. $port = ( rand( 65536 ) % 30_000 ) + 2048 ; my @p4d = ( "p4d", "-f", "-r", $repo, "-p", $port ) ; print "# Running ", join( " ", @p4d ), "\n" ; $h = start \@p4d ; ## Wait for p4d to start. 'twould be better to wait for P4PORT to ## be seen. sleep 1 ; ## The child process will have died if the port is taken or due ## to other errors. last if $h->pumpable; finish $h; die "p4d failed to start after $tries tries, aborting\n" if ++$tries >= 3 ; warn "p4d failed to start, retrying\n" ; } END { return unless $h; $h->kill_kill; $? = 0; ## p4d exits with a "15", which becomes our exit code ## if we don't clear this. } return { user => "${prefix}t_user", port => $port, p4d_handle => $h, } ; } =back =head1 CVS mgmt functions =over =item cvs_borken Returns true if cvs -v works and outputs "Concurrent Versions System". =cut sub cvs_borken { my $cvsV = `cvs -v` || 0 ; return "cvs command not found" unless $cvsV ; return "cvs command does not appear to be for CVS: '$cvsV'" unless $cvsV =~ /Concurrent Versions System/; return "" ; } =item init_cvsroot my $cvs_options = init_cvsroot $prefix, $module_name ; my $cvs_options = init_cvsroot $prefix, $module_name, $rootdir ; Creates a CVS repository containing an empty module. Also sets $ENV{LOGNAME} if it notices that we're running as root, so CVS won't give a "cannot commit files as 'root'" error. Tries "nobody", then "guest". Returns the options needed to access the cvs repository. =cut sub init_cvsroot { my ( $prefix , $module, $root ) = @_ ; my $tmp = File::Spec->tmpdir ; my $is_tmp_root = ! defined $root; $root = File::Spec->catdir( $tmp, "vcp${$}_${prefix}cvsroot" ) if $is_tmp_root; my $options = { repo => $root, work => File::Spec->catdir( $tmp, "vcp${$}_${prefix}cvswork" ), } ; my $cwd = cwd ; ## Give vcp ... cvs:... a repository to work with. Note that it does not ## use $cvswork, just this test script does. $ENV{CVSROOT} = $options->{repo} ; ## CVS does not like root to commit files. So, try to fool it. ## CVS calls geteuid() to determine rootness (so does perl's $>). ## If root, CVS calls getlogin() first, then checks the LOGNAME and USER ## environment vars. ## ## What this means is: if the user is actually logged in on a physical ## terminal as 'root', getlogin() will return "root" to cvs and we can't ## fool CVS. ## ## However, if they've used "su", a very common occurence, then getlogin() ## will return failure (NULL in C, undef in Perl) and we can spoof CVS ## using $ENV{LOGNAME}. if ( ! $> && $^O !~ /Win32/ ) { my $login = getlogin ; if ( ( ! defined $login || ! getpwnam $login ) && ( ! exists $ENV{LOGNAME} || ! getpwnam $ENV{LOGNAME} ) ) { for ( qw( nobody guest ) ) { my $uid = getpwnam $_ ; next unless defined $uid ; ( $ENV{LOGNAME}, $> ) = ( $_, $uid ) ; last ; } ## Must set uid, too, to keep perl (and thus vcp) from bombing ## out when running setuid and given a -I option. This happens ## a lot in the test suite, since the tests often call vcp ## using "perl", "-Iblib/lib", "bin/vcp", ... to recreate the ## appropriate operating environment for Perl. If this becomes ## a problem, perhaps we can hack in a "run as user" option to ## VCP::Utils::cvs so that only the cvs subcommands are run ## setuid, or perhaps we can avoid passing "-I" to the perls. $< = $> ; warn "# Setting real & eff. uids=", $>, "(", $ENV{LOGNAME}, qq{) to quell "cvs: cannot commit files as 'root'"\n} ; } } mk_tmp_dir $options->{repo} if $is_tmp_root; run [ qw( cvs init ) ]; mk_tmp_dir $options->{work} ; chdir $options->{work} or die "$!: $options->{work}" ; mkdir $module, 0770 or die "$!: $module" ; chdir $module or die "$!: $module" ; run [ qw( cvs import -m ), "$module import", $module, "${module}_vendor", "${module}_release" ]; chdir $cwd or die "$!: $cwd" ; delete $ENV{CVSROOT} ; # chdir ".." or die "$! .." ; # # system qw( cvs checkout CVSROOT/modules ) and die "cvs checkout failed" ; # # open MODULES, ">>CVSROOT/modules" or die "$!: CVSROOT/modules" ; # print MODULES "\n$module $module/\n" or die "$!: CVSROOT/modules" ; # close MODULES or die "$!: CVSROOT/modules" ; # # system qw( cvs commit -m foo CVSROOT/modules ) # and die "cvs commit failed" ; return $options ; } =item make_cvsroots ( $infile_0, $cvsroot_0, $infile_1, $cvsroot_1 ) = make_cvsroots( $module, $parent_dir ); Inits two cvsroots, one with t/test-cvs-in-0.revml and one with both that and t/test-cvs-in-1.revml in it. Only remakes these if they are out of date with respect to the appropriate .revml file(s). Returns a list of: revml filename numbered 0, cvs root init'd for previous file, revml filename numbered 1, cvs root init'd for previous file =cut sub make_cvsroots { my ( $module, $parent_dir ) = @_; my $cvsroot_0 = File::Spec->rel2abs( $parent_dir . "cvsroot_0/" ); my $infile_0 = $parent_dir . "test-cvs-in-0.revml"; my $infile_0_age = -M $infile_0; my $cvs_spec_0 = "cvs:$cvsroot_0:$module/" ; if ( ( -M "$cvsroot_0/CVSROOT" || $infile_0_age ) >= $infile_0_age ) { require File::Path; warn "Building $cvsroot_0\n"; File::Path::rmtree( [ $cvsroot_0 ] ) if -e $cvsroot_0; File::Path::mkpath( [ $cvsroot_0 ], 1 ); init_cvsroot "cvs_", $module, $cvsroot_0; my @vcp = vcp_cmd; run [ @vcp, "revml:$infile_0", $cvs_spec_0 ], \undef; } my $cvsroot_1 = File::Spec->rel2abs( "$parent_dir/cvsroot_1/" ); my $infile_1 = $parent_dir . "test-cvs-in-1.revml"; my $infile_1_age = -M $infile_1; my $cvs_spec_1 = "cvs:$cvsroot_1:$module/" ; if ( ( -M "$cvsroot_0/CVSROOT" || $infile_0_age ) >= $infile_0_age || ( -M "$cvsroot_1/CVSROOT" || $infile_1_age ) >= $infile_1_age ) { ## NOTE: could use File::Find and File::Copy to shorcut the ## import of test-cvs-in-0, but this shouldn't have much affect ## normally. require File::Path; warn "Building $cvsroot_1\n"; File::Path::rmtree [ $cvsroot_1 ] if -e $cvsroot_1; File::Path::mkpath [ $cvsroot_1 ], 1; init_cvsroot "cvs_", $module, $cvsroot_1; my @vcp = vcp_cmd; run [ @vcp, "revml:$infile_0", $cvs_spec_1 ], \undef; run [ @vcp, "revml:$infile_1", $cvs_spec_1 ], \undef; } return ( $infile_0, $cvsroot_0, $infile_1, $cvsroot_1, ) } =back =head1 VSS mgmt functions =over =item vss_borken fails unless $ENV{SSUSER} is defined and the command C<ss whoami> runs and returns what looks like a username. May lock up if the ss.exe command prompts for a password. This is because I can't figure out a reliable way to detect if the "ss" command runs well without risking a lock up, since it has a habit of prompting for a password that I can't break it of without initalizing a custom Source Safe repository. =cut sub vss_borken { return "SSUSER not in the environment" unless defined $ENV{SSUSER}; my $user = `ss Whoami` ; return "ss command not found" unless defined $user && length $user; return "ss command did not return just a username" unless $user =~ /\A\S+$/m; return "" ; } =back =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<vcp>. =cut 1 ;
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#68 | 5403 | Barrie Slaymaker | - Misc logging, maintainability & debugging improvements | ||
#67 | 5083 | Barrie Slaymaker | - Minor rmtree() nag about no root dirs prevented | ||
#66 | 4476 | Barrie Slaymaker | - misc bugfixes | ||
#65 | 4417 | Barrie Slaymaker |
- Adapt to "estimated values" messages - Adapt to more accurate test suite |
||
#64 | 4405 | Barrie Slaymaker | - test suites suppress banner to prevent false error detection in testnig stdout | ||
#63 | 4143 | Barrie Slaymaker | - Further adaptation to vcp.exe packaging format | ||
#62 | 3974 | Barrie Slaymaker | - IPC::Run no longer required | ||
#61 | 3970 | Barrie Slaymaker |
- VCP::Source handles rev queing, uses disk to reduce RAM - Lots of other fixes |
||
#60 | 3826 | Barrie Slaymaker |
- test suite: the .expected and .got files may be copy-n-pasted from console output to a diff or gvim -d command on Win32. |
||
#59 | 3738 | Barrie Slaymaker | - TestUtils::rm_elts() can now delete "<foo />" tags | ||
#58 | 3716 | Barrie Slaymaker | - .got and .expected files are now left in /tmp on test failure | ||
#57 | 3713 | Barrie Slaymaker |
- tests now usually emit large diffs to log file - tests now emit .got and .expected files when things differ |
||
#56 | 3692 | Barrie Slaymaker | - assert_eq() is deprecated | ||
#55 | 3560 | John Fetkovich |
make text UI ready for testing via piping from stdin. VCP::TestUtils::Run now optionally may use IPC::Run rather than IPC::Run3. |
||
#54 | 3510 | Barrie Slaymaker | - VSS --continue and branching support | ||
#53 | 3497 | Barrie Slaymaker | - Get more context from eq_or_diff() | ||
#52 | 3460 | Barrie Slaymaker |
- Revamp Plugin/Source/Dest hierarchy to allow for reguritating options in to .vcp files |
||
#51 | 3452 | Barrie Slaymaker | - Show more context in test failure diffs | ||
#50 | 3421 | Barrie Slaymaker |
- Fix regex quoting bugs in copy_dir_tree() - Code cleanup - Better docs - add eq_or_diff() (will move out of lots of test scripts) - vss_borken() now looks for runable MKSS.EXE instead of seeing if $ENV{SSUSER} is set |
||
#49 | 3115 | Barrie Slaymaker |
Move sorting function to the new VCP::Filter::sort; it's for testing and reporting only and the code was bloating VCP::Dest and limiting VCP::Rev and VCP::Dest optimizations. Breaks test suite in minor way. |
||
#48 | 2978 | Barrie Slaymaker | Fix head revs reporting routine to cope with <> branch_id. | ||
#47 | 2974 | John Fetkovich |
fix parse_files_and_revids_from_revml to deal with branches and multiple dotted revs |
||
#46 | 2969 | John Fetkovich | added tweak to force test to pass | ||
#45 | 2968 | John Fetkovich |
altered tests to use parse_files_and_revids_from_head_revs_db change to that routine too. |
||
#44 | 2959 | John Fetkovich |
added dump method to lib/VCP/DB_File/sdbm.pm to dump keys => values from a sdbm file. removed similar code from bin/dump_head_revs, bin/dump_rev_map and bin/dump_main_branch_id and called this method instead. also made parse_files_and_revids_from_head_revs_db sub in TestUtils to use in test suites instead of parse_files_and_revids_from_p4_files et. al. |
||
#43 | 2951 | John Fetkovich | renamed run_new to run, mothballed the old run sub. | ||
#42 | 2939 | John Fetkovich | added empty() call | ||
#41 | 2926 | John Fetkovich |
remove --state-location switch add --db-dir and --repo-id switches build state location from concatenation of those two. |
||
#40 | 2916 | John Fetkovich | fix 'parse_files_and_revids_*' sub names in docs and usages. | ||
#39 | 2836 | John Fetkovich |
Make Source::p4 use --continue and --bootstrap options (partial) update test suite appropriately |
||
#38 | 2801 | Barrie Slaymaker | Add rm_dir_tree. | ||
#37 | 2784 | Barrie Slaymaker |
Restore logging of what command is being run so that testers can see what blew up. |
||
#36 | 2767 | John Fetkovich | comment fix | ||
#35 | 2766 | John Fetkovich | removed an already done TODO comment | ||
#34 | 2754 | John Fetkovich | Convert to use IPC::Run3::run3 rather than IPC::Run::run | ||
#33 | 2714 | Barrie Slaymaker |
Simplify t/90*cvs.t tests, remove make_cvsroots for speed and simplicity. |
||
#32 | 2709 | Barrie Slaymaker | allow ok_result_codes to be passed to TestUtils::run() | ||
#31 | 2663 | Barrie Slaymaker |
Fix mtime bug in VCP::Dest::cvs in branching code Improve temp directory management |
||
#30 | 2645 | John Fetkovich | formatting change | ||
#29 | 2622 | John Fetkovich |
Split revml2cvs.t into three files, then improved; particularly made changes to use parse_files_and_revids_from_revml (already in TestUtils.pm) and parse_files_and_revids_from_cvs_history (newly added to TestUtils.pm) to do checks on changes. |
||
#28 | 2621 | John Fetkovich |
Changed parse_files_and_revids_from_revml to allow optionally ignoring revs containing a <delete /> tag. |
||
#27 | 2619 | John Fetkovich | Fixes to parse_files_and_revids_from_revml | ||
#26 | 2599 | John Fetkovich |
Changed parse_files_and_revids_from_p4_files to accept file_spec argument to p4 files command. Modified test suites to use it. Various documentation changes to TestUtils.pm. |
||
#25 | 2591 | John Fetkovich |
Changed 90revml2p4_1.t to use improvements previously done to 90revml2p4_0.t. Factored out parse_files_and_revids_from_p4_files common to both into TestUtils.pm. |
||
#24 | 2590 | John Fetkovich | Cleared up some documentation. | ||
#23 | 2589 | John Fetkovich |
Split 90p4.t into 90revml2p4_0.t, 90revml2p4_1.t, 91p42revml.t, 95p42cvs.t. Added some utilities to the library files listed. |
||
#22 | 2445 | John Fetkovich |
added compile_dtd_cmd, and factored out find_command from compile_dtd_cmd and vcp_cmd. |
||
#21 | 2293 | Barrie Slaymaker | Update CHANGES, TODO, improve .vcp files, add --init-cvs | ||
#20 | 2267 | Barrie Slaymaker | factor out cvs2revml, test both --use-cvs and direct modes, with times | ||
#19 | 2265 | Barrie Slaymaker | factor out t/95cvs2p4.pm and allow it to reuse the cvs repo for speed. | ||
#18 | 1998 | Barrie Slaymaker | Initial, revml and core VCP support for branches | ||
#17 | 1855 | Barrie Slaymaker |
Major VSS checkin. Works on Win32 |
||
#16 | 1809 | Barrie Slaymaker | VCP::Patch should ignore lineends | ||
#15 | 1731 | Barrie Slaymaker |
Don't leave $? set in END{} block when killing p4d |
||
#14 | 1728 | Barrie Slaymaker | CVS on win32, minor bugfixes | ||
#13 | 1358 | Barrie Slaymaker | Win32 changes | ||
#12 | 1069 | Barrie Slaymaker | bump to 0.25, hide spurious test output | ||
#11 | 1055 | Barrie Slaymaker |
add sorting, revamp test suite, misc cleanup. Dest/revml is not portable off my system yet (need to release ...::Diff) |
||
#10 | 1022 | Barrie Slaymaker |
Perl "$foo\_..." => "${foo}_..." cleanup by Peter Prymmer <PPrymmer@factset.com>. |
||
#9 | 719 | Barrie Slaymaker | vcp 0.221 | ||
#8 | 701 | Barrie Slaymaker | Fixed VCP::Dest::p4 re-rooting problem, further t/* cleanup | ||
#7 | 699 | Barrie Slaymaker | test suite cleanup | ||
#6 | 696 | Barrie Slaymaker | cleanup. | ||
#5 | 692 | Barrie Slaymaker |
Add VCP::Utils::p4 and use it to get VCP::Dest::p4 to create it's own client view as needed. |
||
#4 | 628 | Barrie Slaymaker | Cleaned up POD in bin/vcp, added BSD-style license. | ||
#3 | 615 | Barrie Slaymaker |
Detect p4d <= 99.2 and skip tests. Fix a use strict problem. Both reported by Nick Ing-Simmons. |
||
#2 | 614 | Barrie Slaymaker |
avoid 'make test' die-ing with a use-strict warning, patch from Nick Ing-Simmons <nick@ing-simmons.net>, <20010522191857.623.23@dromedary.ni-s.u-net.com> |
||
#1 | 611 | Barrie Slaymaker | Shoulda added this this moring. |