#!/usr/local/bin/perl -w

#--------------------------------------------------------------------------------
#--  System Name:  Reusable Simulation Environment
#--------------------------------------------------------------------------------
#--  Unit ID:  
#--  $RCSfile: sloc.pl,v $ 
#--  $Revision: 1.5 $
#--  $Date: 1999/11/05 23:28:14 $
#--
#--  Log History:
#--  $Log: sloc.pl,v $
#--  Revision 1.5  1999/11/05 23:28:14  freihofr
#--  Added facilities to handle .app files and their accociated pre-processor
#--  directives, with respect to counting lines of source ada code, which
#--  are marked with semicolons.
#--
#--  Revision 1.4  1999/08/11 00:37:16  hitt
#--  Now recognize perl by .pm as well as by .pl (was just .pl)..
#--
#--  Revision 1.3  1999/08/10 18:44:20  hitt
#--  Added code to print out the revision of each file which comes from
#--  RCS (which will depend on the symbolic name supplied, if any).
#--
#--  Revision 1.2  1999/08/09 23:19:43  hitt
#--  Removed the `only_rcs' option and replaced it with a general method
#--  of specifying types to consider.  So `@,v' would have the same effect
#--  as `only_rcs'.  `@.ads,v @.adb,v' has the effect of causing the script
#--  to only look for files which end in .ads,v or .adb,v (controlled specs
#--  and bodies of ada code).
#--
#--  Also added a counter for shell code (.sh and .csh files).
#--
#--  Revision 1.1  1999/08/08 21:39:50  hitt
#--  Initial revision
#--
#--  Description:  
#--  This script counts lines of code in one or more directories.
#--  Invoke with argument `help' for a description.
#--------------------------------------------------------------------------------
#--

require 5.003;

##################################
####   Main program
##################################

&assign_globals;  ### These have dynamic scope, so must be assigned first.

&parse_args(@ARGV);

&print_date_and_version;

&form_file_list;

&accumulate_sloc_data;

&write_sloc_report;

exit 0;

##################################
####   Subroutines
##################################

sub assign_globals {
    $search_by_include_list=0;
    # Searching is done either by an `include' or an `exclude' list.
    # By default, we use an `exclude' list: we search for everything
    # except items the user says not to search for (using the -type
    # argument: see the help message).
    $ignore_files_without_extensions=0;
    $symbolic_name="";
    &initialize_global_lists;
    $depth=0;
    $unlimited_depth=1;
    &assign_binary_type;
    &assign_programs;
    &assign_default_tmp_dir;
    $default_sloc_report_file="sloc_report";
    $sloc_file=$default_sloc_report_file;
    my $revision='$Revision: 1.5 $';  # Note that RCS maintains this string.
    if ($revision =~ /\s([0-9\.]+)\s/) {
       $rev_number=$1;
    } else {
       die "$0: Could not get revision number.\n";
    }
    # put in other declarations here
}

sub initialize_global_lists {
    @file_types_to_ignore=();  # List of file types to ignore
    %file_types_to_ignore=();  # Auxiliary hash for uniqueness of names
    @file_type_lengths=();     # List of lengths of the ignored types
    $file_type_count=0;
    @file_types_to_include=(); # List of file types to include
    %file_types_to_include=(); # Auxiliary hash for uniqueness of names
    @included_file_type_lengths=();
    $included_file_type_count=0;
    @directories_to_search=();
    %directories_to_search=();  # Auxiliary hash for uniqueness of names
    @files_to_consider=();
    $consider_count=0;
    @missing_version_list=();
    ### TBD (to be done)
    ### We should refine our RCS handling to include a list of the RCS
    ### files which do not have a given version; also, we should record
    ### in the output the exact revision counted (since marks can change).
    ###    @missing_version_list=();
    @ada_sloc=();
    @app_sloc=();
    @c_sloc=();
    @fortran_sloc=();
    @shell_sloc=();
    @makefile_sloc=();
    @perl_sloc=();
    @java_sloc=();
    @cpp_sloc=();
    @h_sloc=();  # for .h files (could be C or C++)
    @miscellaneous_sloc=();
    @unable_to_open=();
    @failed_rcs_commands=();
}

sub assign_binary_type {
    $binary_type=`/bin/uname`;
    if ($?) {die "$0: Could not execute /bin/uname: $!\n";}
    chomp $binary_type;
}

sub assign_program_dir {
    $program_dir="/sw/rse/archive/gnu/binary/$binary_type";
    if (! -e $program_dir) {
	die "$0: `$program_dir' does not exist.\n";
    }
    if (! -d $program_dir) {
	die "$0: `$program_dir' exists but is not a directory.\n";
    }
}

