App-cloc
view release on metacpan or search on metacpan
$opt_progress_rate = 0;
} elsif ($opt_sql) { # write SQL output to a file
$opt_by_file = 1;
$skip_generate_report = 1;
$opt_sum_reports = 0;
}
if ($opt_sql_style) {
$opt_sql_style = lc $opt_sql_style;
if (!grep { lc $_ eq $opt_sql_style } qw ( Oracle )) {
die "'$opt_sql_style' is not a recognized SQL style.\n";
}
}
$opt_by_percent = '' unless defined $opt_by_percent;
if ($opt_by_percent and $opt_by_percent !~ m/^(c|cm|cb|cmb)$/i) {
die "--by-percent must be either 'c', 'cm', 'cb', or 'cmb'\n";
}
$opt_by_percent = lc $opt_by_percent;
if (defined $opt_vcs) {
if ($opt_vcs eq "git") {
$opt_vcs = "git ls-files";
my @submodules = invoke_generator('git submodule status');
foreach my $SM (@submodules) {
$SM =~ s/^\s+//; # may have leading space
$SM =~ s/\(\S+\)\s*$//; # may end with something like (heads/master)
my ($checksum, $dir) = split(' ', $SM, 2);
$dir =~ s/\s+$//;
$Exclude_Dir{$dir} = 1;
}
} elsif ($opt_vcs eq "svn") {
$opt_vcs = "svn list -R";
}
}
my $list_no_autogen = 0;
if (defined $opt_no_autogen and scalar @ARGV == 1 and $ARGV[0] eq "list") {
$list_no_autogen = 1;
}
die $brief_usage unless defined $opt_version or
defined $opt_show_lang or
defined $opt_show_ext or
defined $opt_show_os or
defined $opt_write_lang_def or
defined $opt_list_file or
defined $opt_vcs or
defined $opt_xsl or
defined $opt_explain or
$list_no_autogen or
scalar @ARGV >= 1;
die "--diff requires two arguments; got ", scalar @ARGV, "\n"
if $opt_diff and scalar @ARGV != 2;
if ($opt_version) {
printf "$VERSION\n";
exit;
}
replace_git_hash_with_tarfile(\@ARGV);
# 1}}}
# Step 1: Initialize global constants. {{{1
#
my $nFiles_Found = 0; # updated in make_file_list
my (%Language_by_Extension, %Language_by_Script,
%Filters_by_Language, %Not_Code_Extension, %Not_Code_Filename,
%Language_by_File, %Scale_Factor, %Known_Binary_Archives,
%EOL_Continuation_re,
);
my $ALREADY_SHOWED_HEADER = 0;
my $ALREADY_SHOWED_XML_SECTION = 0;
my %Error_Codes = ( 'Unable to read' => -1,
'Neither file nor directory' => -2,
'Diff error (quoted comments?)' => -3,
'Diff error, exceeded timeout' => -4,
'Line count, exceeded timeout' => -5,
);
my @Autogen_to_ignore = no_autogen_files($list_no_autogen);
if ($opt_force_lang_def) {
# replace cloc's definitions
read_lang_def(
$opt_force_lang_def , # Sample values:
\%Language_by_Extension, # Language_by_Extension{f} = 'Fortran 77'
\%Language_by_Script , # Language_by_Script{sh} = 'Bourne Shell'
\%Language_by_File , # Language_by_File{makefile} = 'make'
\%Filters_by_Language , # Filters_by_Language{Bourne Shell}[0] =
# [ 'remove_matches' , '^\s*#' ]
\%Not_Code_Extension , # Not_Code_Extension{jpg} = 1
\%Not_Code_Filename , # Not_Code_Filename{README} = 1
\%Scale_Factor , # Scale_Factor{Perl} = 4.0
\%EOL_Continuation_re , # EOL_Continuation_re{C++} = '\\$'
);
} else {
set_constants( #
\%Language_by_Extension, # Language_by_Extension{f} = 'Fortran 77'
\%Language_by_Script , # Language_by_Script{sh} = 'Bourne Shell'
\%Language_by_File , # Language_by_File{makefile} = 'make'
\%Filters_by_Language , # Filters_by_Language{Bourne Shell}[0] =
# [ 'remove_matches' , '^\s*#' ]
\%Not_Code_Extension , # Not_Code_Extension{jpg} = 1
\%Not_Code_Filename , # Not_Code_Filename{README} = 1
\%Scale_Factor , # Scale_Factor{Perl} = 4.0
\%Known_Binary_Archives, # Known_Binary_Archives{.tar} = 1
\%EOL_Continuation_re , # EOL_Continuation_re{C++} = '\\$'
);
if ($opt_no_autogen) {
foreach my $F (@Autogen_to_ignore) { $Not_Code_Filename{ $F } = 1; }
}
}
if ($opt_read_lang_def) {
# augment cloc's definitions (keep cloc's where there are overlaps)
merge_lang_def(
$opt_read_lang_def , # Sample values:
\%Language_by_Extension, # Language_by_Extension{f} = 'Fortran 77'
\%Language_by_Script , # Language_by_Script{sh} = 'Bourne Shell'
\%Language_by_File , # Language_by_File{makefile} = 'make'
\%Filters_by_Language , # Filters_by_Language{Bourne Shell}[0] =
# [ 'remove_matches' , '^\s*#' ]
\%Not_Code_Extension , # Not_Code_Extension{jpg} = 1
\%Not_Code_Filename , # Not_Code_Filename{README} = 1
\%Scale_Factor , # Scale_Factor{Perl} = 4.0
\%EOL_Continuation_re , # EOL_Continuation_re{C++} = '\\$'
);
}
chdir $extract_dir;
my $bin_file_full_path = "";
if (File::Spec->file_name_is_absolute( $bin_file )) {
$bin_file_full_path = $bin_file;
#print "bin_file_full_path (was ful) = [$bin_file_full_path]\n";
} else {
$bin_file_full_path = File::Spec->catfile( $cwd, $bin_file );
#print "bin_file_full_path (was rel) = [$bin_file_full_path]\n";
}
my $extract_cmd = uncompress_archive_cmd($bin_file_full_path);
print $extract_cmd, "\n" if $opt_v;
system $extract_cmd;
push @extract_location, $extract_dir;
chdir $cwd;
}
# It is possible that the binary archive itself contains additional
# files compressed the same way (true for Java .ear files). Go
# through all the files that were extracted, see if they are binary
# archives and try to extract them. Lather, rinse, repeat.
my $binary_archives_exist = 1;
my $count_binary_archives = 0;
my $previous_count = 0;
my $n_pass = 0;
while ($binary_archives_exist) {
@binary_archive = ();
foreach my $dir (@extract_location) {
find(\&archive_files, $dir); # populates global @binary_archive
}
foreach my $archive (@binary_archive) {
my $extract_dir = undef;
if ($opt_sdir) {
++$TEMP_OFF;
$extract_dir = "$opt_sdir/$TEMP_OFF";
File::Path::rmtree($extract_dir) if is_dir($extract_dir);
File::Path::mkpath($extract_dir) unless is_dir($extract_dir);
} else {
$extract_dir = tempdir( CLEANUP => 1 ); # 1 = delete on exit
}
$TEMP_DIR{ $extract_dir } = 1 if $opt_sql or $opt_by_file;
print "mkdir $extract_dir\n" if $opt_v;
print "cd $extract_dir\n" if $opt_v;
chdir $extract_dir;
my $extract_cmd = uncompress_archive_cmd($archive);
print $extract_cmd, "\n" if $opt_v;
system $extract_cmd;
push @extract_location, $extract_dir;
unlink $archive; # otherwise will be extracting it forever
}
$count_binary_archives = scalar @binary_archive;
if ($count_binary_archives == $previous_count) {
$binary_archives_exist = 0;
}
$previous_count = $count_binary_archives;
}
chdir $cwd;
@ARGV = @extract_location;
} else {
# see if any of the inputs need to be auto-uncompressed &/or expanded
my @updated_ARGS = ();
foreach my $Arg (@ARGV) {
if (is_dir($Arg)) {
push @updated_ARGS, $Arg;
next;
}
my $full_path = "";
if (File::Spec->file_name_is_absolute( $Arg )) {
$full_path = $Arg;
} else {
$full_path = File::Spec->catfile( $cwd, $Arg );
}
#print "full_path = [$full_path]\n";
my $extract_cmd = uncompress_archive_cmd($full_path);
if ($extract_cmd) {
my $extract_dir = undef;
if ($opt_sdir) {
++$TEMP_OFF;
$extract_dir = "$opt_sdir/$TEMP_OFF";
File::Path::rmtree($extract_dir) if is_dir($extract_dir);
File::Path::mkpath($extract_dir) unless is_dir($extract_dir);
} else {
$extract_dir = tempdir( CLEANUP => 1 ); # 1 = delete on exit
}
$TEMP_DIR{ $extract_dir } = 1 if $opt_sql or $opt_by_file;
print "mkdir $extract_dir\n" if $opt_v;
print "cd $extract_dir\n" if $opt_v;
chdir $extract_dir;
print $extract_cmd, "\n" if $opt_v;
system $extract_cmd;
push @updated_ARGS, $extract_dir;
chdir $cwd;
} else {
# this is a conventional, uncompressed, unarchived file
# or a directory; keep as-is
push @updated_ARGS, $Arg;
}
}
@ARGV = @updated_ARGS;
# make sure we're not counting any directory containing
# temporary installations of Regexp::Common, Algorithm::Diff
foreach my $d (sort keys %TEMP_INST) {
foreach my $a (@ARGV) {
next unless is_dir($a);
if ($opt_v > 2) {
printf "Comparing %s (location of %s) to input [%s]\n",
$d, $TEMP_INST{$d}, $a;
}
if ($a eq $d) {
die "File::Temp::tempdir chose directory ",
$d, " to install ", $TEMP_INST{$d}, " but this ",
"matches one of your input directories. Rerun ",
"with --sdir and supply a different temporary ",
"directory for ", $TEMP_INST{$d}, "\n";
}
}
}
}
# 1}}}
my @Errors = ();
my @file_list = (); # global variable updated in files()
my %Ignored = (); # files that are not counted (language not recognized or
# problems reading the file)
my @Lines_Out = ();
if ($opt_diff) {
# Step 4: Separate code from non-code files. {{{1
my @fh = ();
my @files_for_set = ();
# make file lists for each separate argument
for (my $i = 0; $i < scalar @ARGV; $i++) {
push @fh,
make_file_list([ $ARGV[$i] ], \%Error_Codes, \@Errors, \%Ignored);
@{$files_for_set[$i]} = @file_list;
if ($opt_exclude_list_file) {
# note: process_exclude_list_file() references global @file_list
process_exclude_list_file($opt_exclude_list_file,
\%Exclude_Dir,
\%Ignored);
}
if ($opt_no_autogen) {
exclude_autogenerated_files(\@{$files_for_set[$i]}, # in/out
\%Error_Codes, \@Errors, \%Ignored);
}
@file_list = ();
}
# 1}}}
# Step 5: Remove duplicate files. {{{1
#
my %Language = ();
my %unique_source_file = ();
my $n_set = 0;
foreach my $FH (@fh) { # loop over each pair of file sets
++$n_set;
remove_duplicate_files($FH,
\%{$Language{$FH}} ,
\%{$unique_source_file{$FH}} ,
\%Error_Codes ,
\@Errors ,
\%Ignored );
printf "%2d: %8d unique file%s. \r",
$n_set,
plural_form(scalar keys %unique_source_file)
unless $opt_quiet;
}
# 1}}}
# Step 6: Count code, comments, blank lines. {{{1
#
my %Results_by_Language = ();
my %Results_by_File = ();
my %Delta_by_Language = ();
my %Delta_by_File = ();
my @files_added_tot = ();
my @files_removed_tot = ();
my @file_pairs_tot = ();
my %alignment = ();
my $fset_a = $fh[0];
my $fset_b = $fh[1];
my $n_filepairs_compared = 0;
( run in 0.641 second using v1.01-cache-2.11-cpan-df04353d9ac )