scripts/readme.pl

   1 # Copyright 2012, INRIA
   2 # Julia Lawall, Gilles Muller
   3 # Copyright 2010-2011, INRIA, University of Copenhagen
   4 # Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   5 # Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   6 # Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   7 # This file is part of Coccinelle.
   8 #
   9 # Coccinelle is free software: you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation, according to version 2 of the License.
  12 #
  13 # Coccinelle is distributed in the hope that it will be useful,
  14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 # GNU General Public License for more details.
  17 #
  18 # You should have received a copy of the GNU General Public License
  19 # along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  20 #
  21 # The authors reserve the right to distribute this or future versions of
  22 # Coccinelle under other licenses.
  23
  24
  25 #!/usr/bin/perl
  26 #
  27 # ARGV: 0 = replacement text, 1 = file w. list of files
  28 #
  29
  30 $debug = 0;
  31 $retain = 1;                    # 1 = retain old status
  32
  33 #----------------------------------------------------------------------
  34 $header = 0;  # 0 = not seen header yet; 1 = seen beginning; 2 = seen end
  35
  36 $currentfile = "";
  37 $currentstatus = "";
  38 $oldstatus = "";
  39 @files = ();
  40
  41 # Get replacement text
  42 $replace = shift;
  43
  44 # Get files of interest
  45 open(FILES,shift);
  46 @files = <FILES>;
  47 close(FILES);
  48
  49 # Remove file name suffixes
  50 foreach $_ (@files) {
  51     s/^([^.]+)\..+$/\1/;
  52     chop;
  53     print "--> added [$_]\n" if $debug;
  54 }
  55
  56 # Process std. input
  57 while(<>) {
  58
  59     # Find an ignore header
  60     if(/^-+$/) {
  61         $header = $header + 1;
  62     }
  63
  64     #
  65     if($header > 1) {
  66
  67         # Filename
  68         if(/^([0-9a-zA-Z_-]+)\.c\s*$/) {
  69             $currentfile = $1;
  70             $currentstatus = "";
  71             print "--> currentfile: [$currentfile]\n" if $debug;
  72         }
  73
  74         # Status code
  75         if(/^(\s+\*\s+)\[status\]([ \t\f]*)(\S*)$/) {
  76             $currentstatus = $3;
  77
  78             print "--> $currentfile [$currentstatus]\n" if $debug;
  79
  80             if(grep {/^$currentfile$/} @files) {
  81                 s/^(\s+\*\s+\[status\])[ \t\f]*(.*)$/\1 $replace/;
  82                 print "==>" if $debug;
  83
  84                 if($retain && ($currentstatus ne "")) {
  85                     $oldstatus = "  * [old-status] $currentstatus\n";
  86                 }
  87             }
  88
  89             $currentfile ="";
  90
  91         }
  92
  93     }
  94
  95     #
  96     print "$_";
  97
  98     if($oldstatus ne "") {
  99         print $oldstatus;
 100         $oldstatus = "";
 101     }
 102
 103 }