Extraire des commentaires d'un fichier C/C++
Posted by mazet on 17 Nov 2009 in Programmation, Perl
Extraction de commentaires d'un fichier C/C++ (toute la puissance du perl)
Code
#!/usr/bin/perl | |
| |
use strict; | |
| |
# default value | |
my $format = "%"; | |
my $pattern = ""; | |
| |
# help message | |
sub usage() { | |
| |
print <<EOF; | |
usage: getcomments [-f string] [-h] [-p regex] file... | |
-f|--format string: format string for output printing [%] | |
-h|--help: help message | |
-p|--pattern regex: pattern matching on block [] | |
| |
Extract C/C++ block of comments | |
| |
Example: getcomments.pl -p='test:\s' -f='./%' random.c | |
EOF | |
| |
exit 1; | |
} | |
| |
usage() if ($#ARGV < 0); | |
| |
# process argument | |
foreach my $arg (@ARGV) { | |
use vars qw/$caif $caip $naif $naip/; | |
| |
# analyse format argument | |
($caif, $_) = ($arg =~ /^(-f|--format)=(.*)/); | |
($caif, $_) = (1, $arg) if ($naif); | |
next if ($naif = ($arg =~ /^(-f|--format)$/)); | |
if ($caif) { $format = $_; next } | |
| |
# check for help message | |
usage() if ($arg =~ /^(-h|--help)$/); | |
| |
# analyse pattern argument | |
($caip, $_) = ($arg =~ /^(-p|--pattern)=(.*)/); | |
($caip, $_) = (1, $arg) if ($naip); | |
next if ($naip = ($arg =~ /^(-p|--pattern)$/)); | |
if ($caip) { $pattern = $_; next } | |
| |
# no more argument, only file | |
my $filename = $arg; | |
| |
# open file | |
if (!open (IN, "<", $filename)) { | |
print "Can not open $filename\n"; | |
} | |
| |
# init table of comments | |
my @comments; | |
$#comments = -1; | |
| |
# read all the file | |
while ($_ .= <IN>) { | |
my $cmt; | |
| |
# process c++ comments | |
($cmt, $_) = m{//\s*(.*?)\s*$()} if (m{//} && !m{/\*.*//}); | |
| |
# process standard c comments | |
($cmt, $_) = m{^.*?/\*\s*(.*?)\s*\*/(.*)}s if (m{/\*.*\*/}s); | |
| |
push(@comments, $cmt) if ($cmt); | |
| |
# empty buffer if no comment is present | |
undef($_) if (!m{/[/*]}); | |
} | |
| |
# close file | |
close (IN); | |
| |
# display comment blocks | |
foreach my $block (@comments) { | |
if (($block) = ($block =~ /$pattern(.*)/s)) { | |
($_ = $format) =~ s/%/$block/gs; | |
print "$_\n"; | |
} | |
} | |
} |