sub assign_find_program {
    $find="$program_dir/find"; # Must use gnu find for -maxdepth option
    if (! -e $find) {
	die "$0: `$find' does not exist.\n";
    }
    if (! -x $find) {
	die "$0: `$find' is not executable.\n";
    }
}

sub assign_standard_utilities {
    $co="/usr/local/bin/co";     # standard co
    $rlog="/usr/local/bin/rlog";
    $rm="/bin/rm";
}

sub assign_counters {
    $java_counter="/sw/rse/development/tools/count_semis";
    if (!(-x $java_counter)) { # Program not found or not executable.
        print STDERR
            "$0: $java_counter not found or not executable, so not counting ",
            "lines of java code.\n";
        $java_counter="";
    }
    $cpp_counter=$java_counter;  # same comment convention in both C++ and Java
    if (!(-x $cpp_counter)) { # Program not found or not executable.
        print STDERR
            "$0: $cpp_counter not found or not executable, so not counting ",
            "lines of C++ code.\n";
        $cpp_counter="";
    }
    $c_counter="/sw/rse/development/tools/count_semis";
    if (!(-x $c_counter)) { # Program not found or not executable.
        print STDERR
            "$0: $c_counter not found or not executable, so will count ",
            "lines of c code after first passing them through the ",
            "pre-processor.\n";
        $c_counter="";
    }
}

sub assign_programs {
    &assign_program_dir;
    &assign_find_program;
    &assign_standard_utilities;
    &assign_counters;
}

sub assign_default_tmp_dir {
    if (exists $ENV{HOME}) {
	my $home=$ENV{HOME};

	$default_temp_dir="$home/tmp/sloc";
    } else {
	$default_temp_dir="/tmp";
    }
    $temp_dir=$default_temp_dir;
}


sub print_date_and_version {
    my $date=localtime;

    print "$0 Revision $rev_number, $date.\n";
}

sub form_file_list {
    my $dir_list=join ' ',@directories_to_search;
    my $depth_string="";

    if (!$unlimited_depth) {
	$depth_string="-maxdepth $depth";
    }
    my $command="$find $dir_list $depth_string -print";
    my $raw_list=`$command`;
    if ($?) {
	print STDERR
	    "$0: There were errors in executing `$command'; some files ",
	    "may not have been found: $!\n";
    }
    my @files= split /\s/,$raw_list;
    if (!(scalar @files)) {
	die "$0: No files were found.\n";
    }
    for $file (@files) {
	if (-d $file) {
	    print STDERR "d";
	    next;
	} # skip directories
	if ($file =~ m{/old[^/]*/}) {
	    print STDERR "o";
	    next;
	} # skip files with `old***'  as a component in their paths
	if ($search_by_include_list) {
	    if (&should_include_file($file)) {
		push @files_to_consider,$file;
		print STDERR "c";
	    } else {
		print STDERR "i";
	    }
	} else {
	    if (&should_ignore_file($file)) {
		print STDERR "i";
		next;
	    } else { # skip ignored types
		push @files_to_consider,$file;
		print STDERR "c";
	    }
	}
    }
    $consider_count=scalar @files_to_consider;
    print STDERR "\n";
}

sub should_include_file {
    my $file=$_[0];
    my $flen=length $file;
    my $i;

    if ($file =~ /^\s*$/) {
	print STDERR "[blank]";
	return 0;
    }
    for ($i=0;$i<$included_file_type_count;$i++) {
	my $type=$file_types_to_include[$i];
	my $tlen=$included_file_type_lengths[$i];
	if ($flen>=$tlen) {
	    my $sub=substr $file,$flen-$tlen;
	    if ($sub eq $type) {
		return 1;
	    }
	}
    }
    return 0;
}

sub should_ignore_file {
    my $file=$_[0];
    my $flen=length $file;
    my $i;

    if ($file =~ /^\s*$/) {
	print STDERR "[blank]";
	return 1;
    }
    if ($ignore_files_without_extensions) {
	if ($file =~ m@/@) { # has a slash, so must look past the last slash
	    if ($file =~m@^.*/([^/]*)$@) {
		my $end_name=$1;
		my $elen=length $end_name;
		if (($elen>1)&&(substr($end_name,1) !~ /\./)) {
		    return 1;
		}
	    } else {
		die "$0: Improperly formed regular expression: ",
		"contact coder.\n";
	    }
	} else {
	    if (($flen>1)&&(substr($file,1) !~ /\./)) {
		return 1;
	    }
	}
    }
    for ($i=0;$i<$file_type_count;$i++) {
	my $type=$file_types_to_ignore[$i];
	my $tlen=$file_type_lengths[$i];
	if ($flen>=$tlen) {
	    my $sub=substr $file,$flen-$tlen;
	    if ($sub eq $type) {
		return 1;
	    }
	}
    }
    return 0;
}

