Simple script to count NLOC? - c++

Do you know a simple script to count NLOCs (netto lines of code). The script should count lines of C Code. It should not count empty lines or lines with just braces. But it doesn't need to be overly exact either.

I would do that using awk & cpp (preprocessor) & wc . awk removes all braces and blanks, the preprocessor removes all comments and wc counts the lines:
find . -name \*.cpp -o -name \*.h | xargs -n1 cpp -fpreprocessed -P |
awk '!/^[{[:space:]}]*$/' | wc -l
If you want to have comments included:
find . -name \*.cpp -o -name \*.h | xargs awk '!/^[{[:space:]}]*$/' | wc -l

Looking NLOC on the Net, I found mostly "Non-commented lines of code".
You don't specify if comments must be skipped...
So if I stick to your current message, the following one-liner in Perl should do the job:
perl -pe "s/^\s*[{}]?\s*\n//" Dialog.java | wc -l
I can extend it to handle line comments:
perl -pe "s#^\s*[{}]?\s*\n|^\s*//.*\n##" Dialog.java | wc -l
or perhaps
perl -pe "s#^\s*(?:[{}]?\s*|//.*)\n##" Dialog.java | wc -l
Handling block comments is slightly more tricky (I am not a Perl expert!).
[EDIT] Got it... First part can be probably improved (shorter). Was fun to experiment with.
perl -e "$x = join('', <>); $x =~ s#/\*.*?\*/##gs; print $x" Dialog.java | perl -pe "s#^\s*(?:[{}]?\s*|//.*)\n##" | wc -l
PS.: I use double quotes because I tested on Windows...

Check out DPack plugin for Visual Studio. It has a stats report for any solution/project.

Not a script, but you can try this command-line open source tool: NLOC

Source monitor is freeware source analysis software. It is windows application but it also can be run with parameters from command line.
It can analyze C++, C, C#, VB.NET, Java, Delphi, Visual Basic (VB6) or HTML.

Ohloh offers the free Ohcount which counts lines of code and comments.

If the comments can still be in, the standard unix tool are sufficent:
grep -x -v "[[:space:]}{]*" files.c | wc

SLOCCOunt is not a simple script and does much more than what you need. However, it is a powerful alternative to the already mentioned Ohcount and NLOC. :)

I usually just do this:
grep -vc '^$' (my files)
Works only if your empty lines are really empty (no spaces). Sufficient for me.

Locmetrics works well.

