print "\nGenerating automated scripts for NetWare...\n\n\n";
use File::Basename;
use File::Copy;
chdir '/perl/scripts/';
$DirName = "t";
# These scripts have problems (either abend or hang) as of now (11 May 2001).
# So, they are commented out in the corresponding auto scripts, io.pl and lib.pl
@ScriptsNotUsed = ("t/io/openpid.t", "t/lib/filehandle.t", "t/lib/memoize/t/expire_module_t.t", "t/lib/NEXT/t/next.t", "t/lib/Math/BigInt/t/require.t", "t/ext/B/t/debug.t", "t/lib/IPC/Open3.t", "t/ext/B/t/showlex.t", "t/op/subst_wamp.t", "t/uni/upper.t", "t/lib/Net/t/ftp.t", "t/op/sort.t", "t/ext/POSIX/t/posix.t", "t/lib/CPAN/t/loadme.t", "t/lib/CPAN/t/vcmp.t");
opendir(DIR, $DirName);
@Dirs = readdir(DIR);
close(DIR);
foreach $DirItem(@Dirs)
{
$DirItem1 = $DirName."/".$DirItem;
push @DirNames, $DirItem1; # All items under $DirName folder is copied into an array.
if(-d $DirItem1)
{ # If an item is a folder, then open it further.
# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
$IntAutoScript = "t/".$DirItem.".pl";
# Open once in write mode since later files are opened in append mode,
# and if there already exists a file with the same name, all further opens
# will append to that file!!
open(FHW, "> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for writing.\n";
seek(FHW, 0, 0); # seek to the beginning of the file.
close FHW; # close the file.
}
}
print "Generating t/nwauto.pl ...\n\n\n";
open(FHWA, "> t/nwauto.pl") or die "Unable to open the file, t/nwauto.pl for writing.\n";
seek(FHWA, 0, 0); # seek to the beginning of the file.
$version = sprintf("%vd",$^V);
print FHWA "\n\nprint \"Automated Unit Testing of Perl$version for NetWare\\n\\n\\n\"\;\n\n\n";
foreach $FileName(@DirNames)
{
$index = 0;
if(-d $FileName)
{ # If an item is a folder, then open it further.
$dir = dirname($FileName); # Get the folder name
foreach $DirItem1(@Dirs)
{
$DirItem2 = $DirItem1;
if($FileName =~ m/$DirItem2/)
{
$DirItem = $DirItem1;
# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
$IntAutoScript = "t/".$DirItem.".pl";
}
}
# Write into the intermediary auto script.
open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n";
seek(FHW, 0, 2); # seek to the end of the file.
$pos = tell(FHW);
if($pos <= 0)
{
print "Generating $IntAutoScript...\n";
print FHW "\n\nprint \"Testing $DirItem folder:\\n\\n\\n\"\;\n\n\n";
}
opendir(SUBDIR, $FileName);
@SubDirs = readdir(SUBDIR);
close(SUBDIR);
foreach $SubFileName(@SubDirs)
{
$SubFileName = $FileName."/".$SubFileName;
if(-d $SubFileName)
{
push @DirNames, $SubFileName; # If sub-folder, push it into the array.
}
else
{
&Process_File($SubFileName); # If file, process it.
}
$index++;
}
close FHW; # close the file.
if($index <= 0)
{
# The folder is empty and delete the corresponding '.pl' file.
unlink($IntAutoScript);
print "Deleted $IntAutoScript since it corresponded to an empty folder.\n";
}
else
{
if($pos <= 0)
{ # This logic to make sure that it is written only once.
# Only if something is written into the intermediary auto script,
# only then make an entry of the intermediary auto script in nwauto.pl
print FHWA "print \`perl $IntAutoScript\`\;\n";
print FHWA "print \"\\n\\n\\n\"\;\n\n";
}
}
}
else
{
if(-f $FileName)
{
$dir = dirname($FileName); # Get the folder name
$base = basename($FileName); # Get the base name
($base, $dir, $ext) = fileparse($FileName, '\..*'); # Get the extension of the file passed.
# Do the processing only if the file has '.t' extension.
if($ext eq '.t')
{
print FHWA "print \`perl $FileName\`\;\n";
print FHWA "print \"\\n\\n\\n\"\;\n\n";
}
}
}
}
## Below adds the ending comments into all the intermediary auto scripts:
opendir(DIR, $DirName);
@Dirs = readdir(DIR);
close(DIR);
foreach $DirItem(@Dirs)
{
$index = 0;
$FileName = $DirName."/".$DirItem;
if(-d $FileName)
{ # If an item is a folder, then open it further.
opendir(SUBDIR, $FileName);
@SubDirs = readdir(SUBDIR);
close(SUBDIR);
# To not to write into the file if the corresponding folder was empty.
foreach $SubDir(@SubDirs)
{
$index++;
}
if($index > 0)
{
# The folder not empty.
# Intemediary automated script like base.pl, lib.pl, cmd.pl etc.
$IntAutoScript = "t/".$DirItem.".pl";
# Write into the intermediary auto script.
open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n";
seek(FHW, 0, 2); # seek to the end of the file.
# Write into the intermediary auto script.
print FHW "\nprint \"Testing of $DirItem folder done!\\n\\n\"\;\n\n";
close FHW; # close the file.
}
}
}
# Write into nwauto.pl
print FHWA "\nprint \"Automated Unit Testing of Perl$version for NetWare done!\\n\\n\"\;\n\n";
close FHWA; # close the file.
print "\n\nGeneration of t/nwauto.pl Done!\n\n";
print "\nGeneration of automated scripts for NetWare DONE!\n";
# Process the file.
sub Process_File
{
local($FileToProcess) = @_; # File name.
local($Script) = 0;
local($HeadCut) = 0;
## For example:
## If the value of $FileToProcess is '/perl/scripts/t/pragma/warnings.t', then
## $dir1 = '/perl/scripts/t/pragma/'
## $base1 = 'warnings'
## $ext1 = '.t'
$dir1 = dirname($FileToProcess); # Get the folder name
$base1 = basename($FileToProcess); # Get the base name
($base1, $dir1, $ext1) = fileparse($FileToProcess, '\..*'); # Get the extension of the file passed.
# Do the processing only if the file has '.t' extension.
if($ext1 eq '.t')
{
foreach $Script(@ScriptsNotUsed)
{
# The variables are converted to lower case before they are compared.
# This is done to remove the case-sensitive comparison done by 'eq'.
$Script1 = lc($Script);
$FileToProcess1 = lc($FileToProcess);
if($Script1 eq $FileToProcess1)
{
$HeadCut = 1;
}
}
if($HeadCut)
{
# Write into the intermediary auto script.
print FHW "=head\n";
}
# Write into the intermediary auto script.
print FHW "print \"Testing $base1"."$ext1:\\n\\n\"\;\n";
print FHW "print \`perl $FileToProcess\`\;\n"; # Write the changed array into the file.
print FHW "print \"\\n\\n\\n\"\;\n";
if($HeadCut)
{
# Write into the intermediary auto script.
print FHW "=cut\n";
}
$HeadCut = 0;
print FHW "\n";
}
}
|