sub accumulate_sloc_data {
    my $i;

    print STDERR "[$consider_count files]\n\n";
    for ($i=0;$i<$consider_count;$i++) {
	my $file=$files_to_consider[$i];
	&count_lines_of_code($file);
    }
}

sub write_help_message {
    print <<eo_usage;

Usage:

   $0 arguments . . .

All arguments are optional.

If an argument involves an `=', such as `temp=/my/temp/dir', no spaces
should be put around the `='.

These arguments are recognized:

help:       Print this message and exit with status 0.
version:    Print out version number and exit with status 0.
-type:      Ignore type.  For example, -.c causes files ending in `.c'
            to be ignored. -,v causes RCS archives to be ignored.
            - followed by nothing causes files without an extension
            to be ignored.  There can be multiple items with a -.
            By default we ignore files ending in .o, .a, .so, .bak, .old,
            .gif, .jpg, .gz, .zip, .Z, and ~.
eo_usage
    print <<'eo_literal'; # The @ cannot be in a `double-quoted' string
@type:      Include type.  For example, to count only .ads and .adb files,
            the argument would be `@.ads  @.adb'.  To count only RCS
            archives of those types, the argument would be
            `@.ads,v @.adb,v'.  Note that you cannot specify both
            types to include and types to ignore.
eo_literal
    print <<eo_usage;
version=some_symbolic_name:
            If we're examining RCS files, then choose the version with
            some_symbolic_name.  (If we're not examining RCS files, this
            option will have no effect.)
+dir:       Consider the files in directory dir.  Multiple directories
            can be specified.  If no directories are specified `.' is used.
temp=/a/temporary/directory:
            Use /a/temporary/directory for temporary storage (if needed).
            The default is $default_temp_dir.
report=some_file:
            We write our report to this file, which defaults to
            $default_sloc_report_file.
depth=some_number:
            By default we search for files recursively in the directory tree.
            But if depth is specified, we look only up to a certain depth.
            A depth of 1 means to only look for top level files.

eo_usage
}

sub add_type_to_include {
    my $included_type=$_[0];

    if (!exists $file_types_to_include{$included_type}) {
	push @file_types_to_include,$included_type;
	push @included_file_type_lengths,length($included_type);
	$included_file_type_count++;
	$file_types_to_include{$included_type}=1;
    }
}

sub add_type_to_ignore {
    my $ignored_type=$_[0];

    if (!exists $file_types_to_ignore{$ignored_type}) {
	push @file_types_to_ignore,$ignored_type;
	push @file_type_lengths,length($ignored_type);
	$file_type_count++;
	$file_types_to_ignore{$ignored_type}=1;
    }
}

sub add_dir_to_dir_list {
    my $next_dir=$_[0];

    if (!exists $directories_to_search{$next_dir}) {
	push @directories_to_search,$next_dir;
	$directories_to_search{$next_dir}=1;
    }
}

sub parse_args {
    my @args=@_;
    my $arg_cnt=scalar @args;
    my $i;
    my $temp_assigned=0;
    my $version_assigned=0;
    my $report_assigned=0;
    my $depth_assigned=0;
    my $exclusion_found=0;

    for ($i=0;$i<$arg_cnt;$i++) {
	my $arg=$args[$i];
	if ($arg =~ /^[-]*help$/i) {
	    &write_help_message;
	    exit 0;
	} elsif ($arg =~ /^[-]*version$/i) {
	    print "Revision $rev_number\n";
	    exit 0;
	} elsif ($arg =~ m@^[-]*depth=(.*)$@) {
	    if ($depth_assigned) {
		die "$0: Attempt to multiply search depth\n";
	    } else {
		$depth_assigned=1;
	    }
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: empty definition for search depth\n";
	    } else {
		my $possible_depth=$1;
		if ($possible_depth !~ /^\d+$/) {
		    die "$0: Depth `$possible_depth' is not a string of ",
		    "digits\n";
		} else {
		    $depth=$possible_depth;
		    $unlimited_depth=0;
		}
	    }
	} elsif ($arg =~ m{^@(..*)$}) {
	    $search_by_include_list=1;
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: Isolated `\@' on command line.\n";
	    }
	    &add_type_to_include($1);
	} elsif ($arg =~ m@^\+(.*)$@) {
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: isolated `+' among arguments.\n";
	    } else {
		&add_dir_to_dir_list($1);
	    }
	} elsif ($arg =~ m@^[-]*version=(.*)$@) {
	    if ($version_assigned) {
		die "$0: Attempt to multiply assign version information\n";
	    } else {
		$version_assigned=1;
	    }
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: empty definition for rcs version\n";
	    } else {
		$symbolic_name=$1;
	    }
	} elsif ($arg =~ m@^[-]*temp=(.*)$@) {
	    if ($temp_assigned) {
		die "$0: Attempt to multiply assign tmp directory\n";
	    } else {
		$temp_assigned=1;
	    }
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: empty definition for tmp directory\n";
	    } else {
		$temp_dir=$1;
	    }
	} elsif ($arg =~ m@^[-]*report=(.*)$@) {
	    if ($report_assigned) {
		die "$0: Attempt to multiply sloc report file\n";
	    } else {
		$report_assigned=1;
	    }
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		die "$0: empty definition for sloc report file\n";
	    } else {
		$sloc_file=$1;
	    }
	} elsif ($arg =~ m@^-(.*)$@) {
	    $exclusion_found=1;
	    if ((!defined $1)||($1 =~ /^\s*$/)) {
		$ignore_files_without_extensions=1;
	    } else {
		&add_type_to_ignore($1);
	    }
	} else {
	    die "$0: Could not interpret argument `$arg'; try `help'.\n";
	}
    }
    if ($search_by_include_list&&$exclusion_found) {
	die "$0: Both including (@) and excluding (-) file types.\n";
    }
    &create_temp_dir_if_necessary;
    my $dir_count=scalar @directories_to_search;
    if (!$dir_count) {
	&add_dir_to_dir_list(".");
    }
    if (!$search_by_include_list) {
	foreach $type (".o", ".a", ".so", ".bak", ".old", ".gif", ".jpg",
		       ".gz", ".zip", ".Z", "~") {
	    &add_type_to_ignore($type);
	}
    }
}

