[16538] in Perl-Users-Digest
Perl-Users Digest, Issue: 3950 Volume: 9
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Tue Aug 8 14:10:28 2000
Date: Tue, 8 Aug 2000 11:10:16 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <965758216-v9-i3950@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 8 Aug 2000 Volume: 9 Number: 3950
Today's topics:
Help with a script <ajgilgis@midway.uchicago.edu>
How to pass a value...? <mark325@hotmail.com>
Re: How to pass a value...? <tony_curtis32@yahoo.com>
Re: HTML Table To Text --How? (Andreas Schmidt)
https with certificate <ak@dasburo.de>
Re: ignore IP address (Abigail)
Re: Interesection and subtraction of data sets. <blavender@spk.usace.army.mil>
login usage for perl <jjb13@NOSPAMaxe.humboldt.edu>
Re: newbie hash type question. (Greg Bacon)
Re: Perl and opening tcp socket nobull@mail.com
Re: Problems creating a file in IIS <lr@hpl.hp.com>
Digest Administrivia (Last modified: 16 Sep 99) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 8 Aug 2000 10:19:13 -0500
From: anhedonia <ajgilgis@midway.uchicago.edu>
Subject: Help with a script
Message-Id: <Pine.SOL.4.10.10008081017560.17077-100000@harper.uchicago.edu>
I'm trying to write a perl script as a metric for java- to count the
lines, classes, etc. The program is having trouble even taking in the
java file. If anyone could take a look at this and see where I'm going
wrong, that would be great!
Thanks,
Amy Gilgis
#!/usr/local/bin/perl -w
#-------------------------------------------------------------------------------------------------------------------------#
# metrics.pl
#
# software metrics utility
# author: Jeff Suarez (1999)
#
# Usage:
#
# <perl> metrics.pl [-f filenames][-d directories][-r][-o text | html filename][-t h | c | r][-q][-i][-h]
#
# -f filenames : specify which files exactly you would like to process. This can
# include .h files, .cpp files, or .rc files.
#
# -d directories : specify which diectory or directories you would like to process.
# This will process all valid files within this directory. By
# default the current directory is chosen. Add the -r option for
# recursive searching.
#
# -r : Used in conjunction with the -d option, allows for recursive searching
# of directories.
#
# -o text | html : Output results to a file. Specify text for a text file or html for
# a html file. Also you may specify the filename for each. By default
# 'output.txt' and 'output.html' are chosen.
#
# -t h | s | r | m : Specify the type of files you would like to process. This must be
# followed by one or more of the letters (h, c, r).
# h - header files (.h)
# c - source files (.cpp)
# r - resource files (.rc)
#
# -x directories : exclude specific directories from the search.
#
# -q : Quiet mode. Don't display output to the screen.
#
# -i : Individual mode. Display information about individual classes.
#
# -h : Display this information.
#
# Example:
#
# perl metrics.pl -dr admin -o text textout.txt html htmlout.html -t hc -q -i
#
# Will process header and source files in the admin directory and all its subdirectories.
# Will not output any info to the screen, but will output text to textout.txt, and
# html to htmlout.html, and will do so showing info on individual classes.
#
#-------------------------------------------------------------------------------------------------------------------------#
@file_list = ( );
@dir_list = ( );
%exclude_list = ( );
$text_out_file = "output.txt";
$html_out_file = "output.html";
$recursive = 0;
$individual = 0;
$quiet = 0;
$output = 0;
$html = 0;
$text = 0;
$type = 0;
$h = 0;
$c = 0;
$r = 0;
$total_lines = 0;
$total_code = 0;
$total_methods = 0;
$total_logical_methods = 0;
$total_trivial_methods = 0;
# process command line
foreach $argnum (0 .. $#ARGV) {
# check for file flag (-f)
if ($ARGV[$argnum] =~ /^-f$/) {
$i = $argnum + 1;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
push @file_list, $ARGV[$i];
$i++;
}
}
# check for directories flag (-d)
# check for recursive flag (-r)
elsif ($ARGV[$argnum] =~ /^-[r]*[d]+[r]*$/) {
if ($ARGV[$argnum] =~ /^-[d]*[r]+[d]*$/) {
$recursive = 1;
}
$i = $argnum + 1;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
push @dir_list, $ARGV[$i];
$i++;
}
}
elsif ($ARGV[$argnum] =~ /^-r$/) {
$recursive = 1;
$i = $argnum + 1;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
push @dir_list, $ARGV[$i];
$i++;
}
}
elsif ($ARGV[$argnum] =~ /^-x$/) {
$i = $argnum + 1;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
$temp = $ARGV[$i];
$temp =~ s/\\/\//g;
$exclude_list{$temp} = 1;
$i++;
}
}
# check for quiet flag (-q)
elsif ($ARGV[$argnum] =~ /^-q$/) {
$quiet = 1;
}
# check for type flag (-t)
elsif ($ARGV[$argnum] =~ /^-t$/) {
$i = $argnum + 1;
if ($i > $#ARGV || $ARGV[$i] =~ /^-/) {
print "\nNo file type specified. Accepted types are 'h' (.h files), 'c' (.cpp files), 'r' (.rc files), and 'm' (makefiles)\n";
exit 0;
}
$type = 1;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
if ($ARGV[$i] !~ /^h$/ && $ARGV[$i] !~ /^c$/ && $ARGV[$i] !~ /^r$/ && $ARGV[$i] !~ /^m$/ && $ARGV[$i] !~ /^j$ /^[h]{0,1}[r]{0,1}[j]{0,1}[m]{0,1}[h]{0,1}[r]{0,1}[j]{0,1}[m]{0,1}[h]{0,1}[r]{0,1}[j]{0,1}[m]{0,1}[h]{0,1}[r]{0,1}[j]{0,1}[m]{0,1}$/ ) {
print "\nAccepted file types are 'c', 'h', 'r', and 'm'\n";
exit 0;
}
else {
if ($ARGV[$i] =~ /h{1}/i) {
$h = 1;
}
if ($ARGV[$i] =~ /c{1}/i) {
$c = 1;
}
if ($ARGV[$i] =~ /r{1}/i) {
$r = 1;
}
if ($ARGV[$i] =~ /m{1}/i) {
$m = 1;
}
}
$i++;
}
}
# check for output flag (-o)
elsif ($ARGV[$argnum] =~ /^-o$/) {
$i = $argnum + 1;
if ($i > $#ARGV || $ARGV[$i] =~ /^-/) {
print "\nNo output type specified. Accepted types are 'text' and 'html'\n";
exit 0;
}
$output = 1;
$tflag = 0;
$hflag = 0;
while ($i <= $#ARGV && $ARGV[$i] !~ /^-/) {
if (($ARGV[$i] !~ /^html$/i) && ($ARGV[$i] !~ /^text$/i) && (!$tflag && !$hflag)) {
print "\nAccepted output types are 'text' and 'html' $tflag $hflag $i\n";
exit 0;
}
elsif ($tflag) {
if ($ARGV[$i] =~ /^html$/i) {
$html = 1;
$tflag = 0;
$hflag = 1;
}
else {
$text_out_file = $ARGV[$i];
$tflag = 0;
}
}
elsif ($hflag) {
if ($ARGV[$i] =~ /^text$/i) {
$text = 1;
$hflag = 0;
$tflag = 1;
}
else {
$html_out_file = $ARGV[$i];
$hflag = 0;
}
}
elsif ($ARGV[$i] =~ /^html$/i) {
$html = 1;
$tflag = 0;
$hflag = 1;
}
elsif ($ARGV[$i] =~ /^text$/i) {
$text = 1;
$hflag = 0;
$tflag = 1;
}
$i++;
}
}
elsif ($ARGV[$argnum] =~ /^-i$/) {
$individual = 1;
}
elsif ($ARGV[$argnum] =~ /^-h$/) {
print<<"EndOfHelp";
metrics.pl
Usage:
<perl> metrics.pl [-f filenames][-d directories][-r][-o text | html filename][-t h | c | r][-q][-i][-h]
-f filenames : specify which files exactly you would like to process. This can
include .h files, .cpp files, or .rc files.
-d directories : specify which diectory or directories you would like to process.
This will process all valid files within this directory. By
default the current directory is chosen. Add the -r option for
recursive searching.
-r : Used in conjunction with the -d option, allows for recursive searching
of directories.
-o text | html : Output results to a file. Specify text for a text file or html for
a html file. Also you may specify the filename for each. By default
'output.txt' and 'output.html' are chosen.
-t h | s | r | m : Specify the type of files you would like to process. This must be
followed by one or more of the letters (h, c, r).
h - header files (.h)
c - source files (.cpp)
r - resource files (.rc)
-x directories : exclude specific directories from the search.
-q : Quiet mode. Don't display output to the screen.
-i : Individual mode. Display information about individual classes.
-h : Display this information.
Example:
perl metrics.pl -dr admin -o text textout.txt html htmlout.html -t hc -q -i
Will process header and source files in the admin directory and all its subdirectories.
Will not output any info to the screen, but will output text to textout.txt, and
html to htmlout.html, and will do so showing info on individual classes.
EndOfHelp
;
exit 0;
}
}
@h_files = ( );
@cpp_files = ( );
@rc_files = ( );
%h_lines = ( );
%cpp_lines = ( );
%h_methods = ( );
print "processing files...\n\n";
if ((scalar (@file_list) == 0) && (scalar (@dir_list) == 0)) {
&smash(".");
}
else {
foreach $file (@file_list) {
$file =~ /\.(\w{1,3})$/;
$end = $1;
if ($file =~ /makefile/) {
push @mak_files, $file;
}
elsif (defined($end)) {
print "$end - $file\n";
if ($end eq "h" && (!$type || $h)) {
push @h_files, $file;
}
elsif ($end eq "cpp" && (!$type || $c)) {
push @cpp_files, $file;
}
elsif ($end eq "rc" && (!$type || $r)) {
push @rc_files, $file;
}
elsif ($end eq "mak" && (!$type || $m)) {
push @mak_files, $file;
}
}
}
}
if (scalar (@dir_list) != 0) {
foreach $dir (@dir_list) {
$dir =~ s/\\/\//g;
if (!(exists $exclude_list{$dir})) {
&smash("$dir");
}
}
}
#print ".h files :\t" . scalar(@h_files) . "\n";
#print ".cpp files :\t" . scalar(@cpp_files) . "\n";
#print ".rc files :\t" . scalar(@rc_files) . "\n";
foreach $hfile_name (@h_files) {
#print "$hfile_name\n";
$h_lines{$hfile_name} = &h_file($hfile_name);
}
foreach $cppfile_name (@cpp_files) {
#print "$cppfile_name\n";
$cpp_lines{$cppfile_name} = &cpp_file($cppfile_name);
$total_code = $total_code + $cpp_lines{$cppfile_name};
}
foreach $rcfile_name (@rc_files) {
#print "$cppfile_name\n";
$rc_lines{$rcfile_name} = &rc_file($rcfile_name);
$total_code = $total_code + $rc_lines{$rcfile_name};
}
foreach $makfile_name (@mak_files) {
$mak_lines{$makfile_name} = &mak_file($makfile_name);
$total_code = $total_code + $mak_lines{$makfile_name};
}
#print "----\n";
#foreach $key (keys %exclude_list) {
# print "$key = $exclude_list{$key}\n";
#}
#foreach $key (keys %h_methods) {
#@array1 = split /:/, $h_methods{$key};
#print "$key = $array1[0]:$array1[1]\n";
#}
&print_out();
sub smash {
local($ldir) = shift;
if (!(opendir DIR, $ldir)) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print scalar(localtime)." Error opening debug.txt\n\n";
exit 0;
}
print DEBUG "Could not open directory $ldir\n$!\n";
close DEBUG;
return 0;
}
local(@contents) = map "$ldir/$_", sort grep !/^\.\.?$/, readdir DIR;
closedir DIR;
foreach $_ (@contents) {
if(!-d $_) {
$_ =~ /\.(\w{1,3})$/;
$end = $1;
if ($_ =~ /makefile/) {
push @mak_files, $_;
}
elsif (defined($end)) {
if ($end eq "h" && (!$type || $h)) {
push @h_files, $_;
}
elsif ($end eq "cpp" && (!$type || $c)) {
push @cpp_files, $_;
}
elsif ($end eq "rc" && (!$type || $r)) {
push @rc_files, $_;
}
elsif ($end eq "mak" && (!$type || $m)) {
push @mak_files, $_;
}
}
}
else {
if ($recursive) {
if (!(exists $exclude_list{$_})) {
&smash("$_");
}
}
}
}
return 1;
}
sub h_file {
$file_name = shift;
$code = 0;
$check = 0;
$last_line = 0;
$inclass = 0;
$struct = 0;
$trivial_methods = 0;
$logical_methods = 0;
@method_array = ( );
if ( !(open HFILE, "$file_name") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print "Error opening debug.txt\n\n";
exit 0;
}
print DEBUG print scalar(localtime)." Error opening $file_name.\n$!\n";
return 0;
close DEBUG;
}
$comment = 0;
while ($line = <HFILE>) {
$total_lines++;
if ($line =~ /\/\*/) {
$comment = 1;
}
if (!$comment) {
if (($line !~ /^\s*\/\//) && ($line !~ /^\s+$/)) { $code++; $total_code++; }
}
elsif ($line =~ /\*\//) {
$comment = 0;
}
if (!$comment) {
# in class count methods
if ($inclass) {
if ($line =~ /\bstruct\b/) {
if ($line !~ /\bstruct\b.*\;.*/) {
$struct = 1;
}
}
if ($struct) {
if ($line =~ /\}/) {
$struct = 0;
next;
}
}
next if $line =~ /^\#/;
next if $line =~ /^\s*\/\//;
if (!($struct)) {
if ($line =~ /.+\(/) {
next if $line =~ /^\s*[A-Z_]+\(.*\)\s*$/;
next if $line =~ /^\s*\{/;
next if $line =~ /^.*\/\/.*\(/;
if (($line =~ /get\w+/i) || ($line =~ /set\w+/i)) {
$trivial_methods++;
}
else {
$logical_methods++;
}
}
if ($line =~ /^\s*\}\;/) {
$inclass = 0;
chomp $class_name;
$h_methods{$class_name} = "$trivial_methods:$logical_methods";
@method_array = ( );
$logical_methods = 0;
$trivial_methods = 0;
}
}
}
elsif ($check) {
next if $line =~ /^#/;
if ($line =~ /^\s*\{/) {
$check = 0;
$class_name = $last_line;
$last_line = $line;
$inclass = 1;
}
}
next if $line =~ /^\s*\/\//;
if ($line =~ /\bclass\b\s(\w+\b)\s*(\w+\b){0,2}\s*/) {
if ($line !~ /\bDECLSPEC_UUID/) {
if ($line !~ /\/\/.*\bclass\b/) {
if ($line !~ /\/\*.*\bclass\b/) {
if ($line !~ /^\#define/) {
if ($line !~ /\[\!ClassName\]/i) {
if ($line !~ /\binline\b/i) {
if ($line !~ /.*\;.*(\/\/)*/) {
$check = 1;
$last_line = $line;
}
}
}
}
}
}
}
}
}
}
return $code;
}
sub cpp_file {
$file_name = shift;
$code_lines = 0;
if ( !(open CPPFILE, "$file_name") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print "Error opening debug.txt\n\n";
exit 0;
}
print DEBUG print scalar(localtime)." Error opening $file_name.\n$!\n";
return 0;
close DEBUG;
}
$comment = 0;
while ($line = <CPPFILE>) {
$total_lines++;
if ($line =~ /\/\*/) {
$comment = 1;
}
if (!$comment) {
if (($line !~ /^\/\//) && ($line !~ /^\s+$/)) { $code_lines++; }
}
elsif ($line =~ /\*\//) {
$comment = 0;
}
}
return $code_lines;
}
sub rc_file {
$file_name = shift;
$code_lines = 0;
if ( !(open RCFILE, "$file_name") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print "Error opening debug.txt\n\n";
exit 0;
}
print DEBUG print scalar(localtime)." Error opening $file_name.\n$!\n";
return 0;
close DEBUG;
}
$comment = 0;
while ($line = <RCFILE>) {
$total_lines++;
if ($line =~ /\/\*/) {
$comment = 1;
}
if (!$comment) {
if (($line !~ /^\/\//) && ($line !~ /^\s+$/)) { $code_lines++; }
}
elsif ($line =~ /\*\//) {
$comment = 0;
}
}
return $code_lines;
}
sub mak_file {
$file_name = shift;
$code_lines = 0;
if ( !(open MAKFILE, "$file_name") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print "Error opening debug.txt\n\n";
exit 0;
}
print DEBUG print scalar(localtime)." Error opening $file_name.\n$!\n";
return 0;
close DEBUG;
}
$comment = 0;
while ($line = <MAKFILE>) {
$total_lines++;
if ($line =~ /\/\*/) {
$comment = 1;
}
if (!$comment) {
if (($line !~ /^\/\//) && ($line !~ /^\s+$/)) { $code_lines++; }
}
elsif ($line =~ /\*\//) {
$comment = 0;
}
}
return $code_lines;
}
sub print_out {
if (!$quiet) {
$counter = 0;
$average_methods_per_class = 0;
$total_classes = scalar(keys %h_methods);
foreach $key (keys %h_methods) {
$counter++;
@array1 = split /:/, $h_methods{$key};
$total_methods += ($array1[0] + $array1[1]);
$total_logical_methods += $array1[1];
$total_trivial_methods += $array1[0];
}
if ($counter) {
$average_methods_per_class = $total_methods / $counter;
}
else {
$average_methods_per_class = 0;
}
$h_num = scalar(@h_files);
$c_num = scalar(@cpp_files);
$rc_num = scalar(@rc_files);
$mak_num = scalar(@mak_files);
$total_files = $h_num + $c_num + $rc_num + $mak_num;
# print "\nFiles Searched:\n";
# print "--------------\n";
# foreach $key (@h_files) {
# print "$key\n";
#}
#print "\n\n";
print "Output of metrics.pl run on " . scalar(localtime) . "\n\n\n";
print "Total files searched:\t\t$total_files\n";
print "Total lines:\t\t\t$total_lines\n";
print "Total lines of code:\t\t$total_code\n\n";
print "Header files inspected:\t\t$h_num\n";
print "Source files inspected:\t\t$c_num\n";
print "Resource files inspected:\t$rc_num\n";
print "Makefiles inspected:\t\t$mak_num\n\n";
if (scalar (@h_files) > 0) {
print "Total number of classes:\t$total_classes\n";
print "Total number of methods:\t$total_methods\n";
print "Total logical methods:\t\t$total_logical_methods\n";
print "Total trivial methods:\t\t$total_trivial_methods\n";
printf "Average methods per class:\t%4.1f\n\n",$average_methods_per_class;
}
print "\n";
if ($individual) {
foreach $class (keys %h_methods) {
if ($class =~ /\<class .+\>/) {
@class2 = split /:/, $class;
$class2[1] = $class2[0];
}
else {
@class = split /\bclass\b/, $class;
if ($class[1] !~ /^\s*[A-Z_]+\s/) {
@class2 = split /\s/, $class[1];
}
else {
@class2 = split/\s/, $class[1];
$class2[1] = "$class2[2]";
}
if (defined $class2[1]) {
if ($class2[1] =~ /:/) {
@class3 = split /:/, $class2[1];
$class2[1] = $class3[0];
}
}
else {
next;
}
}
@h_meths = split /:/, $h_methods{$class};
$t_methods = $h_meths[0] + $h_meths[1];
$t_logical_meths = $h_meths[1];
$t_trivial_meths = $h_meths[0];
print "$class2[1]\n";
print "Total Methods:\t\t$t_methods\n";
print "Logical Methods:\t$t_logical_meths\n";
print "Trivial Methods:\t$t_trivial_meths\n\n";
}
}
}
if ($output) {
if ($text) {
if ( !(open OUTPUT_TEXT, ">./$text_out_file") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print scalar(localtime)." Error opening debug.txt\n\n";
exit 0;
}
print DEBUG "Error opening $text_out_file.\n$!\n";
close DEBUG;
return 0;
}
$counter = 0;
$average_methods_per_class = 0;
$total_classes = scalar(keys %h_methods);
$total_methods = 0;
$total_logical_methods = 0;
$total_trivial_methods = 0;
foreach $key (keys %h_methods) {
$counter++;
@array1 = split /:/, $h_methods{$key};
$total_methods += ($array1[0] + $array1[1]);
$total_logical_methods += $array1[1];
$total_trivial_methods += $array1[0];
}
if ($counter) {
$average_methods_per_class = $total_methods / $counter;
}
else {
$average_methods_per_class = 0;
}
$h_num = scalar(@h_files);
$c_num = scalar(@cpp_files);
$rc_num = scalar(@rc_files);
$mak_num = scalar(@mak_files);
$total_files = $h_num + $c_num + $rc_num + $mak_num;
# print "\nFiles Searched:\n";
# print "--------------\n";
# foreach $key (@h_files) {
# print "$key\n";
#}
#print "\n\n";
print OUTPUT_TEXT "Output of metrics.pl run on " . scalar(localtime) . "\n";
print OUTPUT_TEXT "\nFiles Searched (lines of code):\n";
print OUTPUT_TEXT "-------------------------------\n";
foreach $key (@h_files) {
print OUTPUT_TEXT "$key $h_lines{$key}\n";
}
foreach $key (@cpp_files) {
print OUTPUT_TEXT "$key $cpp_lines{$key}\n";
}
foreach $key (@rc_files) {
print OUTPUT_TEXT "$key $rc_lines{$key}\n";
}
foreach $key (@mak_files) {
print OUTPUT_TEXT "$key $mak_lines{$key}\n";
}
print OUTPUT_TEXT "\n\n";
print OUTPUT_TEXT "Total files searched:\t\t$total_files\n";
print OUTPUT_TEXT "Total number of lines:\t\t$total_lines\n";
print OUTPUT_TEXT "Total lines of code:\t\t$total_code\n\n";
print OUTPUT_TEXT "Header files inspected:\t\t$h_num\n";
print OUTPUT_TEXT "Source files inspected:\t\t$c_num\n";
print OUTPUT_TEXT "Resource files inspected:\t$rc_num\n";
print OUTPUT_TEXT "Makefiles inspected:\t\t$mak_num\n\n";
if (scalar (@h_files) > 0) {
print OUTPUT_TEXT "Total number of classes:\t$total_classes\n";
print OUTPUT_TEXT "Total number of methods:\t$total_methods\n";
print OUTPUT_TEXT "Total logical methods:\t\t$total_logical_methods\n";
print OUTPUT_TEXT "Total trivial methods:\t\t$total_trivial_methods\n";
printf OUTPUT_TEXT "Average methods per class:\t%4.1f\n",$average_methods_per_class;
}
printf OUTPUT_TEXT "\n";
if ($individual) {
foreach $class (keys %h_methods) {
if ($class =~ /\<class .+\>/) {
@class2 = split /:/, $class;
$class2[1] = $class2[0];
}
else {
@class = split /class/, $class;
if ($class[1] !~ /^\s*[A-Z]+\s/) {
@class2 = split /\s/, $class[1];
}
else {
@class2 = split/\s/, $class[1];
$class2[1] = "$class2[2]";
}
if (defined $class2[1]) {
if ($class2[1] =~ /:/) {
@class3 = split /:/, $class2[1];
$class2[1] = $class3[0];
}
}
else {
next;
}
}
@h_meths = split /:/, $h_methods{$class};
$t_methods = $h_meths[0] + $h_meths[1];
$t_logical_meths = $h_meths[1];
$t_trivial_meths = $h_meths[0];
print OUTPUT_TEXT "$class2[1]\n";
print OUTPUT_TEXT "Total Methods:\t\t$t_methods\n";
print OUTPUT_TEXT "Logical Methods:\t$t_logical_meths\n";
print OUTPUT_TEXT "Trivial Methods:\t$t_trivial_meths\n\n";
}
}
close OUTPUT_TEXT;
}
if ($html) {
if ( !(open OUTPUT_TEXT, ">./$html_out_file") ) {
if ( !(open DEBUG, ">>./debug.txt") ) {
print scalar(localtime)." Error opening debug.txt\n\n";
exit 0;
}
print DEBUG "Error opening $html_out_file.\n$!\n";
close DEBUG;
return 0;
}
$counter = 0;
$total_methods = 0;
$total_logical_methods = 0;
$total_trivial_methods = 0;
foreach $key (keys %h_methods) {
$counter++;
@array1 = split /:/, $h_methods{$key};
$total_methods += ($array1[0] + $array1[1]);
$total_logical_methods += $array1[1];
$total_trivial_methods += $array1[0];
}
if ($counter) {
$average_methods_per_class = $total_methods / $counter;
}
else {
$average_methods_per_class = 0;
}
$h_num = scalar(@h_files);
$c_num = scalar(@cpp_files);
$rc_num = scalar(@rc_files);
$m_num = scalar(@mak_files);
$total_files = $h_num + $c_num + $rc_num + $mak_num;
$total_classes = scalar(keys %h_methods);
# print "<BR>Files Searched:\n";
# print "--------------\n";
# foreach $key (@h_files) {
# print "$key\n";
#}
#print "\n\n";
print OUTPUT_TEXT "<HTML><TITLE>output of metrics.pl</title><BODY bgcolor=#ffffff><font face=\"arial, helvetica\" size=2>\n";
print OUTPUT_TEXT "Output of metrics.pl run on " . scalar(localtime) . "<BR><BR>";
print OUTPUT_TEXT "\n<font color=#483d8b size =3><b>File Information:<BR></b></font>";
print OUTPUT_TEXT "<BR><center><table border=1 cellspacing=3 width=600><tr>";
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Total files searched:\t\t$total_files</td>";
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Header files inspected:\t\t$h_num</td>";
if (scalar (@h_files) > 0) {
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Total number of methods:\t$total_methods</td></tr>";
}
else {
print OUTPUT_TEXT "</tr>";
}
print OUTPUT_TEXT "<tr><td><font face=\"arial, helvetica\" size=2>Total number of lines:\t\t$total_lines</td>";
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Source files inspected:\t\t$c_num</td>";
if (scalar (@h_files) > 0) {
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Total logical methods:\t\t$total_logical_methods</td></tr>";
}
else {
print OUTPUT_TEXT "</tr>";
}
print OUTPUT_TEXT "<tr><td><font face=\"arial, helvetica\" size=2>Total lines of code:\t\t$total_code</td>";
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Resource files inspected:\t$rc_num</td>";
if (scalar (@h_files) > 0) {
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Total trivial methods:\t\t$total_trivial_methods</td></tr>";
print OUTPUT_TEXT "<tr><td><font face=\"arial, helvetica\" size=2>Total number of classes:\t\t$total_classes</td>";
}
print OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Makefiles inspected:\t\t$m_num</td>";
if (scalar (@h_files) > 0) {
printf OUTPUT_TEXT "<td><font face=\"arial, helvetica\" size=2>Average methods per class:\t%4.1f</td></tr></table>",$average_methods_per_class;
}
else {
print OUTPUT_TEXT "</tr></table>";
}
print OUTPUT_TEXT "</center>";
if ($individual) {
print OUTPUT_TEXT "<center><TABLE border = 1 cellspacing=3><tr><td><font color=#483d8b size =3>
<b>Class Name</b></td><td><font color=483d8b size =3><b>Total Methods</b></td><td>
<font color=483d8b size =3><b>Logical Methods</b></td><td><font color=483d8b size =3>
<b>Trivial Methods</b></td></tr><br><br>";
$position = 0;
foreach $class (keys %h_methods) {
if ($class =~ /\<class .+\>/) {
@class2 = split /:/, $class;
$class2[1] = $class2[0];
}
else {
@class = split /\bclass\b/, $class;
if ($class[1] !~ /^\s*[A-Z_]+\s/) {
@class2 = split /\s/, $class[1];
}
else {
@class2 = split/\s/, $class[1];
$class2[1] = "$class2[2]";
}
if (defined $class2[1]) {
if ($class2[1] =~ /:/) {
@class3 = split /:/, $class2[1];
$class2[1] = $class3[0];
}
}
else {
next;
}
}
@h_meths = split /:/, $h_methods{$class};
$t_methods = $h_meths[0] + $h_meths[1];
$t_logical_meths = $h_meths[1];
$t_trivial_meths = $h_meths[0];
print OUTPUT_TEXT "<td><font color=#483d8b size =3>$class2[1]</font></td>";
print OUTPUT_TEXT "<td><font face=arial,helvetica size =2><i>$t_methods</td>";
print OUTPUT_TEXT "<td><font face=arial,helvetica size =2><i>$t_logical_meths</td>";
print OUTPUT_TEXT "<td><font face=arial,helvetica size =2><i>$t_trivial_meths</i></td>";
$position++;
if ($position == 1) {
print OUTPUT_TEXT "</tr><tr>";
$position = 0;
}
}
printf OUTPUT_TEXT "</center></table>\n";
}
#print OUTPUT_TEXT "\n<br><br><font color=#483d8b size =4><b>Files Searched:<BR></b></font>";
print OUTPUT_TEXT "<BR>";
print OUTPUT_TEXT "<center><table border = 1 cellspacing=3><tr><td><font color=#483d8b size =3><b>File Name</b></td><td><font color=#483d8b size =3><b>Lines of Code</b></td></tr>";
foreach $key (@h_files) {
print OUTPUT_TEXT "<tr><td><font face=arial,helvetica size =2><i>$key</td><td><font face=arial,helvetica size =2><i>$h_lines{$key}</td></tr>";
}
foreach $key (@cpp_files) {
print OUTPUT_TEXT "<tr><td><font face=arial,helvetica size =2><i>$key</td><td><font face=arial,helvetica size =2><i>$cpp_lines{$key}</td></tr>";
}
foreach $key (@rc_files) {
print OUTPUT_TEXT "<tr><td><font face=arial,helvetica size =2><i>$key</td><td><font face=arial,helvetica size =2><i>$rc_lines{$key}</td></tr>";
}
foreach $key (@mak_files) {
print OUTPUT_TEXT "<tr><td><font face=arial,helvetica size =2><i>$key</td><td><font face=arial,helvetica size =2><i>$mak_lines{$key}</td></tr>";
}
print OUTPUT_TEXT "</center></table>";
print OUTPUT_TEXT "</font></BODY></HTML>\n";
close OUTPUT_TEXT;
}
}
}
------------------------------
Date: Tue, 08 Aug 2000 23:34:05 +0800
From: Mark <mark325@hotmail.com>
Subject: How to pass a value...?
Message-Id: <3990286D.917CC06D@hotmail.com>
I have below coding segment of abc.cgi:
------------------------------------------------------------------------
$val = 1;
$html=<<"HTML";
<form method=post action="abc.cgi">
<input type=submit name=abc value="Submit">
</form>
HTML
print "$html";
------------------------------------------------------------------------
and I have another program called xyz.cgi, when I pressed Submit button
in the browser, based on the above coding segment, the value should be
sent to abc.cgi, but if I also want to pass the value of $var in abc.cgi
to the xyz.cgi at the same time, is it possible to do it...?
Thanks for any helps!
Mark ~
------------------------------
Date: 08 Aug 2000 10:38:42 -0500
From: Tony Curtis <tony_curtis32@yahoo.com>
Subject: Re: How to pass a value...?
Message-Id: <87zomndapp.fsf@limey.hpcc.uh.edu>
>> On Tue, 08 Aug 2000 23:34:05 +0800,
>> Mark <mark325@hotmail.com> said:
> $val = 1;
> pressed Submit button in the browser, based on the above
> coding segment, the value should be sent to abc.cgi, but
> if I also want to pass the value of $var in abc.cgi to
> the xyz.cgi at the same time, is it possible to do
> it...?
Well, you haven't defined what $var is, I assume it's
meant to be $val.
The best way to do this is through LWP. You need to build
a UserAgent and Request and that will then construct the
GET/POST to the server, which in turn will invoke the
other program, through CGI:
perldoc lwpcook
perldoc CGI
perldoc LWP::UserAgent
perldoc HTTP::Request
At least, I think that's what you want. You might just be
talking about hidden form fields, but it wasn't clear.
hth
t
--
"With $10,000, we'd be millionaires!"
Homer Simpson
------------------------------
Date: Tue, 08 Aug 2000 17:15:09 GMT
From: Andreas@dus-spot.de (Andreas Schmidt)
Subject: Re: HTML Table To Text --How?
Message-Id: <39903d74.2422723@news.roka.net>
Hello Dennis,
you should try HTML::TableExtract, available on CPAN of course. It
does exactly, what you want...
Bye, Andreas
-------------------------------------------------
Andreas Schmidt
WWW: http://www.dus-spot.de
E-Mail: Andreas@dus-spot.de
-------------------------------------------------
------------------------------
Date: Tue, 08 Aug 2000 19:24:14 +0200
From: Alexander Knack <ak@dasburo.de>
Subject: https with certificate
Message-Id: <3990423E.167609DD@dasburo.de>
hi,
does anybody know how to send a https request with a specified
certificate?
my $ua = new LWP::UserAgent;
my $res = $ua->request (GET 'https://...');
this code works fine, but i don't know how to add a certificate to the
request.
thanks in advance.
--
+--------------------------------------------------------------------+
| Alexander Knack ........Entropie erfordert keine Wartung .........|
| dasburo.de ..................................................|
+--------------------------------------------------------------------+
------------------------------
Date: 08 Aug 2000 15:06:41 GMT
From: abigail@foad.org (Abigail)
Subject: Re: ignore IP address
Message-Id: <slrn8p08fd.st1.abigail@alexandra.foad.org>
noway@nohow.com (noway@nohow.com) wrote on MMDXXXIII September MCMXCIII
in <URL:news:398ef17f.14854845@news>:
^^ Does anyone know how I can make a perl script ignore a certain IP
^^ address?
Huh? What do you mean? What is "ignoring a certain IP address"? To be able
to ignore something, you have to be able to observe something. How does a
program observe an IP address?
Abigail
--
perl -we '$_ = q ;4a75737420616e6f74686572205065726c204861636b65720as;;
for (s;s;s;s;s;s;s;s;s;s;s;s)
{s;(..)s?;qq qprint chr 0x$1 and \161 ssq;excess;}'
------------------------------
Date: Tue, 08 Aug 2000 17:41:57 GMT
From: Brian Lavender <blavender@spk.usace.army.mil>
Subject: Re: Interesection and subtraction of data sets.
Message-Id: <8mpgp4$8nv$1@nnrp1.deja.com>
Oops, I missed that page. That's exactly what I was looking for.
In article <399e8fd6.10362573@news.newsguy.com>,
kcivey@cpcug.org (Keith Calvert Ivey) wrote:
> Brian Lavender <blavender@spk.usace.army.mil> wrote:
>
> >I playing around with manipulating sets of data, and I was happy I
> >figured out how to find the interection between two sets, and how to
> >subtract one set from the other. I looked through the Perl Cookbook,
but
> >I didn't find anything.
>
> Is your copy missing page 106?
>
> I don't understand why the Cookbook doesn't use hash slices in
> that section, though.
>
> --
> Keith C. Ivey <kcivey@cpcug.org>
> Washington, DC
--
Brian E. Lavender
US Army Corps of Engineers -- Programmer / Systems Analyst
Sacramento, CA (916) 557-6623
Sent via Deja.com http://www.deja.com/
Before you buy.
------------------------------
Date: Tue, 8 Aug 2000 08:23:32 -0700
From: "Torch" <jjb13@NOSPAMaxe.humboldt.edu>
Subject: login usage for perl
Message-Id: <8mp8lg$hni$1@hades.csu.net>
Hello
I hope this is the right forum for this sort of thing. My boss wants me to
implement some sort of computer log in for the computer lab I work in. I am
not that knowledgeable with perl having just read some tutorials off the
internet.
I was hoping some one here could point me to script(s) that might work. This
is what I need:
-first it has to be free (cheap office)
-it needs to search through a flat-text database for a student id number and
return the line of info with a time and date stamp as to when the person
came in.
-Then it needs to ask them what computers they used mac/pc and if they used
anything else, some sort of text box.
-Then they need to be able click on their name or student id # as they leave
to give a time stamp out.
-All the info needs to then be written into a log file.
Can anyone tell me where to start?
--
Thank You
Torch
Remove NOSPAM to reply
------------------------------
Date: Tue, 08 Aug 2000 15:31:59 GMT
From: gbacon@HiWAAY.net (Greg Bacon)
Subject: Re: newbie hash type question.
Message-Id: <sp09vf6r63a64@corp.supernews.com>
In article <lBUj5.14$qP5.245@news.ecrc.de>,
sysadmin <sysadmin@tbkcoders.com> wrote:
: My question:-
:
: I have a scalar:-
:
: $myscalar = "router1";
:
: I would like to create a hash with the name "router1".
:
: ie
:
: my %router1;
:
No you wouldn't. See <URL:http://www.plover.com/~mjd/perl/varvarname.html>
Greg
------------------------------
Date: 08 Aug 2000 17:37:37 +0100
From: nobull@mail.com
Subject: Re: Perl and opening tcp socket
Message-Id: <u9punju2su.fsf@wcl-l.bham.ac.uk>
rhlinuxguru@my-deja.com writes:
> I am very very new to perl, but it seems like it would be ideal for
> what I am trying to do...
>
> I've messed with the tcp commands, and am baffled...
If you want to avoid the mess, use the IO::Socket module.
> I want a perl script that will open a tcp connection on a specified
> port to an ip for like 30 seconds, and then close it....
#!/usr/bin/perl -w
use strict;
use IO::Socket;
{
my $socket=IO::Socket::INET->new(PeerAddr=>'localhost:80') or die;
sleep 30;
}
--
\\ ( )
. _\\__[oo
.__/ \\ /\@
. l___\\
# ll l\\
###LL LL\\
------------------------------
Date: Tue, 8 Aug 2000 09:30:44 -0700
From: Larry Rosler <lr@hpl.hp.com>
Subject: Re: Problems creating a file in IIS
Message-Id: <MPG.13f9d58dafdec96998ac49@nntp.hpl.hp.com>
In article <398FBB0F.AFDBD7F4@inlander.es> on Tue, 08 Aug 2000 07:47:41
GMT, Abel Almazan <abel@inlander.es> says...
> I have permisions to "write" and "read" to the directory, and i use
> open OUT,"> filename.ext"; to write it, but the file is not creates or
> overwrited if it's not created.
>
> What happens??
You got two useful answers to this question on August 4. Perhaps you
should say what further was needed to cause you to ask it again on
August 8.
--
(Just Another Larry) Rosler
Hewlett-Packard Laboratories
http://www.hpl.hp.com/personal/Larry_Rosler/
lr@hpl.hp.com
------------------------------
Date: 16 Sep 99 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 16 Sep 99)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
| NOTE: The mail to news gateway, and thus the ability to submit articles
| through this service to the newsgroup, has been removed. I do not have
| time to individually vet each article to make sure that someone isn't
| abusing the service, and I no longer have any desire to waste my time
| dealing with the campus admins when some fool complains to them about an
| article that has come through the gateway instead of complaining
| to the source.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V9 Issue 3950
**************************************
