Here is the latest version of my PerlCheck program.
Dirk Bremer - Systems Programmer II - AMS Department - NISC
636-922-9158 ext. 652 fax 636-447-4471
<mailto:[EMAIL PROTECTED]>
# PerlCheck.pl 03/09/2001.
# Define pragmas.
use diagnostics;
use English;
use strict;
use warnings;
# Define modules.
use FindBin qw($Bin);
use lib $Bin;
# Define all subroutines.
sub ErrorSummary();
sub FindSub($);
sub FindVar($);
sub InitializeProgram();
sub ProcessLoop();
sub StartProgram();
sub TerminateProgram();
# Define all variables.
my $Context = 0;
my $Debug = 0;
my @Files = ();
my $FilesRead = 0;
my $Help = <<EOT;
This program will read the specified Perl programs and perform a series of
checks. A file or files may be entered as an argument, if no argument is
entered, all programs and modules in the c:\\perl\\scripts directory will
be processed. The following checks will be made:
Local variables that have been declared but have not been referenced.
Global variables that have been declared but have not been referenced.
Local variables that have been declared more than once.
Global variables that have been declared more than once.
Subroutines that have been prototyped but have not been declared.
Subroutines that have been declared but have not been prototyped.
Subroutines that have been declared but not been referenced.
Prototypes that have been declared more than once.
Subroutines that have been declared more than once.
Usage: PerlCheck.pl -d(o) -h(o) files(o)
Where (r) = required, (o) = optional
Arguments:
-d - Turn debugging on.
-h - Display help and exit.
files - The file(s) to be checked.
EOT
my %GlobalVar = ();
my %LocalVar = ();
my %Prototype = ();
my %SubDeclared = ();
my $SubName = "";
my %SubReferenced = ();
my @Var = ();
# Call the controlling subroutine.
StartProgram();
#--------------------------------------------------------------------------#
# Structured program-control subroutine #
#--------------------------------------------------------------------------#
sub StartProgram()
{
InitializeProgram();
ProcessLoop();
TerminateProgram();
exit(1);
}
#--------------------------------------------------------------------------#
# Program initialization subroutine #
#--------------------------------------------------------------------------#
sub InitializeProgram()
{
# Check if any options were entered.
{
use Getopt::Std;
our ($opt_d,$opt_h);
getopts("dh");
if (defined $opt_d)
{
# Set debugging on.
$Debug = 1;
}
if (defined $opt_h)
{
print($Help);
exit(1);
}
}
# Define local variables.
my $Var = "";
# Change the current directory to the specified path.
chdir("c:/perl/scripts/") or die "Cannot change directory to c:/perl/scripts/ $!,
stopped";
# Check if arguments have been passed.
SWITCH:
{
if ($#ARGV < 0)
{
# Load a listing of all Perl source and module files in the
# current directory into a list.
@Files = glob("*.p[lm]");
last SWITCH;
}
# Get the entered arguments. If they do not have a file extension,
# append ".pl" as the file extension.
@Files = @ARGV;
for ($Var = 0;$Var < $#Files + 1;$Var++)
{
unless ($Files[$Var] =~ /\.p[l|m]$/io)
{
$Files[$Var] = $Files[$Var] . ".pl";
}
print("Entered argument: $Files[$Var]\n");
}
}
if ($Debug)
{
# Open an output file that will contain the debugging output.
open(OutputFileHnd,">C:/Temp/PerlCheck.txt") or die "Unable to open output
file $!, stopped";
}
return(1);
}
#--------------------------------------------------------------------------#
# Main processing subroutine #
#--------------------------------------------------------------------------#
sub ProcessLoop()
{
# Define local variables.
my $CurFile;
my $InputLine;
my $Key;
my $Sw = 0;
# Loop through each file in the array.
foreach $CurFile (@Files)
{
print("Processing Perl file: $CurFile\n");
if ($Debug) {print(OutputFileHnd "Processing Perl file: $CurFile\n");}
# Check that the filename is a valid file.
if (-e $CurFile)
{
# Open the specified files.
open(InputFileHnd,"<$CurFile") or die "Unable to open $CurFile $!,
stopped";
}
else
{
print("$CurFile does not exist\n");
next;
}
%GlobalVar = ();
%Prototype = ();
%SubDeclared = ();
$SubName = "No Name";
%SubReferenced = ();
$Sw = 0;
# Maintain a count of the files processed.
$FilesRead++;
# Loop through the current file.
W1: while ($InputLine = <InputFileHnd>)
{
# Define local variables.
local $_ = $InputLine;
chomp;
# Skip blank lines.
next W1 unless length;
# Skip comment lines.
next W1 if (/^\s*#/io);
# Check for a start of a subroutine opening brace.
if (/^\{$/o or /sub\s+\w+\{$/io)
{
$Context = 1;
%LocalVar = ();
next W1;
}
# Check for a end of a subroutine closing brace.
if (/^}$/o)
{
next W1 if (! %LocalVar);
$Sw = 0;
# Check the local variables hash to see if any variables are not
referenced.
foreach $Key (sort keys %LocalVar)
{
unless($LocalVar{$Key}> 0)
{
if ($Sw == 0)
{
$Sw = 1;
print(" Local variables for subroutine $SubName:\n");
}
print(" $Key has been declared but have has not been
referenced\n");
}
}
if ($Debug)
{
# Display all local variable names.
print(OutputFileHnd "Local variables for subroutine $SubName:\n");
foreach $Key (sort keys %LocalVar) {print(OutputFileHnd "
$Key:$LocalVar{$Key}\n");}
}
$Context = 0;
next W1;
}
# Skip open brace lines that are proceeded by spaces.
next W1 if (/^\s+\{$/o);
# Skip close brace lines that are proceeded by spaces.
next W1 if (/^\s+\}$/o);
# Skip "next" lines.
next W1 if (/^next\s*\w*;$/o);
# Skip "last" lines.
next W1 if (/^last\s*\w*;$/o);
# Skip "exit" lines.
next W1 if (/^\s*exit\(.\);$/o);
# Skip "package" lines.
next W1 if (/^\s*package\s/o);
# Skip "use" lines.
next W1 if (/^\s*use\s/o);
if (FindSub($_)) {next W1;}
if (FindVar($_)) {next W1;}
# Check each line read for each variable name stored in the
# global hash.
foreach $Key (keys %GlobalVar)
{
SWITCH:
{
$Sw = 0;
# Check for "$Varname" string.
if (index($_,$Key,0) > -1)
{
$Sw = 1;
last SWITCH;
}
# Check for "${Varname}" string.
if (index($_,'${' . substr($Key,1) . '}',0) > -1)
{
$Sw = 1;
last SWITCH;
}
# Check for "$Varname{" string.
if (substr($Key,0,1) eq "%")
{
if (index($_,'$' . substr($Key,1) . '{',0) > -1)
{
$Sw = 1;
last SWITCH;
}
}
# Check for "$Varname[" string.
if (substr($Key,0,1) eq "@")
{
if (index($_,'$' . substr($Key,1) . '[',0) > -1)
{
$Sw = 1;
last SWITCH;
}
}
}
# If the variable name was found in the current line, increment
# its counter stored in the hash.
if ($Sw == 1) {$GlobalVar{$Key}++;}
}
if ($Context == 1)
{
# Check each line read for each variable name stored in the
# local hash.
foreach $Key (keys %LocalVar)
{
SWITCH:
{
$Sw = 0;
# Check for "$Varname" string.
if (index($_,$Key,0) > -1)
{
$Sw = 1;
last SWITCH;
}
# Check for "${Varname}" string.
if (index($_,'${' . substr($Key,1) . '}',0) > -1)
{
$Sw = 1;
last SWITCH;
}
# Check for "$Varname{" string.
if (substr($Key,0,1) eq "%")
{
if (index($_,'$' . substr($Key,1) . '{',0) > -1)
{
$Sw = 1;
last SWITCH;
}
}
# Check for "$Varname[" string.
if (substr($Key,0,1) eq "@")
{
if (index($_,'$' . substr($Key,1) . '[',0) > -1)
{
$Sw = 1;
last SWITCH;
}
}
}
# If the variable name was found in the current line, increment
# its counter stored in the hash.
if ($Sw == 1) {$LocalVar{$Key}++;}
}
}
# Check each line read for each prototype name stored in the hash.
foreach $Key (keys %Prototype)
{
# If the prototype name was found in the current line, increment
# its counter stored in the hash.
if (index($_,"$Key\(",0) > -1) {$Prototype{$Key}++;}
}
# Check each line read for a subroutine call.
if (/(\w+)\(/o)
{
# If the subroutine name exists in the hash, increment its
# value, else add it to the hash.
if (exists $SubReferenced{$1}) {$SubReferenced{$1}++;}
else {$SubReferenced{$1} = 1;}
}
}
# Close the current file.
close(InputFileHnd);
# Display all errors.
ErrorSummary();
}
return(1);
}
#--------------------------------------------------------------------------#
# Program termination subroutine #
#--------------------------------------------------------------------------#
sub TerminateProgram()
{
if ($Debug) {close(OutputFileHnd);}
# Display statistics.
print("\nPerl source files read:$FilesRead\n");
print("\nPause...");
$_ = <STDIN>;
return(1);
}
#--------------------------------------------------------------------------#
# Find program subroutines. #
#--------------------------------------------------------------------------#
sub FindSub($)
{
# Define local variables.
my $Self = shift;
my $Var;
local $_ = $Self;
# If the current line does not contain a valid "sub" string, exit
# this routine.
return(0) if (! /^\s*sub\s+/o);
# if ($Debug) {print(OutputFileHnd "FindSub: $_\n");}
# Extract the subroutine name.
/^\s*sub\s+(\w+)\s*[\(|\{]/io;
$Var = $1;
# Ignore subroutine names of "import" or "autoload".
return(0) if (($Var =~ /import/o) or ($Var =~ /autoload/io));
# Check for a subroutine declaration.
if (! /;$/io)
{
# if ($Debug) {print(OutputFileHnd "FindSub:$Var: $_\n");}
$SubName = $Var;
# Check if the subroutine has been declared more than once.
if (exists $SubDeclared{$Var})
{
print(" Subroutine $Var has been declared more than once\n");
}
# Add the subroutine name to the hash.
else {$SubDeclared{$Var} = 0;}
# If the subroutine name exists in the prototype hash, check its
# value, and if zero, increment its value.
if (exists $Prototype{$Var})
{
if ($Prototype{$Var} == 0) {$Prototype{$Var}++;}
}
return(1);
}
# if ($Debug) {print("Proto: $_\n");}
# Check if the prototype has been declared more than once.
if (exists $Prototype{$Var})
{
print(" Prototype $Var has been declared more than once\n");
}
# Add the subroutine name to the hash.
else {$Prototype{$Var} = 0;}
return(1);
}
#--------------------------------------------------------------------------#
# Find program variables. #
#--------------------------------------------------------------------------#
sub FindVar($)
{
# Define local variables.
my $Self = shift;
my $Var;
local $_ = $Self;
# Find variables and store their names in a hash.
SWITCH:
{
if (/\s*my\s+/o)
{
# Remove the "my" prefix from the string.
$Self =~ s/.*my\s+//o;
last SWITCH;
}
if (/\s*local\s+/o)
{
# Remove the "local" prefix from the string.
$Self =~ s/.*local\s+//o;
last SWITCH;
}
if (/\s*our\s+/o)
{
# Remove the "our" prefix from the string.
$Self =~ s/.*our\s+//o;
last SWITCH;
}
return(0);
}
if ($Debug)
{
print(OutputFileHnd "1:$_\n");
print(OutputFileHnd "2:$Self\n");
}
# Check for a list of variables.
if ($Self =~ /^\(/o)
{
$Self =~ s/[\(|\)|;]|[\s+=.+]$//go;
@Var = split /,/o,$Self;
if ($Debug)
{
foreach $Var (@Var) {print(OutputFileHnd "3:$Var\n");}
}
}
else
{
@Var = substr($Self,0,index($Self," "));
if ($Debug)
{
print(OutputFileHnd "4:$Var[0]\n");
}
}
foreach $Var (@Var)
{
# if ($Debug) {print(OutputFileHnd "split args:$Var\n");}
# Skip Perl built-in variable $_.
if ($Var eq '$_') {next;}
if ($Context == 1)
{
# Check if the local variable has been declared more
# than once.
if (exists $LocalVar{$Var})
{
print(" Local variable for subroutine $SubName $Var has been
declared more than once\n");
}
# Add the variable name to the local hash.
else {$LocalVar{$Var} = 0;}
}
else
{
# Check if the global variable has been declared more
# than once.
if (exists $GlobalVar{$Var})
{
print(" Global variable $Var has been declared more than
once\n");
}
# Add the variable name to the global hash.
else {$GlobalVar{$Var} = 0;}
}
}
if ($Self =~ /=\s+\$/o) {return(0);}
else {return(1)};
}
#--------------------------------------------------------------------------#
# Find program variables. #
#--------------------------------------------------------------------------#
sub ErrorSummary()
{
# Define local variables.
my $Key;
my $Sw = 0;
# Check the global variables hash to see if any variables have not
# been referenced.
foreach $Key (sort keys %GlobalVar)
{
unless($GlobalVar{$Key} > 0)
{
if ($Sw == 0)
{
$Sw = 1;
print(" Global variables:\n");
}
print(" Variable $Key has been declared but has not been
referenced\n");
}
}
$Sw = 0;
# Check the prototypes hash to see if any prototypes have not been
# referenced.
foreach $Key (sort keys %Prototype)
{
unless($Prototype{$Key} > 0)
{
if ($Sw == 0)
{
$Sw = 1;
print(" Prototypes:\n");
}
print(" Subroutine $Key has been prototyped but has not been
declared\n");
}
}
$Sw = 0;
# Check the declared subroutines hash to see if any subroutines have
# not been prototyped.
foreach $Key (sort keys %SubDeclared)
{
# Display the unreferenced subroutines.
if (exists $Prototype{$Key}) {next;}
else
{
if ($Sw == 0)
{
$Sw = 1;
print(" Subroutines (unprototyped):\n");
}
print(" Subroutine $Key has been declared but has not been
prototyped\n");
}
}
$Sw = 0;
# Check the declared subroutines hash to see if any subroutines have
# not been referenced.
foreach $Key (sort keys %SubDeclared)
{
if (exists $SubReferenced{$Key}) {$SubDeclared{$Key}++;}
else
{
if ($Sw == 0)
{
$Sw = 1;
print(" Subroutines (unreferenced):\n");
}
print(" Subroutine $Key has been declared but has not been
referenced\n");
}
}
if ($Debug)
{
# Display all global variable names.
print(OutputFileHnd "Global variables:\n");
foreach $Key (sort keys %GlobalVar) {print(OutputFileHnd "
$Key:$GlobalVar{$Key}\n");}
# Display all prototype names.
print(OutputFileHnd "Prototypes:\n");
foreach $Key (sort keys %Prototype) {print(OutputFileHnd "
$Key:$Prototype{$Key}\n");}
# Display all declared subroutine names.
print(OutputFileHnd "Declared Subroutines:\n");
foreach $Key (sort keys %SubDeclared) {print(OutputFileHnd "
$Key:$SubDeclared{$Key}\n");}
# Display all referenced subroutine names.
print(OutputFileHnd "Referenced Subroutines:\n");
foreach $Key (sort keys %SubReferenced) {print(OutputFileHnd "
$Key:$SubReferenced{$Key}\n");}
}
return(1);
}
_______________________________________________
Perl-Win32-Users mailing list
[EMAIL PROTECTED]
http://listserv.ActiveState.com/mailman/listinfo/perl-win32-users