sub create_temp_dir_if_necessary {
    if (-e $temp_dir) {
	if (!(-d $temp_dir)) {
	    die "$0: $temp_dir exists but is not a directory.\n";
	}
    } else {
	my $command="mkdir -p $temp_dir";
	if (system($command)) {
	    die "$0: Failed on command `$command'\n";
	}
    }
}

sub count_lines_of_code {
    my $infile=$_[0];

    if ($infile =~ /,v$/) {
	&count_lines_of_rcs_file($infile);
    } else {
	&count_lines_of_non_rcs_file($infile,$infile);
    }
}
sub count_lines_of_non_rcs_file {
    my ($infile,$reported_name)=@_;

    # 11/3/99  added additional elsif statement to handle .app files. 

    if ($infile =~ /\.adb$|\.ads$|\.ada$/) {
	&count_lines_of_ada_code($infile,$reported_name);
    } elsif ($infile =~ /\.app$/) {       
        &count_lines_of_app_code($infile,$reported_name);
    } elsif ($infile =~ /\..java$/) {
	&count_lines_of_java_code($infile,$reported_name);
    } elsif ($infile =~ /\.f$/) {
	&count_lines_of_fortran_code($infile,$reported_name);
    } elsif ($infile =~ /\.c$/) {
	&count_lines_of_c_code($infile,$reported_name);
    } elsif ($infile =~ /\.h$|\.hpp$/) {
	&count_lines_of_h_code($infile,$reported_name);
    } elsif ($infile =~ /\.pl$|\.pm$/) {
	&count_lines_of_perl_code($infile,$reported_name);
    } elsif ($infile =~ /\.C$|\.cc$|\.cpp$/) {
	&count_lines_of_cplusplus_code($infile,$reported_name);
    } elsif (($infile =~ /make/i)||($infile =~ /\.mak$/)) {
	&count_lines_of_makefile_code($infile,$reported_name);
    } elsif ($infile =~ /\.csh$|\.sh$/) {
	&count_lines_of_shell_code($infile,$reported_name);
    } else {
	&count_miscellaneous($infile,$reported_name);
    }
}

sub count_lines_of_rcs_file {
    my $infile=$_[0];
    my $end_name="not yet assigned";
    if ($infile =~ m@^.*/([^/]*),v$@) {
	$end_name=$1;
    } else {
	$end_name=substr($infile,0,-2); # remove last two characters: `,v'
    }
    my $outfile="$temp_dir/$end_name";
    my $revision_number=0;
    if ($symbolic_name) {
	if (!&check_for_symbolic_name($infile)) {
	    return;
	}
    }
    my $command="( $co -p$symbolic_name $infile > $outfile ) 2>&1";
    my $output=`$command`;
    if ($?) {
	push @failed_rcs_commands,$command;
	system("$rm -f $outfile");
    } else {
	my $revision_info=&get_revision_info_from_output($output);
	my $rcs_label="[version $revision_info]";
	&count_lines_of_non_rcs_file($outfile,"$rcs_label $infile");
	system("$rm -f $outfile");
    }
}

sub get_revision_info_from_output {
    my $command_output=$_[0];

    my @lines=split /\n/,$command_output;
    for (@lines) {
	if (m/^revision\s+([\d\.]*)\s*$/) {
	    return $1;
	}
    }
    return "?";
}

