#!/usr/bin/env perl # cloc -- Count Lines of Code {{{1 # Copyright (C) 2006-2017 Al Danial # First release August 2006 # # Includes code from: # - SLOCCount v2.26 # http://www.dwheeler.com/sloccount/ # by David Wheeler. # - Regexp::Common v2013031301 # http://search.cpan.org/~abigail/Regexp-Common-2013031301/lib/Regexp/Common.pm # by Damian Conway and Abigail. # - Win32::Autoglob # http://search.cpan.org/~sburke/Win32-Autoglob-1.01/Autoglob.pm # by Sean M. Burke. # - Algorithm::Diff # http://search.cpan.org/~tyemq/Algorithm-Diff-1.1902/lib/Algorithm/Diff.pm # by Tye McQueen. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details: # . # # 1}}} my $VERSION = "1.73"; # odd number == beta; even number == stable my $URL = "github.com/AlDanial/cloc"; # 'https://' pushes header too wide require 5.006; # use modules {{{1 use warnings; use strict; use Getopt::Long; use File::Basename; use File::Temp qw { tempfile tempdir }; use File::Find; use File::Path; use File::Spec; use IO::File; use List::Util qw( min max ); use Cwd; use POSIX qw { strftime ceil}; # Parallel::ForkManager isn't in the standard distribution. Use it only if installed. my $HAVE_Parallel_ForkManager = 0; eval "use Parallel::ForkManager 0.7.6;"; if ( defined $Parallel::ForkManager::VERSION ) { $HAVE_Parallel_ForkManager = 1; } # Digest::MD5 isn't in the standard distribution. Use it only if installed. my $HAVE_Digest_MD5 = 0; eval "use Digest::MD5;"; if (defined $Digest::MD5::VERSION) { $HAVE_Digest_MD5 = 1; } else { warn "Digest::MD5 not installed; will skip file uniqueness checks.\n"; } # Time::HiRes became standard with Perl 5.8 my $HAVE_Time_HiRes = 0; eval "use Time::HiRes;"; $HAVE_Time_HiRes = 1 if defined $Time::HiRes::VERSION; my $HAVE_Rexexp_Common; # Regexp::Common isn't in the standard distribution. It will # be installed in a temp directory if necessary. BEGIN { if (eval "use Regexp::Common;") { $HAVE_Rexexp_Common = 1; } else { $HAVE_Rexexp_Common = 0; } } my $HAVE_Algorith_Diff = 0; # Algorithm::Diff isn't in the standard distribution. It will # be installed in a temp directory if necessary. eval "use Algorithm::Diff qw ( sdiff ) "; if (defined $Algorithm::Diff::VERSION) { $HAVE_Algorith_Diff = 1; } else { Install_Algorithm_Diff(); } # print "2 HAVE_Algorith_Diff = $HAVE_Algorith_Diff\n"; # test_alg_diff($ARGV[$#ARGV - 1], $ARGV[$#ARGV]); die; # die "Hre=$HAVE_Rexexp_Common Had=$HAVE_Algorith_Diff"; # Uncomment next two lines when building Windows executable with perl2exe # or if running on a system that already has Regexp::Common. #use Regexp::Common; #$HAVE_Rexexp_Common = 1; #perl2exe_include "Regexp/Common/whitespace.pm" #perl2exe_include "Regexp/Common/URI.pm" #perl2exe_include "Regexp/Common/URI/fax.pm" #perl2exe_include "Regexp/Common/URI/file.pm" #perl2exe_include "Regexp/Common/URI/ftp.pm" #perl2exe_include "Regexp/Common/URI/gopher.pm" #perl2exe_include "Regexp/Common/URI/http.pm" #perl2exe_include "Regexp/Common/URI/pop.pm" #perl2exe_include "Regexp/Common/URI/prospero.pm" #perl2exe_include "Regexp/Common/URI/news.pm" #perl2exe_include "Regexp/Common/URI/tel.pm" #perl2exe_include "Regexp/Common/URI/telnet.pm" #perl2exe_include "Regexp/Common/URI/tv.pm" #perl2exe_include "Regexp/Common/URI/wais.pm" #perl2exe_include "Regexp/Common/CC.pm" #perl2exe_include "Regexp/Common/SEN.pm" #perl2exe_include "Regexp/Common/number.pm" #perl2exe_include "Regexp/Common/delimited.pm" #perl2exe_include "Regexp/Common/profanity.pm" #perl2exe_include "Regexp/Common/net.pm" #perl2exe_include "Regexp/Common/zip.pm" #perl2exe_include "Regexp/Common/comment.pm" #perl2exe_include "Regexp/Common/balanced.pm" #perl2exe_include "Regexp/Common/lingua.pm" #perl2exe_include "Regexp/Common/list.pm" #perl2exe_include "File/Glob.pm" use Text::Tabs qw { expand }; use Cwd qw { cwd }; use File::Glob; # 1}}} # Usage information, options processing. {{{1 my $ON_WINDOWS = 0; $ON_WINDOWS = 1 if ($^O =~ /^MSWin/) or ($^O eq "Windows_NT"); if ($ON_WINDOWS and $ENV{'SHELL'}) { if ($ENV{'SHELL'} =~ m{^/}) { $ON_WINDOWS = 0; # make Cygwin look like Unix } else { $ON_WINDOWS = 1; # MKS defines $SHELL but still acts like Windows } } my $NN = chr(27) . "[0m"; # normal $NN = "" if $ON_WINDOWS or !(-t STDERR); # -t STDERR: is it a terminal? my $BB = chr(27) . "[1m"; # bold $BB = "" if $ON_WINDOWS or !(-t STDERR); my $script = basename $0; my $brief_usage = " cloc -- Count Lines of Code Usage: $script [options] Count physical lines of source code and comments in the given files (may be archives such as compressed tarballs or zip files) and/or recursively below the given directories or git commit hashes (Unix only). Example: cloc src/ include/ main.c $script [options] --diff Compute differences of physical lines of source code and comments between any pairwise combination of directory names, archive files or git commit hashes (Unix only). Example: cloc --diff Python-3.5.tar.xz python-3.6/ $script --help shows full documentation on the options. http://$URL has numerous examples and more information. "; my $usage = " Usage: $script [options] | | Count, or compute differences of, physical lines of source code in the given files (may be archives such as compressed tarballs or zip files) and/or recursively below the given directories. ${BB}Input Options${NN} --extract-with= This option is only needed if cloc is unable to figure out how to extract the contents of the input file(s) by itself. Use to extract binary archive files (e.g.: .tar.gz, .zip, .Z). Use the literal '>FILE<' as a stand-in for the actual file(s) to be extracted. For example, to count lines of code in the input files gcc-4.2.tar.gz perl-5.8.8.tar.gz on Unix use --extract-with='gzip -dc >FILE< | tar xf -' or, if you have GNU tar, --extract-with='tar zxf >FILE<' and on Windows use, for example: --extract-with=\"\\\"c:\\Program Files\\WinZip\\WinZip32.exe\\\" -e -o >FILE< .\" (if WinZip is installed there). --list-file= Take the list of file and/or directory names to process from , which has one file/directory name per line. Only exact matches are counted; relative path names will be resolved starting from the directory where cloc is invoked. See also --exclude-list-file. --vcs= Invoke a system call to to obtain a list of files to work on. If is 'git', then will invoke 'git ls-files' to get a file list and 'git submodule status' to get a list of submodules whose contents will be ignored. If is 'svn' then will invoke 'svn list -R'. The primary benefit is that cloc will then skip files explicitly excluded by the versioning tool in question, ie, those in .gitignore or have the svn:ignore property. Alternatively may be any system command that generates a list of files. Note: cloc must be in a directory which can read the files as they are returned by . cloc will not download files from remote repositories. 'svn list -R' may refer to a remote repository to obtain file names (and therefore may require authentication to the remote repository), but the files themselves must be local. --unicode Check binary files to see if they contain Unicode expanded ASCII text. This causes performance to drop noticeably. ${BB}Processing Options${NN} --autoconf Count .in files (as processed by GNU autoconf) of recognized languages. See also --no-autogen. --by-file Report results for every source file encountered. --by-file-by-lang Report results for every source file encountered in addition to reporting by language. --count-and-diff First perform direct code counts of source file(s) of and separately, then perform a diff of these. Inputs may be pairs of files, directories, or archives. See also --diff, --diff-alignment, --diff-timeout, --ignore-case, --ignore-whitespace. --diff Compute differences in code and comments between source file(s) of and . The inputs may be any mix of files, directories, archives, or git commit hashes (Unix only). Use --diff-alignment to generate a list showing which file pairs where compared. See also --count-and-diff, --diff-alignment, --diff-timeout, --ignore-case, --ignore-whitespace. --diff-timeout Ignore files which take more than seconds to process. Default is 10 seconds. (Large files with many repeated lines can cause Algorithm::Diff::sdiff() to take hours.) --follow-links [Unix only] Follow symbolic links to directories (sym links to files are always followed). --force-lang=[,] Process all files that have a extension with the counter for language . For example, to count all .f files with the Fortran 90 counter (which expects files to end with .f90) instead of the default Fortran 77 counter, use --force-lang=\"Fortran 90\",f If is omitted, every file will be counted with the counter. This option can be specified multiple times (but that is only useful when is given each time). See also --script-lang, --lang-no-ext. --force-lang-def= Load language processing filters from , then use these filters instead of the built-in filters. Note: languages which map to the same file extension (for example: MATLAB/Mathematica/Objective C/MUMPS/Mercury; Pascal/PHP; Lisp/OpenCL; Lisp/Julia; Perl/Prolog) will be ignored as these require additional processing that is not expressed in language definition files. Use --read-lang-def to define new language filters without replacing built-in filters (see also --write-lang-def). --ignore-whitespace Ignore horizontal white space when comparing files with --diff. See also --ignore-case. --ignore-case Ignore changes in case; consider upper- and lower- case letters equivalent when comparing files with --diff. See also --ignore-whitespace. --lang-no-ext= Count files without extensions using the counter. This option overrides internal logic for files without extensions (where such files are checked against known scripting languages by examining the first line for #!). See also --force-lang, --script-lang. --max-file-size= Skip files larger than megabytes when traversing directories. By default, =100. cloc's memory requirement is roughly twenty times larger than the largest file so running with files larger than 100 MB on a computer with less than 2 GB of memory will cause problems. Note: this check does not apply to files explicitly passed as command line arguments. --no-autogen[=list] Ignore files generated by code-production systems such as GNU autoconf. To see a list of these files (then exit), run with --no-autogen list See also --autoconf. --original-dir [Only effective in combination with --strip-comments] Write the stripped files to the same directory as the original files. --read-binary-files Process binary files in addition to text files. This is usually a bad idea and should only be attempted with text files that have embedded binary data. --read-lang-def= Load new language processing filters from and merge them with those already known to cloc. If defines a language cloc already knows about, cloc's definition will take precedence. Use --force-lang-def to over-ride cloc's definitions (see also --write-lang-def ). --script-lang=, Process all files that invoke as a #! scripting language with the counter for language . For example, files that begin with #!/usr/local/bin/perl5.8.8 will be counted with the Perl counter by using --script-lang=Perl,perl5.8.8 The language name is case insensitive but the name of the script language executable, , must have the right case. This option can be specified multiple times. See also --force-lang, --lang-no-ext. --sdir= Use as the scratch directory instead of letting File::Temp chose the location. Files written to this location are not removed at the end of the run (as they are with File::Temp). --skip-uniqueness Skip the file uniqueness check. This will give a performance boost at the expense of counting files with identical contents multiple times (if such duplicates exist). --stdin-name= Give a file name to use to determine the language for standard input. (Use - as the input name to receive source code via STDIN.) --strip-comments= For each file processed, write to the current directory a version of the file which has blank and commented lines removed (in-line comments persist). The name of each stripped file is the original file name with . appended to it. It is written to the current directory unless --original-dir is on. --sum-reports Input arguments are report files previously created with the --report-file option. Makes a cumulative set of results containing the sum of data from the individual report files. --processes=NUM Sets the maximum number of processes that cloc uses. If this parameter is set to 0, multiprocessing will not be used. On Unix systems, cloc tries to detect the number of CPU cores and creates up to one thread for each core by default. On Windows systems and on systems with an unknown number of cores, using multiple processes is disabled by default. --unix Override the operating system autodetection logic and run in UNIX mode. See also --windows, --show-os. --use-sloccount If SLOCCount is installed, use its compiled executables c_count, java_count, pascal_count, php_count, and xml_count instead of cloc's counters. SLOCCount's compiled counters are substantially faster than cloc's and may give a performance improvement when counting projects with large files. However, these cloc-specific features will not be available: --diff, --count-and-diff, --strip-comments, --unicode. --windows Override the operating system autodetection logic and run in Microsoft Windows mode. See also --unix, --show-os. ${BB}Filter Options${NN} --exclude-dir=[,D2,] Exclude the given comma separated directories D1, D2, D3, et cetera, from being scanned. For example --exclude-dir=.cache,test will skip all files and subdirectories that have /.cache/ or /test/ as their parent directory. Directories named .bzr, .cvs, .hg, .git, .svn, and .snapshot are always excluded. This option only works with individual directory names so including file path separators is not allowed. Use --fullpath and --not-match-d= to supply a regex matching multiple subdirectories. --exclude-ext=[,[...]] Do not count files having the given file name extensions. --exclude-lang=[,L2,] Exclude the given comma separated languages L1, L2, L3, et cetera, from being counted. --exclude-list-file= Ignore files and/or directories whose names appear in . should have one file name per line. Only exact matches are ignored; relative path names will be resolved starting from the directory where cloc is invoked. See also --list-file. --fullpath Modifies the behavior of --match-f, --not-match-f, and --not-match-d to include the file's path in the regex, not just the file's basename. (This does not expand each file to include its absolute path, instead it uses as much of the path as is passed in to cloc.) Note: --match-d always looks at the full path and therefore is unaffected by --fullpath. --include-lang=[,L2,] Count only the given comma separated languages L1, L2, L3, et cetera. --match-d= Only count files in directories matching the Perl regex. For example --match-d='/(src|include)/' only counts files in directories containing /src/ or /include/. Unlike --not-match-d, --match-f, and --not-match-f, --match-d always compares the fully qualified path against the regex. --not-match-d= Count all files except those in directories matching the Perl regex. Only the trailing directory name is compared, for example, when counting in /usr/local/lib, only 'lib' is compared to the regex. Add --fullpath to compare parent directories to the regex. Do not include file path separators at the beginning or end of the regex. --match-f= Only count files whose basenames match the Perl regex. For example --match-f='^[Ww]idget' only counts files that start with Widget or widget. Add --fullpath to include parent directories in the regex instead of just the basename. --not-match-f= Count all files except those whose basenames match the Perl regex. Add --fullpath to include parent directories in the regex instead of just the basename. --skip-archive= Ignore files that end with the given Perl regular expression. For example, if given --skip-archive='(zip|tar(\.(gz|Z|bz2|xz|7z))?)' the code will skip files that end with .zip, .tar, .tar.gz, .tar.Z, .tar.bz2, .tar.xz, and .tar.7z. --skip-win-hidden On Windows, ignore hidden files. ${BB}Debug Options${NN} --categorized= Save names of categorized files to . --counted= Save names of processed source files to . --diff-alignment= Write to a list of files and file pairs showing which files were added, removed, and/or compared during a run with --diff. This switch forces the --diff mode on. --explain= Print the filters used to remove comments for language and exit. In some cases the filters refer to Perl subroutines rather than regular expressions. An examination of the source code may be needed for further explanation. --help Print this usage information and exit. --found= Save names of every file found to . --ignored= Save names of ignored files and the reason they were ignored to . --print-filter-stages Print processed source code before and after each filter is applied. --show-ext[=] Print information about all known (or just the given) file extensions and exit. --show-lang[=] Print information about all known (or just the given) languages and exit. --show-os Print the value of the operating system mode and exit. See also --unix, --windows. -v[=] Verbose switch (optional numeric value). -verbose[=] Long form of -v. --version Print the version of this program and exit. --write-lang-def= Writes to the language processing filters then exits. Useful as a first step to creating custom language definitions (see also --force-lang-def, --read-lang-def). ${BB}Output Options${NN} --3 Print third-generation language output. (This option can cause report summation to fail if some reports were produced with this option while others were produced without it.) --by-percent X Instead of comment and blank line counts, show these values as percentages based on the value of X in the denominator: X = 'c' -> # lines of code X = 'cm' -> # lines of code + comments X = 'cb' -> # lines of code + blanks X = 'cmb' -> # lines of code + comments + blanks For example, if using method 'c' and your code has twice as many lines of comments as lines of code, the value in the comment column will be 200%. The code column remains a line count. --csv Write the results as comma separated values. --csv-delimiter= Use the character as the delimiter for comma separated files instead of ,. This switch forces --json Write the results as JavaScript Object Notation (JSON) formatted output. --md Write the results as Markdown-formatted text. --out= Synonym for --report-file=. --progress-rate= Show progress update after every files are processed (default =100). Set to 0 to suppress progress output (useful when redirecting output to STDOUT). --quiet Suppress all information messages except for the final report. --report-file= Write the results to instead of STDOUT. --sql= Write results as SQL create and insert statements which can be read by a database program such as SQLite. If is -, output is sent to STDOUT. --sql-append Append SQL insert statements to the file specified by --sql and do not generate table creation statements. Only valid with the --sql option. --sql-project= Use as the project identifier for the current run. Only valid with the --sql option. --sql-style= 

