#!/usr/gnu/bin/perl -w
#
# Name:
# test.pl.
#
# Purpose:
# To test $PERL5LIB/VCS/CVS.pm.
#
# Warning:
# setenv CVSROOT <somethingHarmless> during this.
use strict;
use Cwd;
use File::Basename;
use File::Copy;
use File::Path;
use Test::More tests => 1;
use VCS::CVS;
#------------------------------------------------------------------
sub addDirectory
{
my($cvs, $projectName, $subDirName, $fileName, $addDirMsg,
$addFileMsg, $verbose, $permissions) = @_;
&init("$projectName/$subDirName", $fileName, $verbose, $permissions);
&heading('addDirectory');
$cvs -> addDirectory($projectName, $subDirName, $addDirMsg);
print "\n";
# We can only add a file if we haven't used a sticky tag.
if ($projectName !~ /Strip/)
{
$fileName = fileparse($fileName, '');
&heading('addFile');
$cvs -> addFile("$projectName/$subDirName", $fileName, $addFileMsg);
print "\n";
}
} # End of addDirectory.
#------------------------------------------------------------------
sub checkOut
{
my($cvs, $readOnly, $dirName, $oldTag) = @_;
&heading('checkOut');
$cvs -> checkOut($readOnly, $oldTag, $dirName);
&printDir($dirName);
print "\n";
} # End of checkOut.
#------------------------------------------------------------------
sub createRepository
{
my($cvs, $projectSource, $vendorTag, $releaseTag, $initialMsg) = @_;
&heading('createRepository');
$cvs -> createRepository();
print "\n";
&heading('populate');
$cvs -> populate($projectSource, $vendorTag, $releaseTag, $initialMsg);
print "\n";
} # End of creatRepository.
#------------------------------------------------------------------
sub getTags
{
my($cvs) = @_;
&heading('getTags');
my($tagRef) = $cvs -> getTags();
print "Tags: \n";
for (sort(@$tagRef) )
{
print "$_\n";
}
} # End of getTags.
#------------------------------------------------------------------
sub heading
{
my($heading) = @_;
print "$heading\n";
print '-' x (length($heading) ), "\n";
} # End of heading.
#------------------------------------------------------------------
sub init
{
my($projectSource, $fileName, $verbose, $permissions) = @_;
my($destination) = "$ENV{'HOME'}/$projectSource";
&heading("rmtree+mkpath($destination)");
rmtree($destination, $verbose);
mkpath($destination, $verbose, $permissions);
copy($fileName, $destination);
&printDir($destination);
print "\n";
} # End of init.
#------------------------------------------------------------------
sub printDir
{
my($dirName) = @_;
opendir(INX, $dirName) || die("Can't opendir($dirName): $!");
my(@file) = readdir(INX);
closedir(INX);
print "Directory: $dirName. Files: \n";
for (@file)
{
print "$_\n";
}
} # End of printDir.
#------------------------------------------------------------------
sub setTag
{
my($cvs, $newTag) = @_;
# my($cvs, $dirName, $fileName, $newTag) = @_;
#
# Edit file, to cause failure of upToDate call within setTag.
# chdir($dirName) || die(Can't chdir($dirName): $!");
# my($line) = &readFile($fileName);
# splice(@$line, 5, 2);
# &writeFile($fileName, $line);
&heading('setTag');
$cvs -> setTag($newTag);
print "\n";
&getTags($cvs);
print "\n";
} # End of setTag.
#------------------------------------------------------------------
sub strip
{
my($cvs, $dirName) = @_;
&heading('stripCVSDirs');
$cvs -> stripCVSDirs($dirName);
print "\n";
} # End of strip.
#------------------------------------------------------------------
sub upToDate
{
my($cvs) = @_;
&heading('status');
my($status) = $cvs -> status();
print "Status: \n";
for (@$status)
{
print "$_\n";
}
print "\n";
&heading('upToDate');
my($upToDate) = $cvs -> upToDate();
print 'The repository is ', ($upToDate ? '' : 'not '), "up-to-date\n";
print "\n";
} # End of upToDate.
#------------------------------------------------------------------
my($addDirMsg) = 'Add directory';
my($addFileMsg) = 'Add file';
my($dirName) = 'project';
my($fileName) = fileparse($0, '');
my($history) = 1;
my($initialMsg) = 'Initial version';
my($myself) = cwd() . "/$fileName";
my($newTag) = 'release_0.01';
my($noChange) = 1;
my($nullTag) = '';
my($permissions) = 0775; # But not '0775'!
my($projectName) = 'project';
my($projectSource) = 'projectSource';
my($raw) = 0;
my($readOnly) = 0;
my($releaseTag) = 'release_0.00';
my($removeFileMsg) = 'Remove file';
my($repository) = 'repository';
my($roDirName) = 'projectReadOnly';
my($stripDirName) = 'projectStrip';
my($subDirName) = 'subDir';
my($vendorTag) = 'vendorTag';
my($verbose) = 1;
$ENV{'HOME'} = cwd();
$ENV{'CVSROOT'} = "$ENV{'HOME'}/VCS-CVS-test/$repository";
my($cvs) = VCS::CVS -> new({
'project' => $projectName,
'raw' => $raw,
'history' => $history,
'permissions' => $permissions,
'verbose' => $verbose});
&init($projectSource, $myself, $verbose, $permissions);
# Clean up from any previous run...
rmtree("$ENV{'HOME'}/$projectName");
rmtree("$ENV{'HOME'}/$roDirName");
rmtree("$ENV{'HOME'}/$stripDirName");
rmtree("$ENV{'HOME'}/VCS-CVS-test");
chdir($ENV{'HOME'}) || die("Can't chdir($ENV{'HOME'}): $!");
&createRepository($cvs, $projectSource, $vendorTag, $releaseTag, $initialMsg);
&checkOut($cvs, $readOnly, $projectName, $nullTag);
&checkOut($cvs, $readOnly, $stripDirName, $releaseTag);
&checkOut($cvs, (! $readOnly), $roDirName, $releaseTag);
&addDirectory($cvs, $projectName, $subDirName, $myself, $addDirMsg,
$addFileMsg, $verbose, $permissions);
&addDirectory($cvs, $stripDirName, $subDirName, $myself, $addDirMsg,
$addFileMsg, $verbose, $permissions);
#&setTag($cvs, $projectName, $fileName, $newTag);
&setTag($cvs, $newTag);
&upToDate($cvs);
print "Update returned: \n", join("\n", @{$cvs -> update($noChange)}), "\n";
print "\n";
print "History returned: \n", join("\n", @{$cvs -> history({'-e' => ''})}), "\n";
&strip($cvs, $stripDirName);
is(0, 0, 'Success');
syntax highlighted by Code2HTML, v. 0.9.1