sub check_for_symbolic_name {
    my $file=$_[0];

    # We assume going into this procedure that $symbolic_name is not null.

    my $command="$rlog -h $file";
    my $output=`$command`;
    if ($?) {
	push @failed_rcs_commands,$command;
	return 0;
    }
    my @list=split /\n/,$output;

    # We are assuming that $symbolic_name is not ``Working file'',
    # ``head'', ``branch'', ``locks'', ``access list'', ``symbolic names'',
    # ``keyword substitution'', or ``total revisions''.
    # If it is, there could be unexpected results . . .

    for (@list) {
	if (m/^\s*$symbolic_name:/) {
	    return 1;
	}
    }
    push @missing_version_list,$file;
    return 0;
}


sub count_lines_of_ada_code {
    my $infile=$_[0];
    my $reported_name=$_[1];
    my $semicolon_count=0;
    my $line_count=0;
    my $blank_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    } else {
		$semicolon_count += &semicolons_in_ada_line($_);
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$semicolon_count,$blank_count);
	push @ada_sloc,\@out;
	print
	    "$reported_name: $line_count : $semicolon_count : $blank_count\n";
    }
}

sub count_lines_of_app_code {

    # 11/3/99  Added this subroutine to handle pre-processor directives
    #          in the .app files. This routine looks for non-blank lines
    #          and increments $ppd_count if the line starts with a '#' and
    #          if there are also any semicolons in it. If the non-blank line
    #          does not start with a '#', then $semicolon_count is incremented
    #          if there are any semicolons in the line. Comments are ignored.

    my $infile=$_[0];
    my $reported_name=$_[1];
    my $ppd_count=0;
    my $semicolon_count=0;
    my $line_count=0;
    my $blank_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    }
            elsif (/^#/) {
                $ppd_count += &semicolons_in_ada_line($_);
            } 
            else {
		$semicolon_count += &semicolons_in_ada_line($_);
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$semicolon_count,$blank_count);
	push @app_sloc,\@out;
	print
	    "$reported_name: $line_count : $semicolon_count : $blank_count\n";
    }
}

sub semicolons_in_ada_line {
    my $line=$_[0];

    if ($line =~ /^(.*?)--..*$/) { # The ? to match FIRST `--' which occurs
	$line = $1;
    }
    my $count = ( $line =~ tr/;/;/);
    return $count;
}

sub count_lines_of_java_code {
    my $infile=$_[0];
    my $reported_name=$_[1];

    if ($java_counter ne "") {
	my $command="$java_counter $infile";
	my $results=`$command`;

	if ($results =~ /^\D*(\d+)\D+(\d+)\D+(\d+)\D*$/) {
	    my $semicolon_count=$1;
	    my $line_count=$2;
	    my $byte_count=$3;
	    my @out=($reported_name,$byte_count,$line_count,$semicolon_count);
	    push @java_sloc,\@out;
	    print
	     "$reported_name: $byte_count : $line_count : $semicolon_count\n";
	} else {
	    print "$reported_name: could not count\n";
	}
    }
}

sub count_lines_of_h_code {
    # We handle .h files separately from .c files because they might
    # involve C++ comments (if they're headers for C++ files).
    my $infile=$_[0];
    my $reported_name=$_[1];

    if ($cpp_counter ne "") {
	my $command="$cpp_counter $infile";
	my $results=`$command`;

	if ($results =~ /^\D*(\d+)\D+(\d+)\D+(\d+)\D*$/) {
	    my $semicolon_count=$1;
	    my $line_count=$2;
	    my $byte_count=$3;
	    my @out=($reported_name,$byte_count,$line_count,$semicolon_count);
	    push @h_sloc,\@out;
	    print
	     "$reported_name: $byte_count : $line_count : $semicolon_count\n";
	} else {
	    print "$infile: could not count\n";
	}
    }
}

sub count_lines_of_cplusplus_code {
    my $infile=$_[0];
    my $reported_name=$_[1];

    if ($cpp_counter ne "") {
	my $command="$cpp_counter $infile";
	my $results=`$command`;

	if ($results =~ /^\D*(\d+)\D+(\d+)\D+(\d+)\D*$/) {
	    my $semicolon_count=$1;
	    my $line_count=$2;
	    my $byte_count=$3;
	    my @out=($reported_name,$byte_count,$line_count,$semicolon_count);
	    push @cpp_sloc,\@out;
	    print
	     "$reported_name: $byte_count : $line_count : $semicolon_count\n";
	} else {
	    print "$infile: could not count\n";
	}
    }
}

