Recettes informatiques

#!/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";
    }
  }
}