';
    print "<- html_header\n" if $opt_v > 2;
} # 1}}}
sub html_end {                               # {{{1
return
'
'; } # 1}}} sub die_unknown_lang { # {{{1 my ($lang, $option_name) = @_; die "Unknown language '$lang' used with $option_name option. " . "The command\n $script --show-lang\n" . "will print all recognized languages. Language names are " . "case sensitive.\n" ; } # 1}}} sub unicode_file { # {{{1 my $file = shift @_; print "-> unicode_file($file)\n" if $opt_v > 2; return 0 if (-s $file > 2_000_000); # don't bother trying to test binary files bigger than 2 MB my $IN = new IO::File $file, "r"; if (!defined $IN) { warn "Unable to read $file; ignoring.\n"; return 0; } my @lines = <$IN>; $IN->close; if (unicode_to_ascii( join('', @lines) )) { print "<- unicode_file()\n" if $opt_v > 2; return 1; } else { print "<- unicode_file()\n" if $opt_v > 2; return 0; } } # 1}}} sub unicode_to_ascii { # {{{1 my $string = shift @_; # A trivial attempt to convert UTF-16 little or big endian # files into ASCII. These files exhibit the following byte # sequence: # byte 1: 255 # byte 2: 254 # byte 3: ord of ASCII character # byte 4: 0 # byte 3+i: ord of ASCII character # byte 4+i: 0 # or # byte 1: 255 # byte 2: 254 # byte 3: 0 # byte 4: ord of ASCII character # byte 3+i: 0 # byte 4+i: ord of ASCII character my $length = length $string; #print "length=$length\n"; return '' if $length <= 3; my @unicode = split(//, $string); # check the first 100 characters for big or little endian UTF-16 encoding my $max_peek = $length < 200 ? $length : 200; my @view_1 = (); for (my $i = 2; $i < $max_peek; $i += 2) { push @view_1, $unicode[$i] } my @view_2 = (); for (my $i = 3; $i < $max_peek; $i += 2) { push @view_2, $unicode[$i] } my $points_1 = 0; foreach my $C (@view_1) { ++$points_1 if (32 <= ord($C) and ord($C) <= 127) or ord($C) == 13 or ord($C) == 10 or ord($C) == 9; } my $points_2 = 0; foreach my $C (@view_2) { ++$points_2 if (32 <= ord($C) and ord($C) <= 127) or ord($C) == 13 or ord($C) == 10 or ord($C) == 9; } #print "points 1: $points_1\n"; #print "points 2: $points_2\n"; my $offset = undef; if ($points_1 > 90) { $offset = 2; } elsif ($points_2 > 90) { $offset = 3; } else { return '' } # neither big or little endian UTF-16 my @ascii = (); for (my $i = $offset; $i < $length; $i += 2) { push @ascii, $unicode[$i]; } return join("", @ascii); } # 1}}} sub uncompress_archive_cmd { # {{{1 my ($archive_file, ) = @_; # Wrap $archive_file in single or double quotes in the system # commands below to avoid filename chicanery (including # spaces in the names). print "-> uncompress_archive_cmd($archive_file)\n" if $opt_v > 2; my $extract_cmd = ""; my $missing = ""; if ($opt_extract_with) { ( $extract_cmd = $opt_extract_with ) =~ s/>FILE -"; } elsif (($archive_file =~ /\.tar\.(gz|Z)$/ or $archive_file =~ /\.tgz$/ ) and !$ON_WINDOWS) { if (external_utility_exists("gzip --version")) { if (external_utility_exists("tar --version")) { $extract_cmd = "gzip -dc '$archive_file' | tar xf -"; } else { $missing = "tar"; } } else { $missing = "gzip"; } } elsif ($archive_file =~ /\.tar\.bz2$/ and !$ON_WINDOWS) { if (external_utility_exists("bzip2 --help")) { if (external_utility_exists("tar --version")) { $extract_cmd = "bzip2 -dc '$archive_file' | tar xf -"; } else { $missing = "tar"; } } else { $missing = "bzip2"; } } elsif ($archive_file =~ /\.tar\.xz$/ and !$ON_WINDOWS) { if (external_utility_exists("unxz --version")) { if (external_utility_exists("tar --version")) { $extract_cmd = "unxz -dc '$archive_file' | tar xf -"; } else { $missing = "tar"; } } else { $missing = "bzip2"; } } elsif ($archive_file =~ /\.tar$/ and !$ON_WINDOWS) { $extract_cmd = "tar xf '$archive_file'"; } elsif ($archive_file =~ /\.src\.rpm$/i and !$ON_WINDOWS) { if (external_utility_exists("cpio --version")) { if (external_utility_exists("rpm2cpio")) { $extract_cmd = "rpm2cpio '$archive_file' | cpio -i"; } else { $missing = "rpm2cpio"; } } else { $missing = "bzip2"; } } elsif ($archive_file =~ /\.zip$/i and !$ON_WINDOWS) { if (external_utility_exists("unzip")) { $extract_cmd = "unzip -qq -d . '$archive_file'"; } else { $missing = "unzip"; } } elsif ($archive_file =~ /\.deb$/i and !$ON_WINDOWS) { # only useful if the .deb contains source code--most # .deb files just have compiled executables if (external_utility_exists("dpkg-deb")) { $extract_cmd = "dpkg-deb -x '$archive_file' ."; } else { $missing = "dpkg-deb"; } } elsif ($ON_WINDOWS and $archive_file =~ /\.zip$/i) { # zip on Windows, guess default Winzip install location $extract_cmd = ""; my $WinZip = '"C:\\Program Files\\WinZip\\WinZip32.exe"'; if (external_utility_exists($WinZip)) { $extract_cmd = "$WinZip -e -o \"$archive_file\" ."; #print "trace 5 extract_cmd=[$extract_cmd]\n"; } else { #print "trace 6\n"; $missing = $WinZip; } } print "<- uncompress_archive_cmd\n" if $opt_v > 2; if ($missing) { die "Unable to expand $archive_file because external\n", "utility '$missing' is not available.\n", "Another possibility is to use the --extract-with option.\n"; } else { return $extract_cmd; } } # 1}}} sub read_list_file { # {{{1 my ($file, ) = @_; print "-> read_list_file($file)\n" if $opt_v > 2; my $IN = new IO::File $file, "r"; if (!defined $IN) { warn "Unable to read $file; ignoring.\n"; return (); } my @entry = (); while (<$IN>) { next if /^\s*$/ or /^\s*#/; # skip empty or commented lines s/\cM$//; # DOS to Unix chomp; push @entry, $_; } $IN->close; print "<- read_list_file\n" if $opt_v > 2; return @entry; } # 1}}} sub external_utility_exists { # {{{1 my $exe = shift @_; my $success = 0; if ($ON_WINDOWS) { $success = 1 unless system $exe . ' > nul'; } else { $success = 1 unless system $exe . ' >/dev/null 2>&1'; if (!$success) { $success = 1 unless system "which" . " $exe" . ' >/dev/null 2>&1'; } } return $success; } # 1}}} sub write_xsl_file { # {{{1 my $OUT = new IO::File $CLOC_XSL, "w"; if (!defined $OUT) { warn "Unable to write $CLOC_XSL $!\n"; return; } my $XSL = # {{{2 ' CLOC Results