sub count_lines_of_fortran_code {
    my $infile=$_[0];
    my $reported_name=$_[1];
    my $line_count=0;
    my $blank_count=0;
    my $non_blank_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    } else {
		$non_blank_count++;
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$non_blank_count,$blank_count);
	push @fortran_sloc,\@out;
	print
         "$reported_name: $line_count : $non_blank_count : $blank_count\n";
    }
}

sub count_lines_of_shell_code {
    my $infile=$_[0];
    my $reported_name=$_[1];
    my $line_count=0;
    my $blank_count=0;
    my $comment_count=0;
    my $code_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    } else {
		if (/^([^#]*)#/) {
		    $comment_count++;
		    if ($1 !~ /^\s*$/) { # non-blank precedes comment char #
                        $code_count++;
		    }
		} else {
		    $code_count++;
		}
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$comment_count,
		 $code_count,$blank_count);
	push @shell_sloc,\@out;
	print
	    "$reported_name: $line_count : $comment_count : $code_count ",
	    ": $blank_count\n";
    }
}

sub count_lines_of_c_code {
    my ($source,$reported_name)=@_;
    if ($c_counter eq "") {
	my $tmpfile="$temp_dir/deleteme.c";
	my $command="cc -E $source > $tmpfile";
	if (system($command)) {
	    print STDERR
		"$0: Failed on attempt to run $source through preprocessor.";
	} else {
	    my $semicolon_count=0;
	    if (open_file($source)) {
		while (<INFILE>) {
		    $semicolon_count += (tr/;/;/);
		}
		close INFILE;
		$command="rm -f $tmpfile";
		if (system($command)) {
		    die("$0: Failed on attempt to execute command ",
			"`$command': $!\n");
		}
		my @out=($reported_name,$semicolon_count);
		push @c_sloc,\@out;
		print "$reported_name: $semicolon_count\n";
	    }
	}
    } else {
	my $command="$c_counter $source";
	my $results=`$command`;

	if ($results =~ /^\D*(\d+)\D+(\d+)\D+(\d+)\D*$/) {
	    my $semicolon_count=$1;
	    my $line_count=$2;
	    my $byte_count=$3;
	    my @out=($reported_name,$byte_count,$line_count,$semicolon_count);
	    push @c_sloc,\@out;
	    print
             "$reported_name: $byte_count : $line_count : $semicolon_count\n";
	} else {
	    print "$source: could not count\n";
	}
    }
}

sub count_lines_of_perl_code {
    my $infile=$_[0];
    my $reported_name=$_[1];
    my $semicolon_count=0;
    my $line_count=0;
    my $blank_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    } else {
		$semicolon_count += &semicolons_in_perl_line($_);
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$semicolon_count,$blank_count);
	push @perl_sloc,\@out;
	print "$reported_name: $line_count : $semicolon_count : $blank_count\n";
    }
}

sub semicolons_in_perl_line {
    my $line=$_[0];

    if ($line =~ /^\#/) { # Must handle this case separately, no preceding char
	return 0;
    }
    if ($line =~ /^(.*?)[^\\]\#.*$/) { # The ? to match FIRST # which occurs
	                               # UNLESS the # is backslashed . . .
	$line = $1;
    }
    my $count = ( $line =~ tr/;/;/);
    return $count;
}

sub count_lines_of_makefile_code {
    my $infile=$_[0];
    my $reported_name=$_[1];

    my $line_count=0;
    my $blank_count=0;
    my $comment_count=0;
    my $non_blank_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	    chomp;
	    if (/^\s*$/) {
		$blank_count++;
	    } elsif (/^\s*\#/) {
		$comment_count++;
	    } else {
		$non_blank_count++;
	    }
	}
	close INFILE;
	my @out=($reported_name,$line_count,$non_blank_count,$comment_count,
		 $blank_count);
	push @makefile_sloc,\@out;
	print
	    "$reported_name: $line_count : $non_blank_count :",
	    "$comment_count : $blank_count\n";
    }
}

sub count_miscellaneous {
    my $infile=$_[0];
    my $reported_name=$_[1];
    my $line_count=0;

    if (open_file($infile)) {
	while (<INFILE>) {
	    $line_count++;
	}
	close INFILE;
	my @out=($reported_name,$line_count);
	push @miscellaneous_sloc,\@out;
	print "$reported_name: $line_count\n";
    }
}