Here's a simple Perl script eLOC.pl:
#!/usr/bin/perl -w
# eLOC - Effective Lines of Code Counter
# JFS (2005)
#
# $ perl eLOC.pl --help
#
use strict;
use warnings;
use sigtrap;
use diagnostics;
use warnings::register;
no warnings __PACKAGE__;
sub DEBUG { 0 }
use English qw( -no_match_vars ) ; # Avoids regex performance penalty
use Getopt::Long qw(:config gnu_getopt);
use File::DosGlob 'glob';
use Pod::Usage;
our $VERSION = '0.01';
# globals
use constant NOTFILENAME => undef;
my %counter = (
'PHYS' => 0,
'ELOC' => 0,
'PURE_COMMENT' => 0,
'BLANK' => 0,
'LLOC' => 0,
'INLINE_COMMENT'=> 0,
'LOC' => 0,
);
my %header = (
"eloc" => "eloc",
"lloc" => "lloc",
"loc" => "loc",
"comment" => "comment",
"blank" => "blank",
"newline" => "newline",
"logicline" => "lgcline",
);
my %total = %counter; # copy
my $c = \%counter; # see format below
my $h = \%header; # see top format below
my $inside_multiline_comment = 0;
my $filename = NOTFILENAME;
my $filecount = 0;
my $filename_header = "file name";
# process input args
my $version = '';
my $help = '';
my $man = '';
my $is_deterministic = '';
my $has_header = '';
print STDERR "Input args:'" if DEBUG;
print STDERR (join("|",#ARGV),"'\n") if DEBUG;
my %option = ('version' => \$version,
'help' => \$help,
'man' => \$man,
'deterministic' => \$is_deterministic,
'header' => \$has_header
);
GetOptions( \%option, 'version', 'help', 'man',
'eloc|e', # print the eLOC counts
'lloc|s', # print the lLOC counts (code statements)
'loc|l' , # print the LOC counts (eLOC + lines of a single brace or parenthesis)
'comment|c' , # print the comments counts (count lines which contains a comment)
'blank|b' , # print the blank counts
'newline|n' , # print the newline count
'logicline|g' , # print the logical line count (= LOC + Comment Lines + Blank Lines)
'deterministic', # print the LOC determination for every line in the source file
'header', # print header line
) or invalid_options("$0: invalid options\nTry `$0 --help' for more information.");
version() if $version;
pod2usage(-exitstatus => 0, -verbose => 1) if $help ;
pod2usage(-exitstatus => 0, -verbose => 2) if $man;
#
$has_header = 1 if $is_deterministic && $has_header eq '';
#format for print_loc_metric()
my ($format, $format_top) = make_format();
print STDERR "format:\n" if DEBUG > 10;
print STDERR $format if DEBUG > 10;
eval $format;
die $# if $#; # $EVAL_ERROR
if(DEBUG>10) {
print STDERR ("format_top:\n", $format_top);
}
if( $has_header) {
eval $format_top;
die $# if $#; # $EVAL_ERROR
}
# process files
print STDERR ("Input args after Getopts():\n",
join("|",#ARGV),"\n") if DEBUG > 10;
expand_wildcards();
#ARGV = '-' unless #ARGV;
foreach my $fn (#ARGV) {
$filename = $fn;
unless (open(IN, "<$filename")) {
warn "$0: Unable to read from '$filename': $!\n";
next;
}
print STDERR "Scanning $filename...\n" if DEBUG;
clear_counters();
generate_loc_metric();
$filecount++;
print_loc_metric();
close(IN)
or warn "$0: Could not close $filename: $!\n";
}
# print total
if($filecount > 1) {
$filename = "total";
$c = \%total;
print_loc_metric();
}
exit 0;
#-------------------------------------------------
sub wsglob {
my #list = glob;
#list ? #list : #_; #HACK: defence from emtpy list from glob()
}
sub expand_wildcards {
print STDERR ("Input args before expand_wildcards():\n",
join("|",#ARGV),"\n") if DEBUG;
{
#ARGV = map( /['*?']/o ? wsglob($_) : $_ , #ARGV);
}
print STDERR ("Input args after expand_wildcards():\n",
join("|",#ARGV),"\n") if DEBUG;
}
sub clear_counters {
for my $name ( keys %counter) {
$counter{$name} = 0;
}
}
sub make_format {
my $f = 'format STDOUT =' . "\n";
$f .= '# LOC, eLOC, lLOC, comment, blank, newline, logicline and filename' . "\n";
my $f_top = 'format STDOUT_TOP =' . "\n";
my $console_screen_width = (get_terminal_size())[0];
print STDERR '$console_screen_width=' . $console_screen_width ."\n" if DEBUG>10;
$console_screen_width = 100 if $console_screen_width < 0;
my $is_print_specifiers_set =
($option{"eloc"} or
$option{"lloc"} or
$option{"loc"} or
$option{"comment"} or
$option{"blank"} or
$option{"newline"} or
$option{"logicline"});
my %o = %option;
my $fc = 0;
if( $is_print_specifiers_set ) {
$fc++ if $o{"eloc"};
$fc++ if $o{"lloc"};
$fc++ if $o{"loc"};
$fc++ if $o{"comment"};
$fc++ if $o{"blank"};
$fc++ if $o{"newline"};
$fc++ if $o{"logicline"};
if( $fc == 0 ) { die "$0: assertion failed: field count is zero" }
}
else {
# default
$fc = 7;
$o{"loc"} = 1;
$o{"eloc"} = 1;
$o{"lloc"} = 1;
$o{"comment"} = 1;
$o{"blank"} = 1;
$o{"newline"} = 1;
$o{"logicline"} = 1;
}
if (DEBUG > 10) {
while( (my ($name, $value) = each %{o}) ) {
print STDERR "name=$name, value=$value\n";
}
}
# picture line
my $field_format = '#>>>>>> ';
my $field_width = length $field_format;
my $picture_line = $field_format x $fc;
# place for filename
$picture_line .= '^';
$picture_line .= '<' x ($console_screen_width - $field_width * $fc - 2);
$picture_line .= "\n";
$f .= $picture_line;
$f_top .= $picture_line;
# argument line
$f .= '$$c{"LOC"}, ' ,$f_top .= '$$h{"loc"}, ' if $o{"loc"};
$f .= '$$c{"ELOC"}, ' ,$f_top .= '$$h{"eloc"}, ' if $o{"eloc"};
$f .= '$$c{"LLOC"}, ' ,$f_top .= '$$h{"lloc"}, ' if $o{"lloc"};
$f .= '$$c{"comment"}, ' ,$f_top .= '$$h{"comment"}, ' if $o{"comment"};
$f .= '$$c{"BLANK"}, ' ,$f_top .= '$$h{"blank"}, ' if $o{"blank"};
$f .= '$$c{"PHYS"}, ' ,$f_top .= '$$h{"newline"}, ' if $o{"newline"};
$f .= '$$c{"logicline"}, ',$f_top .= '$$h{"logicline"}, ' if $o{"logicline"};
$f .= '$filename' . "\n";
$f_top .= '$filename_header' . "\n";
# 2nd argument line for long file names
$f .= '^';
$f .= '<' x ($console_screen_width-2);
$f .= '~~' . "\n"
.' $filename' . "\n";
$f .='.' . "\n";
$f_top .='.' . "\n";
return ($f, $f_top);
}
sub generate_loc_metric {
my $is_concatinated = 0;
LINE: while(<IN>)
{
chomp;
print if $is_deterministic && !$is_concatinated;
# handle multiline code statements
if ($is_concatinated = s/\\$//) {
warnings::warnif("$0: '\\'-ending line concantinated");
increment('PHYS');
print "\n" if $is_deterministic;
my $line = <IN>;
$_ .= $line;
chomp($line);
print $line if $is_deterministic;
redo unless eof(IN);
}
# blank lines, including inside comments, don't move to next line here
increment('BLANK') if( /^\s*$/ );
# check whether multiline comments finished
if( $inside_multiline_comment && m~\*/\s*(\S*)\s*$~ ) {
$inside_multiline_comment = 0;
# check the rest of the line if it contains non-whitespace characters
#debug $_ = $REDO_LINE . $1, redo LINE if($1);
warnings::warnif("$0: expression '$1' after '*/' discarded") if($1);
# else mark as pure comment
increment('PURE_COMMENT');
next LINE;
}
# inside multiline comments
increment('PURE_COMMENT'), next LINE if( $inside_multiline_comment );
# C++ style comment at the begining of line (except whitespaces)
increment('PURE_COMMENT'), next LINE if( m~^\s*//~ );
# C style comment at the begining of line (except whitespaces)
if ( m~^\s*/\*~ ) {
$inside_multiline_comment = 1 unless( m~\*/~ );
increment('PURE_COMMENT'), next LINE;
}
# inline comment, don't move to next line here
increment('INLINE_COMMENT') if ( is_inline_comment($_) );
# lLOC implicitly incremented inside is_inline_comment($)
#
increment('LOC') unless( /^\s*$/ );
# standalone braces or parenthesis
next LINE if( /^\s*(?:\{|\}|\(|\))+\s*$/ );
# eLOC is not comments, blanks or standalone braces or parenthesis
# therefore just increment eLOC counter here
increment('ELOC'), next LINE unless( /^\s*$/ );
}
continue {
increment('PHYS');
print " [$.]\n" if $is_deterministic; # $INPUT_LINE_NUMBER
}
}
sub print_loc_metric {
$$c{'comment'} = $$c{'PURE_COMMENT'} + $$c{'INLINE_COMMENT'};
# LOC + Comment Lines + Blank Lines
$$c{'logicline'} = $$c{'LOC'} + $$c{'comment'} + $$c{'BLANK'};
unless (defined $filename) {
die "print_loc_metric(): filename is not defined";
}
my $fn = $filename;
$filename = "", $filename_header = ""
unless($#ARGV);
print STDERR ("ARGV in print_loc_metric:" , join('|',#ARGV), "\n")
if DEBUG;
write STDOUT; # replace with printf
$filename = $fn;
}
sub increment {
my $loc_type = shift;
defined $loc_type
or die 'increment(\$): input argument is undefined';
$counter{$loc_type}++;
$total{$loc_type}++;
print "\t#". $loc_type ."#" if $is_deterministic;
}
sub is_inline_comment {
my $line = shift;
defined $line
or die 'is_inline_comment($): $line is not defined';
print "\n$line" if DEBUG > 10;
# here: line is not empty, not begining both C and C++ comments signs,
# not standalone '{}()', not inside multiline comment,
# ending '\' removed (joined line created if needed)
# Possible cases:
# - no C\C++ comment signs => is_inline_comment = 0
# - C++ comment (no C comment sign)
# * no quote characters => is_inline_comment = 1
# * at least one comment sign is not quoted => is_inline_comment = 1
# * all comment signs are quoted => is_inline_comment = 0
# - C comment (no C++ comment sign)
# * no quote characters => is_inline_comment = 1,
# ~ odd number of '/*' and '*/' => $inside_multiple_comment = 1
# ~ even number => $inside_multiple_comment = 0
# * etc...
# - ...
# algorithm: move along the line from left to right
# rule: quoted comments are not counted
# rule: quoted by distinct style quotes are not counted
# rule: commented quotes are not counted
# rule: commented distinct style comments are not counted
# rule: increment('LLOC') if not-quoted, not-commented
# semi-colon presents in the line except that two
# semi-colon in for() counted as one.
#
$_ = $line; #hack: $_ = $line inside sub
# state
my %s = (
'c' => 0, # c slash star - inside c style comments
'cpp' => 0, # c++ slash slash - inside C++ style comment
'qm' => 0, # quoted mark - inside quoted string
'qqm' => 0, # double quoted - inside double quoted string
);
my $has_comment = 0;
# find state
LOOP:
{
/\G\"/gc && do { # match double quote
unless( $s{'qm'} || $s{'c'} || $s{'cpp'} ) {
# toggle
$s{'qqm'} = $s{'qqm'} ? 0 : 1;
}
redo LOOP;
};
/\G\'/gc && do { # match single quote
unless( $s{'qqm'} || $s{'c'} || $s{'cpp'} ) {
# toggle
$s{'qm'} = $s{'qm'} ? 0 : 1;
}
redo LOOP;
};
m~\G//~gc && do { # match C++ comment sign
unless( $s{'qm'} || $s{'qqm'} || $s{'c'} ) {
# on
$has_comment = 1;
$s{'cpp'} = 1;
}
redo LOOP;
};
m~\G/\*~gc && do { # match begining C comment sign
unless( $s{'qm'} || $s{'qqm'} || $s{'cpp'} ) {
# on
$has_comment = 1;
$s{'c'} = $s{'c'} ? 1 : 1;
}
redo LOOP;
};
m~\G\*/~gc && do { # match ending C comment sign
unless( $s{'qm'} || $s{'qqm'} || $s{'cpp'} ) {
# off
if( $s{'c'} ) {
$s{'c'} = 0;
}
else {
die 'is_inline_comment($): unexpected c style ending comment sign'.
"\n'$line'";
}
}
redo LOOP;
};
/\Gfor\s*\(.*\;.*\;.*\)/gc && do { # match for loop
unless( $s{'qm'} || $s{'qqm'} || $s{'cpp'} || $s{'c'} ) {
# not-commented, not-quoted semi-colon
increment('LLOC');
}
redo LOOP;
};
/\G\;/gc && do { # match semi-colon
unless( $s{'qm'} || $s{'qqm'} || $s{'cpp'} || $s{'c'} ) {
# not-commented, not-quoted semi-colon
# not inside for() loop
increment('LLOC');
}
redo LOOP;
};
/\G./gc && do { # match any other character
# skip 1 character
redo LOOP;
};
/\G$/gc && do { # match end of the line
last LOOP;
};
#default
die 'is_inline_comment($): unexpected character in the line:' .
"\n'$line'";
}
# apply state
$inside_multiline_comment = $s{'c'};
return $has_comment;
}
sub version {
# TODO: version implementation
print <<"VERSION";
NAME v$VERSION
Written by AUTHOR
COPYRIGHT AND LICENSE
VERSION
exit 0;
}
sub invalid_options {
print STDERR (#_ ,"\n");
exit 2;
}
sub get_terminal_size {
my ($wchar, $hchar) = ( -1, -1);
my $win32console = <<'WIN32_CONSOLE';
use Win32::Console;
my $CONSOLE = new Win32::Console();
($wchar, $hchar) = $CONSOLE->MaxWindow();
WIN32_CONSOLE
eval($win32console);
return ($wchar, $hchar) unless( $# );
warnings::warnif($#); # $EVAL_ERROR
my $term_readkey = <<'TERM_READKEY';
use Term::ReadKey;
($wchar,$hchar, $wpixels, $hpixels) = GetTerminalSize();
TERM_READKEY
eval($term_readkey);
return ($wchar, $hchar) unless( $# );
warnings::warnif($#); # $EVAL_ERROR
my $ioctl = <<'IOCTL';
require 'sys/ioctl.ph';
die "no TIOCGWINSZ " unless defined &TIOCGWINSZ;
open(TTY, "+</dev/tty")
or die "No tty: $!";
unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) {
die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n",
&TIOCGWINSZ;
}
($hchar, $wchar, $xpixel, $ypixel) =
unpack('S4', $winsize); # probably $hchar & $wchar should be swapped here
IOCTL
eval($ioctl);
warnings::warnif($#) if $# ; # $EVAL_ERROR
return ($wchar, $hchar);
}
1;
__END__
=head1 NAME
eLOC - Effective Lines of Code Counter
=head1 SYNOPSIS
B<eloc> B<[>OPTIONB<]...> B<[>FILEB<]...>
Print LOC, eLOC, lLOC, comment, blank, newline and logicline counts
for each FILE, and a total line if more than one FILE is specified.
See L</"LOC Specification"> for more info, use `eloc --man'.
-e, --eloc print the {E}LOC counts
-s, --lloc print the lLOC counts (code {S}tatements)
-l, --loc print the {L}OC counts (eLOC + lines of a single brace or parenthesis)
-c, --comment print the {C}omments counts (count lines which contains a comment)
-b, --blank print the {B}lank counts
-n, --newline print the {N}ewline count
-g, --logicline print the lo{G}ical line count (= LOC + Comment Lines + Blank Lines)
--deterministic print the LOC determination for every line in the source file
--header print header line
--help display this help and exit
--man display full help and exit
--version output version information and exit
With no FILE, or when FILE is -, read standard input.
Metrics counted by the program are based on narration from
http://msquaredtechnologies.com/m2rsm/docs/rsm_metrics_narration.htm
=for TODO: Comment Percent = Comment Line Count / Logical Line Count ) x 100
=for TODO: White Space Percentage = (Number of spaces / Number of spaces and characters) * 100
=head1 DESCRIPTION
eLOC is a simple LOC counter. See L</"LOC Specification">.
=head2 LOC Specification
=over 1
=item LOC
Lines Of Code = eLOC + lines of a single brace or parenthesis
=item eLOC
An effective line of code or eLOC is the measurement of all lines that are
not comments, blanks or standalone braces or parenthesis.
This metric more closely represents the quantity of work performed.
RSM introduces eLOC as a metrics standard.
See http://msquaredtechnologies.com/m2rsm/docs/rsm_metrics_narration.htm
=item lLOC
Logical lines of code represent a metrics for those line of code which form
code statements. These statements are terminated with a semi-colon.
The control line for the "for" loop contain two semi-colons but accounts
for only one semi colon.
See http://msquaredtechnologies.com/m2rsm/docs/rsm_metrics_narration.htm
=item comment
comment = pure comment + inline comment
=over
=item pure comment
Comment lines represent a metrics for pure comment line without any code in it.
See L</"inline comment">.
=item inline comment
Inline comment line is a line which contains both LOC line and pure comment.
Inline comment line and pure comment line (see L</"pure comment">)
are mutually exclusive, that is a given physical line cannot be an inline comment
line and a pure comment line simultaneously.
=over
=item Example:
static const int defaultWidth = 400; // value provided in declaration
=back
=back
=item blank
Blank line is a line which contains at most whitespaces.
Blank lines are counted inside comments too.
=item logicline
The logical line count = LOC + Comment Lines + Blank Lines
=back
=head1 KNOWN BUGS AND LIMITATIONS
=over
=item
It supports only C/C++ source files.
=item
Comments inside for(;;) statements are not counted
=over
=item Example:
for(int i = 0; i < N /*comment*/; i++ ); #LLOC# #LLOC# #LOC# #ELOC# #PHYS# [1]
=back
=item
'\'-ending lines are concatinated ( though newline count is valid)
=item
Input from stdin is not supported in the case
the script is envoked solely by name without explicit perl executable.
=item
Wildcards in path with spaces are not supported (like GNU utilities).
=back
=over
=begin fixed
=item Limitation: single source file
Only one source file at time supported
=item Limitation: LLOC is unsupported
The logical lines of code metric is unsupported.
=item missed inline comment for C style comment
#include <math.h> /* comment */ #ELOC# #PHYS# [2]
But must be
#include <math.h> /* comment */ #INLINE_COMMENT# #ELOC# #PHYS# [2]
=item wrong LOC type for the code after '*/'
/* another #PURE_COMMENT# #PHYS# [36]
trick #PURE_COMMENT# #PHYS# [37]
*/ i++; #PURE_COMMENT# #PHYS# [38]
In the last line must be
#INLINE_COMMENT# #PHYS# [38]
=end fixed
=back
=head1 SEE ALSO
Metrics counted by the program are based on narration from L<http://msquaredtechnologies.com/m2rsm/docs/rsm_metrics_narration.htm>
=cut

The following script will get count of all file matching a pattern in a given directory.
# START OF SCRIPT
var str files
var str dir
set $files = "*.cpp" # <===================== Set your file name pattern here.
set $dir = "C:/myproject" # <===================== Set your project directory here.
# Get the list of files in variable fileList.
var str fileList
find -rn files($files) dir($dir) > $fileList
# Declare variables where we will save counts of individual files.
var int c # all lines
var int nb # non-blank lines
# Declare variables where we will save total counts for all files.
var int totalc # sum-total of all lines
var int totalnb # sum-total of all non-blank lines
# Declare variable where we will store file count.
var int fileCount
# We will store the name of the file we are working on currently, in the following.
var str file
# Go thru the $fileList one by one file.
while ($fileList<>"")
do
# Extract the next file.
lex "1" $fileList >$file
# Check if this is a flat file. We are not interested in directories.
af $file >null # We don't want to see the output.
# We only want to set the $ftype variable.
if ($ftype=="f")
do
# Yes, this is a flat file.
# Increment file count.<br>
set $fileCount = $fileCount+1<br>
# Collect the content of $file in $content<br>
var str content # Content of one file at a time<br>
repro $file >$content<br>
# Get count and non-blank count.<br>
set $c={len -e $content}<br>
set $nb={len $content}<br>
echo -e "File: " $file ", Total Count: " $c ", Non-blank Count: " $nb<br>
# Update total counts.<br>
set $totalc = $totalc + $c<br>
set $totalnb = $totalnb + $nb<br>
done
endif
done
Show sum-totals
echo "**********************************************************************************************************************************"
echo "Total Count of all lines:\t" $totalc ",\tTotal Count of non-blank lines:\t" $totalnb ", Total files: " $fileCount
echo "**********************************************************************************************************************************"
# END OF SCRIPT
If you want line counts in files modified in year 2008 only, add ($fmtime >= "2008"), etc.
If you don't have biterscripting, get it from .com .

Not a simple script, but CCCC (C and C++ Code Counter) has been around for a while and it works great for me.

I have a program called scc that strips C comments (and C++ comments, though with C99 they're the same). Apply that plus a filter to remove blank lines and, if so desired, lines containing just open and close braces, to generate the line counts. I've used that on internal projects - not needed to discount open/close braces. Those scripts were more complex, comparing the source code for two different versions of a substantial project stored in ClearCase. They also did statistics on files added and removed, and on lines added and removed from common files, etc.
Not counting braces makes quite a difference:
Black JL: co -q -p scc.c | scc | sed '/^[ ]*$/d' | wc -l
208
Black JL: co -q -p scc.c | scc | sed '/^[ {}]*$/d' | wc -l
144
Black JL: co -p -q scc.c | wc -l
271
Black JL:
So, 144 lines under your rules; 208 counting open and close brace lines; 271 counting everything.
Lemme know if you want the code for scc (send email to first dot last at gmail dot com). It's 13 KB of gzipped tar file including man page, torture test, and some library files.
#litb commented that 'cpp -fpreprocessed -P file' handles stripping of
comments. It mostly does. However, when I run it on the stress test
for SCC, it complains when (in my opinion) it should not:
SCC has been trained to handle 'q' single quotes in most of
the aberrant forms that can be used. '\0', '\', '\'', '\\
n' (a valid variant on '\n'), because the backslash followed
by newline is elided by the token scanning code in CPP before
any other processing occurs.
When the CPP from GCC 4.3.2 processes this, it complains (warns):
SCC has been trained to handle 'q' single quotes in most of
<stdin>:2:56: warning: missing terminating ' character
the aberrant forms that can be used. '\0', '\', '\'', '\\
<stdin>:3:27: warning: missing terminating ' character
n' (a valid variant on '\n'), because the backslash followed
by newline is elided by the token scanning code in CPP before
any other processing occurs.
Section 5.1.1.2 Translation Phases of the C99 standard says:
The precedence among the syntax rules of translation is specified by the following phases.(Footnote 5)
Physical source file multibyte characters are mapped, in an implementation-defined
manner, to the source character set (introducing new-line characters for
end-of-line indicators) if necessary. Trigraph sequences are replaced by
corresponding single-character internal representations.
Each instance of a backslash character () immediately followed by a new-line
character is deleted, splicing physical source lines to form logical source lines.
Only the last backslash on any physical source line shall be eligible for being part
of such a splice. A source file that is not empty shall end in a new-line character,
which shall not be immediately preceded by a backslash character before any such
splicing takes place.
Footnote 5 is:
(5) Implementations shall behave as if these separate phases occur, even
though many are typically folded together in practice.
Consequently, in my view, CPP is mishandling phase two in the example text. Or, at least, the warning is not what I want - the construct is valid C and it is not self-evident that the warning is warranted.
Granted, it is an edge case, and extra warnings are permitted. But it would annoy the living daylights out of me. If I didn't have my own, possibly better tool for the job, then using 'cpp -fpreprocessed -P' would do - it is an extreme edge case that I'm complaining about (and, it might be legitimate to argue that it is more likely that there is a problem than not -- though a better heuristic would observe that the line was spliced and the result was a legitimate single character constant and therefore the complaint should be suppressed; if the result was not a legitimate single character constant, then the complaint should be produced. (On my test case - admittedly a torture test - CPP yields 13 problems, mostly related to the one I'm complaining about, where SCC correctly yields 2.)
(I observe that the '-P' manages to suppress a '#line' directive in the output that appears when the option is omitted.)

Related

Replace/substitute adversarial substring variables in shell script

I have three unescaped adversarial shell variables.
$mystring
$old
$new
Remember, all three strings are adversarial. They will contain special characters. They will contain everything possible to mess up the replace. If there is a loophole in your replace, the strings will exploit it.
What is the simplest function to replace $old with $new in $mystring?
(I couldn't find any solution in stack overflow for a generic substitution that will work in all cases).
There's nothing fancy here -- the only thing you need to do to ensure that your values are treated as literals in a parameter expansion is to ensure that you're quoting the search value, as described in the relevant section of BashFAQ #21:
result=${mystring/"$old"/$new}
Without the double quotes on the inside, $old would be interpreted as a fnmatch-style glob expression; with them, it's literal.
To operate on streams instead, consider gsub_literal, also described in BashFAQ #21:
# usage: gsub_literal STR REP
# replaces all instances of STR with REP. reads from stdin and writes to stdout.
gsub_literal() {
# STR cannot be empty
[[ $1 ]] || return
# string manip needed to escape '\'s, so awk doesn't expand '\n' and such
awk -v str="${1//\\/\\\\}" -v rep="${2//\\/\\\\}" '
# get the length of the search string
BEGIN {
len = length(str);
}
{
# empty the output string
out = "";
# continue looping while the search string is in the line
while (i = index($0, str)) {
# append everything up to the search string, and the replacement string
out = out substr($0, 1, i-1) rep;
# remove everything up to and including the first instance of the
# search string from the line
$0 = substr($0, i + len);
}
# append whatever is left
out = out $0;
print out;
}
'
}
some_command | gsub_literal "$search" "$rep"
...which can also be used for in-place replacement on files using techniques from the following (yet again taken from the previously-linked FAQ):
# Using GNU tools to preseve ownership/group/permissions
gsub_literal "$search" "$rep" < "$file" > tmp &&
chown --reference="$file" tmp &&
chmod --reference="$file" tmp &&
mv -- tmp "$file"

Matching a file line by line

$text_file = '/homedir/report';
open ( $DATA,$text_file ) || die "Error!"; #open the file
#ICC2_array = <$DATA>;
$total_line = scalar#ICC2_array; # total number of lines
#address_array = split('\n',$address[6608]); # The first content is what I want and it is correct, I have checked using print
LABEL2:
for ( $count=0; $count < $total_line; $count++ ) {
if ( grep { $_ eq "$address_array[0]" } $ICC2_array[$count] ) {
print "This address is found!\n";
last LABEL2;
}
elsif ( $count == $total_line - 1 ) { # if not found in all lines
print "No matching is found for this address\n";
last LABEL2;
}
}
I am trying to match the 6609th address in #ICC2_array line by line. I am certain that this address is in $text_file but it is exactly the same format.
Something like this:
$address[6608] contains
Startpoint: port/start/input_output (triggered by clock3)
Endpoint: port/end/input_output (rising edge-triggered)
$address_array[0] contains
Startpoint: port/start/input_output (triggered by clock3)
There's a line in $text_file that is
Startpoint: port/start/input_output (triggered by clock3)
However the output is "no matching found for this address", can anybody point out my mistakes?
All of the elements in #ICC2_array will have new-line characters at the end.
As $address_array[0] is created by splitting data on \n it is guaranteed not to contain a new-line character.
A string that ends in a new-line can never be equal to a string that doesn't contain a new-line.
I suggest replacing:
#ICC2_array = <$DATA>;
With:
chomp(#ICC2_array = <$DATA>);
Update: Another problem I've just spotted. You are incrementing $count twice on each iteration. You increment it in the loop control code ($count++) and you're also incrementing it in the else clause ($count += 1). So you're probably only checking every other element in #ICC2_array.
I think your code should look like this
The any operator from core module List::Util is like grep except that it stops searching as soon as it finds a match, so on average should be twice as fast. Early iterations of List::Util did not contain any, and you can simply use grep instead if that applies to you
I've removed the _array from your array identifier as the # indicates that it's an array and it's just unwanted noise
use List::Util 'any';
my $text_file = '/homedir/report';
my #ICC2 = do {
open my $fh,'<', $text_file or die qq{Unable to open "$text_file" for input: $!};
<$fh>;
};
chomp #ICC2;
my ( $address ) = split /\n/, $address[6608], 2;
if ( any { $_ eq $address } #ICC2 ) {
print "This address is found\n"
}
else {
print "No match is found for this address\n";
}

Perl6: Capturing Windows newline in a string with regex

Disclaimer: I've cross-posted this over at PerlMonks.
In Perl5, I can quickly and easily print out the hex representation of the \r\n Windows-style line ending:
perl -nE '/([\r\n]{1,2})/; print(unpack("H*",$1))' in.txt
0d0a
To create a Windows-ending file on Unix if you want to test, create a in.txt file with a single line and line ending. Then: perl -ni -e 's/\n/\r\n/g;print' in.txt. (or in vi/vim, create the file and just do :set ff=dos).
I have tried many things in Perl6 to do the same thing, but I can't get it to work no matter what I do. Here's my most recent test:
use v6;
use experimental :pack;
my $fn = 'in.txt';
my $fh = open $fn, chomp => False; # I've also tried :bin
for $fh.lines -> $line {
if $line ~~ /(<[\r\n]>**1..2)/ {
$0.Str.encode('UTF-8').unpack("H*").say;
}
}
Outputs 0a, as do:
/(\n)/
/(\v)/
First, I don't even know if I'm using unpack() or the regex properly. Second, how do I capture both elements (\r\n) of the newline in P6?
Perl 6 automatically chomps the line separator off for you. Which means it isn't there when you try to do a substitution.
Perl 6 also creates synthetic characters if there are combining characters. so if you want a base 16 representation of your input, use the encoding 'latin1' or use methods on $*IN that return a Buf.
This example just appends CRLF to the end of every line.
( The last line will always end with 0D 0A even if it didn't have a line terminator )
perl6 -ne 'BEGIN $*IN.encoding("latin1"); #`( basically ASCII )
$_ ~= "\r\n"; #`( append CRLF )
put .ords>>.fmt("%02X");'
You could also turn off the autochomp behaviour.
perl6 -ne 'BEGIN {
$*IN.encoding("latin1");
$*IN.chomp = False;
};
s/\n/\r\n/;
put .ords>>.fmt("%02X");'
Ok, so what my goal was (I'm sorry I didn't make that clear when I posted the question) was I want to read a file, capture the line endings, and write the file back out using the original line endings (and not the endings for the current platform).
I got a proof of concept working now. I'm very new to Perl 6, so the code probably isn't very p6-ish, but it does do what I needed it to.
Code tested on FreeBSD:
use v6;
use experimental :pack;
my $fn = 'in.txt';
my $outfile = 'out.txt';
# write something with a windows line ending to a new file
my $fh = open $fn, :w;
$fh.print("ab\r\ndef\r\n");
$fh.close;
# re-open the file
$fh = open $fn, :bin;
my $eol_found = False;
my Str $recsep = '';
# read one byte at a time, or else we'd have to slurp the whole
# file, as I can't find a way to differentiate EOL from EOF
while $fh.read(1) -> $buf {
my $hex = $buf.unpack("H*");
if $hex ~~ /(0d|0a)/ {
$eol_found = True;
$recsep = $recsep ~ $hex;
next;
}
if $eol_found {
if $hex !~~ /(0d|0a)/ {
last;
}
}
}
$fh.close;
my %recseps = (
'0d0a' => "\r\n",
'0d' => "\r",
'0a' => "\n",
);
my $nl = %recseps<<$recsep>>;
# write a new file with the saved record separator
$fh = open $outfile, :w;
$fh.print('a' ~ $nl);
$fh.close;
# re-read file to see if our newline stuck
$fh = open $outfile, :bin;
my $buf = $fh.read(1000);
say $buf;
Output:
Buf[uint8]:0x<61 0d 0a>

How do I get perl to print n lines following a specific string?

I have a very large file and want to pull out all atom symbols and coordinates for the equilibrium geometry. The desired information is displayed as below:
***** EQUILIBRIUM GEOMETRY LOCATED *****
COORDINATES OF ALL ATOMS ARE (ANGS)
ATOM CHARGE X Y Z
-----------------------------------------------------------
C 6.0 0.8438492825 -2.0554543742 0.8601734285
C 6.0 1.7887997955 -1.2651150894 0.4121141006
N 7.0 1.3006136046 0.0934593194 0.2602148346
NOTE: After the coordinates finish there is a blank line.
I have so-far patched together a code that makes sense to me however it produces errors and I am not sure why.
It expects one file after calling on the script, saves each line and changes to $start==1 when it sees the string containing EQUILIBRIUM GEOMETRY which triggers recording of symbols and coordinates. It continues to save lines that contain the coordinate format until it sees a blank line where it finishes recording into $geom.
#!/usr/bin/perl
$num_args = $#ARGV + 1;
if ($num_args != 1) {
   print "\nMust supply GAMESS .log file.\n";
   exit;
}
$file = $ARGV[0];
open FILE, "<", $file;
$start = 0;
$geom="";
while (<FILE>) {
 $line = $_;
if ( $line eq "\n" && ($start == 1) ) {
   $start = 0; }
 if ( $start == 1 && $line =~ m/\s+[A-Z]+\s+[0-9\.]+\s+[0-9\.\-]+\s+[0-9\.\-]+\s+[0-9\.\-]+/ ) {
$line =~ s/^\s+//;
#coordinates = split(/\s+/,$line);
$geom=$coordinates[0],$coordinates[3],$coordinates[4],$coordinates[5];
 }
 if ( $line =~ m/\s+\*+ EQUILIBRIUM GEOMETRY LOCATED\s\*+\s+) {
   $geom = "";
   $start = 1;
 }
}
print $geom;
Error Message:
Unrecognized character \xC2; marked by <-- HERE after <-- HERE near column 1 at ./perl-grep line 5.
There is an invisible character on line 13
i have created a file with only this line (by cut/paste)
and then add one line above which is my retyping
$geom="";
$geom="";
that looks the same but it is not (the second line is the buggy one)
[tmp]=> cat x | perl -ne '$LINE = $_; $HEX = unpack "H*"; print "$HEX $LINE" '
2467656f6d3d22223b0a $geom="";
2467656f6d3d22223be280a80a $geom="";
you can see there are some more character when you hexamine the file.
So => just remove completely this single line and retype
By the way, there is another issue in your file, you miss to close the regexp '/'
if ( $line =~ m/\s+\*+ EQUILIBRIUM GEOMETRY LOCATED\s\*+\s+) {
but I guess, there are still work to do to finish your script cause i don't see too much the purpose ;)
I copied this over to my Linux box and got the same problem.
Basically, the script is saying that there's an unreadable character at the line:
$geom="";
I re-typed that line in gedit and it ran file.
Also, there's an unclosed regex at the bottom of your script. I add a "/" to the line that reads:
if ( $line =~ m/\s+\*+ EQUILIBRIUM GEOMETRY LOCATED\s\*+\s+) {
OK, first and foremost - strict and warnings are really the first port of call when you're writing a scirpt and having problems. Actually, even before you have problems - switch them on, and adhere to them*.
So as with your code:
$geom="";? - trailing question mark. Should be removed.
$num_args = $#ARGV + 1; - redundant. scalar #ARGV has the same result.
open FILE, "<", $file; - 3 arg open is good. Not using lexical filehandles or checking success is bad.
$line = $_; - redundant. Just use while ( my $line = <FH> ) { instead.
if ( $line =~ m/\s+\*+ EQUILIBRIUM GEOMETRY LOCATED\s\*+\s+) - broken regex, no trailing /.
$geom=$coordinates[0],$coordinates[3],$coordinates[4],$coordinates[5]; - doesn't do what you think. You probably want to join these or concatenate them.
$line eq "\n" - picks up blank lines, but might be better if you chomp; first and eq ''.
$start looks like you're trying to do the same thing as the range operator. http://perldoc.perl.org/perlop.html#Range-Operators
you overwrite $geom as you go. Is that your intention?
$line =~ s/^\s+//; - is redundant given all you do is split. split ' ' does the same thing.
it's good form to close your filehandle after using it. Especially when it's not lexically scoped.
So with that in mind, your code might look bit like this:
#!/usr/bin/perl
use strict;
use warnings;
if ( #ARGV != 1 and not -f $ARGV[0] ) {
print "\nMust supply GAMESS .log file.\n";
exit;
}
open( my $input_fh, "<", $ARGV[0] ) or die $!;
my $geom = "";
while ( my $line = <$input_fh> ) {
chomp $line;
if ( $line =~ m/\s+\*+ EQUILIBRIUM GEOMETRY LOCATED\s\*+\s+/ .. m/^$/ ) {
if ( $line
=~ m/\s+[A-Z]+\s+[0-9\.]+\s+[0-9\.\-]+\s+[0-9\.\-]+\s+[0-9\.\-]+/
)
{
my #coordinates = split( ' ', $line );
$geom = join( "",
$coordinates[0], $coordinates[3],
$coordinates[4], $coordinates[5] );
}
}
}
close($input_fh);
print $geom;
(If you have some sample input, I'll verify it).
* There are occasions you might want to switch them off. If you know what these are and why, then you switch them off. Otherwise just assume they're mandatory.

Perl - Start reading from specific line, and only get first column of it line, until end

I have a text file that looks like the following:
Line 1
Line 2
Line 3
Line 4
Line 5
filename2.tif;Smpl/Pix & Bits/Smpl are missing.
There are 5 lines that are always the same, and on the 6th line is where I want to start reading data. Upon reading data, each line (starting from line 6) is delimited by semicolons. I need to just get the first entry of each line (starting on line 6).
For example:
Line 1
Line 2
Line 3
Line 4
Line 5
filename2.tif;Smpl/Pix & Bits/Smpl are missing.
filename4.tif;Smpl/Pix & Bits/Smpl are missing.
filename6.tif;Smpl/Pix & Bits/Smpl are missing.
filename8.tif;Smpl/Pix & Bits/Smpl are missing.
Output desired would be:
filename2.tif
filename4.tif
filename6.tif
filename8.tif
Is this possible, and if so, where do I begin?
This uses the Perl 'autosplit' (or 'awk') mode:
perl -n -F'/;/' -a -e 'next if $. <= 5; print "$F[0]\n";' < data.file
See 'perlrun' and 'perlvar'.
If you need to do this in a function which is given a file handle and a number of lines to skip, then you won't be using the Perl 'autosplit' mode.
sub skip_N_lines_read_column_1
{
my($fh, $N) = #_;
my $i = 0;
my #files = ();
while (my $line = <$fh>)
{
next if $i++ < $N;
my($file) = split /;/, $line;
push #files, $file;
}
return #files;
}
This initializes a loop, reads lines, skipping the first N of them, then splitting the line and capturing the first result only. That line with my($file) = split... is subtle; the parentheses mean that the split has a list context, so it generates a list of values (rather than a count of values) and assigns the first to the variable. If the parentheses were omitted, you would be providing a scalar context to a list operator, so you'd get the number of fields in the split output assigned to $file - not what you needed. The file name is appended to the end of the array, and the array is returned. Since the code did not open the file handle, it does not close it. An alternative interface would pass the file name (instead of an open file handle) into the function. You'd then open and close the file in the function, worrying about error handling.
And if you need the help with opening the file, etc, then:
use Carp;
sub open_skip_read
{
my($name) = #_;
open my $fh, '<', $name or croak "Failed to open file $name ($!)";
my #list = skip_N_lines_read_column_1($fh, 5);
close $fh or croak "Failed to close file $name ($!)";
return #list;
}
#!/usr/bin/env perl
#
# name_of_program - what the program does as brief one-liner
#
# Your Name <your_email#your_host.TLA>
# Date program written/released
#################################################################
use 5.10.0;
use utf8;
use strict;
use autodie;
use warnings FATAL => "all";
# ⚠ change to agree with your input: ↓
use open ":std" => IN => ":encoding(ISO-8859-1)",
OUT => ":utf8";
# ⚠ change for your output: ↑ — *maybe*, but leaving as UTF-8 is sometimes better
END {close STDOUT}
our $VERSION = 1.0;
$| = 1;
if (#ARGV == 0 && -t STDIN) {
warn "reading stdin from keyboard for want of file args or pipe";
}
while (<>) {
next if 1 .. 5;
my $initial_field = /^([^;]+)/ ? $1 : next;
# ╔═══════════════════════════╗
# ☞ your processing goes here ☜
# ╚═══════════════════════════╝
} continue {
close ARGV if eof;
}
__END__
Kinda ugly but, read out the dummy lines and then split on ; for the rest of them.
my $logfile = '/path/to/logfile.txt';
open(FILE, $logfile) || die "Couldn't open $logfile: $!\n";
for (my $i = 0 ; $i < 5 ; $i++) {
my $dummy = <FILE>;
}
while (<FILE>) {
my (#fields) = split /;/;
print $fields[0], "\n";
}
close(FILE);