'; # 2}}} if ($opt_by_file) { $XSL .= #
{{{2 ' '; $XSL .= ' ' if $opt_3; $XSL .= ' '; $XSL .= ' ' if $opt_3; $XSL .= ' '; $XSL .= ' ' if $opt_3; $XSL .= '
File Blank Comment Code Language3rd Generation Equivalent Scale
Total

'; # 2}}} } if (!$opt_by_file or $opt_by_file_by_lang) { $XSL .= #
{{{2 ' '; $XSL .= ' ' if $opt_3; $XSL .= ' '; $XSL .= ' ' if $opt_3; $XSL .= ' '; $XSL .= ' ' if $opt_3; $XSL .= '
Language Files Blank Comment CodeScale 3rd Generation Equivalent
Total
'; # 2}}} } $XSL.= <<'EO_XSL'; # {{{2 EO_XSL # 2}}} my $XSL_DIFF = <<'EO_DIFF_XSL'; # {{{2 CLOC Results

EO_DIFF_XSL # 2}}} if ($opt_by_file) { $XSL_DIFF.= <<'EO_DIFF_XSL'; # {{{2
Same
File Blank Comment Code
Modified
File Blank Comment Code
Added
File Blank Comment Code
Removed
File Blank Comment Code
EO_DIFF_XSL # 2}}} } if (!$opt_by_file or $opt_by_file_by_lang) { $XSL_DIFF.= <<'EO_DIFF_XSL'; # {{{2
Same
Language Files Blank Comment Code
Modified
Language Files Blank Comment Code
Added
Language Files Blank Comment Code
Removed
Language Files Blank Comment Code
EO_DIFF_XSL # 2}}} } $XSL_DIFF.= <<'EO_DIFF_XSL'; # {{{2 EO_DIFF_XSL # 2}}} if ($opt_diff) { print $OUT $XSL_DIFF; } else { print $OUT $XSL; } $OUT->close(); } # 1}}} sub normalize_file_names { # {{{1 my (@files, ) = @_; # Returns a hash of file names reduced to a canonical form # (fully qualified file names, all path separators changed to /, # Windows file names lowercased). Hash values are the original # file name. my %normalized = (); foreach my $F (@files) { my $F_norm = $F; if ($ON_WINDOWS) { $F_norm = lc $F_norm; # for case insensitive file name comparisons $F_norm =~ s{\\}{/}g; # Windows directory separators to Unix $F_norm =~ s{^\./}{}g; # remove leading ./ if (($F_norm !~ m{^/}) and ($F_norm !~ m{^\w:/})) { # looks like a relative path; prefix with cwd $F_norm = lc "$cwd/$F_norm"; } } else { $F_norm =~ s{^\./}{}g; # remove leading ./ if ($F_norm !~ m{^/}) { # looks like a relative path; prefix with cwd $F_norm = lc "$cwd/$F_norm"; } } # Remove trailing / so it does not interfere with further regex code # that does not expect it $F_norm =~ s{/+$}{}; $normalized{ $F_norm } = $F; } return %normalized; } # 1}}} sub combine_diffs { # {{{1 # subroutine by Andy (awalshe@sf.net) # https://sourceforge.net/tracker/?func=detail&aid=3261017&group_id=174787&atid=870625 my ($ra_files) = @_; my $res = "$URL v $VERSION\n"; my $dl = '-'; my $width = 79; # columns are in this order my @cols = ('files', 'blank', 'comment', 'code'); my %HoH = (); foreach my $file (@{$ra_files}) { my $IN = new IO::File $file, "r"; if (!defined $IN) { warn "Unable to read $file; ignoring.\n"; next; } my $sec; while (<$IN>) { chomp; s/\cM$//; next if /^(http|Language|-----)/; if (/^[A-Za-z0-9]+/) { # section title $sec = $_; chomp($sec); $HoH{$sec} = () if ! exists $HoH{$sec}; next; } if (/^\s(same|modified|added|removed)/) { # calculated totals row my @ar = grep { $_ ne '' } split(/ /, $_); chomp(@ar); my $ttl = shift @ar; my $i = 0; foreach(@ar) { my $t = "${ttl}${dl}${cols[$i]}"; $HoH{$sec}{$t} = 0 if ! exists $HoH{$sec}{$t}; $HoH{$sec}{$t} += $_; $i++; } } } $IN->close; } # rows are in this order my @rows = ('same', 'modified', 'added', 'removed'); $res .= sprintf("%s\n", "-" x $width); $res .= sprintf("%-19s %14s %14s %14s %14s\n", 'Language', $cols[0], $cols[1], $cols[2], $cols[3]); $res .= sprintf("%s\n", "-" x $width); for my $sec ( keys %HoH ) { next if $sec =~ /SUM:/; $res .= "$sec\n"; foreach (@rows) { $res .= sprintf(" %-18s %14s %14s %14s %14s\n", $_, $HoH{$sec}{"${_}${dl}${cols[0]}"}, $HoH{$sec}{"${_}${dl}${cols[1]}"}, $HoH{$sec}{"${_}${dl}${cols[2]}"}, $HoH{$sec}{"${_}${dl}${cols[3]}"}); } } $res .= sprintf("%s\n", "-" x $width); my $sec = 'SUM:'; $res .= "$sec\n"; foreach (@rows) { $res .= sprintf(" %-18s %14s %14s %14s %14s\n", $_, $HoH{$sec}{"${_}${dl}${cols[0]}"}, $HoH{$sec}{"${_}${dl}${cols[1]}"}, $HoH{$sec}{"${_}${dl}${cols[2]}"}, $HoH{$sec}{"${_}${dl}${cols[3]}"}); } $res .= sprintf("%s\n", "-" x $width); return $res; } # 1}}} sub get_time { # {{{1 if ($HAVE_Time_HiRes) { return Time::HiRes::time(); } else { return time(); } } # 1}}} sub really_is_D { # {{{1 # Ref bug 131, files ending with .d could be init.d scripts # instead of D language source files. my ($file , # in $rh_Err , # in hash of error codes $raa_errors , # out ) = @_; print "-> really_is_D($file)\n" if $opt_v > 2; my $possible_script = peek_at_first_line($file, $rh_Err, $raa_errors); print "<- really_is_D($file)\n" if $opt_v > 2; return $possible_script; # null string if D, otherwise a language } # 1}}} sub no_autogen_files { # {{{1 # ref https://github.com/AlDanial/cloc/issues/151 my ($print,) = @_; print "-> no_autogen($print)\n" if $opt_v > 2; # These sometimes created manually? # acinclude.m4 # configure.ac # Makefile.am my @files = qw ( aclocal.m4 announce-gen autogen.sh bootstrap compile config.guess config.h.in config.rpath config.status config.sub configure configure.in depcomp gendocs.sh gitlog-to-changelog git-version-gen gnupload gnu-web-doc-update install-sh libtool libtool.m4 link-warning.h ltmain.sh lt~obsolete.m4 ltoptions.m4 ltsugar.m4 ltversion.in ltversion.m4 Makefile.in mdate-sh missing mkinstalldirs test-driver texinfo.tex update-copyright useless-if-before-free vc-list-files ylwrap ); if ($print) { printf "cloc will ignore these %d files with --no-autogen:\n", scalar @files; foreach my $F (@files) { print " $F\n"; } } print "<- no_autogen()\n" if $opt_v > 2; return @files; } # 1}}} # subroutines copied from SLOCCount my %lex_files = (); # really_is_lex() my %expect_files = (); # really_is_expect() my %php_files = (); # really_is_php() sub really_is_lex { # {{{1 # Given filename, returns TRUE if its contents really is lex. # lex file must have "%%", "%{", and "%}". # In theory, a lex file doesn't need "%{" and "%}", but in practice # they all have them, and requiring them avoid mislabeling a # non-lexfile as a lex file. my $filename = shift; chomp($filename); my $is_lex = 0; # Value to determine. my $percent_percent = 0; my $percent_opencurly = 0; my $percent_closecurly = 0; # Return cached result, if available: if ($lex_files{$filename}) { return $lex_files{$filename};} open(LEX_FILE, "<$filename") || die "Can't open $filename to determine if it's lex.\n"; while() { $percent_percent++ if (m/^\s*\%\%/); $percent_opencurly++ if (m/^\s*\%\{/); $percent_closecurly++ if (m/^\s*\%\}/); } close(LEX_FILE); if ($percent_percent && $percent_opencurly && $percent_closecurly) {$is_lex = 1;} $lex_files{$filename} = $is_lex; # Store result in cache. return $is_lex; } # 1}}} sub really_is_expect { # {{{1 # Given filename, returns TRUE if its contents really are Expect. # Many "exp" files (such as in Apache and Mesa) are just "export" data, # summarizing something else # (e.g., its interface). # Sometimes (like in RPM) it's just misc. data. # Thus, we need to look at the file to determine # if it's really an "expect" file. my $filename = shift; chomp($filename); # The heuristic is as follows: it's Expect _IF_ it: # 1. has "load_lib" command and either "#" comments or {}. # 2. {, }, and one of: proc, if, [...], expect my $is_expect = 0; # Value to determine. my $begin_brace = 0; # Lines that begin with curly braces. my $end_brace = 0; # Lines that begin with curly braces. my $load_lib = 0; # Lines with the Load_lib command. my $found_proc = 0; my $found_if = 0; my $found_brackets = 0; my $found_expect = 0; my $found_pound = 0; # Return cached result, if available: if ($expect_files{$filename}) { return expect_files{$filename};} open(EXPECT_FILE, "<$filename") || die "Can't open $filename to determine if it's expect.\n"; while() { if (m/#/) {$found_pound++; s/#.*//;} if (m/^\s*\{/) { $begin_brace++;} if (m/\{\s*$/) { $begin_brace++;} if (m/^\s*\}/) { $end_brace++;} if (m/\};?\s*$/) { $end_brace++;} if (m/^\s*load_lib\s+\S/) { $load_lib++;} if (m/^\s*proc\s/) { $found_proc++;} if (m/^\s*if\s/) { $found_if++;} if (m/\[.*\]/) { $found_brackets++;} if (m/^\s*expect\s/) { $found_expect++;} } close(EXPECT_FILE); if ($load_lib && ($found_pound || ($begin_brace && $end_brace))) {$is_expect = 1;} if ( $begin_brace && $end_brace && ($found_proc || $found_if || $found_brackets || $found_expect)) {$is_expect = 1;} $expect_files{$filename} = $is_expect; # Store result in cache. return $is_expect; } # 1}}} sub really_is_pascal { # {{{1 # Given filename, returns TRUE if its contents really are Pascal. # This isn't as obvious as it seems. # Many ".p" files are Perl files # (such as /usr/src/redhat/BUILD/ispell-3.1/dicts/czech/glob.p), # others are C extractions # (such as /usr/src/redhat/BUILD/linux/include/linux/umsdos_fs.p # and some files in linuxconf). # However, test files in "p2c" really are Pascal, for example. # Note that /usr/src/redhat/BUILD/ucd-snmp-4.1.1/ov/bitmaps/UCD.20.p # is actually C code. The heuristics determine that they're not Pascal, # but because it ends in ".p" it's not counted as C code either. # I believe this is actually correct behavior, because frankly it # looks like it's automatically generated (it's a bitmap expressed as code). # Rather than guess otherwise, we don't include it in a list of # source files. Let's face it, someone who creates C files ending in ".p" # and expects them to be counted by default as C files in SLOCCount needs # their head examined. I suggest examining their head # with a sucker rod (see syslogd(8) for more on sucker rods). # This heuristic counts as Pascal such files such as: # /usr/src/redhat/BUILD/teTeX-1.0/texk/web2c/tangleboot.p # Which is hand-generated. We don't count woven documents now anyway, # so this is justifiable. my $filename = shift; chomp($filename); # The heuristic is as follows: it's Pascal _IF_ it has all of the following # (ignoring {...} and (*...*) comments): # 1. "^..program NAME" or "^..unit NAME", # 2. "procedure", "function", "^..interface", or "^..implementation", # 3. a "begin", and # 4. it ends with "end.", # # Or it has all of the following: # 1. "^..module NAME" and # 2. it ends with "end.". # # Or it has all of the following: # 1. "^..program NAME", # 2. a "begin", and # 3. it ends with "end.". # # The "end." requirements in particular filter out non-Pascal. # # Note (jgb): this does not detect Pascal main files in fpc, like # fpc-1.0.4/api/test/testterminfo.pas, which does not have "program" in # it my $is_pascal = 0; # Value to determine. my $has_program = 0; my $has_unit = 0; my $has_module = 0; my $has_procedure_or_function = 0; my $found_begin = 0; my $found_terminating_end = 0; my $has_begin = 0; open(PASCAL_FILE, "<$filename") || die "Can't open $filename to determine if it's pascal.\n"; while() { s/\{.*?\}//g; # Ignore {...} comments on this line; imperfect, but effective. s/\(\*.*?\*\)//g; # Ignore (*...*) comments on this line; imperfect, but effective. if (m/\bprogram\s+[A-Za-z]/i) {$has_program=1;} if (m/\bunit\s+[A-Za-z]/i) {$has_unit=1;} if (m/\bmodule\s+[A-Za-z]/i) {$has_module=1;} if (m/\bprocedure\b/i) { $has_procedure_or_function = 1; } if (m/\bfunction\b/i) { $has_procedure_or_function = 1; } if (m/^\s*interface\s+/i) { $has_procedure_or_function = 1; } if (m/^\s*implementation\s+/i) { $has_procedure_or_function = 1; } if (m/\bbegin\b/i) { $has_begin = 1; } # Originally I said: # "This heuristic fails if there are multi-line comments after # "end."; I haven't seen that in real Pascal programs:" # But jgb found there are a good quantity of them in Debian, specially in # fpc (at the end of a lot of files there is a multiline comment # with the changelog for the file). # Therefore, assume Pascal if "end." appears anywhere in the file. if (m/end\.\s*$/i) {$found_terminating_end = 1;} # elsif (m/\S/) {$found_terminating_end = 0;} } close(PASCAL_FILE); # Okay, we've examined the entire file looking for clues; # let's use those clues to determine if it's really Pascal: if ( ( ($has_unit || $has_program) && $has_procedure_or_function && $has_begin && $found_terminating_end ) || ( $has_module && $found_terminating_end ) || ( $has_program && $has_begin && $found_terminating_end ) ) {$is_pascal = 1;} return $is_pascal; } # 1}}} sub really_is_incpascal { # {{{1 # Given filename, returns TRUE if its contents really are Pascal. # For .inc files (mainly seen in fpc) my $filename = shift; chomp($filename); # The heuristic is as follows: it is Pascal if any of the following: # 1. really_is_pascal returns true # 2. Any usual reserved word is found (program, unit, const, begin...) # If the general routine for Pascal files works, we have it if (really_is_pascal($filename)) { return 1; } my $is_pascal = 0; # Value to determine. my $found_begin = 0; open(PASCAL_FILE, "<$filename") || die "Can't open $filename to determine if it's pascal.\n"; while() { s/\{.*?\}//g; # Ignore {...} comments on this line; imperfect, but effective. s/\(\*.*?\*\)//g; # Ignore (*...*) comments on this line; imperfect, but effective. if (m/\bprogram\s+[A-Za-z]/i) {$is_pascal=1;} if (m/\bunit\s+[A-Za-z]/i) {$is_pascal=1;} if (m/\bmodule\s+[A-Za-z]/i) {$is_pascal=1;} if (m/\bprocedure\b/i) {$is_pascal = 1; } if (m/\bfunction\b/i) {$is_pascal = 1; } if (m/^\s*interface\s+/i) {$is_pascal = 1; } if (m/^\s*implementation\s+/i) {$is_pascal = 1; } if (m/\bconstant\s+/i) {$is_pascal=1;} if (m/\bbegin\b/i) { $found_begin = 1; } if ((m/end\.\s*$/i) && ($found_begin = 1)) {$is_pascal = 1;} if ($is_pascal) { last; } } close(PASCAL_FILE); return $is_pascal; } # 1}}} sub really_is_php { # {{{1 # Given filename, returns TRUE if its contents really is php. my $filename = shift; chomp($filename); my $is_php = 0; # Value to determine. # Need to find a matching pair of surrounds, with ending after beginning: my $normal_surround = 0; # my $script_surround = 0; # ; bit 0 =