sub write_sloc_report {
    my $outfile=$sloc_file;
    my $build_hierarchy=1;

    # 11/3/99   Added a 'my' declaration for handling the .app sloc count.
    #           Added an 'if' statement for printing out $app_cnt and 
    #           $app_total statistics.

    my ($ada_cnt,$ada_total)           =&total_counts(@ada_sloc);
    my ($app_cnt,$app_total)           =&total_counts(@app_sloc);
    my ($h_cnt,$h_total)               =&total_counts(@h_sloc);
    my ($c_cnt,$c_total)               =&total_counts(@c_sloc);
    my ($cpp_cnt,$cpp_total)           =&total_counts(@cpp_sloc);
    my ($fortran_cnt,$fortran_total)   =&total_counts(@fortran_sloc);
    my ($java_cnt,$java_total)         =&total_counts(@java_sloc);
    my ($perl_cnt,$perl_total)         =&total_counts(@perl_sloc);
    my ($makefile_cnt,$makefile_total) =&total_counts(@makefile_sloc);
    my ($shell_cnt,$shell_total)       =&total_counts(@shell_sloc);
    my ($miscellaneous_cnt,$miscellaneous_total)
                                       =&total_counts(@miscellaneous_sloc);

    my $time=localtime;

    open(OUTFILE,">$outfile")
	or die("$0: Could not open $outfile for writing: $!\n");

    print OUTFILE <<eo_preamble;
This file lists the total slocs separated according to language.

It was generated by revision $rev_number of script
$0 at $time.

eo_preamble

    if ($ada_total) {
	print OUTFILE
	    "Ada Totals:\n",
	    "\tFiles:            ",$ada_cnt,"\n",
	    "\tLines:            ",$ada_total->[1],"\n",
            "\tSemicolons:       ",$ada_total->[2],"\n",
	    "\tBlank Lines:      ",$ada_total->[3],"\n";
    }
    if ($app_total) {
        print OUTFILE
	    "App Totals:\n",
	    "\tFiles:            ",$app_cnt,"\n",
	    "\tLines:            ",$app_total->[1],"\n",
            "\tSemicolons:       ",$app_total->[2],"\n",
	    "\tBlank Lines:      ",$app_total->[3],"\n";
    }
    if ($h_total) {
	print OUTFILE
	    "Header Totals (C/C++):\n",
	    "\tFiles:            ",$h_cnt,"\n",
	    "\tBytes:            ",$h_total->[1],"\n",
	    "\tLines:            ",$h_total->[2],"\n",
	    "\tSemicolons:       ",$h_total->[3],"\n";
    }
    if ($c_total) {
	if ($c_counter eq "") {
	    print OUTFILE
		"C Totals:\n",
		"\tFiles:            ",$c_cnt,"\n",
		"\tSemicolons:       ",$c_total->[1],"\n";
	} else {
	    print OUTFILE
		"C Totals:\n",
		"\tFiles:            ",$c_cnt,"\n",
		"\tBytes:            ",$c_total->[1],"\n",
		"\tLines:            ",$c_total->[2],"\n",
		"\tSemicolons:       ",$c_total->[3],"\n";
	}
    }
    if ($cpp_total) {
	print OUTFILE
	    "C++ Totals:\n",
	    "\tFiles:            ",$cpp_cnt,"\n",
	    "\tBytes:            ",$cpp_total->[1],"\n",
	    "\tLines:            ",$cpp_total->[2],"\n",
	    "\tSemicolons:       ",$cpp_total->[3],"\n";
    }
    if ($fortran_total) {
	print OUTFILE
	    "Fortran Totals:\n",
	    "\tFiles:            ",$fortran_cnt,"\n",
	    "\tLines:            ",$fortran_total->[1],"\n",
	    "\tNon Blanks Lines: ",$fortran_total->[2],"\n",
	    "\tBlank Lines:      ",$fortran_total->[3],"\n";
    }
    if ($java_total) {
	print OUTFILE
	    "Java Totals:\n",
	    "\tFiles:            ",$java_cnt,"\n",
	    "\tBytes:            ",$java_total->[1],"\n",
	    "\tLines:            ",$java_total->[2],"\n",
	    "\tSemicolons:       ",$java_total->[3],"\n";
    }
    if ($perl_total) {
	print OUTFILE
	    "Perl Totals:\n",
	    "\tFiles:            ",$perl_cnt,"\n",
	    "\tLines:            ",$perl_total->[1],"\n",
	    "\tSemicolons:       ",$perl_total->[2],"\n",
	    "\tBlank Lines:      ",$perl_total->[3],"\n";
    }
    if ($makefile_total) {
	print OUTFILE
	    "Makefile Totals:\n",
	    "\tFiles:            ",$makefile_cnt,"\n",
	    "\tLines:            ",$makefile_total->[1],"\n",
	    "\tNon-Comments:     ",$makefile_total->[2],"\n",
	    "\tComment Lines:    ",$makefile_total->[3],"\n",
	    "\tBlank Lines:      ",$makefile_total->[4],"\n";
    }
    if ($shell_total) {
	print OUTFILE
	    "Shell Totals:\n",
	    "\tFiles:            ",$shell_cnt,"\n",
	    "\tLines:            ",$shell_total->[1],"\n",
	    "\tComments:         ",$shell_total->[2],"\n",
	    "\tCode Lines:       ",$shell_total->[3],"\n",
	    "\tBlank Lines:      ",$shell_total->[4],"\n";
    }
    if ($miscellaneous_total) {
	print OUTFILE
	    "Miscellaneous Totals:\n",
	    "\tFiles:            ",$miscellaneous_cnt,"\n",
	    "\tLines:            ",$miscellaneous_total->[1],"\n";
    }
    &print_unable_to_open_summary;
    &print_rcs_failure_summary;
    &print_symbolic_name;
    &print_missing_version_summary;

#    print OUTFILE <<eo_banner;
#
#=====================================
#Details:
#=====================================
#
#
#eo_banner
#
#    &print_to_outfile("Ada",          \@ada_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("Headers (C/C++)",
#                                      \@h_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("C",            \@c_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("C++",          \@cpp_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("Fortran",      \@fortran_sloc,$build_hierarchy,
#		      $temp_dir);
#    &print_to_outfile("Java",         \@java_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("Perl",         \@perl_sloc,$build_hierarchy,$temp_dir);
#    &print_to_outfile("Makefile",     \@makefile_sloc,$build_hierarchy,
#		      $temp_dir);
#    &print_to_outfile("Shell",        \@shell_sloc,$build_hierarchy,
#		      $temp_dir);
#    &print_to_outfile("Miscellaneous",\@miscellaneous_sloc,$build_hierarchy,
#		      $temp_dir);
#    &print_unable_to_open_details;
#    &print_rcs_failure_details;
#    &print_missing_version_details;
    close OUTFILE;
}

sub print_unable_to_open_summary {
    my $count=scalar @unable_to_open;

    if ($count) {
	print OUTFILE "\n\nUnable to open $count file[s].\n\n";
    }
}

sub print_rcs_failure_summary {
    my $count=scalar @failed_rcs_commands;

    if ($count) {
	print OUTFILE "\n\nFailed on $count RCS command[s].\n\n";
    }
}

sub print_symbolic_name {
    if ($symbolic_name) {
	print OUTFILE
	    "\n\nAny RCS extractions used version `$symbolic_name'.\n\n";
    }
}

sub print_missing_version_summary {
    my $count=scalar @missing_version_list;

    if ($count) {
	print OUTFILE
	    "\n\n$count file[s] were missing marker `$symbolic_name'.\n\n";
    }
}

sub print_unable_to_open_details {
    my $count=scalar @unable_to_open;

    if ($count) {
	print OUTFILE "\n\nUnable to open these files:\n";
	my $i;
	for (@unable_to_open) {
	    print OUTFILE "$_\n";
	}
    }
}

sub print_rcs_failure_details {
    my $count=scalar @failed_rcs_commands;

    if ($count) {
	print OUTFILE "\n\nFailed on these RCS commands:\n";
	my $i;
	for (@failed_rcs_commands) {
	    print OUTFILE "$_\n";
	}
    }
}

sub print_missing_version_details {
    my $count=scalar @missing_version_list;

    if ($count) {
	print OUTFILE "\n\nFailed to get `$symbolic_name' from these files:\n";
	my $i;
	for (@missing_version_list) {
	    print OUTFILE "$_\n";
	}
    }
}

sub print_to_outfile {
    my ($language,$array_ref,$build_hierarchy,$temp_dir)=@_;

    print OUTFILE "\n\n$language:\n";
    my @array=@$array_ref;
    if (!(scalar @array)) {
	print OUTFILE "[None]\n\n";
	return;
    }
    for (@array) {
	my @to_print=@$_;
	my $out_string=join "\t",@to_print;
	if (!$build_hierarchy) {
	    if ($out_string =~ m|^$temp_dir/(.*)$|) {
		$out_string=$1;
	    }
	}
	print OUTFILE "$out_string\n";
    }
}

sub total_counts {
    my @input=@_;
    my $len=@input;

    if ($len == 0) {
	return (0,0);
    }
    my $first_element=$input[0];
    my @first_array=@$first_element;
    my $array_len=@first_array;
    my ($i,$j);
    my @out=("total");
    for ($j=1;$j<$array_len;$j++) {
	push @out,$first_array[$j];
    }
    for ($i=1;$i<$len;$i++) {
	my $element=$input[$i];
	for ($j=1;$j<$array_len;$j++) {
	    $out[$j] += $element->[$j];
	}
    }
    return ($len,\@out);
}

sub open_file {
    my $infile=$_[0];

    if (open(INFILE,$infile)) {
	return 1;
    } else {
	print STDERR "$0: failed to open $infile: $!\n";
	push @unable_to_open,$infile;
	return 0;
    }
}